1(* 2 * @TAG(OTHER_PRINCETON_OSS) 3 *) 4(* Modified by sweeks@acm.org on 2000-8-24. 5 * Ported to MLton. 6 *) 7type int = Int.int 8 9(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 10 * 11 * $Log$ 12 * Revision 1.1 2006/06/22 07:40:27 michaeln 13 * Add a MoscowML compilable implementation of MLyacc, using the MLton sources 14 * as the base. 15 * 16 * Revision 1.1.1.1 1998/04/08 18:40:16 george 17 * Version 110.5 18 * 19 * Revision 1.1.1.1 1997/01/14 01:38:05 george 20 * Version 109.24 21 * 22 * Revision 1.2 1996/02/26 15:02:34 george 23 * print no longer overloaded. 24 * use of makestring has been removed and replaced with Int.toString .. 25 * use of IO replaced with TextIO 26 * 27 * Revision 1.1.1.1 1996/01/31 16:01:45 george 28 * Version 109 29 * 30 *) 31 32functor HeaderFun () : HEADER = 33 struct 34 val DEBUG = true 35 36 type pos = int 37 val lineno: int ref = ref 0 38 val text = ref (nil: string list) 39 type inputSource = {name : string, 40 errStream : TextIO.outstream, 41 inStream : TextIO.instream, 42 errorOccurred : bool ref} 43 44 val newSource = 45 fn (s : string,i : TextIO.instream ,errs : TextIO.outstream) => 46 {name=s,errStream=errs,inStream=i, 47 errorOccurred = ref false} 48 49 val errorOccurred = fn (s : inputSource) =>fn () => !(#errorOccurred s) 50 51 val pr = fn out : TextIO.outstream => fn s : string => TextIO.output(out,s) 52 53 val error = fn {name,errStream, errorOccurred,...} : inputSource => 54 let val pr = pr errStream 55 in fn l : pos => fn msg : string => 56 (pr name; pr ", line "; pr (Int.toString l); pr ": Error: "; 57 pr msg; pr "\n"; errorOccurred := true) 58 end 59 60 val warn = fn {name,errStream, errorOccurred,...} : inputSource => 61 let val pr = pr errStream 62 in fn l : pos => fn msg : string => 63 (pr name; pr ", line "; pr (Int.toString l); pr ": Warning: "; 64 pr msg; pr "\n") 65 end 66 67 datatype prec = LEFT | RIGHT | NONASSOC 68 69 datatype symbol = SYMBOL of string * pos 70 val symbolName = fn SYMBOL(s,_) => s 71 val symbolPos = fn SYMBOL(_,p) => p 72 val symbolMake = fn sp => SYMBOL sp 73 74 type ty = string 75 val tyName = fn i => i 76 val tyMake = fn i => i 77 78 datatype control = NODEFAULT | VERBOSE | PARSER_NAME of symbol | 79 FUNCTOR of string | START_SYM of symbol | 80 NSHIFT of symbol list | POS of string | PURE | 81 PARSE_ARG of string * string | 82 TOKEN_SIG_INFO of string 83 84 datatype declData = DECL of 85 {eop : symbol list, 86 keyword : symbol list, 87 nonterm : (symbol*ty option) list option, 88 prec : (prec * (symbol list)) list, 89 change: (symbol list * symbol list) list, 90 term : (symbol* ty option) list option, 91 control : control list, 92 value : (symbol * string) list} 93 94 type rhsData = {rhs:symbol list,code:string, prec:symbol option} list 95 datatype rule = RULE of {lhs : symbol, rhs : symbol list, 96 code : string, prec : symbol option} 97 98 type parseResult = string * declData * rule list 99 val getResult = fn p => p 100 101 fun join_decls 102 (DECL {eop=e,control=c,keyword=k,nonterm=n,prec, 103 change=su,term=t,value=v}:declData, 104 DECL {eop=e',control=c',keyword=k',nonterm=n',prec=prec', 105 change=su',term=t',value=v'} : declData, 106 inputSource,pos) = 107 let val ignore = fn s => 108 (warn inputSource pos ("ignoring duplicate " ^ s ^ 109 " declaration")) 110 val join = fn (e,NONE,NONE) => NONE 111 | (e,NONE,a) => a 112 | (e,a,NONE) => a 113 | (e,a,b) => (ignore e; a) 114 fun mergeControl (nil,a) = [a] 115 | mergeControl (l as h::t,a) = 116 case (h,a) 117 of (PARSER_NAME _,PARSER_NAME n1) => (ignore "%name"; l) 118 | (FUNCTOR _,FUNCTOR _) => (ignore "%header"; l) 119 | (PARSE_ARG _,PARSE_ARG _) => (ignore "%arg"; l) 120 | (START_SYM _,START_SYM s) => (ignore "%start"; l) 121 | (POS _,POS _) => (ignore "%pos"; l) 122 | (TOKEN_SIG_INFO _, TOKEN_SIG_INFO _) 123 => (ignore "%token_sig_info"; l) 124 | (NSHIFT a,NSHIFT b) => (NSHIFT (a@b)::t) 125 | _ => h :: mergeControl(t,a) 126 fun loop (nil,r) = r 127 | loop (h::t,r) = loop(t,mergeControl(r,h)) 128 in DECL {eop=e@e',control=loop(c',c),keyword=k'@k, 129 nonterm=join("%nonterm",n,n'), prec=prec@prec', 130 change=su@su', term=join("%term",t,t'),value=v@v'} : 131 declData 132 end 133end; 134 135structure Header = HeaderFun(); 136 137