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.

ZRoseTranslateReduce.Mesa
Last Edited by: Spreitzer, January 25, 1985 2:52:39 pm PST
Κm–

"cedar" style˜Icode™Kš
œ:™:K˜KšΟk	œœn˜Ž
K˜šΠbxœœ
˜"Kšœ
œ*˜?Kšœ˜—K˜Kšœ
œ*˜4K˜šΟnœœ˜*Kš
˜Kšœœ
œ	˜&Kšœœœ
œ	˜NKšœœœœ˜Ošœ
œœ
˜$Kšœ#œ"˜HKšœ-œœ"˜fKšœœ!˜AKšœ!œœ!˜XKšœž
œ˜ΐ
—Kšœ
˜—K˜šŸ
œœ˜+Kš
˜Kšœ
œ˜%Kšœœ
œ	˜&šœœ
˜Kšœœ˜KšœœE˜V—šœœ
˜$Kšœœœ
˜Kšœœ
˜ Kšœœ
˜Kšœ
œ
˜Kšœ
œ
˜Kšœœ
˜Kšœ
œ
˜Kšœœ
˜Kšœœ/œœ˜t—Kš
œ˜K˜Kšœ
˜—K˜šŸœœ˜*Kš
˜Kš
œ˜Kšœœ
œ	˜&šœœ
˜Kš
œ˜KšœœPœ˜}—šœœ
˜$Kš
œ*˜*KšœœHœ˜z—K˜
K˜Kšœ
˜—K˜šŸœœ˜*Kš
˜Kš
œ˜Kšœœ
œ	˜&šœœ
˜Kš
œ˜KšœœPœ˜}—šœœ
˜$Kš
œ1˜1Kš
œ+˜+K˜#Kšœœ6œ˜h—K˜
K˜Kšœ
˜—K˜šŸ	œœ˜'Kš
˜Kšœœ!œ
œ˜FKšœœ
œ	˜&šœœ
˜Kš
œ*˜*K˜$Kšœœbœ˜
—šœœ
˜$Kš
œ˜KšœœAœ˜s—K˜Kšœ
˜—K˜šŸ
œœ˜(Kš
˜Kš
œ˜Kšœœ
œ	˜&šœœ
˜$K˜GKšœœ6œ˜h—šœœ
˜Kšœ%œ(˜QKšœœ&˜HKšœœeœ˜’
—Kš
œ˜Kšœ
˜—K˜šŸœœ˜*Kš
˜K˜Kšœœ
œ	˜&Kšœ:œ
œ
œ	˜Tšœœ
˜$˜š	œœœœ
˜/šœœ
œ
œ
œ
˜0Kšœœœ5œ˜^Kšœ
˜—KšœPœ˜eKšœ
˜—K˜—KšœœTœ˜†
—Kšœ
˜—K˜šŸœœ˜)Kš
˜Kšœœ
œ
˜Kšœœ
œ	˜&šœœ
˜$Kšœ!œ˜5Kšœ+œ˜?Kšœœœœ˜/Kšœœœ˜1Kšœœœ˜1Kšœœœ˜2K˜Kš
œ ˜ K˜Kšœœ3œœ˜€
—šœœ
˜šœœœ
˜2Kšœœ˜/Kšœœ
œ
œX˜pKšœIœœ˜‹
—šœœœ
˜6Kšœœ˜3Kšœœ	œ
œX˜oKšœHœœ˜Š
—š
œ
˜
K˜šœœ
˜Kšœœœ˜6Kšœœ˜8Kšœœ˜7Kšœœ˜8KšœCœœ˜{—K˜—Kšœœ
˜—Kšœ
˜—K˜šŸ
œœ˜(Kš
˜Kšœœœ
˜%Kšœœœ&˜4Kšœœ
œ	˜&šœœ
˜Kšœœ
˜Kšœœ
˜Kšœœ
˜Kšœœ
˜Kšœœ˜,Kšœœ4œ˜a—šœœ
˜$š
œ˜Kšœ
œ
œœ#˜OKš
œ˜Kšœœ
˜*Kš
œ˜Kš
œ˜—Kšœœ˜6Kšœœ˜:Kšœœ˜=Kšœœ˜7šœœ˜.K˜Kšœ
œ
œ
œ
œ
œ˜=Kšœœ˜—Kšœœ4œ˜f—Kšœœ
œ
œO˜qKšœ
˜—K˜šŸœœ˜-Kš
˜Kšœœ
˜Kš
œ˜šœœ
˜šœœœ
œœœ
˜?šœ	œ
˜Kšœœ˜%Kšœœ<œ˜b—Kšœ
˜—Kšœœ˜%KšœWœ˜y—Kšœ
˜—K˜šŸ
œœ˜+Kš
˜Kšœœ
˜Kš
œ˜šœœ
˜šœœœ
œœœ
˜?šœ	œ
˜Kšœœ˜"Kšœœ:œ˜`—Kšœ
˜—Kšœœ˜"KšœUœ˜w—Kšœ
˜—K˜šŸ
œœ˜(Kš
˜Kšœœ
˜Kš
œ˜šœœ
˜šœœœ
œœœ
˜?šœ	œ
˜Kšœœ˜ Kšœœ7œ˜]—Kšœ
˜—Kšœœ˜ KšœRœ˜t—Kšœ
˜—K˜šŸ
œœ˜+Kš
˜Kšœœ
˜Kš
œ˜šœœ
˜šœœœ
œœœ
˜?šœ	œ
˜Kšœœ˜#Kšœœ:œ˜`—Kšœ
˜—Kšœœ˜#KšœUœ˜w—Kšœ
˜—K˜Kšœ
˜K˜—…—'v3=