Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/ml-yacc/src/hdr.sml
ViewVC logotype

Annotation of /sml/trunk/src/ml-yacc/src/hdr.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 249 - (view) (download)
Original Path: sml/branches/SMLNJ/src/ml-yacc/src/hdr.sml

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

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0