DIRECTORY AMTypes, Basics, Convert, IO, OperatorPrecedenceParse, Process, RedBlackTree, Rope, RoseTranslateTypes, RoseTranslateInsides, SignalTypeRegistration, TextNode, TiogaStreams; RoseTranslateRead: CEDAR PROGRAM IMPORTS Convert, IO, OPP: OperatorPrecedenceParse, Process, RedBlackTree, Rope, RoseTranslateTypes, RoseTranslateInsides, SignalTypeRegistration, TS: TiogaStreams EXPORTS RoseTranslateInsides = BEGIN OPEN RoseTranslateTypes, RoseTranslateInsides; wasRef: PUBLIC WasRef _ NEW [WasRefRep _ ["was module reference"]]; arglikeError, oplikeError: OPP.Token; ops: PUBLIC SymbolTable _ RedBlackTree.Create[GetOpKey, CompareOps]; ltClass, gtClass, eqClass, lambdaClass, returnClass, cellClass, cellEndClass, nameClass, portsProcClass, applyClass, sfClass, isfClass, initializerClass, refClass, recClass, ivClass, testClass, bbClass, stClass, expandClass, portsClass, cedarClass, intfCedarClass, initCTPropsClass, errorClass, noisyErrClass, myArgClass: TokenClass; evalClasses: ARRAY EvalType OF TokenClass; auxClasses: ARRAY AuxClass OF TokenClass; autoName: Op _ NIL; MyBreak: PUBLIC IO.BreakProc = {RETURN [SELECT char FROM IN ['a..'z], IN ['A .. 'Z], IN ['0 .. '9] => other, IO.SP, IO.CR, IO.TAB, IO.LF, IO.FF => sepr, ENDCASE => break]}; ErrCheck: PUBLIC PROC [args: OPP.ArgList] RETURNS [errFound: BOOLEAN] = BEGIN WHILE args # NIL DO IF args.first.arg = error THEN RETURN [TRUE]; args _ args.rest; ENDLOOP; errFound _ FALSE; END; OpsCheck: PUBLIC PROC [context: REF ANY, sr: SourceRange, ops: OPP.TokenList, classes: TokenClassList] RETURNS [err: BOOL] = BEGIN err _ FALSE; WHILE (ops # NIL) AND (classes # NIL) AND NOT err DO IF ops.first.class # classes.first THEN {err _ TRUE; EXIT}; ops _ ops.rest; classes _ classes.rest; ENDLOOP; IF (ops # NIL) # (classes # NIL) THEN err _ TRUE; IF (ops = NIL) AND (classes # NIL) THEN { Whimper[sr, context, SELECT classes.first FROM returnClass => "missing RETURN", rsClass => "missing right square-bracket", cellEndClass => "missing EndCellType", ENDCASE => "mismatched LAMBDA - RETURN, [ - ], or CellType - EndCellType"]; RETURN}; IF err THEN Whimper[sr, context, "mismatched LAMBDA - RETURN, [ - ], or CellType - EndCellType"]; END; ReduceNoisily: PUBLIC OPP.Reducer = BEGIN reduced _ Complain[sr, context, "Missing op before %g", IO.refAny[args.rest.first.arg]]; END; SimplerReduce: PUBLIC OPP.Reducer = {reduced _ args.first.arg}; ReduceError: PUBLIC OPP.Reducer = {reduced _ error}; ReduceIntfCedar: PUBLIC OPP.Reducer = { IF ErrCheck[args] THEN RETURN [error]; reduced _ NEW [InterfaceCedarRep _ [NARROW[args.first.arg]]]; }; ReduceIntElt: PUBLIC OPP.Reducer = BEGIN ie: InterfaceElt _ NEW [InterfaceEltRep _ []]; nodeType: REF ANY; IF ErrCheck[args] THEN RETURN [error]; SELECT ops.first.class FROM ltClass => ie.input _ NOT (ie.output _ FALSE); gtClass => ie.input _ NOT (ie.output _ TRUE); eqClass => ie.input _ ie.output _ TRUE; ENDCASE => ERROR; WITH args.first.arg SELECT FROM id: ID => ie.name _ id.rope; ENDCASE => RETURN [Complain[sr, context, "An Interface Element must be identified by an ID, not %g", IO.refAny[args.first.arg]]]; IF (nodeType _ args.rest.first.arg) = omitted THEN { IF SignalTypeRegistration.defaultNodeType = NIL THEN RETURN [Complain[sr, context, "No default NodeType"]]; nodeType _ NEW [IDRep _ [sr, SignalTypeRegistration.defaultNodeType]]}; WITH nodeType SELECT FROM sti: SignalTypeInvocation => ie.sti _ sti; id: ID => IF (ie.sti _ InstantiateSignalType[context, id.rope, NIL]) = NIL THEN RETURN [error]; ENDCASE => RETURN [Complain[sr, context, "An Interface Element must use a Signal Type, not %g", IO.refAny[nodeType]]]; ie.sr _ sr; reduced _ ie; END; ReduceLambda: PUBLIC OPP.Reducer = BEGIN cf: CellFn _ NEW [CellFnRep _ []]; ok: BOOL _ TRUE; IF ErrCheck[args] THEN RETURN [error]; IF OpsCheck[context, sr, ops, LIST[lambdaClass, returnClass]] THEN RETURN [error]; WITH args.first.arg SELECT FROM sb: SquareBracketed => WITH sb.subject SELECT FROM bl: BindingList => cf.args _ bl; ENDCASE => ok _ FALSE; ENDCASE => ok _ FALSE; IF NOT ok THEN RETURN [Complain[sr, context, "LAMBDA must be given parameters, not %g", IO.refAny[args.first.arg]]]; WITH args.rest.first.arg SELECT FROM cd: CellDef => cf.cd _ cd; ENDCASE => ok _ FALSE; IF NOT ok THEN RETURN [Complain[sr, context, "I can only construct functions that return cell types, not %g", IO.refAny[args.rest.first.arg]]]; cf.cd.forFn _ cf; cf.sr _ sr; reduced _ cf; END; CedarExpressionRope: PUBLIC PROC [fc: CedarExpression] RETURNS [r: ROPE] = {r _ fc.rope}; CedarFromRope: PUBLIC PROC [r: ROPE, sr: SourceRange _ nullSR] RETURNS [fc: CedarExpression] = { fc _ NEW [CedarExpressionRep _ [sr, internal, r]]; }; CedarFromID: PUBLIC PROC [id: ID] RETURNS [fc: CedarExpression] = {fc _ NEW [CedarExpressionRep _ [sr: id.sr, kind: id, rope: id.rope]]}; CedarFromQuoted: PUBLIC PROC [q: Quoted] RETURNS [fc: CedarExpression] = {fc _ NEW [CedarExpressionRep _ [sr: q.sr, kind: ropeLiteral, rope: Convert.RopeFromRope[q.rope]]]}; Sofar: PUBLIC PROC [sr: SourceRange, context, org: REF ANY] RETURNS [cd: CellDef] = BEGIN IF org = autoName THEN cd _ NEW [CellDefRep _ [sr: sr, nameIsLiteral: FALSE, nameSource: NIL]] ELSE WITH org SELECT FROM q: Quoted => { cd _ NEW [CellDefRep _ [sr: sr, literalName: q.rope, nameIsLiteral: TRUE]]; }; cellDef: CellDef => {cd _ cellDef; cd.sr _ sr}; ENDCASE => { [] _ Complain[sr, context, "Bad Cell header: %g", IO.refAny[org]]; cd _ NIL; }; END; InsistOnCedarChildren: PUBLIC PROC [context: REF ANY, sofar: REF ANY, args: OPP.ArgList] RETURNS [cs: CedarChildren, reduced: REF ANY] = BEGIN WITH args.rest.first.arg SELECT FROM cedar: CedarChildren => {cs _ cedar; reduced _ sofar}; ENDCASE => {cs _ NIL; reduced _ Complain[nullSR, context, "Internal Error"]}; END; AuxKnown: PUBLIC PROC [name: ROPE, cellDef: CellDef, auxClass: AuxClass, auxVal: AuxVal] RETURNS [known: BOOL] = {known _ GetAux[name, cellDef, auxClass, auxVal] # NIL}; AuxSpecd: PUBLIC PROC [name: ROPE, cellDef: CellDef, auxClass: AuxClass, auxVal: AuxVal] RETURNS [given: BOOL] = { SELECT auxClass FROM State => IF cellDef.sfSource # NIL THEN RETURN [TRUE]; SwitchIO, SimpleIO, Drive => IF cellDef.interfaceLiteral # NIL AND cellDef.interfaceLiteral.asList # NIL THEN RETURN [TRUE]; ENDCASE => ERROR; given _ cellDef.auxes[auxClass][auxVal] # NIL; }; GetAux: PUBLIC PROC [name: ROPE, cellDef: CellDef, auxClass: AuxClass, auxVal: AuxVal] RETURNS [aux: ROPE] = { SELECT auxClass FROM State => IF cellDef.sfSource # NIL THEN RETURN [SELECT auxVal FROM Ref => IO.PutFR["%gStateRef", IO.rope[name]], Rec => IO.PutFR["%gStateRec", IO.rope[name]], Val => IO.PutFR["NEW[%gStateRec%g]", IO.rope[name], IO.rope[IF cellDef.stateInittable THEN " _ []" ELSE ""]], ENDCASE => ERROR]; SwitchIO, SimpleIO, Drive => IF cellDef.interfaceLiteral # NIL AND cellDef.interfaceLiteral.asList # NIL THEN RETURN [SELECT auxVal FROM Ref => IO.PutFR["%g%gRef", IO.rope[name], IO.rope[auxClassNames[auxClass]]], Rec => IO.PutFR["%g%gRec", IO.rope[name], IO.rope[auxClassNames[auxClass]]], Val => IO.PutFR["NEW[%g%gRec]", IO.rope[name], IO.rope[auxClassNames[auxClass]]], ENDCASE => ERROR]; ENDCASE => ERROR; RETURN [SELECT auxVal FROM Val => IF cellDef.auxes[auxClass][Val] # NIL THEN CedarExpressionRope[cellDef.auxes[auxClass][Val]] ELSE IF cellDef.auxes[auxClass][Rec] # NIL THEN Rope.Cat["NEW[", CedarExpressionRope[cellDef.auxes[auxClass][Rec]], "]"] ELSE NIL, Rec => IF cellDef.auxes[auxClass][Rec] # NIL THEN CedarExpressionRope[cellDef.auxes[auxClass][Rec]] ELSE NIL, Ref => IF cellDef.auxes[auxClass][Ref] # NIL THEN CedarExpressionRope[cellDef.auxes[auxClass][Ref]] ELSE IF cellDef.auxes[auxClass][Rec] # NIL THEN Rope.Cat["REF ", CedarExpressionRope[cellDef.auxes[auxClass][Rec]] ] ELSE NIL, ENDCASE => ERROR]; }; ReduceName: PUBLIC OPP.Reducer = BEGIN IF ErrCheck[args] THEN RETURN [error]; WITH args.first.arg SELECT FROM cs: CedarChildren => reduced _ NEW [CellDefRep _ [sr: sr, nameIsLiteral: FALSE, nameSource: cs ]]; ENDCASE => RETURN [Complain[sr, context, "Internal Error"]]; END; ReduceCell: PUBLIC OPP.Reducer = BEGIN sofar: CellDef; IF ErrCheck[args] THEN RETURN [error]; IF OpsCheck[context, sr, ops, LIST[cellClass, cellEndClass]] THEN RETURN [error]; IF (reduced _ sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error]; IF sofar.interfaceLiteral = NIL AND sofar.interfaceSource = NIL THEN sofar.interfaceLiteral _ DigestInterface[context, NIL]; END; ReducePortsProc: PUBLIC OPP.Reducer = BEGIN sofar: CellDef; IF ErrCheck[args] THEN RETURN [error]; IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error]; IF sofar.interfaceSource # NIL THEN Whimper[sr, context, "Redefining PortsProc"]; [sofar.interfaceSource, reduced] _ InsistOnCedarChildren[context, sofar, args]; END; ReduceApply: PUBLIC OPP.Reducer = BEGIN cf: CellFn; IF ErrCheck[args] THEN RETURN [error]; WITH args.first.arg SELECT FROM cellFn: CellFn => cf _ cellFn; ENDCASE => RETURN [Complain[sr, context, "HowToApply tacked onto %g, should have been a Cell Type Function", IO.refAny[args.first.arg]]]; IF cf.howToApply # NIL THEN Whimper[sr, context, "Redefining how to Apply"]; cf.sr _ sr; [cf.howToApply, reduced] _ InsistOnCedarChildren[context, cf, args]; END; ReduceStateFields: PUBLIC OPP.Reducer = BEGIN sofar: CellDef; IF ErrCheck[args] THEN RETURN [error]; IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error]; IF AuxSpecd[NIL, sofar, State, Rec] THEN Whimper[sr, context, "Redefining State Record Type"]; [sofar.sfSource, reduced] _ InsistOnCedarChildren[context, sofar, args]; sofar.stateInittable _ FALSE; END; ReduceInitStateFields: PUBLIC OPP.Reducer = BEGIN sofar: CellDef; IF ErrCheck[args] THEN RETURN [error]; IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error]; IF AuxSpecd[NIL, sofar, State, Rec] THEN Whimper[sr, context, "Redefining State Record Type"]; [sofar.sfSource, reduced] _ InsistOnCedarChildren[context, sofar, args]; sofar.stateInittable _ TRUE; END; ReducePorts: PUBLIC OPP.Reducer = BEGIN sofar: CellDef; IF ErrCheck[args] THEN RETURN [error]; IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error]; WITH args.rest.first.arg SELECT FROM sb: SquareBracketed => { IF NOT ISTYPE[sb.subject, InterfaceEltList] THEN RETURN [Complain[sr, context, "PORTS must be given a square bracketed interface element list, not %g", IO.refAny[args.rest.first.arg]]]; sofar.interfaceLiteral _ DigestInterface[context, NARROW[sb.subject]] } ENDCASE => reduced _ Complain[sr, context, "PORTS must be given a square bracketed interface element list, not %g", IO.refAny[args.rest.first.arg]]; reduced _ sofar; END; ReduceExpand: PUBLIC OPP.Reducer = BEGIN sofar: CellDef; IF ErrCheck[args] THEN RETURN [error]; IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error]; IF sofar.expandCode # NIL THEN Whimper[sr, context, "Redefining Expand Proc"]; reduced _ sofar; WITH args.rest.first.arg SELECT FROM s: Statements => sofar.expandCode _ s; cs: CedarChildren => sofar.expandCode _ NEW [StatementsRep _ [sr, LIST[cs]]]; bl: BindingList => sofar.expandCode _ NEW [StatementsRep _ [sr, LIST[bl]]]; b: Binding => sofar.expandCode _ NEW [StatementsRep _ [sr, LIST[b]]]; ENDCASE => reduced _ Complain[sr, context, "EXPAND must be given a statement or statement list, not %g", IO.refAny[args.rest.first.arg]]; END; ReduceInitializer: PUBLIC OPP.Reducer = BEGIN sofar: CellDef; IF ErrCheck[args] THEN RETURN [error]; IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error]; IF sofar.initializerSource # NIL THEN Whimper[sr, context, "Redefining Initializer"]; [sofar.initializerSource, reduced] _ InsistOnCedarChildren[context, sofar, args]; END; ReduceEval: PUBLIC OPP.Reducer = BEGIN sofar: CellDef; type: EvalType _ ToEvalType[ops.first.class]; IF ErrCheck[args] THEN RETURN [error]; IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error]; IF sofar.evals[type] # NIL THEN Whimper[sr, context, "Redefining %g Proc", IO.rope[etNames[type]]]; [sofar.evals[type], reduced] _ InsistOnCedarChildren[context, sofar, args]; END; ToEvalType: PROC [class: TokenClass] RETURNS [et: EvalType] = BEGIN FOR et IN EvalType DO IF evalClasses[et] = class THEN RETURN ENDLOOP; ERROR; END; ReduceTest: PUBLIC OPP.Reducer = BEGIN sofar: CellDef; IF ErrCheck[args] THEN RETURN [error]; IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error]; reduced _ sofar; WITH args.rest.first.arg SELECT FROM tn: TestNote => sofar.tests _ CONS[tn, sofar.tests]; ENDCASE => reduced _ Complain[sr, context, "Confusion after Test (got %g)", IO.refAny[args.rest.first.arg]]; END; ReduceTestClass: PUBLIC OPP.Reducer = BEGIN tn: TestNote _ NEW [TestNoteRep _ [sr: sr, name: NIL, code: NIL, stateToo: FALSE]]; IF ErrCheck[args] THEN RETURN [error]; reduced _ tn; WITH args.first.arg SELECT FROM id: ID => tn.name _ id.rope; ENDCASE => RETURN [Complain[sr, context, "BLACKBOX or STATETOO should be proceeded with an ID, not %g", IO.refAny[args.first.arg]]]; WITH args.rest.first.arg SELECT FROM cs: CedarChildren => tn.code _ cs; ENDCASE => RETURN [Complain[sr, context, "BLACKBOX or STATETOO should be followed by cedar children, not %g", IO.refAny[args.rest.first.arg]]]; SELECT ops.first.class FROM bbClass => tn.stateToo _ FALSE; stClass => tn.stateToo _ TRUE; ENDCASE => ERROR; END; ReduceAuxClass: PUBLIC OPP.Reducer = BEGIN sofar: CellDef; auxClass: AuxClass; auxed: Auxed; IF ErrCheck[args] THEN RETURN [error]; IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error]; FOR ac: AuxClass IN AuxClass DO IF ops.first.class = auxClasses[ac] THEN {auxClass _ ac; EXIT}; REPEAT FINISHED => ERROR; ENDLOOP; WITH args.rest.first.arg SELECT FROM a: Auxed => auxed _ a; ENDCASE => RETURN[Complain[sr, context, "Confusion after SwitchAux or SimpleAux or StateAux or DriveAux (got %g)", IO.refAny[args.rest.first.arg]]]; IF AuxSpecd[NIL, sofar, auxClass, auxed.val] THEN Whimper[sr, context, "Redefining %g %g", IO.rope[auxClassNames[auxClass]], IO.rope[auxValNames[auxed.val]]]; sofar.auxes[auxClass][auxed.val] _ auxed.subject; reduced _ sofar; END; ReduceAuxVal: PUBLIC OPP.Reducer = BEGIN auxed: Auxed _ NEW [AuxedRep _ [sr: sr, val: , subject: NIL]]; IF ErrCheck[args] THEN RETURN [error]; WITH args.first.arg SELECT FROM id: ID => auxed.subject _ CedarFromID[id]; q: Quoted => auxed.subject _ CedarFromQuoted[q]; fc: CedarExpression => auxed.subject _ fc; ENDCASE => RETURN[Complain[sr, context, "REFTYPE or RECTYPE or INITIALVALUE given %g, instead of an ID or CedarLiteral", IO.refAny[args.first.arg]]]; SELECT ops.first.class FROM refClass => auxed.val _ Ref; recClass => auxed.val _ Rec; ivClass => auxed.val _ Val; ENDCASE => ERROR; reduced _ auxed; END; ReduceInitCTProps: PUBLIC OPP.Reducer = BEGIN sofar: CellDef; IF ErrCheck[args] THEN RETURN [error]; IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error]; IF sofar.initCTPropsSource # NIL THEN Whimper[args.rest.first.sr, context, "Redefining Initial Props Proc"]; [sofar.initCTPropsSource, reduced] _ InsistOnCedarChildren[context, sofar, args]; END; GetOpKey: PUBLIC PROC [data: REF ANY] RETURNS [key: ROPE] --RedBlackTree.GetKey-- = {op: Op _ NARROW[data]; key _ op.name}; CompareOps: PUBLIC PROC [k, data: REF ANY] RETURNS [c: Basics.Comparison] --RedBlackTree.Compare-- = BEGIN s1: ROPE _ NARROW[k]; s2: ROPE _ GetOpKey[data]; c _ s1.Compare[s2, FALSE]; END; ParseExpression: PUBLIC PROC [job: Job] RETURNS [expr: REF ANY] = BEGIN GetToken: PROC [context: REF ANY, expectingArg: BOOLEAN] RETURNS [token: OPP.Token] --OPP.TokenProc-- = BEGIN asRope: ROPE; op: Op; peek: CHAR; startIdx: INT; GetSR: PROC RETURNS [sr: SourceRange] = { next: INT _ job.from.GetIndex[]; sr _ [startIdx, next-1]}; HandleNumber: PROC [sgn: INT] RETURNS [OPP.Token] = BEGIN tokenKind: IO.TokenKind; token: ROPE; [tokenKind, token, ] _ job.from.GetCedarTokenRope[]; SELECT tokenKind FROM tokenREAL => RETURN [[GetSR[], myArgClass, NEW [ReelRep _ [GetSR[], Convert.RealFromLiteral[token]*sgn]]]]; tokenDECIMAL, tokenOCTAL, tokenHEX => RETURN [[ GetSR[], myArgClass, NEW [IntRep _ [ GetSR[], sgn*Convert.CardFromWholeNumberLiteral[token]]]]]; ENDCASE => ERROR; END; WHILE TRUE DO Process.CheckForAbort[]; IF useOld THEN {useOld _ FALSE; RETURN [[oldSR, myArgClass, old]]}; [] _ job.from.SkipWhitespace[flushComments: FALSE]; startIdx _ job.from.GetIndex[]; IF job.from.EndOf[] THEN RETURN [OPP.end]; job.tokenCount _ job.tokenCount + 1; peek _ job.from.PeekChar[]; IF peek = '" THEN BEGIN asAny: REF ANY; asRope: ROPE; asAny _ IO.GetRefAny[job.from !IO.Error, IO.EndOfStream => { Whimper[GetSR[], job, "Syntax error in quoted string"]; asAny _ error; CONTINUE}]; IF asAny = error THEN RETURN [IF expectingArg THEN arglikeError ELSE oplikeError]; asRope _ NARROW[asAny]; RETURN [[GetSR[], myArgClass, NEW [QuotedRep _ [GetSR[], asRope]] ]]; END; IF peek = '| THEN BEGIN cedar: ROPE _ NIL; IF job.from.GetChar[] # '| THEN ERROR; WHILE NOT job.from.EndOf[] DO char: CHAR _ job.from.GetChar[]; IF char = '| THEN BEGIN IF job.from.PeekChar[] # '| THEN EXIT ELSE [] _ job.from.GetChar[]; END; cedar _ cedar.Concat[Rope.FromChar[char]]; ENDLOOP; RETURN [[GetSR[], myArgClass, NEW [CedarExpressionRep _ [GetSR[], cedarLiteral, cedar]] ]]; END; IF peek = '( THEN BEGIN asAny: REF ANY; asAny _ IO.GetRefAny[job.from !IO.Error, IO.EndOfStream => { Whimper[GetSR[], job, "Syntax error in list"]; asAny _ error; CONTINUE}]; IF asAny = error THEN RETURN [IF expectingArg THEN arglikeError ELSE oplikeError]; RETURN [[GetSR[], myArgClass, NEW [RefAnyListRep _ [GetSR[], NARROW[asAny]]] ]]; END; IF peek IN ['0 .. '9] THEN RETURN [HandleNumber[1]]; IF peek = '$ THEN { err: BOOL _ FALSE; IF job.from.GetChar[] # '$ THEN ERROR; asRope _ job.from.GetRopeLiteral[ !IO.Error, IO.EndOfStream => { Whimper[GetSR[], job, "should have quoted string following dollar sign"]; err _ TRUE; CONTINUE}]; IF err THEN RETURN [IF expectingArg THEN arglikeError ELSE oplikeError]; RETURN [[GetSR[], myArgClass, NEW [IDRep _ [GetSR[], asRope]] ]]; }; IF peek = '_ THEN { IF job.from.GetChar[] # '_ THEN ERROR; asRope _ "_"; SELECT job.from.PeekChar[] FROM IN ['a .. 'z], IN ['A .. 'Z] => asRope _ asRope.Cat[Rope.FromChar[job.from.GetChar[]]]; ENDCASE; } ELSE IF peek = '- THEN BEGIN IF job.from.GetChar[] # '- THEN ERROR; IF (peek _ job.from.PeekChar[]) = '- THEN BEGIN IF job.from.GetChar[] # '- THEN ERROR; WHILE NOT job.from.EndOf[] DO char: CHAR _ job.from.GetChar[]; IF char = '\n THEN EXIT; IF char = '- THEN BEGIN char _ job.from.GetChar[]; IF char = '- OR char = '\n THEN EXIT; END; ENDLOOP; LOOP; END ELSE IF peek IN ['0 .. '9] THEN RETURN [HandleNumber[-1]] ELSE asRope _ "-"; END ELSE IF peek = '. THEN { IF job.from.GetChar[] # '. THEN ERROR; IF (peek _ job.from.PeekChar[]) = '. THEN { IF job.from.GetChar[] # '. THEN ERROR; asRope _ ".."; } ELSE asRope _ "."; } ELSE asRope _ job.from.GetTokenRope[MyBreak].token; op _ NARROW[ops.Lookup[asRope]]; IF op = NIL THEN RETURN [[GetSR[], myArgClass, NEW [IDRep _ [GetSR[], asRope]] ]]; IF op.eatsCedar THEN BEGIN parent: TextNode.Ref _ TS.CurInNode[job.from]; TS.SkipChildren[job.from]; useOld _ TRUE; oldSR _ GetSR[]; old _ NEW [CedarChildrenRep _ [GetSR[], parent]]; END; IF op.class[expectingArg] = NIL THEN BEGIN job.log.PutF["Syntax error at %g: %g not allowed\n", IO.int[job.from.GetIndex[]], IO.rope[asRope]]; job.errCount _ job.errCount + 1; RETURN [IF expectingArg THEN arglikeError ELSE oplikeError]; END; RETURN [[GetSR[], op.class[expectingArg], op]]; ENDLOOP; END; useOld: BOOLEAN _ FALSE; oldSR: SourceRange; old: REF ANY _ NIL; [] _ job.from.GetIndex[]; [[, expr]] _ OPP.Parse[job, GetToken !OPP.CantReduce, OPP.CantFix, OPP.DoesntFix, OPP.TerminateErr, OPP.LastReduceErr, OPP.InvalidToken => BEGIN job.log.PutF["Congratulations! You trashed the parser (somewhere before %g)... You lose!\n", IO.int[job.from.GetIndex[]]]; job.errCount _ job.errCount + 1; expr _ NIL; CONTINUE; END]; END; Setup: PROC = BEGIN Add: PROC [op: Op] = {ops.Insert[op, op.name]}; noisyErrClass _ NEW[TokenClassRep _ [2000, 3000, ReduceNoisily]]; myArgClass _ NEW[TokenClassRep _ [000, 000, NIL, [nullSR, noisyErrClass, NIL]]]; ltClass _ NEW[TokenClassRep _ [510, 500, ReduceIntElt]]; gtClass _ NEW[TokenClassRep _ [510, 500, ReduceIntElt]]; eqClass _ NEW[TokenClassRep _ [510, 500, ReduceIntElt]]; cedarClass _ NEW[TokenClassRep _ [000, 10000, SimplerReduce]]; intfCedarClass _ NEW[TokenClassRep _ [000, 10000, ReduceIntfCedar]]; nameClass _ NEW[TokenClassRep _ [000, 10000, ReduceName]]; errorClass _ NEW[TokenClassRep _ [250, 250, ReduceError]]; lambdaClass _ NEW[TokenClassRep _ [000, 150, ReduceLambda]]; returnClass _ NEW[TokenClassRep _ [150, 1000, NIL]]; portsProcClass_ NEW[TokenClassRep _ [080, 090, ReducePortsProc]]; applyClass _ NEW[TokenClassRep _ [810, 090, ReduceApply]]; sfClass _ NEW[TokenClassRep _ [080, 090, ReduceStateFields]]; isfClass _ NEW[TokenClassRep _ [080, 090, ReduceInitStateFields]]; initializerClass _ NEW[TokenClassRep _ [080, 090, ReduceInitializer]]; testClass _ NEW[TokenClassRep _ [080, 090, ReduceTest]]; bbClass _ NEW[TokenClassRep _ [110, 100, ReduceTestClass]]; stClass _ NEW[TokenClassRep _ [110, 100, ReduceTestClass]]; refClass _ NEW[TokenClassRep _ [000, 100, ReduceAuxVal]]; recClass _ NEW[TokenClassRep _ [000, 100, ReduceAuxVal]]; ivClass _ NEW[TokenClassRep _ [000, 100, ReduceAuxVal]]; initCTPropsClass_ NEW[TokenClassRep_ [080, 090, ReduceInitCTProps]]; expandClass _ NEW[TokenClassRep _ [080, 090, ReduceExpand]]; portsClass _ NEW[TokenClassRep _ [080, 090, ReducePorts]]; cellClass _ NEW[TokenClassRep _ [000, 010, ReduceCell]]; cellEndClass_ NEW[TokenClassRep _ [010, 000]]; FOR et: EvalType IN EvalType DO evalClasses[et] _ NEW[TokenClassRep _ [80, 90, ReduceEval]]; Add[NEW[OpRep _ [etNames[et], [evalClasses[et], NIL], TRUE]]]; ENDLOOP; FOR ac: AuxClass IN AuxClass DO auxClasses[ac] _ NEW [TokenClassRep _ [80, 90, ReduceAuxClass]]; Add[NEW[OpRep _ [auxClassNames[ac].Cat["Aux"], [auxClasses[ac], NIL]]]]; ENDLOOP; Add[NEW[OpRep _ ["<", [ltClass, NIL]]]]; Add[NEW[OpRep _ [">", [gtClass, NIL]]]]; Add[NEW[OpRep _ ["=", [eqClass, NIL]]]]; Add[NEW[OpRep _ ["LAMBDA", [NIL, lambdaClass]]]]; Add[NEW[OpRep _ ["RETURN", [returnClass, NIL]]]]; Add[NEW[OpRep _ ["CELLTYPE", [NIL, cellClass]]]]; Add[NEW[OpRep _ ["EndCellType", [cellEndClass, NIL]]]]; Add[NEW[OpRep _ ["PORTS", [portsClass, NIL]]]]; Add[NEW[OpRep _ ["PortsProc", [portsProcClass, NIL], TRUE]]]; Add[NEW[OpRep _ ["ApplyCode",[applyClass, NIL], TRUE]]]; Add[NEW[OpRep _ ["State", [sfClass, NIL], TRUE]]]; Add[NEW[OpRep _ ["InittableState", [isfClass, NIL], TRUE]]]; Add[NEW[OpRep _ ["Initializer", [initializerClass, NIL], TRUE]]]; Add[NEW[OpRep _ ["Expand", [expandClass, NIL]]]]; Add[NEW[OpRep _ ["CEDAR", [NIL, cedarClass], TRUE]]]; Add[NEW[OpRep _ ["InterfaceCedar", [NIL, intfCedarClass], TRUE]]]; Add[NEW[OpRep _ ["NameMaker",[NIL, nameClass], TRUE]]]; Add[autoName_NEW[OpRep _ ["AutoName",[NIL, myArgClass]]]]; Add[NEW[OpRep _ ["Test", [testClass, NIL]]]]; Add[NEW[OpRep _ ["StateToo", [stClass, NIL], TRUE]]]; Add[NEW[OpRep _ ["BlackBox", [bbClass, NIL], TRUE]]]; Add[NEW[OpRep _ ["InitCTProps", [initCTPropsClass, NIL], TRUE]]]; Add[NEW[OpRep _ ["RefType", [NIL, refClass]]]]; Add[NEW[OpRep _ ["RecType", [NIL, recClass]]]]; Add[NEW[OpRep _ ["InitialValue", [NIL, ivClass]]]]; arglikeError _ [nullSR, OPP.argClass, error]; oplikeError _ [nullSR, errorClass, NIL]; END; Setup[]; END. ΒRoseTranslateRead.Mesa Last Edited by: Spreitzer, September 18, 1985 9:45:05 pm PDT Last Edited by: Barth, March 8, 1983 10:43 am Last Edited by: Gasbarro, August 16, 1984 3:42:16 pm PDT Κ˜J™Jšœ<™˜G—K˜šŸœœœ œ˜HKšœœ[˜d—K˜š Ÿœœœ!œœœ˜SKš˜Kš œœœ'œœ˜^šœœœ˜šœ˜Kšœœ<œ˜KK˜—K˜/šœ˜ Kšœ2œ˜BKšœœ˜ K˜——Kšœ˜—K˜šŸœœœ œœ œœœ œœœ˜ˆKš˜šœœ˜$Kšœ6˜6Kšœ œ9˜M—Kšœ˜—K˜š Ÿœœœœ8œ œ˜pKšœ3œ˜8—K˜š Ÿœœœœ8œ œ˜ršœ ˜Kš œ œœœœœ˜6Kšœœœœ#œœœœ˜|Kšœœ˜—Kšœ*œ˜.K˜—K˜š Ÿœœœœ8œœ˜nšœ ˜š œ œœœœœ˜BKšœœœ ˜-Kšœœœ ˜-Kš œœœ œœœ œ˜mKšœœ˜—šœœœœ#œœœœ˜ˆKšœœœ œ ˜LKšœœœ œ ˜LKšœœœ œ ˜QKšœœ˜—Kšœœ˜—šœœ˜šœ˜Kšœ œœ2˜\Kšœœ œœI˜xKšœœ˜ —Kš œœ œœ3œœ˜m˜Kšœ œœ2˜\Kšœœ œœE˜tKšœœ˜ —Kšœœ˜—K˜—K˜šŸ œœœ ˜ Kš˜Kšœœœ ˜&šœœ˜Kšœœ'œ˜bKšœœ+˜<—Kšœ˜—K˜šŸ œœœ ˜ Kš˜K˜Kšœœœ ˜&Kšœœœœ ˜QKšœ:œœœ ˜TKš œœœœœ3œ˜|Kšœ˜—K˜šŸœœœ ˜%Kš˜K˜Kšœœœ ˜&Kšœ0œœœ ˜JKšœœœ.˜QKšœO˜OKšœ˜—K˜šŸ œœœ ˜!Kš˜K˜ Kšœœœ ˜&šœœ˜K˜Kšœœ\œ˜‰—Kšœœœ1˜LK˜ KšœD˜DKšœ˜—K˜šŸœœœ ˜'Kš˜K˜Kšœœœ ˜&Kšœ0œœœ ˜JKšœ œœ6˜^KšœH˜HKšœœ˜Kšœ˜—K˜šŸœœœ ˜+Kš˜K˜Kšœœœ ˜&Kšœ0œœœ ˜JKšœ œœ6˜^KšœH˜HKšœœ˜Kšœ˜—K˜šŸ œœœ ˜!Kš˜K˜Kšœœœ ˜&Kšœ0œœœ ˜Jšœœ˜$šœ˜Kš œœœœœaœ˜ΉKšœ2œ ˜EK˜—Kšœmœ˜”—K˜Kšœ˜—K˜šŸ œœœ ˜"Kš˜K˜Kšœœœ ˜&Kšœ0œœœ ˜JKšœœœ0˜NK˜šœœ˜$K˜&Kšœ(œœ˜MKšœ&œœ˜KKšœ!œœ˜EKšœbœ˜‰—Kšœ˜—K˜šŸœœœ ˜'Kš˜K˜Kšœœœ ˜&Kšœ0œœœ ˜JKšœœœ0˜UKšœQ˜QKšœ˜—K˜šŸ œœœ ˜ Kš˜K˜K˜-Kšœœœ ˜&Kšœ0œœœ ˜JKšœœœ,œ˜cKšœK˜KKšœ˜—K˜šŸ œœœ˜=Kš˜Kšœœ œœœœœ˜EKšœ˜Kšœ˜—K˜šŸ œœœ ˜ Kš˜K˜Kšœœœ ˜&Kšœ0œœœ ˜JK˜šœœ˜$Kšœœ˜4KšœEœ˜l—Kšœ˜—K˜šŸœœœ ˜%Kš˜Kš œœœœ œ˜SKšœœœ ˜&K˜ šœœ˜Kšœœ˜KšœœWœ˜„—šœœ˜$Kšœ"˜"Kšœœ]œ˜—šœ˜Kšœœ˜Kšœœ˜Kšœœ˜—Kšœ˜—K˜šŸœœœ ˜$Kš˜K˜K˜K˜ Kšœœœ ˜&Kšœ0œœœ ˜Jšœœ ˜Kšœ"œœ˜?š˜Kšœœ˜—Kšœ˜—šœœ˜$Kšœ˜Kšœœbœ˜”—Kš œ œœ*œ œ˜žK˜1K˜Kšœ˜—K˜šŸ œœœ ˜"Kš˜Kšœœ&œ˜>Kšœœœ ˜&šœœ˜Kšœœ$˜*K˜0K˜*Kšœœhœ˜•—šœ˜Kšœ˜Kšœ˜Kšœ˜Kšœœ˜—K˜Kšœ˜—K˜šŸœœœ ˜'Kš˜K˜Kšœœœ ˜&Kšœ0œœœ ˜JKšœœœG˜lKšœQ˜QKšœ˜—K˜šŸœœœœœœœΟcœ˜SKšœ œ˜'—K˜šŸ œœœ œœœ œ˜dKš˜Kšœœœ˜Kšœœ˜Kšœœ˜Kšœ˜—K˜š Ÿœœœ œœœ˜AKš˜K˜šŸœœ œœœœ œ œ˜gKš˜Kšœœ˜ K˜Kšœœ˜ Kšœ œ˜šŸœœœ˜)Kšœœ˜ Kšœ˜—š Ÿ œœœœœ ˜3Kš˜Kšœ œ ˜Kšœœ˜ Kšœ4˜4šœ ˜Kšœ œœ=˜kšœ&œ˜/Kšœ˜Kšœ ˜ šœ ˜Kšœ˜Kšœ2˜2——Kšœœ˜—Kšœ˜—šœœ˜ K˜Kšœœ œœ˜CKšœ,œ˜3K˜Kšœœœœ˜*K˜$K˜šœ ˜Kš˜Kšœœœ˜Kšœœ˜ šœœœœ˜Kšœœ0˜DKšœ œ+˜:K˜Kšœ œ*˜:K˜Kšœœ+˜Kšœ˜—šœœ ˜Kšœœ,˜@Kšœœ9œ˜HKšœ˜—K˜Kšœœœ˜(Kšœœœ˜(Kšœœœ˜(Kšœœœ˜1Kšœœ"œ˜1Kšœœœ˜1Kšœœ(œ˜7Kšœœ œ˜/Kšœœ(œœ˜=Kšœœ#œœ˜8Kšœœœœ˜2Kšœœ'œœ˜