Mercurial > urweb

comparison src/compiler.sml @ 202:af5bd54cbbd7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Finish moving all phases to the new interface
author Adam Chlipala <adamc@hcoop.net>
date Tue, 12 Aug 2008 14:55:05 -0400
parents f2cac0dba9bf
children 71bafe66dbe1
comparison
equal deleted inserted replaced
201:f2cac0dba9bf 202:af5bd54cbbd7
255 print = CorePrint.p_file CoreEnv.empty 255 print = CorePrint.p_file CoreEnv.empty
256 } 256 }
257 257
258 val toCorify = toExplify o transform corify "corify" 258 val toCorify = toExplify o transform corify "corify"
259 259
260 (*fun shake' job = 260 val shake = {
261 case corify job of 261 func = Shake.shake,
262 NONE => NONE 262 print = CorePrint.p_file CoreEnv.empty
263 | SOME file => 263 }
264 if ErrorMsg.anyErrors () then 264
265 NONE 265 val toShake1 = toCorify o transform shake "shake1"
266 else 266
267 SOME (Shake.shake file) 267 val tag = {
268 268 func = Tag.tag,
269 fun tag job = 269 print = CorePrint.p_file CoreEnv.empty
270 case shake' job of 270 }
271 NONE => NONE 271
272 | SOME file => 272 val toTag = toShake1 o transform tag "tag"
273 if ErrorMsg.anyErrors () then 273
274 NONE 274 val reduce = {
275 else 275 func = Reduce.reduce,
276 SOME (Tag.tag file) 276 print = CorePrint.p_file CoreEnv.empty
277 277 }
278 fun reduce job = 278
279 case tag job of 279 val toReduce = toTag o transform reduce "reduce"
280 NONE => NONE 280
281 | SOME file => 281 val specialize = {
282 if ErrorMsg.anyErrors () then 282 func = Specialize.specialize,
283 NONE 283 print = CorePrint.p_file CoreEnv.empty
284 else 284 }
285 SOME (Reduce.reduce file) 285
286 286 val toSpecialize = toReduce o transform specialize "specialize"
287 fun specialize job = 287
288 case reduce job of 288 val toShake2 = toSpecialize o transform shake "shake2"
289 NONE => NONE 289
290 | SOME file => 290 val monoize = {
291 if ErrorMsg.anyErrors () then 291 func = Monoize.monoize CoreEnv.empty,
292 NONE 292 print = MonoPrint.p_file MonoEnv.empty
293 else 293 }
294 SOME (Specialize.specialize file) 294
295 295 val toMonoize = toShake2 o transform monoize "monoize"
296 fun shake job = 296
297 case specialize job of 297 val mono_opt = {
298 NONE => NONE 298 func = MonoOpt.optimize,
299 | SOME file => 299 print = MonoPrint.p_file MonoEnv.empty
300 if ErrorMsg.anyErrors () then 300 }
301 NONE 301
302 else 302 val toMono_opt1 = toMonoize o transform mono_opt "mono_opt1"
303 SOME (Shake.shake file) 303
304 304 val untangle = {
305 fun monoize job = 305 func = Untangle.untangle,
306 case shake job of 306 print = MonoPrint.p_file MonoEnv.empty
307 NONE => NONE 307 }
308 | SOME file => 308
309 if ErrorMsg.anyErrors () then 309 val toUntangle = toMono_opt1 o transform untangle "untangle"
310 NONE 310
311 else 311 val mono_reduce = {
312 SOME (Monoize.monoize CoreEnv.empty file) 312 func = MonoReduce.reduce,
313 313 print = MonoPrint.p_file MonoEnv.empty
314 fun mono_opt' job = 314 }
315 case monoize job of 315
316 NONE => NONE 316 val toMono_reduce = toUntangle o transform mono_reduce "mono_reduce"
317 | SOME file => 317
318 if ErrorMsg.anyErrors () then 318 val mono_shake = {
319 NONE 319 func = MonoShake.shake,
320 else 320 print = MonoPrint.p_file MonoEnv.empty
321 SOME (MonoOpt.optimize file) 321 }
322 322
323 fun untangle job = 323 val toMono_shake = toMono_reduce o transform mono_shake "mono_shake"
324 case mono_opt' job of 324
325 NONE => NONE 325 val toMono_opt2 = toMono_shake o transform mono_opt "mono_opt2"
326 | SOME file => 326
327 if ErrorMsg.anyErrors () then 327 val cjrize = {
328 NONE 328 func = Cjrize.cjrize,
329 else 329 print = CjrPrint.p_file CjrEnv.empty
330 SOME (Untangle.untangle file) 330 }
331 331
332 fun mono_reduce job = 332 val toCjrize = toMono_opt2 o transform cjrize "cjrize"
333 case untangle job of
334 NONE => NONE
335 | SOME file =>
336 if ErrorMsg.anyErrors () then
337 NONE
338 else
339 SOME (MonoReduce.reduce file)
340
341 fun mono_shake job =
342 case mono_reduce job of
343 NONE => NONE
344 | SOME file =>
345 if ErrorMsg.anyErrors () then
346 NONE
347 else
348 SOME (MonoShake.shake file)
349
350 fun mono_opt job =
351 case mono_shake job of
352 NONE => NONE
353 | SOME file =>
354 if ErrorMsg.anyErrors () then
355 NONE
356 else
357 SOME (MonoOpt.optimize file)
358
359 fun cjrize job =
360 case mono_opt job of
361 NONE => NONE
362 | SOME file =>
363 if ErrorMsg.anyErrors () then
364 NONE
365 else
366 SOME (Cjrize.cjrize file)
367
368 fun testParse job =
369 case parse job of
370 NONE => print "Failed\n"
371 | SOME file =>
372 (Print.print (SourcePrint.p_file file);
373 print "\n")
374
375 fun testElaborate job =
376 (case elaborate job of
377 NONE => print "Failed\n"
378 | SOME file =>
379 (print "Succeeded\n";
380 Print.print (ElabPrint.p_file ElabEnv.empty file);
381 print "\n"))
382 handle ElabEnv.UnboundNamed n =>
383 print ("Unbound named " ^ Int.toString n ^ "\n")
384
385 fun testExplify job =
386 (case explify job of
387 NONE => print "Failed\n"
388 | SOME file =>
389 (Print.print (ExplPrint.p_file ExplEnv.empty file);
390 print "\n"))
391 handle ExplEnv.UnboundNamed n =>
392 print ("Unbound named " ^ Int.toString n ^ "\n")
393
394 fun testCorify job =
395 (case corify job of
396 NONE => print "Failed\n"
397 | SOME file =>
398 (Print.print (CorePrint.p_file CoreEnv.empty file);
399 print "\n"))
400 handle CoreEnv.UnboundNamed n =>
401 print ("Unbound named " ^ Int.toString n ^ "\n")
402
403 fun testShake' job =
404 (case shake' job of
405 NONE => print "Failed\n"
406 | SOME file =>
407 (Print.print (CorePrint.p_file CoreEnv.empty file);
408 print "\n"))
409 handle CoreEnv.UnboundNamed n =>
410 print ("Unbound named " ^ Int.toString n ^ "\n")
411
412 fun testReduce job =
413 (case reduce job of
414 NONE => print "Failed\n"
415 | SOME file =>
416 (Print.print (CorePrint.p_file CoreEnv.empty file);
417 print "\n"))
418 handle CoreEnv.UnboundNamed n =>
419 print ("Unbound named " ^ Int.toString n ^ "\n")
420
421 fun testSpecialize job =
422 (case specialize job of
423 NONE => print "Failed\n"
424 | SOME file =>
425 (Print.print (CorePrint.p_file CoreEnv.empty file);
426 print "\n"))
427 handle CoreEnv.UnboundNamed n =>
428 print ("Unbound named " ^ Int.toString n ^ "\n")
429
430 fun testTag job =
431 (case tag job of
432 NONE => print "Failed\n"
433 | SOME file =>
434 (Print.print (CorePrint.p_file CoreEnv.empty file);
435 print "\n"))
436 handle CoreEnv.UnboundNamed n =>
437 print ("Unbound named " ^ Int.toString n ^ "\n")
438
439 fun testShake job =
440 (case shake job of
441 NONE => print "Failed\n"
442 | SOME file =>
443 (Print.print (CorePrint.p_file CoreEnv.empty file);
444 print "\n"))
445 handle CoreEnv.UnboundNamed n =>
446 print ("Unbound named " ^ Int.toString n ^ "\n")
447
448 fun testMonoize job =
449 (case monoize job of
450 NONE => print "Failed\n"
451 | SOME file =>
452 (Print.print (MonoPrint.p_file MonoEnv.empty file);
453 print "\n"))
454 handle MonoEnv.UnboundNamed n =>
455 print ("Unbound named " ^ Int.toString n ^ "\n")
456
457 fun testMono_opt' job =
458 (case mono_opt' job of
459 NONE => print "Failed\n"
460 | SOME file =>
461 (Print.print (MonoPrint.p_file MonoEnv.empty file);
462 print "\n"))
463 handle MonoEnv.UnboundNamed n =>
464 print ("Unbound named " ^ Int.toString n ^ "\n")
465
466 fun testUntangle job =
467 (case untangle job of
468 NONE => print "Failed\n"
469 | SOME file =>
470 (Print.print (MonoPrint.p_file MonoEnv.empty file);
471 print "\n"))
472 handle MonoEnv.UnboundNamed n =>
473 print ("Unbound named " ^ Int.toString n ^ "\n")
474
475 fun testMono_reduce job =
476 (case mono_reduce job of
477 NONE => print "Failed\n"
478 | SOME file =>
479 (Print.print (MonoPrint.p_file MonoEnv.empty file);
480 print "\n"))
481 handle MonoEnv.UnboundNamed n =>
482 print ("Unbound named " ^ Int.toString n ^ "\n")
483
484 fun testMono_shake job =
485 (case mono_shake job of
486 NONE => print "Failed\n"
487 | SOME file =>
488 (Print.print (MonoPrint.p_file MonoEnv.empty file);
489 print "\n"))
490 handle MonoEnv.UnboundNamed n =>
491 print ("Unbound named " ^ Int.toString n ^ "\n")
492
493 fun testMono_opt job =
494 (case mono_opt job of
495 NONE => print "Failed\n"
496 | SOME file =>
497 (Print.print (MonoPrint.p_file MonoEnv.empty file);
498 print "\n"))
499 handle MonoEnv.UnboundNamed n =>
500 print ("Unbound named " ^ Int.toString n ^ "\n")
501
502 fun testCjrize job =
503 (case cjrize job of
504 NONE => print "Failed\n"
505 | SOME file =>
506 (Print.print (CjrPrint.p_file CjrEnv.empty file);
507 print "\n"))
508 handle CjrEnv.UnboundNamed n =>
509 print ("Unbound named " ^ Int.toString n ^ "\n")*)
510 333
511 fun compileC {cname, oname, ename} = 334 fun compileC {cname, oname, ename} =
512 let 335 let
513 val compile = "gcc -O3 -I include -c " ^ cname ^ " -o " ^ oname 336 val compile = "gcc -O3 -I include -c " ^ cname ^ " -o " ^ oname
514 val link = "gcc -pthread -O3 clib/lacweb.o " ^ oname ^ " clib/driver.o -o " ^ ename 337 val link = "gcc -pthread -O3 clib/lacweb.o " ^ oname ^ " clib/driver.o -o " ^ ename
519 print "C linking failed\n" 342 print "C linking failed\n"
520 else 343 else
521 print "Success\n" 344 print "Success\n"
522 end 345 end
523 346
524 (*fun compile job = 347 fun compile job =
525 case cjrize job of 348 case run toCjrize job of
526 NONE => print "Laconic compilation failed\n" 349 NONE => print "Laconic compilation failed\n"
527 | SOME file => 350 | SOME file =>
528 if ErrorMsg.anyErrors () then 351 let
529 print "Laconic compilation failed\n" 352 val cname = "/tmp/lacweb.c"
530 else 353 val oname = "/tmp/lacweb.o"
531 let 354 val ename = "/tmp/webapp"
532 val cname = "/tmp/lacweb.c" 355
533 val oname = "/tmp/lacweb.o" 356 val outf = TextIO.openOut cname
534 val ename = "/tmp/webapp" 357 val s = TextIOPP.openOut {dst = outf, wid = 80}
535 358 in
536 val outf = TextIO.openOut cname 359 Print.fprint s (CjrPrint.p_file CjrEnv.empty file);
537 val s = TextIOPP.openOut {dst = outf, wid = 80} 360 TextIO.closeOut outf;
538 in 361
539 Print.fprint s (CjrPrint.p_file CjrEnv.empty file); 362 compileC {cname = cname, oname = oname, ename = ename}
540 TextIO.closeOut outf; 363 end
541
542 compileC {cname = cname, oname = oname, ename = ename}
543 end*)
544 364
545 end 365 end