Mercurial > urweb

annotate src/compiler.sml @ 201:f2cac0dba9bf

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Consolidating compiler phase interface and adding timing
author Adam Chlipala <adamc@hcoop.net>
date Tue, 12 Aug 2008 14:40:07 -0400
parents 8a70e2919e86
children af5bd54cbbd7
rev   line source
adamc@1 1 (* Copyright (c) 2008, Adam Chlipala
adamc@1 2 * All rights reserved.
adamc@1 3 *
adamc@1 4 * Redistribution and use in source and binary forms, with or without
adamc@1 5 * modification, are permitted provided that the following conditions are met:
adamc@1 6 *
adamc@1 7 * - Redistributions of source code must retain the above copyright notice,
adamc@1 8 * this list of conditions and the following disclaimer.
adamc@1 9 * - Redistributions in binary form must reproduce the above copyright notice,
adamc@1 10 * this list of conditions and the following disclaimer in the documentation
adamc@1 11 * and/or other materials provided with the distribution.
adamc@1 12 * - The names of contributors may not be used to endorse or promote products
adamc@1 13 * derived from this software without specific prior written permission.
adamc@1 14 *
adamc@1 15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
adamc@1 16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
adamc@1 17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
adamc@1 18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
adamc@1 19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
adamc@1 20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
adamc@1 21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
adamc@1 22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
adamc@1 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
adamc@1 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
adamc@1 25 * POSSIBILITY OF SUCH DAMAGE.
adamc@1 26 *)
adamc@1 27
adamc@1 28 (* Laconic/Web language parser *)
adamc@1 29
adamc@1 30 structure Compiler :> COMPILER = struct
adamc@1 31
adamc@1 32 structure LacwebLrVals = LacwebLrValsFn(structure Token = LrParser.Token)
adamc@1 33 structure Lex = LacwebLexFn(structure Tokens = LacwebLrVals.Tokens)
adamc@1 34 structure LacwebP = Join(structure ParserData = LacwebLrVals.ParserData
adamc@1 35 structure Lex = Lex
adamc@1 36 structure LrParser = LrParser)
adamc@1 37
adamc@201 38 type job = string list
adamc@201 39
adamc@201 40 type ('src, 'dst) phase = {
adamc@201 41 func : 'src -> 'dst,
adamc@201 42 print : 'dst -> Print.PD.pp_desc
adamc@201 43 }
adamc@201 44
adamc@201 45 type pmap = (string * Time.time) list
adamc@201 46
adamc@201 47 type ('src, 'dst) transform = {
adamc@201 48 func : 'src -> 'dst option,
adamc@201 49 print : 'dst -> Print.PD.pp_desc,
adamc@201 50 time : 'src * pmap -> 'dst option * pmap
adamc@201 51 }
adamc@201 52
adamc@201 53 fun transform (ph : ('src, 'dst) phase) name = {
adamc@201 54 func = fn input => let
adamc@201 55 val v = #func ph input
adamc@201 56 in
adamc@201 57 if ErrorMsg.anyErrors () then
adamc@201 58 NONE
adamc@201 59 else
adamc@201 60 SOME v
adamc@201 61 end,
adamc@201 62 print = #print ph,
adamc@201 63 time = fn (input, pmap) => let
adamc@201 64 val befor = Time.now ()
adamc@201 65 val v = #func ph input
adamc@201 66 val elapsed = Time.- (Time.now (), befor)
adamc@201 67 in
adamc@201 68 (if ErrorMsg.anyErrors () then
adamc@201 69 NONE
adamc@201 70 else
adamc@201 71 SOME v,
adamc@201 72 (name, elapsed) :: pmap)
adamc@201 73 end
adamc@201 74 }
adamc@201 75
adamc@201 76 fun op o (tr1 : ('a, 'b) transform, tr2 : ('b, 'c) transform) = {
adamc@201 77 func = fn input => case #func tr1 input of
adamc@201 78 NONE => NONE
adamc@201 79 | SOME v => #func tr2 v,
adamc@201 80 print = #print tr2,
adamc@201 81 time = fn (input, pmap) => let
adamc@201 82 val (ro, pmap) = #time tr1 (input, pmap)
adamc@201 83 in
adamc@201 84 case ro of
adamc@201 85 NONE => (NONE, pmap)
adamc@201 86 | SOME v => #time tr2 (v, pmap)
adamc@201 87 end
adamc@201 88 }
adamc@201 89
adamc@201 90 fun run (tr : ('src, 'dst) transform) = #func tr
adamc@201 91
adamc@201 92 fun runPrint (tr : ('src, 'dst) transform) input =
adamc@201 93 case #func tr input of
adamc@201 94 NONE => print "Failure\n"
adamc@201 95 | SOME v =>
adamc@201 96 (print "Success\n";
adamc@201 97 Print.print (#print tr v);
adamc@201 98 print "\n")
adamc@201 99
adamc@201 100 fun time (tr : ('src, 'dst) transform) input =
adamc@55 101 let
adamc@201 102 val (_, pmap) = #time tr (input, [])
adamc@201 103 in
adamc@201 104 app (fn (name, time) =>
adamc@201 105 print (name ^ ": " ^ LargeReal.toString (Time.toReal time) ^ "\n")) (rev pmap);
adamc@201 106 print ("TOTAL: " ^ LargeReal.toString (Time.toReal (foldl Time.+ Time.zeroTime (map #2 pmap))) ^ "\n");
adamc@201 107 print "\n"
adamc@201 108 end
adamc@55 109
adamc@201 110 fun timePrint (tr : ('src, 'dst) transform) input =
adamc@201 111 let
adamc@201 112 val (ro, pmap) = #time tr (input, [])
adamc@55 113 in
adamc@201 114 app (fn (name, time) =>
adamc@201 115 print (name ^ ": " ^ LargeReal.toString (Time.toReal time) ^ "\n")) (rev pmap);
adamc@201 116 print ("TOTAL: " ^ LargeReal.toString (Time.toReal (foldl Time.+ Time.zeroTime (map #2 pmap))) ^ "\n");
adamc@201 117 print "\n";
adamc@201 118 case ro of
adamc@201 119 NONE => print "Failure\n"
adamc@201 120 | SOME v =>
adamc@201 121 (print "Success\n";
adamc@201 122 Print.print (#print tr v);
adamc@201 123 print "\n")
adamc@55 124 end
adamc@55 125
adamc@201 126 val parseLig =
adamc@201 127 {func = fn filename => let
adamc@201 128 val fname = OS.FileSys.tmpName ()
adamc@201 129 val outf = TextIO.openOut fname
adamc@201 130 val () = TextIO.output (outf, "sig\n")
adamc@201 131 val inf = TextIO.openIn filename
adamc@201 132 fun loop () =
adamc@201 133 case TextIO.inputLine inf of
adamc@201 134 NONE => ()
adamc@201 135 | SOME line => (TextIO.output (outf, line);
adamc@201 136 loop ())
adamc@201 137 val () = loop ()
adamc@201 138 val () = TextIO.closeIn inf
adamc@201 139 val () = TextIO.closeOut outf
adamc@201 140
adamc@201 141 val () = (ErrorMsg.resetErrors ();
adamc@201 142 ErrorMsg.resetPositioning filename;
adamc@201 143 Lex.UserDeclarations.initialize ())
adamc@201 144 val file = TextIO.openIn fname
adamc@201 145 fun get _ = TextIO.input file
adamc@201 146 fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
adamc@201 147 val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
adamc@201 148 val (absyn, _) = LacwebP.parse (30, lexer, parseerror, ())
adamc@201 149 in
adamc@201 150 TextIO.closeIn file;
adamc@201 151 case absyn of
adamc@201 152 [(Source.DSgn ("?", (Source.SgnConst sgis, _)), _)] => sgis
adamc@201 153 | _ => (ErrorMsg.errorAt {file = filename,
adamc@201 154 first = {line = 0,
adamc@201 155 char = 0},
adamc@201 156 last = {line = 0,
adamc@201 157 char = 0}} "Not a signature";
adamc@201 158 [])
adamc@201 159 end
adamc@201 160 handle LrParser.ParseError => [],
adamc@201 161 print = Print.p_list_sep Print.PD.newline SourcePrint.p_sgn_item}
adamc@55 162
adamc@1 163 (* The main parsing routine *)
adamc@201 164 val parseLac = {
adamc@201 165 func = fn filename =>
adamc@201 166 let
adamc@201 167 val () = (ErrorMsg.resetErrors ();
adamc@201 168 ErrorMsg.resetPositioning filename;
adamc@201 169 Lex.UserDeclarations.initialize ())
adamc@201 170 val file = TextIO.openIn filename
adamc@201 171 fun get _ = TextIO.input file
adamc@201 172 fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
adamc@201 173 val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
adamc@201 174 val (absyn, _) = LacwebP.parse (30, lexer, parseerror, ())
adamc@201 175 in
adamc@201 176 TextIO.closeIn file;
adamc@201 177 case absyn of
adamc@201 178 [(Source.DSgn ("?", _), _)] =>
adamc@201 179 (ErrorMsg.errorAt {file = filename,
adamc@201 180 first = {line = 0,
adamc@201 181 char = 0},
adamc@201 182 last = {line = 0,
adamc@201 183 char = 0}} "File starts with 'sig'";
adamc@201 184 [])
adamc@201 185 | _ => absyn
adamc@201 186 end
adamc@201 187 handle LrParser.ParseError => [],
adamc@201 188 print = SourcePrint.p_file}
adamc@56 189
adamc@56 190 fun capitalize "" = ""
adamc@56 191 | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
adamc@56 192
adamc@201 193 val parse = {
adamc@201 194 func = fn fnames =>
adamc@201 195 let
adamc@201 196 fun nameOf fname = capitalize (OS.Path.file fname)
adamc@109 197
adamc@201 198 fun parseOne fname =
adamc@201 199 let
adamc@201 200 val mname = nameOf fname
adamc@201 201 val lac = OS.Path.joinBaseExt {base = fname, ext = SOME "lac"}
adamc@201 202 val lig = OS.Path.joinBaseExt {base = fname, ext = SOME "lig"}
adamc@56 203
adamc@201 204 val sgnO =
adamc@201 205 if Posix.FileSys.access (lig, []) then
adamc@201 206 SOME (Source.SgnConst (#func parseLig lig),
adamc@201 207 {file = lig,
adamc@201 208 first = ErrorMsg.dummyPos,
adamc@201 209 last = ErrorMsg.dummyPos})
adamc@201 210 else
adamc@201 211 NONE
adamc@56 212
adamc@201 213 val loc = {file = lac,
adamc@201 214 first = ErrorMsg.dummyPos,
adamc@201 215 last = ErrorMsg.dummyPos}
adamc@56 216
adamc@201 217 val ds = #func parseLac lac
adamc@201 218 in
adamc@201 219 (Source.DStr (mname, sgnO, (Source.StrConst ds, loc)), loc)
adamc@201 220 end
adamc@56 221
adamc@201 222 val ds = map parseOne fnames
adamc@201 223 in
adamc@201 224 let
adamc@201 225 val final = nameOf (List.last fnames)
adamc@201 226 in
adamc@201 227 ds @ [(Source.DExport (Source.StrVar final, ErrorMsg.dummySpan), ErrorMsg.dummySpan)]
adamc@201 228 end handle Empty => ds
adamc@201 229 end,
adamc@201 230 print = SourcePrint.p_file
adamc@201 231 }
adamc@56 232
adamc@201 233 val toParse = transform parse "parse"
adamc@38 234
adamc@201 235 val elaborate = {
adamc@201 236 func = fn file => let
adamc@201 237 val basis = #func parseLig "lib/basis.lig"
adamc@201 238 in
adamc@201 239 Elaborate.elabFile basis ElabEnv.empty file
adamc@201 240 end,
adamc@201 241 print = ElabPrint.p_file ElabEnv.empty
adamc@201 242 }
adamc@5 243
adamc@201 244 val toElaborate = toParse o transform elaborate "elaborate"
adamc@201 245
adamc@201 246 val explify = {
adamc@201 247 func = Explify.explify,
adamc@201 248 print = ExplPrint.p_file ExplEnv.empty
adamc@201 249 }
adamc@201 250
adamc@201 251 val toExplify = toElaborate o transform explify "explify"
adamc@201 252
adamc@201 253 val corify = {
adamc@201 254 func = Corify.corify,
adamc@201 255 print = CorePrint.p_file CoreEnv.empty
adamc@201 256 }
adamc@201 257
adamc@201 258 val toCorify = toExplify o transform corify "corify"
adamc@201 259
adamc@201 260 (*fun shake' job =
adamc@56 261 case corify job of
adamc@39 262 NONE => NONE
adamc@39 263 | SOME file =>
adamc@39 264 if ErrorMsg.anyErrors () then
adamc@39 265 NONE
adamc@39 266 else
adamc@39 267 SOME (Shake.shake file)
adamc@39 268
adamc@110 269 fun tag job =
adamc@110 270 case shake' job of
adamc@110 271 NONE => NONE
adamc@110 272 | SOME file =>
adamc@110 273 if ErrorMsg.anyErrors () then
adamc@110 274 NONE
adamc@110 275 else
adamc@110 276 SOME (Tag.tag file)
adamc@110 277
adamc@56 278 fun reduce job =
adamc@110 279 case tag job of
adamc@20 280 NONE => NONE
adamc@25 281 | SOME file =>
adamc@25 282 if ErrorMsg.anyErrors () then
adamc@25 283 NONE
adamc@25 284 else
adamc@193 285 SOME (Reduce.reduce file)
adamc@193 286
adamc@193 287 fun specialize job =
adamc@193 288 case reduce job of
adamc@193 289 NONE => NONE
adamc@193 290 | SOME file =>
adamc@193 291 if ErrorMsg.anyErrors () then
adamc@193 292 NONE
adamc@193 293 else
adamc@193 294 SOME (Specialize.specialize file)
adamc@20 295
adamc@56 296 fun shake job =
adamc@193 297 case specialize job of
adamc@23 298 NONE => NONE
adamc@25 299 | SOME file =>
adamc@25 300 if ErrorMsg.anyErrors () then
adamc@25 301 NONE
adamc@25 302 else
adamc@25 303 SOME (Shake.shake file)
adamc@25 304
adamc@56 305 fun monoize job =
adamc@56 306 case shake job of
adamc@25 307 NONE => NONE
adamc@25 308 | SOME file =>
adamc@25 309 if ErrorMsg.anyErrors () then
adamc@25 310 NONE
adamc@25 311 else
adamc@56 312 SOME (Monoize.monoize CoreEnv.empty file)
adamc@23 313
adamc@132 314 fun mono_opt' job =
adamc@132 315 case monoize job of
adamc@132 316 NONE => NONE
adamc@132 317 | SOME file =>
adamc@132 318 if ErrorMsg.anyErrors () then
adamc@132 319 NONE
adamc@132 320 else
adamc@132 321 SOME (MonoOpt.optimize file)
adamc@132 322
adamc@131 323 fun untangle job =
adamc@132 324 case mono_opt' job of
adamc@131 325 NONE => NONE
adamc@131 326 | SOME file =>
adamc@131 327 if ErrorMsg.anyErrors () then
adamc@131 328 NONE
adamc@131 329 else
adamc@131 330 SOME (Untangle.untangle file)
adamc@131 331
adamc@133 332 fun mono_reduce job =
adamc@133 333 case untangle job of
adamc@133 334 NONE => NONE
adamc@133 335 | SOME file =>
adamc@133 336 if ErrorMsg.anyErrors () then
adamc@133 337 NONE
adamc@133 338 else
adamc@133 339 SOME (MonoReduce.reduce file)
adamc@133 340
adamc@134 341 fun mono_shake job =
adamc@134 342 case mono_reduce job of
adamc@134 343 NONE => NONE
adamc@134 344 | SOME file =>
adamc@134 345 if ErrorMsg.anyErrors () then
adamc@134 346 NONE
adamc@134 347 else
adamc@134 348 SOME (MonoShake.shake file)
adamc@134 349
adamc@96 350 fun mono_opt job =
adamc@134 351 case mono_shake job of
adamc@96 352 NONE => NONE
adamc@96 353 | SOME file =>
adamc@96 354 if ErrorMsg.anyErrors () then
adamc@96 355 NONE
adamc@96 356 else
adamc@96 357 SOME (MonoOpt.optimize file)
adamc@96 358
adamc@109 359 fun cjrize job =
adamc@96 360 case mono_opt job of
adamc@26 361 NONE => NONE
adamc@26 362 | SOME file =>
adamc@26 363 if ErrorMsg.anyErrors () then
adamc@26 364 NONE
adamc@26 365 else
adamc@29 366 SOME (Cjrize.cjrize file)
adamc@29 367
adamc@56 368 fun testParse job =
adamc@56 369 case parse job of
adamc@5 370 NONE => print "Failed\n"
adamc@1 371 | SOME file =>
adamc@5 372 (Print.print (SourcePrint.p_file file);
adamc@5 373 print "\n")
adamc@5 374
adamc@56 375 fun testElaborate job =
adamc@56 376 (case elaborate job of
adamc@5 377 NONE => print "Failed\n"
adamc@56 378 | SOME file =>
adamc@32 379 (print "Succeeded\n";
adamc@56 380 Print.print (ElabPrint.p_file ElabEnv.empty file);
adamc@5 381 print "\n"))
adamc@5 382 handle ElabEnv.UnboundNamed n =>
adamc@5 383 print ("Unbound named " ^ Int.toString n ^ "\n")
adamc@1 384
adamc@56 385 fun testExplify job =
adamc@56 386 (case explify job of
adamc@38 387 NONE => print "Failed\n"
adamc@38 388 | SOME file =>
adamc@56 389 (Print.print (ExplPrint.p_file ExplEnv.empty file);
adamc@38 390 print "\n"))
adamc@38 391 handle ExplEnv.UnboundNamed n =>
adamc@38 392 print ("Unbound named " ^ Int.toString n ^ "\n")
adamc@38 393
adamc@56 394 fun testCorify job =
adamc@56 395 (case corify job of
adamc@16 396 NONE => print "Failed\n"
adamc@16 397 | SOME file =>
adamc@56 398 (Print.print (CorePrint.p_file CoreEnv.empty file);
adamc@16 399 print "\n"))
adamc@16 400 handle CoreEnv.UnboundNamed n =>
adamc@16 401 print ("Unbound named " ^ Int.toString n ^ "\n")
adamc@16 402
adamc@56 403 fun testShake' job =
adamc@56 404 (case shake' job of
adamc@39 405 NONE => print "Failed\n"
adamc@39 406 | SOME file =>
adamc@56 407 (Print.print (CorePrint.p_file CoreEnv.empty file);
adamc@39 408 print "\n"))
adamc@39 409 handle CoreEnv.UnboundNamed n =>
adamc@39 410 print ("Unbound named " ^ Int.toString n ^ "\n")
adamc@39 411
adamc@193 412 fun testReduce job =
adamc@193 413 (case reduce job of
adamc@110 414 NONE => print "Failed\n"
adamc@110 415 | SOME file =>
adamc@110 416 (Print.print (CorePrint.p_file CoreEnv.empty file);
adamc@110 417 print "\n"))
adamc@110 418 handle CoreEnv.UnboundNamed n =>
adamc@110 419 print ("Unbound named " ^ Int.toString n ^ "\n")
adamc@110 420
adamc@193 421 fun testSpecialize job =
adamc@193 422 (case specialize job of
adamc@193 423 NONE => print "Failed\n"
adamc@193 424 | SOME file =>
adamc@193 425 (Print.print (CorePrint.p_file CoreEnv.empty file);
adamc@193 426 print "\n"))
adamc@193 427 handle CoreEnv.UnboundNamed n =>
adamc@193 428 print ("Unbound named " ^ Int.toString n ^ "\n")
adamc@193 429
adamc@193 430 fun testTag job =
adamc@193 431 (case tag job of
adamc@20 432 NONE => print "Failed\n"
adamc@20 433 | SOME file =>
adamc@56 434 (Print.print (CorePrint.p_file CoreEnv.empty file);
adamc@20 435 print "\n"))
adamc@20 436 handle CoreEnv.UnboundNamed n =>
adamc@20 437 print ("Unbound named " ^ Int.toString n ^ "\n")
adamc@20 438
adamc@56 439 fun testShake job =
adamc@56 440 (case shake job of
adamc@23 441 NONE => print "Failed\n"
adamc@23 442 | SOME file =>
adamc@56 443 (Print.print (CorePrint.p_file CoreEnv.empty file);
adamc@23 444 print "\n"))
adamc@23 445 handle CoreEnv.UnboundNamed n =>
adamc@23 446 print ("Unbound named " ^ Int.toString n ^ "\n")
adamc@23 447
adamc@56 448 fun testMonoize job =
adamc@56 449 (case monoize job of
adamc@25 450 NONE => print "Failed\n"
adamc@25 451 | SOME file =>
adamc@56 452 (Print.print (MonoPrint.p_file MonoEnv.empty file);
adamc@25 453 print "\n"))
adamc@25 454 handle MonoEnv.UnboundNamed n =>
adamc@25 455 print ("Unbound named " ^ Int.toString n ^ "\n")
adamc@25 456
adamc@132 457 fun testMono_opt' job =
adamc@132 458 (case mono_opt' job of
adamc@132 459 NONE => print "Failed\n"
adamc@132 460 | SOME file =>
adamc@132 461 (Print.print (MonoPrint.p_file MonoEnv.empty file);
adamc@132 462 print "\n"))
adamc@132 463 handle MonoEnv.UnboundNamed n =>
adamc@132 464 print ("Unbound named " ^ Int.toString n ^ "\n")
adamc@132 465
adamc@131 466 fun testUntangle job =
adamc@131 467 (case untangle job of
adamc@131 468 NONE => print "Failed\n"
adamc@131 469 | SOME file =>
adamc@131 470 (Print.print (MonoPrint.p_file MonoEnv.empty file);
adamc@131 471 print "\n"))
adamc@131 472 handle MonoEnv.UnboundNamed n =>
adamc@131 473 print ("Unbound named " ^ Int.toString n ^ "\n")
adamc@131 474
adamc@133 475 fun testMono_reduce job =
adamc@133 476 (case mono_reduce job of
adamc@133 477 NONE => print "Failed\n"
adamc@133 478 | SOME file =>
adamc@133 479 (Print.print (MonoPrint.p_file MonoEnv.empty file);
adamc@133 480 print "\n"))
adamc@133 481 handle MonoEnv.UnboundNamed n =>
adamc@133 482 print ("Unbound named " ^ Int.toString n ^ "\n")
adamc@133 483
adamc@134 484 fun testMono_shake job =
adamc@134 485 (case mono_shake job of
adamc@134 486 NONE => print "Failed\n"
adamc@134 487 | SOME file =>
adamc@134 488 (Print.print (MonoPrint.p_file MonoEnv.empty file);
adamc@134 489 print "\n"))
adamc@134 490 handle MonoEnv.UnboundNamed n =>
adamc@134 491 print ("Unbound named " ^ Int.toString n ^ "\n")
adamc@134 492
adamc@96 493 fun testMono_opt job =
adamc@96 494 (case mono_opt job of
adamc@96 495 NONE => print "Failed\n"
adamc@96 496 | SOME file =>
adamc@96 497 (Print.print (MonoPrint.p_file MonoEnv.empty file);
adamc@96 498 print "\n"))
adamc@96 499 handle MonoEnv.UnboundNamed n =>
adamc@96 500 print ("Unbound named " ^ Int.toString n ^ "\n")
adamc@96 501
adamc@56 502 fun testCjrize job =
adamc@56 503 (case cjrize job of
adamc@29 504 NONE => print "Failed\n"
adamc@29 505 | SOME file =>
adamc@56 506 (Print.print (CjrPrint.p_file CjrEnv.empty file);
adamc@29 507 print "\n"))
adamc@29 508 handle CjrEnv.UnboundNamed n =>
adamc@201 509 print ("Unbound named " ^ Int.toString n ^ "\n")*)
adamc@29 510
adamc@183 511 fun compileC {cname, oname, ename} =
adamc@183 512 let
adamc@183 513 val compile = "gcc -O3 -I include -c " ^ cname ^ " -o " ^ oname
adamc@183 514 val link = "gcc -pthread -O3 clib/lacweb.o " ^ oname ^ " clib/driver.o -o " ^ ename
adamc@183 515 in
adamc@183 516 if not (OS.Process.isSuccess (OS.Process.system compile)) then
adamc@183 517 print "C compilation failed\n"
adamc@183 518 else if not (OS.Process.isSuccess (OS.Process.system link)) then
adamc@186 519 print "C linking failed\n"
adamc@183 520 else
adamc@183 521 print "Success\n"
adamc@183 522 end
adamc@183 523
adamc@201 524 (*fun compile job =
adamc@56 525 case cjrize job of
adamc@114 526 NONE => print "Laconic compilation failed\n"
adamc@29 527 | SOME file =>
adamc@186 528 if ErrorMsg.anyErrors () then
adamc@186 529 print "Laconic compilation failed\n"
adamc@186 530 else
adamc@186 531 let
adamc@186 532 val cname = "/tmp/lacweb.c"
adamc@186 533 val oname = "/tmp/lacweb.o"
adamc@186 534 val ename = "/tmp/webapp"
adamc@102 535
adamc@186 536 val outf = TextIO.openOut cname
adamc@186 537 val s = TextIOPP.openOut {dst = outf, wid = 80}
adamc@186 538 in
adamc@186 539 Print.fprint s (CjrPrint.p_file CjrEnv.empty file);
adamc@186 540 TextIO.closeOut outf;
adamc@102 541
adamc@186 542 compileC {cname = cname, oname = oname, ename = ename}
adamc@201 543 end*)
adamc@29 544
adamc@1 545 end