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 /pgraph/releases/release-110.64/scan.sml
ViewVC logotype

Annotation of /pgraph/releases/release-110.64/scan.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 975 - (view) (download)
Original Path: sml/trunk/src/cm/pgraph/scan.sml

1 : blume 975 (* scan.sml
2 :     *
3 :     * (C) 2001 Lucent Technologies, Bell Labs
4 :     *
5 :     * Read the output of format.sml and reconstruct the original
6 :     * PortableGraph.graph.
7 :     *
8 :     * author: Matthias Blume (blume@research.bell-labs.com)
9 :     *)
10 :     structure ScanPortable : sig
11 :     exception ParseError of string
12 :     val input : TextIO.instream -> PortableGraph.graph
13 :     end = struct
14 :    
15 :     structure P = PortableGraph
16 :     structure S = TextIO.StreamIO
17 :    
18 :     exception ParseError of string
19 :    
20 :     fun input ins = let
21 :     val s = TextIO.getInstream ins
22 :    
23 :     fun allof l s = foldl (fn (f, s) => f s) s l
24 :    
25 :     fun skipWS s =
26 :     case S.input1 s of
27 :     NONE => s
28 :     | SOME (c, s') => if Char.isSpace c then skipWS s' else s
29 :    
30 :     fun maybeident s = let
31 :     val s = skipWS s
32 :     val finish = String.implode o rev
33 :     fun loop (s, a) =
34 :     case S.input1 s of
35 :     NONE => SOME (finish a, s)
36 :     | SOME (c, s') => if Char.isAlphaNum c then loop (s', c :: a)
37 :     else SOME (finish a, s)
38 :     in
39 :     case S.input1 s of
40 :     NONE => NONE
41 :     | SOME (c, s') => if Char.isAlpha c then loop (s', [c])
42 :     else NONE
43 :     end
44 :    
45 :     fun ident s =
46 :     case maybeident s of
47 :     NONE => raise ParseError "expected: identifier"
48 :     | SOME (i, s') => (i, s')
49 :    
50 :     fun maybestring s = let
51 :     val s = skipWS s
52 :     fun eof () = raise ParseError "unexpected EOF in string"
53 :     fun loop (s, a) =
54 :     case S.input1 s of
55 :     NONE => eof ()
56 :     | SOME (#"\"", s') =>
57 :     (case String.fromString (String.implode (rev a)) of
58 :     SOME x => SOME (x, s')
59 :     | NONE => raise ParseError "illegal string syntax")
60 :     | SOME (#"\\", s') =>
61 :     (case S.input1 s' of
62 :     NONE => eof ()
63 :     | SOME (c, s'') => loop (s'', c :: #"\\" :: a))
64 :     | SOME (c, s') => loop (s', c :: a)
65 :     in
66 :     case S.input1 s of
67 :     SOME (#"\"", s') => loop (s', [])
68 :     | _ => raise ParseError "expected: string"
69 :     end
70 :    
71 :     fun string s =
72 :     case maybestring s of
73 :     NONE => raise ParseError "expected: string"
74 :     | SOME (x, s') => (x, s')
75 :    
76 :     fun expect c s = let
77 :     val s = skipWS s
78 :     fun notc what =
79 :     raise ParseError (concat ["expected: ", Char.toString c,
80 :     ", found: ", what])
81 :     in
82 :     case S.input1 s of
83 :     NONE => notc "EOF"
84 :     | SOME (c', s') => if c = c' then s' else notc (Char.toString c')
85 :     end
86 :    
87 :     fun expectId i s = let
88 :     val (i', s') = ident s
89 :     in
90 :     if i = i' then s'
91 :     else raise ParseError (concat ["expected: ", i, ", found: ", i'])
92 :     end
93 :    
94 :     fun varlist s = let
95 :     fun eof () = raise ParseError "unexpected EOF in varlist"
96 :     val s = allof [expect #"[", skipWS] s
97 :     fun rest s = let
98 :     val s = skipWS s
99 :     in
100 :     case S.input1 s of
101 :     NONE => eof ()
102 :     | SOME (#"]", s') => ([], s')
103 :     | SOME (#",", s') => let
104 :     val (h, s'') = ident s'
105 :     val (t, s''') = rest s''
106 :     in
107 :     (h :: t, s''')
108 :     end
109 :     | SOME (c, _) =>
110 :     raise ParseError
111 :     (concat ["expected , or ], found: ",
112 :     Char.toString c])
113 :     end
114 :     in
115 :     case S.input1 s of
116 :     NONE => eof ()
117 :     | SOME (#"]", s') => ([], s')
118 :     | SOME _ => let
119 :     val (h, s') = ident s
120 :     val (t, s'') = rest s'
121 :     in
122 :     (h :: t, s'')
123 :     end
124 :     end
125 :    
126 :     fun def s =
127 :     case maybeident s of
128 :     SOME ("val", s) =>
129 :     let val s = allof [expect #"(", expectId "C", expect #","] s
130 :     val (lhs, s) = ident s
131 :     val s = allof [expect #")", expect #"="] s
132 :     val (f, s) = ident s
133 :     val s = expectId "C" s
134 :     fun def (rhs, s) =
135 :     SOME (P.DEF { lhs = lhs, rhs = rhs }, s)
136 :     fun comp native = let
137 :     val (r, s) = string s
138 :     val (e, s) = ident s
139 :     val (ss, s) = ident s
140 :     in
141 :     def (P.COMPILE { src = r, env = e,
142 :     syms = ss, native = native }, s)
143 :     end
144 :     in
145 :     case f of
146 :     "SYMS" => let
147 :     val (l, s) = varlist s
148 :     in
149 :     def (P.SYMS l, s)
150 :     end
151 :     | "IMPORT" => let
152 :     val (l, s) = ident s
153 :     val (ss, s) = ident s
154 :     in
155 :     def (P.IMPORT { lib = l, syms = ss }, s)
156 :     end
157 :     | "COMPILE" => comp false
158 :     | "NCOMPILE" => comp true
159 :     | "MERGE" => let
160 :     val (l, s) = varlist s
161 :     in
162 :     def (P.MERGE l, s)
163 :     end
164 :     | "FILTER" => let
165 :     val (e, s) = ident s
166 :     val (ss, s) = ident s
167 :     in
168 :     def (P.FILTER { env = e, syms = ss }, s)
169 :     end
170 :     | "SYM" => let
171 :     val (ns, s) = string s
172 :     val (n, s) = string s
173 :     in
174 :     def (P.SYM (ns, n), s)
175 :     end
176 :     | x => raise ParseError ("unknown function: " ^ x)
177 :     end
178 :     | _ => NONE
179 :    
180 :     fun deflist s = let
181 :     fun loop (s, a) =
182 :     case def s of
183 :     SOME (d, s') => loop (s', d :: a)
184 :     | NONE => (rev a, s)
185 :     in
186 :     loop (s, [])
187 :     end
188 :    
189 :     fun graph s = let
190 :     val s = allof [#2 o S.inputLine, expectId "fn"] s
191 :     val (imports, s) = varlist s
192 :     val s = allof [expect #"=", expect #">", expectId "let"] s
193 :     val (defs, s) = deflist s
194 :     val s = allof [expectId "in", expectId "EXPORT", expectId "C"] s
195 :     val (export, s) = ident s
196 :     (* gobble up remaining boilerplate... *)
197 :     val s = allof [expectId "end", expect #"|", expect #"_",
198 :     expect #"=", expect #">", expectId "raise",
199 :     expectId "Fail", #2 o string, expect #")",
200 :     #2 o S.inputLine]
201 :     s
202 :     in
203 :     TextIO.setInstream (ins, s);
204 :     P.GRAPH { imports = imports, defs = defs, export = export }
205 :     end
206 :     in
207 :     graph s
208 :     end
209 :     end

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