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