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: CedarLiteral => 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; ReduceArrow: 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.initial _ q; cl: CedarLiteral => b.initial _ cl; ENDCASE => RETURN [Complain[sr, context, "Must initialize with a ROPE or Cedar literal, not %g", IO.refAny[args.rest.first.arg]]]; b.sr _ sr; reduced _ b; 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: CedarSource => 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]]; cs: CedarSource => 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. \RoseTranslateReduce.Mesa Last Edited by: Spreitzer, September 28, 1984 8:18:30 pm PDT Κ <– "cedar" style˜Icode™Kšœ<™