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 1368 - (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 : blume 977 val s = TextIO.getInstream ins
22 : blume 975
23 : mblume 1368 fun skipLine s = getOpt (Option.map #2 (S.inputLine s), s)
24 :    
25 : blume 977 fun allof l s = foldl (fn (f, s) => f s) s l
26 : blume 975
27 : blume 977 fun skipWS s =
28 :     case S.input1 s of
29 :     NONE => s
30 :     | SOME (c, s') => if Char.isSpace c then skipWS s' else s
31 : blume 975
32 : blume 977 fun maybeident s = let
33 :     val s = skipWS s
34 :     val finish = String.implode o rev
35 :     fun loop (s, a) =
36 :     case S.input1 s of
37 :     NONE => SOME (finish a, s)
38 :     | SOME (c, s') => if Char.isAlphaNum c then loop (s', c :: a)
39 :     else SOME (finish a, s)
40 :     in
41 :     case S.input1 s of
42 :     NONE => NONE
43 :     | SOME (c, s') => if Char.isAlpha c then loop (s', [c])
44 :     else NONE
45 :     end
46 : blume 975
47 : blume 977 fun ident s =
48 :     case maybeident s of
49 :     NONE => raise ParseError "expected: identifier"
50 :     | SOME (i, s') => (i, s')
51 : blume 975
52 : blume 977 fun maybestring s = let
53 :     val s = skipWS s
54 :     fun eof () = raise ParseError "unexpected EOF in string"
55 :     fun loop (s, a) =
56 :     case S.input1 s of
57 :     NONE => eof ()
58 :     | SOME (#"\"", s') =>
59 :     (case String.fromString (String.implode (rev a)) of
60 :     SOME x => SOME (x, s')
61 :     | NONE => raise ParseError "illegal string syntax")
62 :     | SOME (#"\\", s') =>
63 :     (case S.input1 s' of
64 :     NONE => eof ()
65 :     | SOME (c, s'') => loop (s'', c :: #"\\" :: a))
66 :     | SOME (c, s') => loop (s', c :: a)
67 :     in
68 :     case S.input1 s of
69 :     SOME (#"\"", s') => loop (s', [])
70 :     | _ => raise ParseError "expected: string"
71 :     end
72 : blume 975
73 : blume 977 fun string s =
74 :     case maybestring s of
75 :     NONE => raise ParseError "expected: string"
76 :     | SOME (x, s') => (x, s')
77 : blume 975
78 : blume 977 fun expect c s = let
79 :     val s = skipWS s
80 :     fun notc what =
81 :     raise ParseError (concat ["expected: ", Char.toString c,
82 :     ", found: ", what])
83 :     in
84 :     case S.input1 s of
85 :     NONE => notc "EOF"
86 :     | SOME (c', s') => if c = c' then s' else notc (Char.toString c')
87 :     end
88 : blume 975
89 : blume 977 fun expectId i s = let
90 :     val (i', s') = ident s
91 :     in
92 :     if i = i' then s'
93 :     else raise ParseError (concat ["expected: ", i, ", found: ", i'])
94 :     end
95 : blume 975
96 : blume 977 fun varlist s = let
97 :     fun eof () = raise ParseError "unexpected EOF in varlist"
98 :     val s = allof [expect #"[", skipWS] s
99 :     fun rest s = let
100 :     val s = skipWS s
101 :     in
102 :     case S.input1 s of
103 :     NONE => eof ()
104 :     | SOME (#"]", s') => ([], s')
105 :     | SOME (#",", s') => let
106 :     val (h, s'') = ident s'
107 :     val (t, s''') = rest s''
108 :     in
109 :     (h :: t, s''')
110 :     end
111 :     | SOME (c, _) =>
112 :     raise ParseError
113 :     (concat ["expected , or ], found: ",
114 :     Char.toString c])
115 :     end
116 :     in
117 :     case S.input1 s of
118 :     NONE => eof ()
119 :     | SOME (#"]", s') => ([], s')
120 :     | SOME _ => let
121 :     val (h, s') = ident s
122 :     val (t, s'') = rest s'
123 :     in
124 :     (h :: t, s'')
125 :     end
126 :     end
127 : blume 975
128 : blume 977 fun def s =
129 :     case maybeident s of
130 :     SOME ("val", s) =>
131 :     let val s = allof [expect #"(", expectId "c", expect #","] s
132 :     val (lhs, s) = ident s
133 :     val s = allof [expect #")", expect #"="] s
134 :     val (f, s) = ident s
135 :     val s = expectId "c" s
136 :     fun def (rhs, s) =
137 :     SOME (P.DEF { lhs = lhs, rhs = rhs }, s)
138 :     fun comp native = let
139 :     val (r, s) = string s
140 :     val (e, s) = ident s
141 :     val (ss, s) = ident s
142 :     in
143 :     def (P.COMPILE { src = (r, native),
144 :     env = e, syms = ss },
145 :     s)
146 :     end
147 : blume 1011 fun sym ns = let
148 :     val (n, s) = string s
149 :     in
150 :     def (P.SYM (ns, n), s)
151 :     end
152 : blume 977 in
153 :     case f of
154 :     "syms" => let
155 :     val (l, s) = varlist s
156 :     in
157 :     def (P.SYMS l, s)
158 :     end
159 :     | "import" => let
160 :     val (l, s) = ident s
161 :     val (ss, s) = ident s
162 :     in
163 :     def (P.IMPORT { lib = l, syms = ss }, s)
164 :     end
165 :     | "compile" => comp false
166 :     | "ncompile" => comp true
167 :     | "merge" => let
168 :     val (l, s) = varlist s
169 :     in
170 :     def (P.MERGE l, s)
171 :     end
172 :     | "filter" => let
173 :     val (e, s) = ident s
174 :     val (ss, s) = ident s
175 :     in
176 :     def (P.FILTER { env = e, syms = ss }, s)
177 :     end
178 : blume 1011 | "sgn" => sym P.SGN
179 :     | "str" => sym P.STR
180 :     | "fct" => sym P.FCT
181 : blume 977 | x => raise ParseError ("unknown function: " ^ x)
182 :     end
183 :     | _ => NONE
184 : blume 975
185 : blume 977 fun deflist s = let
186 :     fun loop (s, a) =
187 :     case def s of
188 :     SOME (d, s') => loop (s', d :: a)
189 :     | NONE => (rev a, s)
190 :     in
191 :     loop (s, [])
192 :     end
193 : blume 975
194 : blume 977 fun graph s = let
195 : mblume 1368 val s = allof [skipLine, expectId "fn"] s
196 : blume 977 val (imports, s) = varlist s
197 : blume 1011 val s = allof [expect #"=", expect #">", expectId "let",
198 :     expectId "open", expectId "PGOps"] s
199 : blume 977 val (defs, s) = deflist s
200 :     val s = allof [expectId "in", expectId "export", expectId "c"] s
201 :     val (export, s) = ident s
202 :     (* gobble up remaining boilerplate... *)
203 :     val s = allof [expectId "end", expect #"|", expect #"_",
204 :     expect #"=", expect #">", expectId "raise",
205 :     expectId "Fail", #2 o string, expect #")",
206 : mblume 1368 skipLine]
207 : blume 977 s
208 :     in
209 :     TextIO.setInstream (ins, s);
210 :     P.GRAPH { imports = imports, defs = defs, export = export }
211 :     end
212 : blume 975 in
213 : blume 977 graph s
214 : blume 975 end
215 :     end

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