MODULE yaccformBundle;
Generated by m3bundle; see its manpage.
IMPORT Bundle, BundleRep, Text;
IMPORT Thread, Wr, TextWr;
TYPE T = Bundle.T OBJECT OVERRIDES
get := LookUp;
getNames := GetNames;
END;
TYPE Texts = REF ARRAY OF TEXT;
VAR
bundle: T := NIL;
names : Texts := NIL;
PROCEDURE Get(): Bundle.T =
BEGIN
IF (bundle = NIL) THEN bundle := NEW (T) END;
RETURN bundle;
END Get;
PROCEDURE GetNames (<*UNUSED*> self: T): Texts =
BEGIN
IF names = NIL THEN
names := NEW (Texts, NUMBER (Names));
names^ := Names;
END;
RETURN names;
END GetNames;
PROCEDURE LookUp (<*UNUSED*> self: T; element: TEXT): TEXT =
BEGIN
FOR i := 0 TO LAST (Names)-1 DO
IF Text.Equal (Names[i], element) THEN
IF Elements[i] = NIL THEN Elements[i] := GetElt (i) END;
RETURN Elements[i];
END;
END;
RETURN NIL;
END LookUp;
CONST Names = ARRAY [0..8] OF TEXT {
"yaccform.i3",
"yaccform.type.m3",
"yaccform.proc.m3",
"yaccform.typecase.m3",
"yaccform.rule.m3",
"yaccform.m3",
"yaccform.orig.m3",
"yaccform.reduce.m3",
NIL
};
VAR Elements := ARRAY [0..8] OF TEXT {
E0,
E1,
E2,
E3,
E4,
NIL (* E5 .. E5_2 *),
E6,
E7,
NIL
};
PROCEDURE GetElt (n: INTEGER): TEXT =
<*FATAL Thread.Alerted, Wr.Failure *>
VAR wr := TextWr.New ();
BEGIN
CASE n OF
| 5 =>
Wr.PutText (wr, E5);
Wr.PutText (wr, E5_0);
Wr.PutText (wr, E5_1);
Wr.PutText (wr, E5_2);
ELSE (*skip*)
END;
RETURN TextWr.ToText (wr);
END GetElt;
CONST E0 =
"INTERFACE %yacc;\n%gen\n(* original parser definition *)\nIMPORT %tok;\n"
& "TYPE\n (* additional parse types *)\n StartType = %tok.ParseType BRAN"
& "DED \"%yacc.StartType\" OBJECT END;\n OtherType = %tok.ParseType;\n%ty"
& "pe\\\n\n (* import tokens *)\n ConstToken = %tok.ConstToken;\n%gettok"
& "\\\n\n (* the parser *)\n T <: Public;\n Public = OBJECT\n METHODS\n"
& " setLex(lex: %tok.Lexer): T;\n parse(exhaustInput: BOOLEAN := TRU"
& "E): StartType;\n\n (* rules *)\n%prot\\\n\n purge(): INTEGER;\n "
& " (* Allow any internally allocated ParseTypes to be garbage collected,"
& "\n even if the parser itself remains in scope. Return number of P"
& "arseType\n objects allocated but not discarded (not the number of"
& " purged objects).\n Can be called at any time by the thread calli"
& "ng get. *)\n END;\n\n (* And now, for a hack to allow compatible meth"
& "ods *)\n (* ... without importing the original parser *)\n Original_P"
& "arser = T;\n%orig\\\n (* ... and without importing the original token "
& "*)\n%tokOrig\\\n\nEND %yacc.\n";
CONST E1 =
" %name = %sup BRANDED \"%yacc.%name\" OBJECT END;\n";
CONST E2 =
"PROCEDURE %name(self: T;\n VAR result: %return%uparams) = BEGIN\n IF re"
& "sult=NIL THEN\n result:=NewPT(self.allocate_%return,TYPECODE(%return)"
& ");\n END;END %name;\n\n";
CONST E3 =
" | %name => symCode := %code;\n";
CONST E4 =
" R{%length, %codeReturn, %debug}\\,\n";
CONST E5 =
"MODULE %yacc;\n%gen\nIMPORT %tok;\nIMPORT IntIntTbl, IntTextTbl;\nIMPOR"
& "T RTType;\nIMPORT Env, Thread, Wr, Fmt, Rd;\nFROM Stdio IMPORT stdout;\n"
& "FROM %tok IMPORT NewPT;\n<* FATAL Wr.Failure, Thread.Alerted *>\n\nTYPE"
& "\n TypedSymbol = RECORD\n code: INTEGER;\n value: %tok.ParseType"
& ";\n END;\nCONST\n EOFSymbol = TypedSymbol{code := 0, value := NIL};\n"
& " NoToken = TypedSymbol{code := -1, value := NIL};\n NotASymbol = Type"
& "dSymbol{code := -1000, value := NIL};\n\nTYPE\n StackElem = RECORD\n "
& " state: INTEGER;\n value: TypedSymbol;\n END;\n StackElemArray = "
& "REF ARRAY OF StackElem;\n\n Stack = RECORD\n a: StackElemArray;\n "
& " ptr: INTEGER;\n END;\n\nREVEAL\n T = Public BRANDED \"%yacc\" OBJEC"
& "T\n lex: %tok.Lexer;\n tokenLookup: IntIntTbl.T := NIL; (* M3 typ"
& "e code -> SymCode *)\n symbols: IntTextTbl.T; (* SymCode -"
& "> name *)\n%alloc\\\n OVERRIDES\n setLex := SetLex;\n parse := P"
& "arse;\n purge := Purge;\n%ovr\\\n END;\n\nTYPE\n SymCode = BITS %s"
& "ymCodeBits FOR [0..%symCodeLast];\n (* symbol code: 0 .. %symCodePenu"
& "lt\n set default: %symCodeLast *)\n\n Action = BITS %actionBits F"
& "OR [0..%actionLast];\n (* error: -1 (not stored in table)\n "
& " shift: 1 .. %lastShift0\n accept: %lastShift1\n "
& " reduce: %lastShift2 .. %lastReduce0\n shift&accept: %lastRed"
& "uce1\n shift&reduce: %lastReduce2 .. %actionLast *)\n\n StateRef "
& "= BITS %stateBits FOR [0..%stateLast];\n (* no more: 0\n next"
& " state: 1..%stateLast *)\n\n S = RECORD\n key: SymCode;\n acti"
& "on: Action;\n next: StateRef;\n END;\n\n R = RECORD\n length: I"
& "NTEGER;\n returnCode: INTEGER;\n name: TEXT;\n END;\n\n Y = REC"
& "ORD\n code: INTEGER;\n name: TEXT;\n END;\n\nCONST\n States = A"
& "RRAY [1..%stateLast] OF S {\n%States};\n\n Rules = ARRAY [%lastShift2."
& ".%lastReduce0] OF R {\n%Rules};\n\n Symbols = ARRAY [1..%numSym] OF Y "
& "{\n%Symbols};\n\nVAR\n Debug := Env.Get(\"%yaccDEBUG\") # NIL;\n\nPROC"
& "EDURE SetLex(self: T; lex: %tok.Lexer): T =\n BEGIN self.lex := lex; R"
& "ETURN self; END SetLex;\n\nPROCEDURE Init";
CONST E5_0 =
"(self: T) =\n BEGIN (* called on first parse *)\n self.tokenLookup "
& ":= NEW(IntIntTbl.Default).init(%numSym);\n IF Debug THEN\n self"
& ".symbols := NEW(IntTextTbl.Default).init(%numSym);\n FOR i := 1 TO"
& " %numSym DO\n EVAL self.symbols.put(Symbols[i].code, Symbols[i]."
& "name);\n END;\n END;\n END Init;\n\nPROCEDURE NextToken(self: "
& "T): TypedSymbol =\n VAR\n symCode, m3code: INTEGER;\n token: %to"
& "k.Token;\n found := FALSE;\n BEGIN\n TRY\n token := self.le"
& "x.get();\n EXCEPT\n Rd.EndOfFile => RETURN EOFSymbol;\n END;"
& "\n m3code := TYPECODE(token);\n IF NOT self.tokenLookup.get(m3cod"
& "e, symCode) THEN\n REPEAT\n m3code := RTType.Supertype(m3co"
& "de);\n IF m3code = RTType.NoSuchType THEN\n TYPECASE to"
& "ken OF\n | ConstToken => symCode := -1;\n%case\\\n EL"
& "SE\n <* ASSERT FALSE *>\n END;\n found := "
& "TRUE;\n ELSE\n found := self.tokenLookup.get(m3code, sy"
& "mCode);\n END;\n UNTIL found;\n EVAL self.tokenLookup."
& "put(TYPECODE(token), symCode);\n END;\n IF symCode = -1 THEN\n "
& " symCode := NARROW(token, ConstToken).val;\n END;\n RETURN Type"
& "dSymbol{code := symCode, value := token};\n END NextToken;\n\nPROCEDUR"
& "E AllocStack(): Stack =\n VAR\n a :=NEW(StackElemArray, 16);\n BEG"
& "IN\n a[0] := StackElem{state := 1, value := EOFSymbol};\n RETURN "
& "Stack{a := a, ptr := 0};\n END AllocStack;\n\nPROCEDURE Push(VAR stack"
& ": Stack; elem: StackElem) =\n VAR\n new: StackElemArray;\n BEGIN\n"
& " INC(stack.ptr);\n IF stack.ptr > LAST(stack.a^) THEN\n new "
& ":= NEW(StackElemArray, NUMBER(stack.a^) * 2);\n SUBARRAY(new^, 0, "
& "NUMBER(stack.a^)) := stack.a^;\n stack.a := new;\n END;\n st"
& "ack.a[stack.ptr] := elem;\n END Push;\n\nPROCEDURE ActionLookup(curSta"
& "te: INTEGER; symbol: TypedSymbol): INTEGER =\n VAR\n cur := curStat"
& "e;\n state: S;\n default := -1;\n BEGIN\n REPEAT\n state"
& " := States[cur];\n IF state.key = %symCodeLast THEN\n defau"
& "lt := state.action";
CONST E5_1 =
";\n ELSIF state.key = symbol.code THEN\n RETURN state.actio"
& "n;\n END;\n cur := state.next;\n UNTIL cur = 0;\n RETUR"
& "N default;\n END ActionLookup;\n\nPROCEDURE Parse(self: T; exhaustInpu"
& "t: BOOLEAN := TRUE): StartType =\n VAR\n curState: INTEGER := 1;\n "
& " stack := AllocStack();\n action: INTEGER;\n symbol, preservedT"
& "oken: TypedSymbol;\n skipTokenGets: INTEGER := 0;\n\n PROCEDURE Deb"
& "ugPrint(message: TEXT) = BEGIN\n IF Debug THEN Wr.PutText(stdout,\"%"
& "yaccDEBUG: \"&message&\"\\n\");\n Wr.Flush(stdout);END;END DebugPri"
& "nt;\n PROCEDURE DebugSymbol(message: TEXT) = VAR name: TEXT; BEGIN\n "
& " IF Debug THEN EVAL self.symbols.get(symbol.code, name);\n DebugPrin"
& "t(message & \" \" & name & \"(\" &\n Fmt.Int(symbol.code) & \")\")"
& "; END; END DebugSymbol;\n PROCEDURE DebugState(message: TEXT) = BEGIN "
& "IF Debug THEN\n DebugPrint(message & \" \" & Fmt.Int(curState));END;"
& "END DebugState;\n PROCEDURE DebugRule(message: TEXT) = BEGIN IF Debug "
& "THEN\n DebugPrint(message&\" \"&Rules[action].name);END;END DebugRul"
& "e;\n\n BEGIN\n IF self.tokenLookup = NIL THEN Init(self); END;\n "
& " stack.a[0] := StackElem{state := curState, value := NotASymbol};\n "
& "DebugState(\"starting in state\");\n LOOP\n IF skipTokenGets = "
& "2 THEN\n skipTokenGets := 1;\n DebugSymbol(\"scanning red"
& "uced symbol\");\n ELSIF skipTokenGets = 1 AND preservedToken # NoT"
& "oken THEN\n skipTokenGets := 0;\n symbol := preservedToke"
& "n;\n DebugSymbol(\"re-scanning input token\");\n ELSE\n "
& " skipTokenGets := 0;\n symbol := NextToken(self);\n pr"
& "eservedToken := symbol;\n DebugSymbol(\"input token\");\n E"
& "ND;\n action := ActionLookup(curState, symbol);\n IF action >"
& "= %lastReduce1 THEN\n DebugPrint(\"shifting anonymously\");\n "
& " Push(stack, StackElem{state := 0, value := symbol});\n DEC("
& "action, %DECaction);\n IF skipTokenGets = 0 THEN\n pres"
& "ervedToken := NoToken;\n END;\n END;\n IF action = -1 "
& "THEN\n DebugPrin";
CONST E5_2 =
"t(\"syntax error\");\n self.lex.error(\"%yacc: syntax error\");R"
& "ETURN NIL;\n ELSIF action <= %lastShift0 THEN\n curState :="
& " action;\n DebugState(\"shifting to state\");\n Push(stac"
& "k, StackElem{state := curState, value := symbol});\n ELSIF action "
& "= %lastShift1 THEN\n DebugPrint(\"parsing stopped with singleton"
& " start symbol on stack\");\n <* ASSERT stack.ptr = 1 *>\n "
& " IF exhaustInput AND preservedToken = NoToken THEN\n symbol :="
& " NextToken(self);\n DebugPrint(\"getting token to check that i"
& "t\'s an EOF\");\n END;\n IF symbol.code # 0 THEN\n "
& " IF exhaustInput THEN\n DebugPrint(\"Error: last token was"
& " not EOF\");\n self.lex.unget();\n self.lex.error"
& "(\"%yacc: syntax error (parsing stopped before EOF)\");\n RE"
& "TURN NIL;\n END;\n IF preservedToken # NoToken THEN\n"
& " self.lex.unget();\n DebugPrint(\"ungetting last "
& "token\");\n END;\n END;\n symbol := stack.a[1].v"
& "alue;\n DebugSymbol(\"returning symbol\");\n RETURN symbo"
& "l.value;\n ELSE\n DebugRule(\"reducing by rule\");\n "
& " WITH p=stack.ptr, a=stack.a, v=symbol.value, l=Rules[action].length DO"
& "\n CASE action OF\n%reduce\\\n ELSE\n <* A"
& "SSERT FALSE *>\n END;\n FOR i := p - l + 1 TO p DO a["
& "i].value.value.discard(); END;\n DEC(p, l);\n curStat"
& "e := a[p].state;\n END;\n DebugState(\"popping to state\""
& ");\n symbol.code := Rules[action].returnCode;\n skipToken"
& "Gets := 2;\n END;\n END;\n END Parse; \n\nPROCEDURE Purge(self"
& ": T): INTEGER =\n BEGIN\n RETURN 0%purge;\n END Purge;\n\n(* defau"
& "lt methods *)\n%defimpl\\\nBEGIN\nEND %yacc.\n";
CONST E6 =
" Original_%name = %name;\n";
CONST E7 =
" | %number => VAR w: %return := NIL;\\\n%fromStack\n "
& " BEGIN self.%name(w%cparams); v:=w; END;\n";
BEGIN
END yaccformBundle.