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: 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;
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: 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
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: 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
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.