Mercurial > urweb

annotate src/compiler.sml @ 305:55eedecb6c50

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Remove need to mention table name in expressions for UPDATE and DELETE
author Adam Chlipala <adamc@hcoop.net>
date Sun, 07 Sep 2008 14:30:32 -0400
parents 59dc042629b9
children e0ed0d4dabc9
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@244 28 (* Ur/Web language parser *)
adamc@1 29
adamc@1 30 structure Compiler :> COMPILER = struct
adamc@1 31
adamc@244 32 structure UrwebLrVals = UrwebLrValsFn(structure Token = LrParser.Token)
adamc@244 33 structure Lex = UrwebLexFn(structure Tokens = UrwebLrVals.Tokens)
adamc@244 34 structure UrwebP = Join(structure ParserData = UrwebLrVals.ParserData
adamc@1 35 structure Lex = Lex
adamc@1 36 structure LrParser = LrParser)
adamc@1 37
adamc@270 38 type job = {
adamc@270 39 database : string option,
adamc@274 40 sources : string list,
adamc@274 41 exe : string,
adamc@274 42 sql : string option,
adamc@274 43 debug : bool
adamc@270 44 }
adamc@201 45
adamc@201 46 type ('src, 'dst) phase = {
adamc@201 47 func : 'src -> 'dst,
adamc@201 48 print : 'dst -> Print.PD.pp_desc
adamc@201 49 }
adamc@201 50
adamc@201 51 type pmap = (string * Time.time) list
adamc@201 52
adamc@201 53 type ('src, 'dst) transform = {
adamc@201 54 func : 'src -> 'dst option,
adamc@201 55 print : 'dst -> Print.PD.pp_desc,
adamc@201 56 time : 'src * pmap -> 'dst option * pmap
adamc@201 57 }
adamc@201 58
adamc@201 59 fun transform (ph : ('src, 'dst) phase) name = {
adamc@201 60 func = fn input => let
adamc@201 61 val v = #func ph input
adamc@201 62 in
adamc@201 63 if ErrorMsg.anyErrors () then
adamc@201 64 NONE
adamc@201 65 else
adamc@201 66 SOME v
adamc@201 67 end,
adamc@201 68 print = #print ph,
adamc@201 69 time = fn (input, pmap) => let
adamc@201 70 val befor = Time.now ()
adamc@201 71 val v = #func ph input
adamc@201 72 val elapsed = Time.- (Time.now (), befor)
adamc@201 73 in
adamc@201 74 (if ErrorMsg.anyErrors () then
adamc@201 75 NONE
adamc@201 76 else
adamc@201 77 SOME v,
adamc@201 78 (name, elapsed) :: pmap)
adamc@201 79 end
adamc@201 80 }
adamc@201 81
adamc@270 82 fun op o (tr2 : ('b, 'c) transform, tr1 : ('a, 'b) transform) = {
adamc@201 83 func = fn input => case #func tr1 input of
adamc@201 84 NONE => NONE
adamc@201 85 | SOME v => #func tr2 v,
adamc@201 86 print = #print tr2,
adamc@201 87 time = fn (input, pmap) => let
adamc@201 88 val (ro, pmap) = #time tr1 (input, pmap)
adamc@201 89 in
adamc@201 90 case ro of
adamc@201 91 NONE => (NONE, pmap)
adamc@201 92 | SOME v => #time tr2 (v, pmap)
adamc@201 93 end
adamc@201 94 }
adamc@201 95
adamc@280 96 fun run (tr : ('src, 'dst) transform) x = (ErrorMsg.resetErrors ();
adamc@280 97 #func tr x)
adamc@201 98
adamc@201 99 fun runPrint (tr : ('src, 'dst) transform) input =
adamc@280 100 (ErrorMsg.resetErrors ();
adamc@280 101 case #func tr input of
adamc@280 102 NONE => print "Failure\n"
adamc@280 103 | SOME v =>
adamc@280 104 (print "Success\n";
adamc@280 105 Print.print (#print tr v);
adamc@280 106 print "\n"))
adamc@201 107
adamc@201 108 fun time (tr : ('src, 'dst) transform) input =
adamc@55 109 let
adamc@201 110 val (_, pmap) = #time tr (input, [])
adamc@201 111 in
adamc@201 112 app (fn (name, time) =>
adamc@201 113 print (name ^ ": " ^ LargeReal.toString (Time.toReal time) ^ "\n")) (rev pmap);
adamc@201 114 print ("TOTAL: " ^ LargeReal.toString (Time.toReal (foldl Time.+ Time.zeroTime (map #2 pmap))) ^ "\n");
adamc@201 115 print "\n"
adamc@201 116 end
adamc@55 117
adamc@201 118 fun timePrint (tr : ('src, 'dst) transform) input =
adamc@201 119 let
adamc@201 120 val (ro, pmap) = #time tr (input, [])
adamc@55 121 in
adamc@201 122 app (fn (name, time) =>
adamc@201 123 print (name ^ ": " ^ LargeReal.toString (Time.toReal time) ^ "\n")) (rev pmap);
adamc@201 124 print ("TOTAL: " ^ LargeReal.toString (Time.toReal (foldl Time.+ Time.zeroTime (map #2 pmap))) ^ "\n");
adamc@201 125 print "\n";
adamc@201 126 case ro of
adamc@201 127 NONE => print "Failure\n"
adamc@201 128 | SOME v =>
adamc@201 129 (print "Success\n";
adamc@201 130 Print.print (#print tr v);
adamc@201 131 print "\n")
adamc@55 132 end
adamc@55 133
adamc@244 134 val parseUrs =
adamc@201 135 {func = fn filename => let
adamc@201 136 val fname = OS.FileSys.tmpName ()
adamc@201 137 val outf = TextIO.openOut fname
adamc@201 138 val () = TextIO.output (outf, "sig\n")
adamc@201 139 val inf = TextIO.openIn filename
adamc@201 140 fun loop () =
adamc@201 141 case TextIO.inputLine inf of
adamc@201 142 NONE => ()
adamc@201 143 | SOME line => (TextIO.output (outf, line);
adamc@201 144 loop ())
adamc@201 145 val () = loop ()
adamc@201 146 val () = TextIO.closeIn inf
adamc@201 147 val () = TextIO.closeOut outf
adamc@201 148
adamc@201 149 val () = (ErrorMsg.resetErrors ();
adamc@201 150 ErrorMsg.resetPositioning filename;
adamc@201 151 Lex.UserDeclarations.initialize ())
adamc@201 152 val file = TextIO.openIn fname
adamc@201 153 fun get _ = TextIO.input file
adamc@201 154 fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
adamc@201 155 val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
adamc@244 156 val (absyn, _) = UrwebP.parse (30, lexer, parseerror, ())
adamc@201 157 in
adamc@201 158 TextIO.closeIn file;
adamc@201 159 case absyn of
adamc@201 160 [(Source.DSgn ("?", (Source.SgnConst sgis, _)), _)] => sgis
adamc@201 161 | _ => (ErrorMsg.errorAt {file = filename,
adamc@201 162 first = {line = 0,
adamc@201 163 char = 0},
adamc@201 164 last = {line = 0,
adamc@201 165 char = 0}} "Not a signature";
adamc@201 166 [])
adamc@201 167 end
adamc@201 168 handle LrParser.ParseError => [],
adamc@201 169 print = Print.p_list_sep Print.PD.newline SourcePrint.p_sgn_item}
adamc@55 170
adamc@1 171 (* The main parsing routine *)
adamc@244 172 val parseUr = {
adamc@201 173 func = fn filename =>
adamc@201 174 let
adamc@201 175 val () = (ErrorMsg.resetErrors ();
adamc@201 176 ErrorMsg.resetPositioning filename;
adamc@201 177 Lex.UserDeclarations.initialize ())
adamc@201 178 val file = TextIO.openIn filename
adamc@201 179 fun get _ = TextIO.input file
adamc@201 180 fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
adamc@201 181 val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
adamc@244 182 val (absyn, _) = UrwebP.parse (30, lexer, parseerror, ())
adamc@201 183 in
adamc@201 184 TextIO.closeIn file;
adamc@201 185 case absyn of
adamc@201 186 [(Source.DSgn ("?", _), _)] =>
adamc@201 187 (ErrorMsg.errorAt {file = filename,
adamc@201 188 first = {line = 0,
adamc@201 189 char = 0},
adamc@201 190 last = {line = 0,
adamc@201 191 char = 0}} "File starts with 'sig'";
adamc@201 192 [])
adamc@201 193 | _ => absyn
adamc@201 194 end
adamc@201 195 handle LrParser.ParseError => [],
adamc@201 196 print = SourcePrint.p_file}
adamc@56 197
adamc@274 198 fun p_job {database, exe, sql, sources, debug} =
adamc@270 199 let
adamc@270 200 open Print.PD
adamc@270 201 open Print
adamc@270 202 in
adamc@274 203 box [if debug then
adamc@274 204 box [string "DEBUG", newline]
adamc@274 205 else
adamc@274 206 box [],
adamc@274 207 case database of
adamc@270 208 NONE => string "No database."
adamc@270 209 | SOME db => string ("Database: " ^ db),
adamc@270 210 newline,
adamc@274 211 string "Exe: ",
adamc@274 212 string exe,
adamc@274 213 newline,
adamc@274 214 case sql of
adamc@274 215 NONE => string "No SQL file."
adamc@274 216 | SOME sql => string ("SQL fle: " ^ sql),
adamc@270 217 string "Sources:",
adamc@270 218 p_list string sources,
adamc@270 219 newline]
adamc@270 220 end
adamc@270 221
adamc@270 222 fun trim s =
adamc@270 223 let
adamc@270 224 val (_, s) = Substring.splitl Char.isSpace s
adamc@270 225 val (s, _) = Substring.splitr Char.isSpace s
adamc@270 226 in
adamc@270 227 s
adamc@270 228 end
adamc@270 229
adamc@270 230 val parseUrp = {
adamc@270 231 func = fn filename =>
adamc@270 232 let
adamc@270 233 val dir = OS.Path.dir filename
adamc@270 234 val inf = TextIO.openIn (OS.Path.joinBaseExt {base = filename, ext = SOME "urp"})
adamc@270 235
adamc@274 236 fun relify fname =
adamc@274 237 OS.Path.concat (dir, fname)
adamc@274 238 handle OS.Path.Path => fname
adamc@274 239
adamc@270 240 fun readSources acc =
adamc@270 241 case TextIO.inputLine inf of
adamc@270 242 NONE => rev acc
adamc@270 243 | SOME line =>
adamc@270 244 let
adamc@270 245 val acc = if CharVector.all Char.isSpace line then
adamc@270 246 acc
adamc@270 247 else
adamc@270 248 let
adamc@270 249 val fname = String.implode (List.filter (fn x => not (Char.isSpace x))
adamc@270 250 (String.explode line))
adamc@274 251 val fname = relify fname
adamc@270 252 in
adamc@270 253 fname :: acc
adamc@270 254 end
adamc@270 255 in
adamc@270 256 readSources acc
adamc@270 257 end
adamc@270 258
adamc@274 259 fun finish (database, exe, sql, debug, sources) =
adamc@274 260 {database = database,
adamc@274 261 exe = Option.getOpt (exe, OS.Path.joinBaseExt {base = OS.Path.base filename,
adamc@274 262 ext = SOME "exe"}),
adamc@274 263 sql = sql,
adamc@274 264 debug = debug,
adamc@274 265 sources = sources}
adamc@274 266
adamc@274 267 fun read (database, exe, sql, debug) =
adamc@270 268 case TextIO.inputLine inf of
adamc@274 269 NONE => finish (database, exe, sql, debug, [])
adamc@274 270 | SOME "\n" => finish (database, exe, sql, debug, readSources [])
adamc@270 271 | SOME line =>
adamc@270 272 let
adamc@270 273 val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line)
adamc@270 274 val cmd = Substring.string (trim cmd)
adamc@270 275 val arg = Substring.string (trim arg)
adamc@270 276 in
adamc@270 277 case cmd of
adamc@270 278 "database" =>
adamc@270 279 (case database of
adamc@270 280 NONE => ()
adamc@270 281 | SOME _ => ErrorMsg.error "Duplicate 'database' directive";
adamc@274 282 read (SOME arg, exe, sql, debug))
adamc@274 283 | "exe" =>
adamc@274 284 (case exe of
adamc@274 285 NONE => ()
adamc@274 286 | SOME _ => ErrorMsg.error "Duplicate 'exe' directive";
adamc@274 287 read (database, SOME (relify arg), sql, debug))
adamc@274 288 | "sql" =>
adamc@274 289 (case sql of
adamc@274 290 NONE => ()
adamc@274 291 | SOME _ => ErrorMsg.error "Duplicate 'sql' directive";
adamc@274 292 read (database, exe, SOME (relify arg), debug))
adamc@274 293 | "debug" => read (database, exe, sql, true)
adamc@270 294 | _ => (ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
adamc@274 295 read (database, exe, sql, debug))
adamc@270 296 end
adamc@270 297 in
adamc@274 298 read (NONE, NONE, NONE, false)
adamc@270 299 before TextIO.closeIn inf
adamc@270 300 end,
adamc@270 301 print = p_job
adamc@270 302 }
adamc@270 303
adamc@270 304 val toParseJob = transform parseUrp "parseJob"
adamc@270 305
adamc@56 306 fun capitalize "" = ""
adamc@56 307 | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
adamc@56 308
adamc@201 309 val parse = {
adamc@274 310 func = fn {database, sources = fnames, ...} : job =>
adamc@201 311 let
adamc@201 312 fun nameOf fname = capitalize (OS.Path.file fname)
adamc@109 313
adamc@201 314 fun parseOne fname =
adamc@201 315 let
adamc@201 316 val mname = nameOf fname
adamc@244 317 val ur = OS.Path.joinBaseExt {base = fname, ext = SOME "ur"}
adamc@244 318 val urs = OS.Path.joinBaseExt {base = fname, ext = SOME "urs"}
adamc@56 319
adamc@201 320 val sgnO =
adamc@244 321 if Posix.FileSys.access (urs, []) then
adamc@244 322 SOME (Source.SgnConst (#func parseUrs urs),
adamc@244 323 {file = urs,
adamc@201 324 first = ErrorMsg.dummyPos,
adamc@201 325 last = ErrorMsg.dummyPos})
adamc@201 326 else
adamc@201 327 NONE
adamc@56 328
adamc@244 329 val loc = {file = ur,
adamc@201 330 first = ErrorMsg.dummyPos,
adamc@201 331 last = ErrorMsg.dummyPos}
adamc@56 332
adamc@244 333 val ds = #func parseUr ur
adamc@201 334 in
adamc@201 335 (Source.DStr (mname, sgnO, (Source.StrConst ds, loc)), loc)
adamc@201 336 end
adamc@56 337
adamc@201 338 val ds = map parseOne fnames
adamc@201 339 in
adamc@201 340 let
adamc@201 341 val final = nameOf (List.last fnames)
adamc@271 342
adamc@271 343 val ds = ds @ [(Source.DExport (Source.StrVar final, ErrorMsg.dummySpan), ErrorMsg.dummySpan)]
adamc@201 344 in
adamc@271 345 case database of
adamc@271 346 NONE => ds
adamc@271 347 | SOME s => (Source.DDatabase s, ErrorMsg.dummySpan) :: ds
adamc@201 348 end handle Empty => ds
adamc@201 349 end,
adamc@201 350 print = SourcePrint.p_file
adamc@201 351 }
adamc@56 352
adamc@270 353 val toParse = transform parse "parse" o toParseJob
adamc@38 354
adamc@201 355 val elaborate = {
adamc@201 356 func = fn file => let
adamc@244 357 val basis = #func parseUrs "lib/basis.urs"
adamc@201 358 in
adamc@201 359 Elaborate.elabFile basis ElabEnv.empty file
adamc@201 360 end,
adamc@201 361 print = ElabPrint.p_file ElabEnv.empty
adamc@201 362 }
adamc@5 363
adamc@270 364 val toElaborate = transform elaborate "elaborate" o toParse
adamc@201 365
adamc@201 366 val explify = {
adamc@201 367 func = Explify.explify,
adamc@201 368 print = ExplPrint.p_file ExplEnv.empty
adamc@201 369 }
adamc@201 370
adamc@270 371 val toExplify = transform explify "explify" o toElaborate
adamc@201 372
adamc@201 373 val corify = {
adamc@201 374 func = Corify.corify,
adamc@201 375 print = CorePrint.p_file CoreEnv.empty
adamc@201 376 }
adamc@201 377
adamc@270 378 val toCorify = transform corify "corify" o toExplify
adamc@201 379
adamc@202 380 val shake = {
adamc@202 381 func = Shake.shake,
adamc@202 382 print = CorePrint.p_file CoreEnv.empty
adamc@202 383 }
adamc@39 384
adamc@270 385 val toShake1 = transform shake "shake1" o toCorify
adamc@110 386
adamc@202 387 val tag = {
adamc@202 388 func = Tag.tag,
adamc@202 389 print = CorePrint.p_file CoreEnv.empty
adamc@202 390 }
adamc@193 391
adamc@270 392 val toTag = transform tag "tag" o toShake1
adamc@20 393
adamc@202 394 val reduce = {
adamc@202 395 func = Reduce.reduce,
adamc@202 396 print = CorePrint.p_file CoreEnv.empty
adamc@202 397 }
adamc@25 398
adamc@270 399 val toReduce = transform reduce "reduce" o toTag
adamc@23 400
adamc@202 401 val specialize = {
adamc@202 402 func = Specialize.specialize,
adamc@202 403 print = CorePrint.p_file CoreEnv.empty
adamc@202 404 }
adamc@132 405
adamc@270 406 val toSpecialize = transform specialize "specialize" o toReduce
adamc@131 407
adamc@270 408 val toShake2 = transform shake "shake2" o toSpecialize
adamc@133 409
adamc@202 410 val monoize = {
adamc@202 411 func = Monoize.monoize CoreEnv.empty,
adamc@202 412 print = MonoPrint.p_file MonoEnv.empty
adamc@202 413 }
adamc@134 414
adamc@270 415 val toMonoize = transform monoize "monoize" o toShake2
adamc@96 416
adamc@202 417 val mono_opt = {
adamc@202 418 func = MonoOpt.optimize,
adamc@202 419 print = MonoPrint.p_file MonoEnv.empty
adamc@202 420 }
adamc@29 421
adamc@270 422 val toMono_opt1 = transform mono_opt "mono_opt1" o toMonoize
adamc@5 423
adamc@202 424 val untangle = {
adamc@202 425 func = Untangle.untangle,
adamc@202 426 print = MonoPrint.p_file MonoEnv.empty
adamc@202 427 }
adamc@1 428
adamc@270 429 val toUntangle = transform untangle "untangle" o toMono_opt1
adamc@38 430
adamc@202 431 val mono_reduce = {
adamc@202 432 func = MonoReduce.reduce,
adamc@202 433 print = MonoPrint.p_file MonoEnv.empty
adamc@202 434 }
adamc@16 435
adamc@270 436 val toMono_reduce = transform mono_reduce "mono_reduce" o toUntangle
adamc@39 437
adamc@202 438 val mono_shake = {
adamc@202 439 func = MonoShake.shake,
adamc@202 440 print = MonoPrint.p_file MonoEnv.empty
adamc@202 441 }
adamc@110 442
adamc@270 443 val toMono_shake = transform mono_shake "mono_shake1" o toMono_reduce
adamc@193 444
adamc@270 445 val toMono_opt2 = transform mono_opt "mono_opt2" o toMono_shake
adamc@20 446
adamc@202 447 val cjrize = {
adamc@202 448 func = Cjrize.cjrize,
adamc@202 449 print = CjrPrint.p_file CjrEnv.empty
adamc@202 450 }
adamc@23 451
adamc@270 452 val toCjrize = transform cjrize "cjrize" o toMono_opt2
adamc@29 453
adamc@282 454 val prepare = {
adamc@282 455 func = Prepare.prepare,
adamc@282 456 print = CjrPrint.p_file CjrEnv.empty
adamc@282 457 }
adamc@282 458
adamc@282 459 val toPrepare = transform prepare "prepare" o toCjrize
adamc@282 460
adamc@274 461 val sqlify = {
adamc@274 462 func = Cjrize.cjrize,
adamc@274 463 print = CjrPrint.p_sql CjrEnv.empty
adamc@274 464 }
adamc@274 465
adamc@274 466 val toSqlify = transform sqlify "sqlify" o toMono_opt2
adamc@274 467
adamc@183 468 fun compileC {cname, oname, ename} =
adamc@183 469 let
adamc@297 470 val compile = "gcc -Wstrict-prototypes -Werror -s -O3 -I include -c " ^ cname ^ " -o " ^ oname
adamc@297 471 val link = "gcc -Werror -s -O3 -pthread -lpq clib/urweb.o " ^ oname ^ " clib/driver.o -o " ^ ename
adamc@183 472 in
adamc@183 473 if not (OS.Process.isSuccess (OS.Process.system compile)) then
adamc@183 474 print "C compilation failed\n"
adamc@183 475 else if not (OS.Process.isSuccess (OS.Process.system link)) then
adamc@186 476 print "C linking failed\n"
adamc@183 477 else
adamc@183 478 print "Success\n"
adamc@183 479 end
adamc@183 480
adamc@202 481 fun compile job =
adamc@282 482 case run toPrepare job of
adamc@244 483 NONE => print "Ur compilation failed\n"
adamc@29 484 | SOME file =>
adamc@202 485 let
adamc@274 486 val job = valOf (run (transform parseUrp "parseUrp") job)
adamc@102 487
adamc@274 488 val (cname, oname, cleanup) =
adamc@274 489 if #debug job then
adamc@274 490 ("/tmp/urweb.c", "/tmp/urweb.o", fn () => ())
adamc@274 491 else
adamc@274 492 let
adamc@274 493 val dir = OS.FileSys.tmpName ()
adamc@274 494 val cname = OS.Path.joinDirFile {dir = dir, file = "urweb.c"}
adamc@274 495 val oname = OS.Path.joinDirFile {dir = dir, file = "urweb.o"}
adamc@274 496 in
adamc@274 497 OS.FileSys.mkDir dir;
adamc@274 498 (cname, oname,
adamc@274 499 fn () => (OS.FileSys.remove cname;
adamc@274 500 OS.FileSys.remove oname;
adamc@274 501 OS.FileSys.rmDir dir))
adamc@274 502 end
adamc@274 503 val ename = #exe job
adamc@202 504 in
adamc@274 505 let
adamc@274 506 val outf = TextIO.openOut cname
adamc@274 507 val s = TextIOPP.openOut {dst = outf, wid = 80}
adamc@274 508 in
adamc@274 509 Print.fprint s (CjrPrint.p_file CjrEnv.empty file);
adamc@274 510 TextIO.closeOut outf;
adamc@102 511
adamc@274 512 case #sql job of
adamc@274 513 NONE => ()
adamc@274 514 | SOME sql =>
adamc@274 515 let
adamc@274 516 val outf = TextIO.openOut sql
adamc@274 517 val s = TextIOPP.openOut {dst = outf, wid = 80}
adamc@274 518 in
adamc@274 519 Print.fprint s (CjrPrint.p_sql CjrEnv.empty file);
adamc@274 520 TextIO.closeOut outf
adamc@274 521 end;
adamc@274 522
adamc@274 523 compileC {cname = cname, oname = oname, ename = ename};
adamc@274 524
adamc@274 525 cleanup ()
adamc@274 526 end
adamc@274 527 handle ex => (((cleanup ()) handle _ => ()); raise ex)
adamc@202 528 end
adamc@29 529
adamc@1 530 end