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/benchmarks/programs/mlyacc/hdr.sml
ViewVC logotype

Annotation of /sml/trunk/benchmarks/programs/mlyacc/hdr.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 193 - (view) (download)

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

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