RoseTranslateRead.Mesa
Last Edited by: Spreitzer, April 28, 1985 3:28:42 pm PDT
Last Edited by: Barth, March 8, 1983 10:43 am
Last Edited by: Gasbarro, August 16, 1984 3:42:16 pm PDT
DIRECTORY AMTypes, Convert, IO, OpPrecParse, OrderedSymbolTableRef, ProcessExtras, Rope, RoseTranslateTypes, RoseTranslateInsides, SignalTypeRegistration, TextNode, TiogaStreams;
RoseTranslateRead: CEDAR PROGRAM
IMPORTS Convert, IO, OPP: OpPrecParse, OSTR: OrderedSymbolTableRef, ProcessExtras, 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 ← OSTR.CreateTable[CompareOps];
ltClass, gtClass, eqClass, lambdaClass, returnClass, cellClass, cellEndClass, nameClass, portsProcClass, applyClass, sfClass, isfClass, initializerClass, refClass, recClass, ivClass, testClass, bbClass, stClass, expandClass, portsClass, cedarClass, 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: OpPrecParse.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};
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: BOOLTRUE;
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;
CompareOps: PUBLIC OSTR.CompareProc =
BEGIN
s1, s2: ROPE;
s1 ← WITH r1 SELECT FROM
r: ROPE => r,
op: Op => op.name,
ENDCASE => ERROR;
s2 ← WITH r2 SELECT FROM
r: ROPE => r,
op: Op => op.name,
ENDCASE => ERROR;
RETURN [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
ProcessExtras.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: ROPENIL;
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: BOOLFALSE;
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
char: CHAR ← job.from.GetChar[]; --counter Backup in GetToken
parent: TextNode.Ref ← TS.CurInNode[job.from];
to allow comments there, don't test: IF char # '\n THEN ERROR;
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: BOOLEANFALSE;
oldSR: SourceRange;
old: REF ANYNIL;
[] ← 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
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]];
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]];
ops.Insert[NEW[OpRep ← [etNames[et], [evalClasses[et], NIL], TRUE]]];
ENDLOOP;
FOR ac: AuxClass IN AuxClass DO
auxClasses[ac] ← NEW [TokenClassRep ← [80, 90, ReduceAuxClass]];
ops.Insert[NEW[OpRep ← [auxClassNames[ac].Cat["Aux"], [auxClasses[ac], NIL]]]];
ENDLOOP;
ops.Insert[NEW[OpRep ← ["<", [ltClass, NIL]]]];
ops.Insert[NEW[OpRep ← [">", [gtClass, NIL]]]];
ops.Insert[NEW[OpRep ← ["=", [eqClass, NIL]]]];
ops.Insert[NEW[OpRep ← ["LAMBDA", [NIL, lambdaClass]]]];
ops.Insert[NEW[OpRep ← ["RETURN", [returnClass, NIL]]]];
ops.Insert[NEW[OpRep ← ["CELLTYPE", [NIL, cellClass]]]];
ops.Insert[NEW[OpRep ← ["EndCellType", [cellEndClass, NIL]]]];
ops.Insert[NEW[OpRep ← ["PORTS", [portsClass, NIL]]]];
ops.Insert[NEW[OpRep ← ["PortsProc", [portsProcClass, NIL], TRUE]]];
ops.Insert[NEW[OpRep ← ["ApplyCode",[applyClass, NIL], TRUE]]];
ops.Insert[NEW[OpRep ← ["State", [sfClass, NIL], TRUE]]];
ops.Insert[NEW[OpRep ← ["InittableState", [isfClass, NIL], TRUE]]];
ops.Insert[NEW[OpRep ← ["Initializer", [initializerClass, NIL], TRUE]]];
ops.Insert[NEW[OpRep ← ["Expand", [expandClass, NIL]]]];
ops.Insert[NEW[OpRep ← ["CEDAR", [NIL, cedarClass], TRUE]]];
ops.Insert[NEW[OpRep ← ["NameMaker",[NIL, nameClass], TRUE]]];
ops.Insert[autoName←NEW[OpRep ← ["AutoName",[NIL, myArgClass]]]];
ops.Insert[NEW[OpRep ← ["Test", [testClass, NIL]]]];
ops.Insert[NEW[OpRep ← ["StateToo", [stClass, NIL], TRUE]]];
ops.Insert[NEW[OpRep ← ["BlackBox", [bbClass, NIL], TRUE]]];
ops.Insert[NEW[OpRep ← ["InitCTProps", [initCTPropsClass, NIL], TRUE]]];
ops.Insert[NEW[OpRep ← ["RefType", [NIL, refClass]]]];
ops.Insert[NEW[OpRep ← ["RecType", [NIL, recClass]]]];
ops.Insert[NEW[OpRep ← ["InitialValue", [NIL, ivClass]]]];
arglikeError ← [nullSR, OPP.argClass, error];
oplikeError ← [nullSR, errorClass, NIL];
END;
Setup[];
END.