MODULE CalcParse;
Generated by kyacc
IMPORT CalcTok;
IMPORT IntIntTbl, IntTextTbl;
IMPORT RTType;
IMPORT Env, Thread, Wr, Fmt, Rd;
FROM Stdio IMPORT stdout;
FROM CalcTok IMPORT NewPT;
<* FATAL Wr.Failure, Thread.Alerted *>
TYPE
TypedSymbol = RECORD
code: INTEGER;
value: CalcTok.ParseType;
END;
CONST
EOFSymbol = TypedSymbol{code := 0, value := NIL};
NoToken = TypedSymbol{code := -1, value := NIL};
NotASymbol = TypedSymbol{code := -1000, value := NIL};
TYPE
StackElem = RECORD
state: INTEGER;
value: TypedSymbol;
END;
StackElemArray = REF ARRAY OF StackElem;
Stack = RECORD
a: StackElemArray;
ptr: INTEGER;
END;
REVEAL
T = Public BRANDED "CalcParse" OBJECT
lex: CalcTok.Lexer;
tokenLookup: IntIntTbl.T := NIL; (* M3 type code -> SymCode *)
symbols: IntTextTbl.T; (* SymCode -> name *)
allocate_expr: CalcTok.Allocator;
allocate_list: CalcTok.Allocator;
allocate_number: CalcTok.Allocator;
allocate_stat: CalcTok.Allocator;
OVERRIDES
setLex := SetLex;
parse := Parse;
purge := Purge;
empty_list := empty_list;
cons_list := cons_list;
eval_stat := eval_stat;
assign_stat := assign_stat;
paren_expr := paren_expr;
add_expr := add_expr;
sub_expr := sub_expr;
mul_expr := mul_expr;
div_expr := div_expr;
uminus_expr := uminus_expr;
ident_expr := ident_expr;
num_expr := num_expr;
digit_number := digit_number;
cons_number := cons_number;
END;
TYPE
SymCode = BITS 9 FOR [0..264];
(* symbol code: 0 .. 263
set default: 264 *)
Action = BITS 6 FOR [0..54];
(* error: -1 (not stored in table)
shift: 1 .. 24
accept: 25
reduce: 26 .. 39
shift&accept: 40
shift&reduce: 41 .. 54 *)
StateRef = BITS 6 FOR [0..45];
(* no more: 0
next state: 1..45 *)
S = RECORD
key: SymCode;
action: Action;
next: StateRef;
END;
R = RECORD
length: INTEGER;
returnCode: INTEGER;
name: TEXT;
END;
Y = RECORD
code: INTEGER;
name: TEXT;
END;
CONST
States = ARRAY [1..45] OF S {
S{264,26,25}, S{264,25,26}, S{260,12,27}, S{260,50,28}, S{10,42,0},
S{264,28,29}, S{264,36,30}, S{264,37,31}, S{260,49,27}, S{264,29,29},
S{260,50,27}, S{41,45,32}, S{260,17,27}, S{264,32,33}, S{260,18,27},
S{260,48,27}, S{264,32,34}, S{264,31,34}, S{260,48,28}, S{260,24,28},
S{260,14,28}, S{260,49,28}, S{260,10,28}, S{264,31,33}, S{258,2,0},
S{259,5,35}, S{45,11,36}, S{45,4,36}, S{43,20,37}, S{256,23,0},
S{263,54,0}, S{43,15,38}, S{42,19,39}, S{42,16,40}, S{260,6,41},
S{261,51,42}, S{45,21,33}, S{45,13,34}, S{47,22,0}, S{47,9,0},
S{261,7,43}, S{40,3,44}, S{45,4,42}, S{262,8,45}, S{263,53,0}};
Rules = ARRAY [26..39] OF R {
R{0, 258, "empty_list :"},
R{3, 258, "cons_list : list stat '\\n'"},
R{1, 259, "eval_stat : expr"},
R{3, 259, "assign_stat : LETTER ASSIGN expr"},
R{3, 260, "paren_expr : '(' expr ')'"},
R{3, 260, "add_expr : expr '+' expr"},
R{3, 260, "sub_expr : expr '-' expr"},
R{3, 260, "mul_expr : expr '*' expr"},
R{3, 260, "div_expr : expr '/' expr"},
R{2, 260, "uminus_expr : '-' expr"},
R{1, 260, "ident_expr : LETTER"},
R{1, 260, "num_expr : number"},
R{1, 262, "digit_number : DIGIT"},
R{2, 262, "cons_number : number DIGIT"}
};
Symbols = ARRAY [1..16] OF Y {
Y{0,"EOF"}, Y{10,"'\\n'"}, Y{40,"'('"}, Y{41,"')'"}, Y{42,"'*'"},
Y{43,"'+'"}, Y{45,"'-'"}, Y{47,"'/'"}, Y{256,"ASSIGN"}, Y{257,"ERROR"},
Y{258,"list"}, Y{259,"stat"}, Y{260,"expr"}, Y{261,"LETTER"},
Y{262,"number"}, Y{263,"DIGIT"}};
VAR
Debug := Env.Get("CalcParseDEBUG") # NIL;
PROCEDURE SetLex(self: T; lex: CalcTok.Lexer): T =
BEGIN self.lex := lex; RETURN self; END SetLex;
PROCEDURE Init(self: T) =
BEGIN (* called on first parse *)
self.tokenLookup := NEW(IntIntTbl.Default).init(16);
IF Debug THEN
self.symbols := NEW(IntTextTbl.Default).init(16);
FOR i := 1 TO 16 DO
EVAL self.symbols.put(Symbols[i].code, Symbols[i].name);
END;
END;
END Init;
PROCEDURE NextToken(self: T): TypedSymbol =
VAR
symCode, m3code: INTEGER;
token: CalcTok.Token;
found := FALSE;
BEGIN
TRY
token := self.lex.get();
EXCEPT
Rd.EndOfFile => RETURN EOFSymbol;
END;
m3code := TYPECODE(token);
IF NOT self.tokenLookup.get(m3code, symCode) THEN
REPEAT
m3code := RTType.Supertype(m3code);
IF m3code = RTType.NoSuchType THEN
TYPECASE token OF
| ConstToken => symCode := -1;
| DIGIT => symCode := 263;
| LETTER => symCode := 261;
ELSE
<* ASSERT FALSE *>
END;
found := TRUE;
ELSE
found := self.tokenLookup.get(m3code, symCode);
END;
UNTIL found;
EVAL self.tokenLookup.put(TYPECODE(token), symCode);
END;
IF symCode = -1 THEN
symCode := NARROW(token, ConstToken).val;
END;
RETURN TypedSymbol{code := symCode, value := token};
END NextToken;
PROCEDURE AllocStack(): Stack =
VAR
a :=NEW(StackElemArray, 16);
BEGIN
a[0] := StackElem{state := 1, value := EOFSymbol};
RETURN Stack{a := a, ptr := 0};
END AllocStack;
PROCEDURE Push(VAR stack: Stack; elem: StackElem) =
VAR
new: StackElemArray;
BEGIN
INC(stack.ptr);
IF stack.ptr > LAST(stack.a^) THEN
new := NEW(StackElemArray, NUMBER(stack.a^) * 2);
SUBARRAY(new^, 0, NUMBER(stack.a^)) := stack.a^;
stack.a := new;
END;
stack.a[stack.ptr] := elem;
END Push;
PROCEDURE ActionLookup(curState: INTEGER; symbol: TypedSymbol): INTEGER =
VAR
cur := curState;
state: S;
default := -1;
BEGIN
REPEAT
state := States[cur];
IF state.key = 264 THEN
default := state.action;
ELSIF state.key = symbol.code THEN
RETURN state.action;
END;
cur := state.next;
UNTIL cur = 0;
RETURN default;
END ActionLookup;
PROCEDURE Parse(self: T; exhaustInput: BOOLEAN := TRUE): StartType =
VAR
curState: INTEGER := 1;
stack := AllocStack();
action: INTEGER;
symbol, preservedToken: TypedSymbol;
skipTokenGets: INTEGER := 0;
PROCEDURE DebugPrint(message: TEXT) = BEGIN
IF Debug THEN Wr.PutText(stdout,"CalcParseDEBUG: "&message&"\n");
Wr.Flush(stdout);END;END DebugPrint;
PROCEDURE DebugSymbol(message: TEXT) = VAR name: TEXT; BEGIN
IF Debug THEN EVAL self.symbols.get(symbol.code, name);
DebugPrint(message & " " & name & "(" &
Fmt.Int(symbol.code) & ")"); END; END DebugSymbol;
PROCEDURE DebugState(message: TEXT) = BEGIN IF Debug THEN
DebugPrint(message & " " & Fmt.Int(curState));END;END DebugState;
PROCEDURE DebugRule(message: TEXT) = BEGIN IF Debug THEN
DebugPrint(message&" "&Rules[action].name);END;END DebugRule;
BEGIN
IF self.tokenLookup = NIL THEN Init(self); END;
stack.a[0] := StackElem{state := curState, value := NotASymbol};
DebugState("starting in state");
LOOP
IF skipTokenGets = 2 THEN
skipTokenGets := 1;
DebugSymbol("scanning reduced symbol");
ELSIF skipTokenGets = 1 AND preservedToken # NoToken THEN
skipTokenGets := 0;
symbol := preservedToken;
DebugSymbol("re-scanning input token");
ELSE
skipTokenGets := 0;
symbol := NextToken(self);
preservedToken := symbol;
DebugSymbol("input token");
END;
action := ActionLookup(curState, symbol);
IF action >= 40 THEN
DebugPrint("shifting anonymously");
Push(stack, StackElem{state := 0, value := symbol});
DEC(action, 15);
IF skipTokenGets = 0 THEN
preservedToken := NoToken;
END;
END;
IF action = -1 THEN
DebugPrint("syntax error");
self.lex.error("CalcParse: syntax error");RETURN NIL;
ELSIF action <= 24 THEN
curState := action;
DebugState("shifting to state");
Push(stack, StackElem{state := curState, value := symbol});
ELSIF action = 25 THEN
DebugPrint("parsing stopped with singleton start symbol on stack");
<* ASSERT stack.ptr = 1 *>
IF exhaustInput AND preservedToken = NoToken THEN
symbol := NextToken(self);
DebugPrint("getting token to check that it's an EOF");
END;
IF symbol.code # 0 THEN
IF exhaustInput THEN
DebugPrint("Error: last token was not EOF");
self.lex.unget();
self.lex.error("CalcParse: syntax error (parsing stopped before EOF)");
RETURN NIL;
END;
IF preservedToken # NoToken THEN
self.lex.unget();
DebugPrint("ungetting last token");
END;
END;
symbol := stack.a[1].value;
DebugSymbol("returning symbol");
RETURN symbol.value;
ELSE
DebugRule("reducing by rule");
WITH p=stack.ptr, a=stack.a, v=symbol.value, l=Rules[action].length DO
CASE action OF
| 26 => VAR w: list := NIL;
BEGIN self.empty_list(w); v:=w; END;
| 27 => VAR w: list := NIL;
p1:list:=a[p-2].value.value;p2:stat:=a[p-1].value.value;
BEGIN self.cons_list(w, p1, p2); v:=w; END;
| 28 => VAR w: stat := NIL;
p1:expr:=a[p].value.value;
BEGIN self.eval_stat(w, p1); v:=w; END;
| 29 => VAR w: stat := NIL;
p1:LETTER:=a[p-2].value.value;p2:expr:=a[p].value.value;
BEGIN self.assign_stat(w, p1, p2); v:=w; END;
| 30 => VAR w: expr := NIL;
p1:expr:=a[p-1].value.value;
BEGIN self.paren_expr(w, p1); v:=w; END;
| 31 => VAR w: expr := NIL;
p1:expr:=a[p-2].value.value;p2:expr:=a[p].value.value;
BEGIN self.add_expr(w, p1, p2); v:=w; END;
| 32 => VAR w: expr := NIL;
p1:expr:=a[p-2].value.value;p2:expr:=a[p].value.value;
BEGIN self.sub_expr(w, p1, p2); v:=w; END;
| 33 => VAR w: expr := NIL;
p1:expr:=a[p-2].value.value;p2:expr:=a[p].value.value;
BEGIN self.mul_expr(w, p1, p2); v:=w; END;
| 34 => VAR w: expr := NIL;
p1:expr:=a[p-2].value.value;p2:expr:=a[p].value.value;
BEGIN self.div_expr(w, p1, p2); v:=w; END;
| 35 => VAR w: expr := NIL;
p1:expr:=a[p].value.value;
BEGIN self.uminus_expr(w, p1); v:=w; END;
| 36 => VAR w: expr := NIL;
p1:LETTER:=a[p].value.value;
BEGIN self.ident_expr(w, p1); v:=w; END;
| 37 => VAR w: expr := NIL;
p1:number:=a[p].value.value;
BEGIN self.num_expr(w, p1); v:=w; END;
| 38 => VAR w: number := NIL;
p1:DIGIT:=a[p].value.value;
BEGIN self.digit_number(w, p1); v:=w; END;
| 39 => VAR w: number := NIL;
p1:number:=a[p-1].value.value;p2:DIGIT:=a[p].value.value;
BEGIN self.cons_number(w, p1, p2); v:=w; END;
ELSE
<* ASSERT FALSE *>
END;
FOR i := p - l + 1 TO p DO a[i].value.value.discard(); END;
DEC(p, l);
curState := a[p].state;
END;
DebugState("popping to state");
symbol.code := Rules[action].returnCode;
skipTokenGets := 2;
END;
END;
END Parse;
PROCEDURE Purge(self: T): INTEGER =
BEGIN
RETURN 0
+ CalcTok.Purge(self.allocate_expr)
+ CalcTok.Purge(self.allocate_list)
+ CalcTok.Purge(self.allocate_number)
+ CalcTok.Purge(self.allocate_stat);
END Purge;
default methods
PROCEDURE empty_list(self: T;
VAR result: list) = BEGIN
IF result=NIL THEN
result:=NewPT(self.allocate_list,TYPECODE(list));
END;END empty_list;
PROCEDURE cons_list(self: T;
VAR result: list;<*UNUSED*>p1: list;<*UNUSED*>p2: stat) = BEGIN
IF result=NIL THEN
result:=NewPT(self.allocate_list,TYPECODE(list));
END;END cons_list;
PROCEDURE eval_stat(self: T;
VAR result: stat;<*UNUSED*>p1: expr) = BEGIN
IF result=NIL THEN
result:=NewPT(self.allocate_stat,TYPECODE(stat));
END;END eval_stat;
PROCEDURE assign_stat(self: T;
VAR result: stat;<*UNUSED*>p1: LETTER;<*UNUSED*>p2: expr) = BEGIN
IF result=NIL THEN
result:=NewPT(self.allocate_stat,TYPECODE(stat));
END;END assign_stat;
PROCEDURE paren_expr(self: T;
VAR result: expr;<*UNUSED*>p1: expr) = BEGIN
IF result=NIL THEN
result:=NewPT(self.allocate_expr,TYPECODE(expr));
END;END paren_expr;
PROCEDURE add_expr(self: T;
VAR result: expr;<*UNUSED*>p1: expr;<*UNUSED*>p2: expr) = BEGIN
IF result=NIL THEN
result:=NewPT(self.allocate_expr,TYPECODE(expr));
END;END add_expr;
PROCEDURE sub_expr(self: T;
VAR result: expr;<*UNUSED*>p1: expr;<*UNUSED*>p2: expr) = BEGIN
IF result=NIL THEN
result:=NewPT(self.allocate_expr,TYPECODE(expr));
END;END sub_expr;
PROCEDURE mul_expr(self: T;
VAR result: expr;<*UNUSED*>p1: expr;<*UNUSED*>p2: expr) = BEGIN
IF result=NIL THEN
result:=NewPT(self.allocate_expr,TYPECODE(expr));
END;END mul_expr;
PROCEDURE div_expr(self: T;
VAR result: expr;<*UNUSED*>p1: expr;<*UNUSED*>p2: expr) = BEGIN
IF result=NIL THEN
result:=NewPT(self.allocate_expr,TYPECODE(expr));
END;END div_expr;
PROCEDURE uminus_expr(self: T;
VAR result: expr;<*UNUSED*>p1: expr) = BEGIN
IF result=NIL THEN
result:=NewPT(self.allocate_expr,TYPECODE(expr));
END;END uminus_expr;
PROCEDURE ident_expr(self: T;
VAR result: expr;<*UNUSED*>p1: LETTER) = BEGIN
IF result=NIL THEN
result:=NewPT(self.allocate_expr,TYPECODE(expr));
END;END ident_expr;
PROCEDURE num_expr(self: T;
VAR result: expr;<*UNUSED*>p1: number) = BEGIN
IF result=NIL THEN
result:=NewPT(self.allocate_expr,TYPECODE(expr));
END;END num_expr;
PROCEDURE digit_number(self: T;
VAR result: number;<*UNUSED*>p1: DIGIT) = BEGIN
IF result=NIL THEN
result:=NewPT(self.allocate_number,TYPECODE(number));
END;END digit_number;
PROCEDURE cons_number(self: T;
VAR result: number;<*UNUSED*>p1: number;<*UNUSED*>p2: DIGIT) = BEGIN
IF result=NIL THEN
result:=NewPT(self.allocate_number,TYPECODE(number));
END;END cons_number;
BEGIN
END CalcParse.