implement Yacc; include "sys.m"; sys: Sys; print, fprint, sprint: import sys; UTFmax: import Sys; include "bufio.m"; bufio: Bufio; Iobuf: import bufio; include "draw.m"; Yacc: module{ init: fn(ctxt: ref Draw->Context, argv: list of string);}; Arg: adt{ argv: list of string; c: int; opts: string; init: fn(argv: list of string): ref Arg; opt: fn(arg: self ref Arg): int; arg: fn(arg: self ref Arg): string;}; PARSER: con "/lib/yaccpar";OFILE: con "tab.b";FILEU: con "output";FILED: con "tab.m";FILEDEBUG: con "debug"; # the following are adjustable# according to memory sizeACTSIZE: con 30000;NSTATES: con 2000;TEMPSIZE: con 2000; SYMINC: con 50; # increase for non-term or termRULEINC: con 50; # increase for max rule length prodptr[i]PRODINC: con 100; # increase for productions prodptrWSETINC: con 50; # increase for working sets wsetsSTATEINC: con 200; # increase for states statemem NAMESIZE: con 50;NTYPES: con 63;ISIZE: con 400; PRIVATE: con 16rE000; # unicode private use # relationships which must hold:# TEMPSIZE >= NTERMS + NNONTERM + 1# TEMPSIZE >= NSTATES# NTBASE: con 8r10000;ERRCODE: con 8190;ACCEPTCODE: con 8191;YYLEXUNK: con 3;TOKSTART: con 4; #index of first defined token # no, left, right, binary assoc.NOASC, LASC, RASC, BASC: con iota; # flags for state generationDONE, MUSTDO, MUSTLOOKAHEAD: con iota; # flags for a rule having an action, and being reducedACTFLAG: con 16r4;REDFLAG: con 16r8; # output parser flagsYYFLAG1: con -1000; # parse tokensIDENTIFIER, MARK, TERM, LEFT, RIGHT, BINARY, PREC, LCURLY, IDENTCOLON, NUMBER, START, TYPEDEF, TYPENAME, MODULE: con PRIVATE+iota; ENDFILE: con 0; EMPTY: con 1;WHOKNOWS: con 0;OK: con 1;NOMORE: con -1000; # macros for getting associativity and precedence levelsASSOC(i: int): int{ return i & 3;} PLEVEL(i: int): int{ return (i >> 4) & 16r3f;} TYPE(i: int): int{ return (i >> 10) & 16r3f;} # macros for setting associativity and precedence levelsSETASC(i, j: int): int{ return i | j;} SETPLEV(i, j: int): int{ return i | (j << 4);} SETTYPE(i, j: int): int{ return i | (j << 10);} # I/O descriptorsstderr: ref Sys->FD;fdefine: ref Iobuf; # file for module definitionfdebug: ref Iobuf; # y.debug for strings for debuggingftable: ref Iobuf; # y.tab.c filefinput: ref Iobuf; # input filefoutput: ref Iobuf; # y.output file CodeData, CodeMod, CodeAct: con iota;NCode: con 8192; Code: adt{ kind: int; data: array of byte; ndata: int; next: cyclic ref Code;}; codehead: ref Code;codetail: ref Code; modname: string; # name of modulesuppressmod: int; # suppress module definitionstacksize := 200; # communication variables between various I/O routinesinfile: string; # input file namenumbval: int; # value of an input numbertokname: string; # input token name, slop for runes and 0 # structure declarationsLkset: type array of int; Pitem: adt{ prod: array of int; off: int; # offset within the production first: int; # first term or non-term in item prodno: int; # production number for sorting}; Item: adt{ pitem: Pitem; look: Lkset;}; Symb: adt{ name: string; value: int;}; Wset: adt{ pitem: Pitem; flag: int; ws: Lkset;}; # storage of names parser := PARSER;yydebug: string; # storage of typesntypes: int; # number of types definedtypeset := array[NTYPES] of string; # pointers to type tags # token information ntokens := 0; # number of tokenstokset: array of Symb;toklev: array of int; # vector with the precedence of the terminals # nonterminal information nnonter := -1; # the number of nonterminalsnontrst: array of Symb;start: int; # start symbol # state information nstate := 0; # number of statespstate := array[NSTATES+2] of int; # index into statemem to the descriptions of the statesstatemem : array of Item;tystate := array[NSTATES] of int; # contains type information about the stateststates : array of int; # states generated by terminal gotosntstates : array of int; # states generated by nonterminal gotosmstates := array[NSTATES] of {* => 0}; # chain of overflows of term/nonterm generation listslastred: int; # number of last reduction of a statedefact := array[NSTATES] of int; # default actions of states # lookahead set information lkst: array of Lkset;nolook := 0; # flag to turn off lookahead computationstbitset := 0; # size of lookahead setsclset: Lkset; # temporary storage for lookahead computations # working set information wsets: array of Wset;cwp: int; # storage for action table amem: array of int; # action table storagememp: int; # next free action table positionindgo := array[NSTATES] of int; # index to the stored goto table # temporary vector, indexable by states, terms, or ntokens temp1 := array[TEMPSIZE] of int; # temporary storage, indexed by terms + ntokens or stateslineno := 1; # current input line numberfatfl := 1; # if on, error is fatalnerrors := 0; # number of errors # assigned token type valuesextval := 0; ytabc := OFILE; # name of y.tab.c # grammar rule information nprod := 1; # number of productionsprdptr: array of array of int; # pointers to descriptions of productionslevprd: array of int; # precedence levels for the productionsrlines: array of int; # line number for this rule # statistics collection variables zzgoent := 0;zzgobest := 0;zzacent := 0;zzexcp := 0;zzclose := 0;zzrrconf := 0;zzsrconf := 0;zzstate := 0; # optimizer arraysyypgo: array of array of int;optst: array of array of int;ggreed: array of int;pgo: array of int; maxspr: int; # maximum spread of any entrymaxoff: int; # maximum offset into a arraymaxa: int; # storage for information about the nonterminals pres: array of array of array of int; # vector of pointers to productions yielding each nonterminalpfirst: array of Lkset;pempty: array of int; # vector of nonterminals nontrivially deriving e # random stuff picked out from between functions indebug := 0; # debugging flag for cpfirpidebug := 0; # debugging flag for putitemgsdebug := 0; # debugging flag for stagencldebug := 0; # debugging flag for closurepkdebug := 0; # debugging flag for apackg2debug := 0; # debugging for go2genadb := 0; # debugging for callopt Resrv : adt{ name: string; value: int;}; resrv := array[] of { Resrv("binary", BINARY), Resrv("module", MODULE), Resrv("left", LEFT), Resrv("nonassoc", BINARY), Resrv("prec", PREC), Resrv("right", RIGHT), Resrv("start", START), Resrv("term", TERM), Resrv("token", TERM), Resrv("type", TYPEDEF),}; zznewstate := 0; init(nil: ref Draw->Context, argv: list of string){ sys = load Sys Sys->PATH; bufio = load Bufio Bufio->PATH; stderr = sys->fildes(2); setup(argv); # initialize and read productions tbitset = (ntokens+32)/32; cpres(); # make table of which productions yield a given nonterminal cempty(); # make a table of which nonterminals can match the empty string cpfir(); # make a table of firsts of nonterminals stagen(); # generate the states yypgo = array[nnonter+1] of array of int; optst = array[nstate] of array of int; output(); # write the states and the tables go2out(); hideprod(); summary(); callopt(); others(); if(fdefine != nil) fdefine.close(); if(fdebug != nil) fdebug.close(); if(ftable != nil) ftable.close(); if(foutput != nil) foutput.close();} setup(argv: list of string){ j, ty: int; ytab := 0; vflag := 0; dflag := 0; stem := 0; stemc := "y"; foutput = nil; fdefine = nil; fdebug = nil; arg := Arg.init(argv); while(c := arg.opt()){ case c{ 'v' or 'V' => vflag++; 'D' => yydebug = arg.arg(); 'd' => dflag++; 'n' => stacksize = int arg.arg(); 'o' => ytab++; ytabc = arg.arg(); 's' => stem++; stemc = arg.arg(); 'm' => suppressmod++; * => usage(); } } argv = arg.argv; if(len argv != 1) usage(); if (suppressmod && dflag) { sys->fprint(stderr, "yacc: -m and -d are exclusive\n"); usage(); } if (stacksize < 1) { sys->fprint(stderr, "yacc: stack size too small\n"); usage(); } infile = hd argv; finput = bufio->open(infile, Bufio->OREAD); if(finput == nil) error("cannot open '"+infile+"'"); openup(stemc, dflag, vflag, ytab, ytabc); defin(0, "$end"); extval = PRIVATE; # tokens start in unicode 'private use' defin(0, "error"); defin(1, "$accept"); defin(0, "$unk"); i := 0; for(t := gettok(); t != MARK && t != ENDFILE; ) case t { ';' => t = gettok(); START => if(gettok() != IDENTIFIER) error("bad %%start construction"); start = chfind(1, tokname); t = gettok(); TYPEDEF => if(gettok() != TYPENAME) error("bad syntax in %%type"); ty = numbval; for(;;) { t = gettok(); case t { IDENTIFIER => if((t=chfind(1, tokname)) < NTBASE) { j = TYPE(toklev[t]); if(j != 0 && j != ty) error("type redeclaration of token "+ tokset[t].name); else toklev[t] = SETTYPE(toklev[t], ty); } else { j = nontrst[t-NTBASE].value; if(j != 0 && j != ty) error("type redeclaration of nonterminal "+ nontrst[t-NTBASE].name); else nontrst[t-NTBASE].value = ty; } continue; ',' => continue; ';' => t = gettok(); } break; } MODULE => cpymodule(); t = gettok(); LEFT or BINARY or RIGHT or TERM => # nonzero means new prec. and assoc. lev := t-TERM; if(lev) i++; ty = 0; # get identifiers so defined t = gettok(); # there is a type defined if(t == TYPENAME) { ty = numbval; t = gettok(); } for(;;) { case t { ',' => t = gettok(); continue; ';' => break; IDENTIFIER => j = chfind(0, tokname); if(j >= NTBASE) error(tokname+" defined earlier as nonterminal"); if(lev) { if(ASSOC(toklev[j])) error("redeclaration of precedence of "+tokname); toklev[j] = SETASC(toklev[j], lev); toklev[j] = SETPLEV(toklev[j], i); } if(ty) { if(TYPE(toklev[j])) error("redeclaration of type of "+tokname); toklev[j] = SETTYPE(toklev[j],ty); } t = gettok(); if(t == NUMBER) { tokset[j].value = numbval; t = gettok(); } continue; } break; }Lines 1–500 of 2809. Load more
implement Yacc; include "sys.m"; sys: Sys; print, fprint, sprint: import sys; UTFmax: import Sys; include "bufio.m"; bufio: Bufio; Iobuf: import bufio; include "draw.m"; Yacc: module { init: fn(ctxt: ref Draw->Context, argv: list of string); }; Arg: adt { argv: list of string; c: int; opts: string; init: fn(argv: list of string): ref Arg; opt: fn(arg: self ref Arg): int; arg: fn(arg: self ref Arg): string; }; PARSER: con "/lib/yaccpar"; OFILE: con "tab.b"; FILEU: con "output"; FILED: con "tab.m"; FILEDEBUG: con "debug"; # the following are adjustable # according to memory size ACTSIZE: con 30000; NSTATES: con 2000; TEMPSIZE: con 2000; SYMINC: con 50; # increase for non-term or term RULEINC: con 50; # increase for max rule length prodptr[i] PRODINC: con 100; # increase for productions prodptr WSETINC: con 50; # increase for working sets wsets STATEINC: con 200; # increase for states statemem NAMESIZE: con 50; NTYPES: con 63; ISIZE: con 400; PRIVATE: con 16rE000; # unicode private use # relationships which must hold: # TEMPSIZE >= NTERMS + NNONTERM + 1 # TEMPSIZE >= NSTATES # NTBASE: con 8r10000; ERRCODE: con 8190; ACCEPTCODE: con 8191; YYLEXUNK: con 3; TOKSTART: con 4; #index of first defined token # no, left, right, binary assoc. NOASC, LASC, RASC, BASC: con iota; # flags for state generation DONE, MUSTDO, MUSTLOOKAHEAD: con iota; # flags for a rule having an action, and being reduced ACTFLAG: con 16r4; REDFLAG: con 16r8; # output parser flags YYFLAG1: con -1000; # parse tokens IDENTIFIER, MARK, TERM, LEFT, RIGHT, BINARY, PREC, LCURLY, IDENTCOLON, NUMBER, START, TYPEDEF, TYPENAME, MODULE: con PRIVATE+iota; ENDFILE: con 0; EMPTY: con 1; WHOKNOWS: con 0; OK: con 1; NOMORE: con -1000; # macros for getting associativity and precedence levels ASSOC(i: int): int { return i & 3; } PLEVEL(i: int): int { return (i >> 4) & 16r3f; } TYPE(i: int): int { return (i >> 10) & 16r3f; } # macros for setting associativity and precedence levels SETASC(i, j: int): int { return i | j; } SETPLEV(i, j: int): int { return i | (j << 4); } SETTYPE(i, j: int): int { return i | (j << 10); } # I/O descriptors stderr: ref Sys->FD; fdefine: ref Iobuf; # file for module definition fdebug: ref Iobuf; # y.debug for strings for debugging ftable: ref Iobuf; # y.tab.c file finput: ref Iobuf; # input file foutput: ref Iobuf; # y.output file CodeData, CodeMod, CodeAct: con iota; NCode: con 8192; Code: adt { kind: int; data: array of byte; ndata: int; next: cyclic ref Code; }; codehead: ref Code; codetail: ref Code; modname: string; # name of module suppressmod: int; # suppress module definition stacksize := 200; # communication variables between various I/O routines infile: string; # input file name numbval: int; # value of an input number tokname: string; # input token name, slop for runes and 0 # structure declarations Lkset: type array of int; Pitem: adt { prod: array of int; off: int; # offset within the production first: int; # first term or non-term in item prodno: int; # production number for sorting }; Item: adt { pitem: Pitem; look: Lkset; }; Symb: adt { name: string; value: int; }; Wset: adt { pitem: Pitem; flag: int; ws: Lkset; }; # storage of names parser := PARSER; yydebug: string; # storage of types ntypes: int; # number of types defined typeset := array[NTYPES] of string; # pointers to type tags # token information ntokens := 0; # number of tokens tokset: array of Symb; toklev: array of int; # vector with the precedence of the terminals # nonterminal information nnonter := -1; # the number of nonterminals nontrst: array of Symb; start: int; # start symbol # state information nstate := 0; # number of states pstate := array[NSTATES+2] of int; # index into statemem to the descriptions of the states statemem : array of Item; tystate := array[NSTATES] of int; # contains type information about the states tstates : array of int; # states generated by terminal gotos ntstates : array of int; # states generated by nonterminal gotos mstates := array[NSTATES] of {* => 0}; # chain of overflows of term/nonterm generation lists lastred: int; # number of last reduction of a state defact := array[NSTATES] of int; # default actions of states # lookahead set information lkst: array of Lkset; nolook := 0; # flag to turn off lookahead computations tbitset := 0; # size of lookahead sets clset: Lkset; # temporary storage for lookahead computations # working set information wsets: array of Wset; cwp: int; # storage for action table amem: array of int; # action table storage memp: int; # next free action table position indgo := array[NSTATES] of int; # index to the stored goto table # temporary vector, indexable by states, terms, or ntokens temp1 := array[TEMPSIZE] of int; # temporary storage, indexed by terms + ntokens or states lineno := 1; # current input line number fatfl := 1; # if on, error is fatal nerrors := 0; # number of errors # assigned token type values extval := 0; ytabc := OFILE; # name of y.tab.c # grammar rule information nprod := 1; # number of productions prdptr: array of array of int; # pointers to descriptions of productions levprd: array of int; # precedence levels for the productions rlines: array of int; # line number for this rule # statistics collection variables zzgoent := 0; zzgobest := 0; zzacent := 0; zzexcp := 0; zzclose := 0; zzrrconf := 0; zzsrconf := 0; zzstate := 0; # optimizer arrays yypgo: array of array of int; optst: array of array of int; ggreed: array of int; pgo: array of int; maxspr: int; # maximum spread of any entry maxoff: int; # maximum offset into a array maxa: int; # storage for information about the nonterminals pres: array of array of array of int; # vector of pointers to productions yielding each nonterminal pfirst: array of Lkset; pempty: array of int; # vector of nonterminals nontrivially deriving e # random stuff picked out from between functions indebug := 0; # debugging flag for cpfir pidebug := 0; # debugging flag for putitem gsdebug := 0; # debugging flag for stagen cldebug := 0; # debugging flag for closure pkdebug := 0; # debugging flag for apack g2debug := 0; # debugging for go2gen adb := 0; # debugging for callopt Resrv : adt { name: string; value: int; }; resrv := array[] of { Resrv("binary", BINARY), Resrv("module", MODULE), Resrv("left", LEFT), Resrv("nonassoc", BINARY), Resrv("prec", PREC), Resrv("right", RIGHT), Resrv("start", START), Resrv("term", TERM), Resrv("token", TERM), Resrv("type", TYPEDEF),}; zznewstate := 0; init(nil: ref Draw->Context, argv: list of string) { sys = load Sys Sys->PATH; bufio = load Bufio Bufio->PATH; stderr = sys->fildes(2); setup(argv); # initialize and read productions tbitset = (ntokens+32)/32; cpres(); # make table of which productions yield a given nonterminal cempty(); # make a table of which nonterminals can match the empty string cpfir(); # make a table of firsts of nonterminals stagen(); # generate the states yypgo = array[nnonter+1] of array of int; optst = array[nstate] of array of int; output(); # write the states and the tables go2out(); hideprod(); summary(); callopt(); others(); if(fdefine != nil) fdefine.close(); if(fdebug != nil) fdebug.close(); if(ftable != nil) ftable.close(); if(foutput != nil) foutput.close(); } setup(argv: list of string) { j, ty: int; ytab := 0; vflag := 0; dflag := 0; stem := 0; stemc := "y"; foutput = nil; fdefine = nil; fdebug = nil; arg := Arg.init(argv); while(c := arg.opt()){ case c{ 'v' or 'V' => vflag++; 'D' => yydebug = arg.arg(); 'd' => dflag++; 'n' => stacksize = int arg.arg(); 'o' => ytab++; ytabc = arg.arg(); 's' => stem++; stemc = arg.arg(); 'm' => suppressmod++; * => usage(); } } argv = arg.argv; if(len argv != 1) usage(); if (suppressmod && dflag) { sys->fprint(stderr, "yacc: -m and -d are exclusive\n"); usage(); } if (stacksize < 1) { sys->fprint(stderr, "yacc: stack size too small\n"); usage(); } infile = hd argv; finput = bufio->open(infile, Bufio->OREAD); if(finput == nil) error("cannot open '"+infile+"'"); openup(stemc, dflag, vflag, ytab, ytabc); defin(0, "$end"); extval = PRIVATE; # tokens start in unicode 'private use' defin(0, "error"); defin(1, "$accept"); defin(0, "$unk"); i := 0; for(t := gettok(); t != MARK && t != ENDFILE; ) case t { ';' => t = gettok(); START => if(gettok() != IDENTIFIER) error("bad %%start construction"); start = chfind(1, tokname); t = gettok(); TYPEDEF => if(gettok() != TYPENAME) error("bad syntax in %%type"); ty = numbval; for(;;) { t = gettok(); case t { IDENTIFIER => if((t=chfind(1, tokname)) < NTBASE) { j = TYPE(toklev[t]); if(j != 0 && j != ty) error("type redeclaration of token "+ tokset[t].name); else toklev[t] = SETTYPE(toklev[t], ty); } else { j = nontrst[t-NTBASE].value; if(j != 0 && j != ty) error("type redeclaration of nonterminal "+ nontrst[t-NTBASE].name); else nontrst[t-NTBASE].value = ty; } continue; ',' => continue; ';' => t = gettok(); } break; } MODULE => cpymodule(); t = gettok(); LEFT or BINARY or RIGHT or TERM => # nonzero means new prec. and assoc. lev := t-TERM; if(lev) i++; ty = 0; # get identifiers so defined t = gettok(); # there is a type defined if(t == TYPENAME) { ty = numbval; t = gettok(); } for(;;) { case t { ',' => t = gettok(); continue; ';' => break; IDENTIFIER => j = chfind(0, tokname); if(j >= NTBASE) error(tokname+" defined earlier as nonterminal"); if(lev) { if(ASSOC(toklev[j])) error("redeclaration of precedence of "+tokname); toklev[j] = SETASC(toklev[j], lev); toklev[j] = SETPLEV(toklev[j], i); } if(ty) { if(TYPE(toklev[j])) error("redeclaration of type of "+tokname); toklev[j] = SETTYPE(toklev[j],ty); } t = gettok(); if(t == NUMBER) { tokset[j].value = numbval; t = gettok(); } continue; } break; }