1213496Scognet(* Modified by sweeks@acm.org on 2000-8-24. 2213496Scognet * Ported to MLton. 3213496Scognet *) 4213496Scognettype int = Int.int 5213496Scognet 6213496Scognet(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 7213496Scognet * 8213496Scognet * $Log$ 9213496Scognet * Revision 1.1 2006/06/22 07:40:27 michaeln 10213496Scognet * Add a MoscowML compilable implementation of MLyacc, using the MLton sources 11213496Scognet * as the base. 12213496Scognet * 13213496Scognet * Revision 1.1.1.1 1998/04/08 18:40:16 george 14213496Scognet * Version 110.5 15213496Scognet * 16213496Scognet * Revision 1.1.1.1 1997/01/14 01:38:05 george 17213496Scognet * Version 109.24 18213496Scognet * 19213496Scognet * Revision 1.2 1996/02/26 15:02:34 george 20213496Scognet * print no longer overloaded. 21213496Scognet * use of makestring has been removed and replaced with Int.toString .. 22213496Scognet * use of IO replaced with TextIO 23213496Scognet * 24213496Scognet * Revision 1.1.1.1 1996/01/31 16:01:45 george 25213496Scognet * Version 109 26213496Scognet * 27213496Scognet *) 28238369Simp 29238369Simpfunctor HeaderFun () : HEADER = 30213496Scognet struct 31213496Scognet val DEBUG = true 32213496Scognet 33213496Scognet type pos = int 34213496Scognet val lineno: int ref = ref 0 35213496Scognet val text = ref (nil: string list) 36213496Scognet type inputSource = {name : string, 37213496Scognet errStream : TextIO.outstream, 38213496Scognet inStream : TextIO.instream, 39213496Scognet errorOccurred : bool ref} 40213496Scognet 41213496Scognet val newSource = 42213496Scognet fn (s : string,i : TextIO.instream ,errs : TextIO.outstream) => 43213496Scognet {name=s,errStream=errs,inStream=i, 44213496Scognet errorOccurred = ref false} 45213496Scognet 46213496Scognet val errorOccurred = fn (s : inputSource) =>fn () => !(#errorOccurred s) 47213496Scognet 48213496Scognet val pr = fn out : TextIO.outstream => fn s : string => TextIO.output(out,s) 49213496Scognet 50213496Scognet val error = fn {name,errStream, errorOccurred,...} : inputSource => 51213496Scognet let val pr = pr errStream 52213496Scognet in fn l : pos => fn msg : string => 53213496Scognet (pr name; pr ", line "; pr (Int.toString l); pr ": Error: "; 54213496Scognet pr msg; pr "\n"; errorOccurred := true) 55213496Scognet end 56213496Scognet 57213496Scognet val warn = fn {name,errStream, errorOccurred,...} : inputSource => 58213496Scognet let val pr = pr errStream 59238369Simp in fn l : pos => fn msg : string => 60238369Simp (pr name; pr ", line "; pr (Int.toString l); pr ": Warning: "; 61238369Simp pr msg; pr "\n") 62238369Simp end 63238369Simp 64 datatype prec = LEFT | RIGHT | NONASSOC 65 66 datatype symbol = SYMBOL of string * pos 67 val symbolName = fn SYMBOL(s,_) => s 68 val symbolPos = fn SYMBOL(_,p) => p 69 val symbolMake = fn sp => SYMBOL sp 70 71 type ty = string 72 val tyName = fn i => i 73 val tyMake = fn i => i 74 75 datatype control = NODEFAULT | VERBOSE | PARSER_NAME of symbol | 76 FUNCTOR of string | START_SYM of symbol | 77 NSHIFT of symbol list | POS of string | PURE | 78 PARSE_ARG of string * string | 79 TOKEN_SIG_INFO of string 80 81 datatype declData = DECL of 82 {eop : symbol list, 83 keyword : symbol list, 84 nonterm : (symbol*ty option) list option, 85 prec : (prec * (symbol list)) list, 86 change: (symbol list * symbol list) list, 87 term : (symbol* ty option) list option, 88 control : control list, 89 value : (symbol * string) list} 90 91 type rhsData = {rhs:symbol list,code:string, prec:symbol option} list 92 datatype rule = RULE of {lhs : symbol, rhs : symbol list, 93 code : string, prec : symbol option} 94 95 type parseResult = string * declData * rule list 96 val getResult = fn p => p 97 98 fun join_decls 99 (DECL {eop=e,control=c,keyword=k,nonterm=n,prec, 100 change=su,term=t,value=v}:declData, 101 DECL {eop=e',control=c',keyword=k',nonterm=n',prec=prec', 102 change=su',term=t',value=v'} : declData, 103 inputSource,pos) = 104 let val ignore = fn s => 105 (warn inputSource pos ("ignoring duplicate " ^ s ^ 106 " declaration")) 107 val join = fn (e,NONE,NONE) => NONE 108 | (e,NONE,a) => a 109 | (e,a,NONE) => a 110 | (e,a,b) => (ignore e; a) 111 fun mergeControl (nil,a) = [a] 112 | mergeControl (l as h::t,a) = 113 case (h,a) 114 of (PARSER_NAME _,PARSER_NAME n1) => (ignore "%name"; l) 115 | (FUNCTOR _,FUNCTOR _) => (ignore "%header"; l) 116 | (PARSE_ARG _,PARSE_ARG _) => (ignore "%arg"; l) 117 | (START_SYM _,START_SYM s) => (ignore "%start"; l) 118 | (POS _,POS _) => (ignore "%pos"; l) 119 | (TOKEN_SIG_INFO _, TOKEN_SIG_INFO _) 120 => (ignore "%token_sig_info"; l) 121 | (NSHIFT a,NSHIFT b) => (NSHIFT (a@b)::t) 122 | _ => h :: mergeControl(t,a) 123 fun loop (nil,r) = r 124 | loop (h::t,r) = loop(t,mergeControl(r,h)) 125 in DECL {eop=e@e',control=loop(c',c),keyword=k'@k, 126 nonterm=join("%nonterm",n,n'), prec=prec@prec', 127 change=su@su', term=join("%term",t,t'),value=v@v'} : 128 declData 129 end 130end; 131 132structure Header = HeaderFun(); 133 134