Mercurial > urweb

comparison src/compiler.sml @ 56:d3cc191cb25f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Separate compilation and automatic basis importation
author Adam Chlipala <adamc@hcoop.net>
date Sun, 22 Jun 2008 14:23:05 -0400
parents 5c97b7cd912b
children 82aaa1c406d3
comparison
equal deleted inserted replaced
55:5c97b7cd912b 56:d3cc191cb25f
74 | SOME sgis => 74 | SOME sgis =>
75 app (fn sgi => (Print.print (SourcePrint.p_sgn_item sgi); 75 app (fn sgi => (Print.print (SourcePrint.p_sgn_item sgi);
76 print "\n")) sgis 76 print "\n")) sgis
77 77
78 (* The main parsing routine *) 78 (* The main parsing routine *)
79 fun parse filename = 79 fun parseLac filename =
80 let 80 let
81 val () = (ErrorMsg.resetErrors (); 81 val () = (ErrorMsg.resetErrors ();
82 ErrorMsg.resetPositioning filename) 82 ErrorMsg.resetPositioning filename)
83 val file = TextIO.openIn filename 83 val file = TextIO.openIn filename
84 fun get _ = TextIO.input file 84 fun get _ = TextIO.input file
96 NONE) 96 NONE)
97 | _ => SOME absyn 97 | _ => SOME absyn
98 end 98 end
99 handle LrParser.ParseError => NONE 99 handle LrParser.ParseError => NONE
100 100
101 fun elaborate env filename = 101 fun testLac fname =
102 case parse filename of 102 case parseLac fname of
103 NONE => NONE 103 NONE => ()
104 | SOME file => 104 | SOME file => (Print.print (SourcePrint.p_file file);
105 let 105 print "\n")
106 val out = Elaborate.elabFile env file 106
107 in 107 type job = string list
108 if ErrorMsg.anyErrors () then 108
109 NONE 109 fun capitalize "" = ""
110 else 110 | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
111 SOME out 111
112 end 112 fun parse fnames =
113 113 let
114 fun explify eenv filename = 114 fun parseOne fname =
115 case elaborate eenv filename of 115 let
116 NONE => NONE 116 val mname = capitalize (OS.Path.file fname)
117 | SOME (file, _) => 117 val lac = OS.Path.joinBaseExt {base = fname, ext = SOME "lac"}
118 val lig = OS.Path.joinBaseExt {base = fname, ext = SOME "lig"}
119
120 val sgnO =
121 if Posix.FileSys.access (lig, []) then
122 case parseLig lig of
123 NONE => NONE
124 | SOME sgis => SOME (Source.SgnConst sgis, {file = lig,
125 first = ErrorMsg.dummyPos,
126 last = ErrorMsg.dummyPos})
127 else
128 NONE
129
130 val loc = {file = lac,
131 first = ErrorMsg.dummyPos,
132 last = ErrorMsg.dummyPos}
133 in
134 case parseLac lac of
135 NONE => NONE
136 | SOME ds =>
137 SOME (Source.DStr (mname, sgnO, (Source.StrConst ds, loc)), loc)
138 end
139
140 val ds = List.mapPartial parseOne fnames
141 in
142 if ErrorMsg.anyErrors () then
143 NONE
144 else
145 SOME ds
146 end
147
148 fun elaborate job =
149 case parseLig "lib/basis.lig" of
150 NONE => NONE
151 | SOME empty =>
152 case parse job of
153 NONE => NONE
154 | SOME file =>
155 let
156 val out = Elaborate.elabFile empty ElabEnv.empty file
157 in
158 if ErrorMsg.anyErrors () then
159 NONE
160 else
161 SOME out
162 end
163
164 fun explify job =
165 case elaborate job of
166 NONE => NONE
167 | SOME file =>
118 if ErrorMsg.anyErrors () then 168 if ErrorMsg.anyErrors () then
119 NONE 169 NONE
120 else 170 else
121 SOME (Explify.explify file) 171 SOME (Explify.explify file)
122 172
123 fun corify eenv filename = 173 fun corify job =
124 case explify eenv filename of 174 case explify job of
125 NONE => NONE 175 NONE => NONE
126 | SOME file => 176 | SOME file =>
127 if ErrorMsg.anyErrors () then 177 if ErrorMsg.anyErrors () then
128 NONE 178 NONE
129 else 179 else
130 SOME (Corify.corify file) 180 SOME (Corify.corify file)
131 181
132 fun shake' eenv filename = 182 fun shake' job =
133 case corify eenv filename of 183 case corify job of
134 NONE => NONE 184 NONE => NONE
135 | SOME file => 185 | SOME file =>
136 if ErrorMsg.anyErrors () then 186 if ErrorMsg.anyErrors () then
137 NONE 187 NONE
138 else 188 else
139 SOME (Shake.shake file) 189 SOME (Shake.shake file)
140 190
141 fun reduce eenv filename = 191 fun reduce job =
142 case corify eenv filename of 192 case corify job of
143 NONE => NONE 193 NONE => NONE
144 | SOME file => 194 | SOME file =>
145 if ErrorMsg.anyErrors () then 195 if ErrorMsg.anyErrors () then
146 NONE 196 NONE
147 else 197 else
148 SOME (Reduce.reduce (Shake.shake file)) 198 SOME (Reduce.reduce (Shake.shake file))
149 199
150 fun shake eenv filename = 200 fun shake job =
151 case reduce eenv filename of 201 case reduce job of
152 NONE => NONE 202 NONE => NONE
153 | SOME file => 203 | SOME file =>
154 if ErrorMsg.anyErrors () then 204 if ErrorMsg.anyErrors () then
155 NONE 205 NONE
156 else 206 else
157 SOME (Shake.shake file) 207 SOME (Shake.shake file)
158 208
159 fun monoize eenv cenv filename = 209 fun monoize job =
160 case shake eenv filename of 210 case shake job of
161 NONE => NONE 211 NONE => NONE
162 | SOME file => 212 | SOME file =>
163 if ErrorMsg.anyErrors () then 213 if ErrorMsg.anyErrors () then
164 NONE 214 NONE
165 else 215 else
166 SOME (Monoize.monoize cenv file) 216 SOME (Monoize.monoize CoreEnv.empty file)
167 217
168 fun cloconv eenv cenv filename = 218 fun cloconv job =
169 case monoize eenv cenv filename of 219 case monoize job of
170 NONE => NONE 220 NONE => NONE
171 | SOME file => 221 | SOME file =>
172 if ErrorMsg.anyErrors () then 222 if ErrorMsg.anyErrors () then
173 NONE 223 NONE
174 else 224 else
175 SOME (Cloconv.cloconv file) 225 SOME (Cloconv.cloconv file)
176 226
177 fun cjrize eenv cenv filename = 227 fun cjrize job =
178 case cloconv eenv cenv filename of 228 case cloconv job of
179 NONE => NONE 229 NONE => NONE
180 | SOME file => 230 | SOME file =>
181 if ErrorMsg.anyErrors () then 231 if ErrorMsg.anyErrors () then
182 NONE 232 NONE
183 else 233 else
184 SOME (Cjrize.cjrize file) 234 SOME (Cjrize.cjrize file)
185 235
186 fun testParse filename = 236 fun testParse job =
187 case parse filename of 237 case parse job of
188 NONE => print "Failed\n" 238 NONE => print "Failed\n"
189 | SOME file => 239 | SOME file =>
190 (Print.print (SourcePrint.p_file file); 240 (Print.print (SourcePrint.p_file file);
191 print "\n") 241 print "\n")
192 242
193 fun testElaborate filename = 243 fun testElaborate job =
194 (case elaborate ElabEnv.basis filename of 244 (case elaborate job of
195 NONE => print "Failed\n" 245 NONE => print "Failed\n"
196 | SOME (file, _) => 246 | SOME file =>
197 (print "Succeeded\n"; 247 (print "Succeeded\n";
198 Print.print (ElabPrint.p_file ElabEnv.basis file); 248 Print.print (ElabPrint.p_file ElabEnv.empty file);
199 print "\n")) 249 print "\n"))
200 handle ElabEnv.UnboundNamed n => 250 handle ElabEnv.UnboundNamed n =>
201 print ("Unbound named " ^ Int.toString n ^ "\n") 251 print ("Unbound named " ^ Int.toString n ^ "\n")
202 252
203 fun testExplify filename = 253 fun testExplify job =
204 (case explify ElabEnv.basis filename of 254 (case explify job of
205 NONE => print "Failed\n" 255 NONE => print "Failed\n"
206 | SOME file => 256 | SOME file =>
207 (Print.print (ExplPrint.p_file ExplEnv.basis file); 257 (Print.print (ExplPrint.p_file ExplEnv.empty file);
208 print "\n")) 258 print "\n"))
209 handle ExplEnv.UnboundNamed n => 259 handle ExplEnv.UnboundNamed n =>
210 print ("Unbound named " ^ Int.toString n ^ "\n") 260 print ("Unbound named " ^ Int.toString n ^ "\n")
211 261
212 fun testCorify filename = 262 fun testCorify job =
213 (case corify ElabEnv.basis filename of 263 (case corify job of
214 NONE => print "Failed\n" 264 NONE => print "Failed\n"
215 | SOME file => 265 | SOME file =>
216 (Print.print (CorePrint.p_file CoreEnv.basis file); 266 (Print.print (CorePrint.p_file CoreEnv.empty file);
217 print "\n")) 267 print "\n"))
218 handle CoreEnv.UnboundNamed n => 268 handle CoreEnv.UnboundNamed n =>
219 print ("Unbound named " ^ Int.toString n ^ "\n") 269 print ("Unbound named " ^ Int.toString n ^ "\n")
220 270
221 fun testShake' filename = 271 fun testShake' job =
222 (case shake' ElabEnv.basis filename of 272 (case shake' job of
223 NONE => print "Failed\n" 273 NONE => print "Failed\n"
224 | SOME file => 274 | SOME file =>
225 (Print.print (CorePrint.p_file CoreEnv.basis file); 275 (Print.print (CorePrint.p_file CoreEnv.empty file);
226 print "\n")) 276 print "\n"))
227 handle CoreEnv.UnboundNamed n => 277 handle CoreEnv.UnboundNamed n =>
228 print ("Unbound named " ^ Int.toString n ^ "\n") 278 print ("Unbound named " ^ Int.toString n ^ "\n")
229 279
230 fun testReduce filename = 280 fun testReduce job =
231 (case reduce ElabEnv.basis filename of 281 (case reduce job of
232 NONE => print "Failed\n" 282 NONE => print "Failed\n"
233 | SOME file => 283 | SOME file =>
234 (Print.print (CorePrint.p_file CoreEnv.basis file); 284 (Print.print (CorePrint.p_file CoreEnv.empty file);
235 print "\n")) 285 print "\n"))
236 handle CoreEnv.UnboundNamed n => 286 handle CoreEnv.UnboundNamed n =>
237 print ("Unbound named " ^ Int.toString n ^ "\n") 287 print ("Unbound named " ^ Int.toString n ^ "\n")
238 288
239 fun testShake filename = 289 fun testShake job =
240 (case shake ElabEnv.basis filename of 290 (case shake job of
241 NONE => print "Failed\n" 291 NONE => print "Failed\n"
242 | SOME file => 292 | SOME file =>
243 (Print.print (CorePrint.p_file CoreEnv.basis file); 293 (Print.print (CorePrint.p_file CoreEnv.empty file);
244 print "\n")) 294 print "\n"))
245 handle CoreEnv.UnboundNamed n => 295 handle CoreEnv.UnboundNamed n =>
246 print ("Unbound named " ^ Int.toString n ^ "\n") 296 print ("Unbound named " ^ Int.toString n ^ "\n")
247 297
248 fun testMonoize filename = 298 fun testMonoize job =
249 (case monoize ElabEnv.basis CoreEnv.basis filename of 299 (case monoize job of
250 NONE => print "Failed\n" 300 NONE => print "Failed\n"
251 | SOME file => 301 | SOME file =>
252 (Print.print (MonoPrint.p_file MonoEnv.basis file); 302 (Print.print (MonoPrint.p_file MonoEnv.empty file);
253 print "\n")) 303 print "\n"))
254 handle MonoEnv.UnboundNamed n => 304 handle MonoEnv.UnboundNamed n =>
255 print ("Unbound named " ^ Int.toString n ^ "\n") 305 print ("Unbound named " ^ Int.toString n ^ "\n")
256 306
257 fun testCloconv filename = 307 fun testCloconv job =
258 (case cloconv ElabEnv.basis CoreEnv.basis filename of 308 (case cloconv job of
259 NONE => print "Failed\n" 309 NONE => print "Failed\n"
260 | SOME file => 310 | SOME file =>
261 (Print.print (FlatPrint.p_file FlatEnv.basis file); 311 (Print.print (FlatPrint.p_file FlatEnv.empty file);
262 print "\n")) 312 print "\n"))
263 handle FlatEnv.UnboundNamed n => 313 handle FlatEnv.UnboundNamed n =>
264 print ("Unbound named " ^ Int.toString n ^ "\n") 314 print ("Unbound named " ^ Int.toString n ^ "\n")
265 315
266 fun testCjrize filename = 316 fun testCjrize job =
267 (case cjrize ElabEnv.basis CoreEnv.basis filename of 317 (case cjrize job of
268 NONE => print "Failed\n" 318 NONE => print "Failed\n"
269 | SOME file => 319 | SOME file =>
270 (Print.print (CjrPrint.p_file CjrEnv.basis file); 320 (Print.print (CjrPrint.p_file CjrEnv.empty file);
271 print "\n")) 321 print "\n"))
272 handle CjrEnv.UnboundNamed n => 322 handle CjrEnv.UnboundNamed n =>
273 print ("Unbound named " ^ Int.toString n ^ "\n") 323 print ("Unbound named " ^ Int.toString n ^ "\n")
274 324
275 fun compile filename = 325 fun compile job =
276 case cjrize ElabEnv.basis CoreEnv.basis filename of 326 case cjrize job of
277 NONE => () 327 NONE => ()
278 | SOME file => 328 | SOME file =>
279 let 329 let
280 val outf = TextIO.openOut "/tmp/lacweb.c" 330 val outf = TextIO.openOut "/tmp/lacweb.c"
281 val s = TextIOPP.openOut {dst = outf, wid = 80} 331 val s = TextIOPP.openOut {dst = outf, wid = 80}
282 in 332 in
283 Print.fprint s (CjrPrint.p_file CjrEnv.basis file); 333 Print.fprint s (CjrPrint.p_file CjrEnv.empty file);
284 TextIO.closeOut outf 334 TextIO.closeOut outf
285 end 335 end
286 336
287 end 337 end