OpPrecParseImpl.Mesa
Last Edited by: Spreitzer, March 4, 1983 11:16 am
OpPrecParseImpl:
CEDAR
PROGRAM
EXPORTS OpPrecParse =
BEGIN OPEN OpPrecParse;
CantReduce: PUBLIC SIGNAL [ops: TokenList, args: LORA] RETURNS [use: REF ANY] = CODE;
CantFix: PUBLIC SIGNAL [token: Token] RETURNS [fix: Token] = CODE;
DoesntFix: PUBLIC ERROR [token: Token, expectingArg, willGetArg: BOOLEAN] = CODE;
TerminateErr: PUBLIC ERROR [argStack: LORA, opStack: TokenList] = CODE;
LastReduceErr: PUBLIC ERROR [args: LORA, ops: TokenList] = CODE;
InvalidToken: PUBLIC ERROR [token: Token] = CODE;
endClass: TokenClass ← NEW [TokenClassRep ← [leftPrec: 1, rightPrec: 0]];
beginClass: TokenClass ← NEW [TokenClassRep ← [leftPrec: 0, rightPrec: 1, Reduce: ReduceEnd]];
argClass: PUBLIC TokenClass ← NEW [TokenClassRep ← [leftPrec: 0, rightPrec: 0]];
end: PUBLIC Token ← [class: endClass];
begin: Token ← [class: beginClass];
Parse:
PUBLIC
PROC [context:
REF
ANY, GetToken: TokenProc]
RETURNS [ans:
REF
ANY] =
BEGIN
Reduce:
PROC =
BEGIN
GrabArg: PROC = {args ← CONS[argStack.first, args]; argStack ← argStack.rest};
args: LORA ← NIL;
ops: TokenList ← NIL;
new: REF ANY;
WHILE
TRUE
DO
IF opStack.first.class.rightPrec > 0 THEN GrabArg[];
ops ← CONS[opStack.first, ops];
IF (opStack ← opStack.rest) = NIL THEN EXIT;
IF opStack.first.class.rightPrec # ops.first.class.leftPrec THEN EXIT;
ENDLOOP;
IF ops.first.class.leftPrec > 0 THEN GrabArg[];
IF ops.first.class.Reduce # NIL THEN new ← ops.first.class.Reduce[context, ops, args] ELSE new ← SIGNAL CantReduce[ops, args];
argStack ← CONS[new, argStack];
END;
argStack: LORA ← NIL;
opStack: TokenList ← LIST[begin];
expectingArg: BOOLEAN ← TRUE;
useOld: BOOLEAN ← FALSE;
old: Token;
WHILE opStack #
NIL
DO
next: Token;
IF useOld THEN {next ← old; useOld ← FALSE} ELSE next ← GetToken[context, expectingArg];
IF next.class = NIL THEN ERROR InvalidToken[next];
IF next.class.rightPrec = 1 THEN ERROR InvalidToken[next];
IF next.class.leftPrec = 1 AND next # end THEN ERROR InvalidToken[next];
IF expectingArg # (next.class.leftPrec = 0)
THEN
BEGIN
old ← next;
IF next.class.leftFix.class = NIL THEN next ← SIGNAL CantFix[next] ELSE next ← next.class.leftFix;
IF expectingArg # (next.class.leftPrec = 0) THEN ERROR DoesntFix[next, expectingArg, old.class.leftPrec = 0];
IF (next.class.rightPrec > 0) # (old.class.leftPrec = 0) THEN ERROR DoesntFix[next, expectingArg, old.class.leftPrec = 0];
useOld ← TRUE;
END;
IF next.class.leftPrec > 0
THEN
BEGIN
WHILE opStack.first.class.rightPrec > next.class.leftPrec DO Reduce[] ENDLOOP;
END;
IF next.class.leftPrec = 0 AND next.class.rightPrec = 0 THEN argStack ← CONS[next.asArg, argStack] ELSE opStack ← CONS[next, opStack];
expectingArg ← next.class.rightPrec > 0;
IF (next.class.leftPrec > 0) AND NOT expectingArg THEN Reduce[];
ENDLOOP;
IF argStack = NIL THEN ERROR TerminateErr[argStack, opStack];
IF argStack.rest # NIL THEN ERROR TerminateErr[argStack, opStack];
ans ← argStack.first;
END;
ReduceEnd: Reducer =
BEGIN
IF args = NIL THEN ERROR LastReduceErr[args, ops];
IF args.rest # NIL THEN ERROR LastReduceErr[args, ops];
IF ops = NIL THEN ERROR;
IF ops.rest = NIL THEN ERROR LastReduceErr[args, ops];
IF ops.rest.rest # NIL THEN ERROR LastReduceErr[args, ops];
reduced ← args.first;
END;
END.