RoseTranslateReduce.Mesa
Last Edited by: Spreitzer, January 25, 1985 2:52:39 pm PST
DIRECTORY AMTypes, Asserting, IO, OpPrecParse, Rope, RoseTranslateTypes, RoseTranslateInsides, SignalTypeRegistration, TextNode, TiogaStreams;
RoseTranslateReduce:
CEDAR
PROGRAM
IMPORTS Asserting, IO, RoseTranslateTypes, RoseTranslateInsides
EXPORTS RoseTranslateInsides =
BEGIN OPEN RoseTranslateTypes, RoseTranslateInsides;
ReduceSquare:
PUBLIC OpPrecParse.Reducer =
BEGIN
IF ErrCheck[args] THEN RETURN [error];
IF OpsCheck[context, sr, ops, LIST[squareClass, rsClass]] THEN RETURN [error];
IF args.first.arg = omitted THEN reduced ← NEW [SquareBracketedRep ← [sr, NIL]]
ELSE
WITH args.first.arg
SELECT
FROM
iel: InterfaceEltList => reduced ← NEW [SquareBracketedRep ← [sr, iel]];
ie: InterfaceElt => {iel: InterfaceEltList ← LIST[ie]; reduced ← NEW[SquareBracketedRep ← [sr, iel]]};
bl: BindingList => reduced ← NEW [SquareBracketedRep ← [sr, bl]];
b: Binding => {bl: BindingList ← LIST[b]; reduced ← NEW[SquareBracketedRep ← [sr, bl]]};
ENDCASE => reduced ← Complain[sr, context, "Surroundfix square brackets are used only to construct Interfaces or Parameter lists... applying them to %g is garbage", IO.refAny[args.first.arg]];
END;
ReduceBinding:
PUBLIC OpPrecParse.Reducer =
BEGIN
b: Binding ← NEW [BindingRep ← [sr]];
IF ErrCheck[args] THEN RETURN [error];
WITH args.first.arg
SELECT
FROM
x: ID => b.name ← x.rope;
ENDCASE => RETURN [Complain[sr, context, "Can't Bind %g", IO.refAny[args.first.arg]]];
WITH args.rest.first.arg
SELECT
FROM
r: ID => NULL;
x: SignalTypeInvocation => NULL;
x: Application => NULL;
x: CellFn => NULL;
x: Int => NULL;
x: Reel => NULL;
x: Quoted => NULL;
x: CedarExpression => NULL;
ENDCASE => RETURN [Complain[sr, context, "Can't Bind %g to %g", IO.refAny[b.name], IO.refAny[args.rest.first.arg]]];
b.value ← args.rest.first.arg;
reduced ← b;
END;
ReduceArrowD:
PUBLIC OpPrecParse.Reducer =
BEGIN
b: Binding;
IF ErrCheck[args] THEN RETURN [error];
WITH args.first.arg
SELECT
FROM
x: Binding => b ← x;
ENDCASE => RETURN [Complain[sr, context, "Can't Initialize something (%g) other than a Binding", IO.refAny[args.first.arg]]];
WITH args.rest.first.arg
SELECT
FROM
fc: CedarExpression => b.initialData ← fc;
ENDCASE => RETURN [Complain[sr, context, "Must initialize with a Cedar literal, not %g", IO.refAny[args.rest.first.arg]]];
b.sr ← sr;
reduced ← b;
END;
ReduceArrowV:
PUBLIC OpPrecParse.Reducer =
BEGIN
b: Binding;
IF ErrCheck[args] THEN RETURN [error];
WITH args.first.arg
SELECT
FROM
x: Binding => b ← x;
ENDCASE => RETURN [Complain[sr, context, "Can't Initialize something (%g) other than a Binding", IO.refAny[args.first.arg]]];
WITH args.rest.first.arg
SELECT
FROM
q: Quoted => b.initialValue ← CedarFromQuoted[q];
ce: CedarExpression => b.initialValue ← ce;
f: Formatted => b.initialValue ← f;
ENDCASE => RETURN [Complain[sr, context, "Can not initialize with %g", IO.refAny[args.rest.first.arg]]];
b.sr ← sr;
reduced ← b;
END;
ReduceFmt:
PUBLIC OpPrecParse.Reducer =
BEGIN
f: Formatted ← NEW [FormattedRep ← [sr: sr, value: NIL, format: NIL]];
IF ErrCheck[args] THEN RETURN [error];
WITH args.first.arg
SELECT
FROM
q: Quoted => f.value ← CedarFromQuoted[q];
fc: CedarExpression => f.value ← fc;
ENDCASE => RETURN [Complain[sr, context, "Can't format something (%g) other than a rope literal or cedar literal", IO.refAny[args.first.arg]]];
WITH args.rest.first.arg
SELECT
FROM
q: Quoted => f.format ← q;
ENDCASE => RETURN [Complain[sr, context, "Format must be a rope literal, not %g", IO.refAny[args.rest.first.arg]]];
reduced ← f;
END;
ReduceDash:
PUBLIC OpPrecParse.Reducer =
BEGIN
assertion: Asserting.Assertion;
IF ErrCheck[args] THEN RETURN [error];
WITH args.rest.first.arg
SELECT
FROM
ral: RefAnyList => assertion ← Asserting.Cons[ral.l.first, ral.l.rest];
ENDCASE => RETURN [Complain[sr, context, "Must assert a list, not %g", IO.refAny[args.rest.first.arg]]];
WITH args.first.arg
SELECT
FROM
ie: InterfaceElt => {ie.assertions ← CONS[assertion, ie.assertions]; ie.sr ← sr};
b: Binding => {b.assertions ← CONS[assertion, b.assertions]; b.sr ← sr};
ENDCASE => RETURN [Complain[sr, context, "Can't assert on something (%g) other than an Interface Element or Binding", IO.refAny[args.first.arg]]];
reduced ← args.first.arg;
END;
ReduceAssert:
PUBLIC OpPrecParse.Reducer =
BEGIN
sofar: CellDef;
IF ErrCheck[args] THEN RETURN [error];
IF (reduced ← sofar ← Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error];
WITH args.rest.first.arg
SELECT
FROM
ral: RefAnyList => {
FOR ll:
LORA ← ral.l, ll.rest
WHILE ll #
NIL
DO
IF ll.first #
NIL
THEN
WITH ll.first
SELECT
FROM
l: LORA => {sofar.assertions ← CONS[Asserting.Cons[l.first, l.rest], sofar.assertions]; LOOP};
ENDCASE;
Whimper[ral.sr, context, "Assertion list element must be an assertion, not %g", IO.refAny[ll.first]];
ENDLOOP;
};
ENDCASE => RETURN [Complain[args.rest.first.sr, context, "Must assert a list of assertions, not %g", IO.refAny[args.rest.first.arg]]];
END;
ReduceComma:
PUBLIC OpPrecParse.Reducer =
BEGIN
rest: REF ANY;
IF ErrCheck[args] THEN RETURN [error];
WITH args.rest.first.arg
SELECT
FROM
b: Binding => {bl: BindingList ← LIST[b]; rest ← bl};
ie: InterfaceElt => {i: InterfaceEltList ← LIST[ie]; rest ← i};
id: ID => rest ← NEW[ArgsRep ← [sr, LIST[id]]];
q: Quoted => rest ← NEW[ArgsRep ← [sr, LIST[q]]];
ri: Int => rest ← NEW [ArgsRep ← [sr, LIST[ri]]];
rr: Reel => rest ← NEW [ArgsRep ← [sr, LIST[rr]]];
x: BindingList => rest ← x;
x: InterfaceEltList => rest ← x;
x: Args => rest ← x;
ENDCASE => RETURN [Complain[sr, context, "Can't catenate %g to %g", IO.refAny[args.first.arg], IO.refAny[args.rest.first.arg]]];
WITH rest
SELECT
FROM
bl: BindingList =>
WITH args.first.arg
SELECT
FROM
b: Binding => {bl ← CONS[b, bl]; reduced ← bl};
id: ID => {bl ← CONS[NEW[BindingRep ← bl.first^], bl]; bl.first.sr ← sr; bl.first.name ← id.rope; reduced ← bl};
ENDCASE => reduced ← Complain[sr, context, "Cant prepend %g to BindingList %g", IO.refAny[args.first.arg], IO.refAny[args.rest.first.arg]];
i: InterfaceEltList =>
WITH args.first.arg
SELECT
FROM
ie: InterfaceElt => {i ← CONS[ie, i]; reduced ← i};
id: ID => {i ← CONS[NEW[InterfaceEltRep ← i.first^], i]; i.first.sr ← sr; i.first.name ← id.rope; reduced ← i};
ENDCASE => reduced ← Complain[sr, context, "Can't prepend %g to Interface %g", IO.refAny[args.first.arg], IO.refAny[args.rest.first.arg]];
as: Args => {
as.sr ← sr;
WITH args.first.arg
SELECT
FROM
id: ID => {as.args ← CONS[id, as.args]; reduced ← as};
q: Quoted => {as.args ← CONS[q, as.args]; reduced ← as};
ri: Int => {as.args ← CONS[ri, as.args]; reduced ← as};
rr: Reel => {as.args ← CONS[rr, as.args]; reduced ← as};
ENDCASE => reduced ← Complain[sr, context, "Can't prepend %g to Args %g", IO.refAny[args.first.arg], IO.refAny[args.rest]];
};
ENDCASE => ERROR;
END;
ReduceSemi:
PUBLIC OpPrecParse.Reducer =
BEGIN
firstRef, secondRef: BOOLEAN ← FALSE;
a: LORA ← LIST[args.first.arg, args.rest.first.arg];
IF ErrCheck[args] THEN RETURN [error];
WITH args.first.arg
SELECT
FROM
x: Binding => NULL;
y: BindingList => NULL;
cs: CedarChildren => NULL;
cd: CellDef => NULL;
wr: WasRef => {firstRef ← TRUE; a ← a.rest};
ENDCASE => RETURN [Complain[sr, context, "%g not a valid statement", IO.refAny[args.first.arg]]];
WITH args.rest.first.arg
SELECT
FROM
stmts: Statements => {
IF NOT firstRef THEN stmts.statements ← CONS[args.first.arg, stmts.statements];
secondRef ← stmts.hasRefs;
stmts.hasRefs ← stmts.hasRefs OR firstRef;
stmts.sr ← sr;
reduced ← stmts};
x: Binding => reduced ← NEW [StatementsRep ← [sr, a]];
y: BindingList => reduced ← NEW [StatementsRep ← [sr, a]];
fc: CedarChildren => reduced ← NEW [StatementsRep ← [sr, a]];
cd: CellDef => reduced ← NEW [StatementsRep ← [sr, a]];
wr: WasRef => reduced ←
NEW [StatementsRep ← [
sr: sr,
statements: (IF firstRef THEN NIL ELSE LIST[args.first.arg]),
hasRefs: secondRef ← TRUE]];
ENDCASE => RETURN [Complain[sr, context, "%g not a valid statement", IO.refAny[args.rest.first.arg]]];
IF secondRef AND NOT firstRef THEN Whimper[sr, context, "Should have module reference statements before others"];
END;
ReduceDirectory:
PUBLIC OpPrecParse.Reducer =
BEGIN
job: Job ← NARROW[context];
reduced ← wasRef;
WITH args.first.arg
SELECT
FROM
a: Args =>
FOR l:
LIST
OF Arg ← a.args, l.rest
WHILE l #
NIL
DO
WITH l.first
SELECT
FROM
id: ID => AddDirectory[job, id.rope];
ENDCASE => RETURN [Complain[sr, context, "DIRECTORY only takes IDs, not %g", IO.refAny[l.first]]];
ENDLOOP;
id: ID => AddDirectory[job, id.rope];
ENDCASE => reduced ← Complain[sr, context, "DIRECTORY must be given an ID or IDList, not %g", IO.refAny[args.first.arg]];
END;
ReduceImports:
PUBLIC OpPrecParse.Reducer =
BEGIN
job: Job ← NARROW[context];
reduced ← wasRef;
WITH args.first.arg
SELECT
FROM
a: Args =>
FOR l:
LIST
OF Arg ← a.args, l.rest
WHILE l #
NIL
DO
WITH l.first
SELECT
FROM
id: ID => AddImport[job, id.rope];
ENDCASE => RETURN [Complain[sr, context, "IMPORTS only takes IDs, not %g", IO.refAny[l.first]]];
ENDLOOP;
id: ID => AddImport[job, id.rope];
ENDCASE => reduced ← Complain[sr, context, "IMPORTS must be given an ID or IDList, not %g", IO.refAny[args.first.arg]];
END;
ReduceOpen:
PUBLIC OpPrecParse.Reducer =
BEGIN
job: Job ← NARROW[context];
reduced ← wasRef;
WITH args.first.arg
SELECT
FROM
a: Args =>
FOR l:
LIST
OF Arg ← a.args, l.rest
WHILE l #
NIL
DO
WITH l.first
SELECT
FROM
id: ID => AddOpen[job, id.rope];
ENDCASE => RETURN [Complain[sr, context, "OPEN only takes IDs, not %g", IO.refAny[l.first]]];
ENDLOOP;
id: ID => AddOpen[job, id.rope];
ENDCASE => reduced ← Complain[sr, context, "OPEN must be given an ID or IDList, not %g", IO.refAny[args.first.arg]];
END;
ReduceLibrary:
PUBLIC OpPrecParse.Reducer =
BEGIN
job: Job ← NARROW[context];
reduced ← wasRef;
WITH args.first.arg
SELECT
FROM
a: Args =>
FOR l:
LIST
OF Arg ← a.args, l.rest
WHILE l #
NIL
DO
WITH l.first
SELECT
FROM
id: ID => AddSymbols[job, id.rope];
ENDCASE => RETURN [Complain[sr, context, "LIBRARY only takes IDs, not %g", IO.refAny[l.first]]];
ENDLOOP;
id: ID => AddSymbols[job, id.rope];
ENDCASE => reduced ← Complain[sr, context, "LIBRARY must be given an ID or IDList, not %g", IO.refAny[args.first.arg]];
END;
END.