Mercurial > urweb

annotate src/compiler.sml @ 1034:a779402841f6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Hooks for measuring how much interesting proving is going on in elaboration
author Adam Chlipala <adamc@hcoop.net>
date Tue, 17 Nov 2009 12:44:14 -0500
parents dfe34fad749d
children 0d916892e39e
rev   line source
adamc@764 1 (* Copyright (c) 2008-2009, 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 structure Compiler :> COMPILER = struct
adamc@1 29
adamc@244 30 structure UrwebLrVals = UrwebLrValsFn(structure Token = LrParser.Token)
adamc@244 31 structure Lex = UrwebLexFn(structure Tokens = UrwebLrVals.Tokens)
adamc@244 32 structure UrwebP = Join(structure ParserData = UrwebLrVals.ParserData
adamc@1 33 structure Lex = Lex
adamc@1 34 structure LrParser = LrParser)
adamc@1 35
adamc@270 36 type job = {
adamc@385 37 prefix : string,
adamc@270 38 database : string option,
adamc@274 39 sources : string list,
adamc@274 40 exe : string,
adamc@274 41 sql : string option,
adamc@502 42 debug : bool,
adamc@673 43 profile : bool,
adamc@764 44 timeout : int,
adamc@764 45 ffi : string list,
adamc@764 46 link : string list,
adamc@765 47 headers : string list,
adamc@766 48 scripts : string list,
adamc@765 49 clientToServer : Settings.ffi list,
adamc@765 50 effectful : Settings.ffi list,
adamc@765 51 clientOnly : Settings.ffi list,
adamc@765 52 serverOnly : Settings.ffi list,
adamc@768 53 jsFuncs : (Settings.ffi * string) list,
adamc@769 54 rewrites : Settings.rewrite list,
adamc@769 55 filterUrl : Settings.rule list,
adamc@866 56 filterMime : Settings.rule list,
adamc@866 57 protocol : string option,
adamc@866 58 dbms : string option
adamc@270 59 }
adamc@201 60
adamc@201 61 type ('src, 'dst) phase = {
adamc@201 62 func : 'src -> 'dst,
adamc@201 63 print : 'dst -> Print.PD.pp_desc
adamc@201 64 }
adamc@201 65
adamc@201 66 type pmap = (string * Time.time) list
adamc@201 67
adamc@201 68 type ('src, 'dst) transform = {
adamc@201 69 func : 'src -> 'dst option,
adamc@201 70 print : 'dst -> Print.PD.pp_desc,
adamc@201 71 time : 'src * pmap -> 'dst option * pmap
adamc@201 72 }
adamc@201 73
adamc@201 74 fun transform (ph : ('src, 'dst) phase) name = {
adamc@201 75 func = fn input => let
adamc@201 76 val v = #func ph input
adamc@201 77 in
adamc@201 78 if ErrorMsg.anyErrors () then
adamc@201 79 NONE
adamc@201 80 else
adamc@201 81 SOME v
adamc@201 82 end,
adamc@201 83 print = #print ph,
adamc@201 84 time = fn (input, pmap) => let
adamc@201 85 val befor = Time.now ()
adamc@201 86 val v = #func ph input
adamc@201 87 val elapsed = Time.- (Time.now (), befor)
adamc@201 88 in
adamc@201 89 (if ErrorMsg.anyErrors () then
adamc@201 90 NONE
adamc@201 91 else
adamc@201 92 SOME v,
adamc@201 93 (name, elapsed) :: pmap)
adamc@201 94 end
adamc@201 95 }
adamc@201 96
adamc@270 97 fun op o (tr2 : ('b, 'c) transform, tr1 : ('a, 'b) transform) = {
adamc@201 98 func = fn input => case #func tr1 input of
adamc@201 99 NONE => NONE
adamc@201 100 | SOME v => #func tr2 v,
adamc@201 101 print = #print tr2,
adamc@201 102 time = fn (input, pmap) => let
adamc@201 103 val (ro, pmap) = #time tr1 (input, pmap)
adamc@201 104 in
adamc@201 105 case ro of
adamc@201 106 NONE => (NONE, pmap)
adamc@201 107 | SOME v => #time tr2 (v, pmap)
adamc@201 108 end
adamc@201 109 }
adamc@201 110
adamc@346 111 fun check (tr : ('src, 'dst) transform) x = (ErrorMsg.resetErrors ();
adamc@346 112 ignore (#func tr x))
adamc@346 113
adamc@280 114 fun run (tr : ('src, 'dst) transform) x = (ErrorMsg.resetErrors ();
adamc@280 115 #func tr x)
adamc@201 116
adamc@201 117 fun runPrint (tr : ('src, 'dst) transform) input =
adamc@280 118 (ErrorMsg.resetErrors ();
adamc@280 119 case #func tr input of
adamc@280 120 NONE => print "Failure\n"
adamc@280 121 | SOME v =>
adamc@280 122 (print "Success\n";
adamc@280 123 Print.print (#print tr v);
adamc@280 124 print "\n"))
adamc@201 125
adamc@201 126 fun time (tr : ('src, 'dst) transform) input =
adamc@55 127 let
adamc@201 128 val (_, pmap) = #time tr (input, [])
adamc@201 129 in
adamc@201 130 app (fn (name, time) =>
adamc@201 131 print (name ^ ": " ^ LargeReal.toString (Time.toReal time) ^ "\n")) (rev pmap);
adamc@201 132 print ("TOTAL: " ^ LargeReal.toString (Time.toReal (foldl Time.+ Time.zeroTime (map #2 pmap))) ^ "\n");
adamc@201 133 print "\n"
adamc@201 134 end
adamc@55 135
adamc@201 136 fun timePrint (tr : ('src, 'dst) transform) input =
adamc@201 137 let
adamc@201 138 val (ro, pmap) = #time tr (input, [])
adamc@55 139 in
adamc@201 140 app (fn (name, time) =>
adamc@201 141 print (name ^ ": " ^ LargeReal.toString (Time.toReal time) ^ "\n")) (rev pmap);
adamc@201 142 print ("TOTAL: " ^ LargeReal.toString (Time.toReal (foldl Time.+ Time.zeroTime (map #2 pmap))) ^ "\n");
adamc@201 143 print "\n";
adamc@201 144 case ro of
adamc@201 145 NONE => print "Failure\n"
adamc@201 146 | SOME v =>
adamc@201 147 (print "Success\n";
adamc@201 148 Print.print (#print tr v);
adamc@201 149 print "\n")
adamc@55 150 end
adamc@55 151
adamc@244 152 val parseUrs =
adamc@201 153 {func = fn filename => let
adamc@201 154 val fname = OS.FileSys.tmpName ()
adamc@201 155 val outf = TextIO.openOut fname
adamc@201 156 val () = TextIO.output (outf, "sig\n")
adamc@201 157 val inf = TextIO.openIn filename
adamc@201 158 fun loop () =
adamc@201 159 case TextIO.inputLine inf of
adamc@201 160 NONE => ()
adamc@201 161 | SOME line => (TextIO.output (outf, line);
adamc@201 162 loop ())
adamc@201 163 val () = loop ()
adamc@201 164 val () = TextIO.closeIn inf
adamc@201 165 val () = TextIO.closeOut outf
adamc@201 166
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 fname
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@244 174 val (absyn, _) = UrwebP.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 ("?", (Source.SgnConst sgis, _)), _)] => sgis
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}} "Not a signature";
adamc@201 184 [])
adamc@201 185 end
adamc@201 186 handle LrParser.ParseError => [],
adamc@201 187 print = Print.p_list_sep Print.PD.newline SourcePrint.p_sgn_item}
adamc@55 188
adamc@1 189 (* The main parsing routine *)
adamc@244 190 val parseUr = {
adamc@201 191 func = fn filename =>
adamc@201 192 let
adamc@201 193 val () = (ErrorMsg.resetErrors ();
adamc@201 194 ErrorMsg.resetPositioning filename;
adamc@201 195 Lex.UserDeclarations.initialize ())
adamc@201 196 val file = TextIO.openIn filename
adamc@201 197 fun get _ = TextIO.input file
adamc@201 198 fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
adamc@201 199 val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
adamc@244 200 val (absyn, _) = UrwebP.parse (30, lexer, parseerror, ())
adamc@201 201 in
adamc@201 202 TextIO.closeIn file;
adamc@201 203 case absyn of
adamc@201 204 [(Source.DSgn ("?", _), _)] =>
adamc@201 205 (ErrorMsg.errorAt {file = filename,
adamc@201 206 first = {line = 0,
adamc@201 207 char = 0},
adamc@201 208 last = {line = 0,
adamc@201 209 char = 0}} "File starts with 'sig'";
adamc@201 210 [])
adamc@201 211 | _ => absyn
adamc@201 212 end
adamc@201 213 handle LrParser.ParseError => [],
adamc@201 214 print = SourcePrint.p_file}
adamc@56 215
adamc@768 216 fun p_job ({prefix, database, exe, sql, sources, debug, profile,
adamc@768 217 timeout, ffi, link, headers, scripts,
adamc@768 218 clientToServer, effectful, clientOnly, serverOnly, jsFuncs, ...} : job) =
adamc@270 219 let
adamc@270 220 open Print.PD
adamc@270 221 open Print
adamc@765 222
adamc@765 223 fun p_ffi name = p_list_sep (box []) (fn (m, s) =>
adamc@765 224 box [string name, space, string m, string ".", string s, newline])
adamc@270 225 in
adamc@274 226 box [if debug then
adamc@274 227 box [string "DEBUG", newline]
adamc@274 228 else
adamc@274 229 box [],
adamc@502 230 if profile then
adamc@502 231 box [string "PROFILE", newline]
adamc@502 232 else
adamc@502 233 box [],
adamc@274 234 case database of
adamc@270 235 NONE => string "No database."
adamc@270 236 | SOME db => string ("Database: " ^ db),
adamc@270 237 newline,
adamc@274 238 string "Exe: ",
adamc@274 239 string exe,
adamc@274 240 newline,
adamc@274 241 case sql of
adamc@274 242 NONE => string "No SQL file."
adamc@274 243 | SOME sql => string ("SQL fle: " ^ sql),
adamc@673 244 newline,
adamc@673 245 string "Timeout: ",
adamc@673 246 string (Int.toString timeout),
adamc@673 247 newline,
adamc@764 248 p_list_sep (box []) (fn s => box [string "Ffi", space, string s, newline]) ffi,
adamc@764 249 p_list_sep (box []) (fn s => box [string "Header", space, string s, newline]) headers,
adamc@766 250 p_list_sep (box []) (fn s => box [string "Script", space, string s, newline]) scripts,
adamc@764 251 p_list_sep (box []) (fn s => box [string "Link", space, string s, newline]) link,
adamc@765 252 p_ffi "ClientToServer" clientToServer,
adamc@765 253 p_ffi "Effectful" effectful,
adamc@765 254 p_ffi "ClientOnly" clientOnly,
adamc@765 255 p_ffi "ServerOnly" serverOnly,
adamc@765 256 p_list_sep (box []) (fn ((m, s), s') =>
adamc@765 257 box [string "JsFunc", space, string m, string ".", string s,
adamc@765 258 space, string "=", space, string s', newline]) jsFuncs,
adamc@270 259 string "Sources:",
adamc@270 260 p_list string sources,
adamc@270 261 newline]
adamc@270 262 end
adamc@270 263
adamc@270 264 fun trim s =
adamc@270 265 let
adamc@270 266 val (_, s) = Substring.splitl Char.isSpace s
adamc@270 267 val (s, _) = Substring.splitr Char.isSpace s
adamc@270 268 in
adamc@270 269 s
adamc@270 270 end
adamc@270 271
adamc@794 272 structure M = BinaryMapFn(struct
adamc@794 273 type ord_key = string
adamc@794 274 val compare = String.compare
adamc@794 275 end)
adamc@794 276
adamc@794 277 fun parseUrp' fname =
adamc@767 278 let
adamc@794 279 val pathmap = ref (M.insert (M.empty, "", Config.libUr))
adamc@767 280
adamc@794 281 fun pu filename =
adamc@794 282 let
adamc@794 283 val dir = OS.Path.dir filename
adamc@794 284 val inf = TextIO.openIn (OS.Path.joinBaseExt {base = filename, ext = SOME "urp"})
adamc@767 285
adamc@794 286 fun pathify fname =
adamc@794 287 if size fname > 0 andalso String.sub (fname, 0) = #"$" then
adamc@794 288 let
adamc@794 289 val fname' = Substring.extract (fname, 1, NONE)
adamc@794 290 val (befor, after) = Substring.splitl (fn ch => ch <> #"/") fname'
adamc@794 291 in
adamc@794 292 if Substring.isEmpty after then
adamc@794 293 fname
adamc@794 294 else
adamc@794 295 case M.find (!pathmap, Substring.string befor) of
adamc@794 296 NONE => fname
adamc@794 297 | SOME rep => rep ^ Substring.string after
adamc@794 298 end
adamc@794 299 else
adamc@794 300 fname
adamc@767 301
adamc@794 302 fun relify fname =
adamc@794 303 let
adamc@794 304 val fname = pathify fname
adamc@794 305 in
adamc@794 306 OS.Path.concat (dir, fname)
adamc@794 307 handle OS.Path.Path => fname
adamc@794 308 end
adamc@767 309
adamc@794 310 val absDir = OS.Path.mkAbsolute {path = dir, relativeTo = OS.FileSys.getDir ()}
adamc@767 311
adamc@794 312 fun relifyA fname =
adamc@794 313 OS.Path.mkAbsolute {path = pathify fname, relativeTo = absDir}
adamc@767 314
adamc@794 315 fun readSources acc =
adamc@794 316 case TextIO.inputLine inf of
adamc@794 317 NONE => rev acc
adamc@794 318 | SOME line =>
adamc@794 319 let
adamc@794 320 val acc = if CharVector.all Char.isSpace line then
adamc@794 321 acc
adamc@794 322 else
adamc@794 323 let
adamc@794 324 val fname = String.implode (List.filter (fn x => not (Char.isSpace x))
adamc@794 325 (String.explode line))
adamc@794 326 val fname = relify fname
adamc@794 327 in
adamc@794 328 fname :: acc
adamc@794 329 end
adamc@794 330 in
adamc@794 331 readSources acc
adamc@794 332 end
adamc@767 333
adamc@794 334 val prefix = ref NONE
adamc@891 335 val database = ref (Settings.getDbstring ())
adamc@891 336 val exe = ref (Settings.getExe ())
adamc@891 337 val sql = ref (Settings.getSql ())
adamc@857 338 val debug = ref (Settings.getDebug ())
adamc@794 339 val profile = ref false
adamc@794 340 val timeout = ref NONE
adamc@794 341 val ffi = ref []
adamc@794 342 val link = ref []
adamc@794 343 val headers = ref []
adamc@794 344 val scripts = ref []
adamc@794 345 val clientToServer = ref []
adamc@794 346 val effectful = ref []
adamc@794 347 val clientOnly = ref []
adamc@794 348 val serverOnly = ref []
adamc@794 349 val jsFuncs = ref []
adamc@794 350 val rewrites = ref []
adamc@794 351 val url = ref []
adamc@794 352 val mime = ref []
adamc@794 353 val libs = ref []
adamc@866 354 val protocol = ref NONE
adamc@866 355 val dbms = ref NONE
adamc@767 356
adamc@794 357 fun finish sources =
adamc@794 358 let
adamc@794 359 val job = {
adamc@794 360 prefix = Option.getOpt (!prefix, "/"),
adamc@794 361 database = !database,
adamc@794 362 exe = Option.getOpt (!exe, OS.Path.joinBaseExt {base = OS.Path.base filename,
adamc@794 363 ext = SOME "exe"}),
adamc@794 364 sql = !sql,
adamc@794 365 debug = !debug,
adamc@794 366 profile = !profile,
adamc@794 367 timeout = Option.getOpt (!timeout, 60),
adamc@794 368 ffi = rev (!ffi),
adamc@794 369 link = rev (!link),
adamc@794 370 headers = rev (!headers),
adamc@794 371 scripts = rev (!scripts),
adamc@794 372 clientToServer = rev (!clientToServer),
adamc@794 373 effectful = rev (!effectful),
adamc@794 374 clientOnly = rev (!clientOnly),
adamc@794 375 serverOnly = rev (!serverOnly),
adamc@794 376 jsFuncs = rev (!jsFuncs),
adamc@794 377 rewrites = rev (!rewrites),
adamc@794 378 filterUrl = rev (!url),
adamc@794 379 filterMime = rev (!mime),
adamc@866 380 sources = sources,
adamc@866 381 protocol = !protocol,
adamc@866 382 dbms = !dbms
adamc@794 383 }
adamc@767 384
adamc@794 385 fun mergeO f (old, new) =
adamc@794 386 case (old, new) of
adamc@794 387 (NONE, _) => new
adamc@794 388 | (_, NONE) => old
adamc@794 389 | (SOME v1, SOME v2) => SOME (f (v1, v2))
adamc@794 390
adamc@794 391 fun same desc = mergeO (fn (x : string, y) =>
adamc@794 392 (if x = y then
adamc@794 393 ()
adamc@794 394 else
adamc@794 395 ErrorMsg.error ("Multiple "
adamc@794 396 ^ desc ^ " values that don't agree");
adamc@794 397 x))
adamc@794 398
adamc@794 399 fun merge (old : job, new : job) = {
adamc@794 400 prefix = #prefix old,
adamc@891 401 database = mergeO (fn (old, _) => old) (#database old, #database new),
adamc@794 402 exe = #exe old,
adamc@794 403 sql = #sql old,
adamc@794 404 debug = #debug old orelse #debug new,
adamc@794 405 profile = #profile old orelse #profile new,
adamc@794 406 timeout = #timeout old,
adamc@794 407 ffi = #ffi old @ #ffi new,
adamc@794 408 link = #link old @ #link new,
adamc@794 409 headers = #headers old @ #headers new,
adamc@794 410 scripts = #scripts old @ #scripts new,
adamc@794 411 clientToServer = #clientToServer old @ #clientToServer new,
adamc@794 412 effectful = #effectful old @ #effectful new,
adamc@794 413 clientOnly = #clientOnly old @ #clientOnly new,
adamc@794 414 serverOnly = #serverOnly old @ #serverOnly new,
adamc@794 415 jsFuncs = #jsFuncs old @ #jsFuncs new,
adamc@794 416 rewrites = #rewrites old @ #rewrites new,
adamc@794 417 filterUrl = #filterUrl old @ #filterUrl new,
adamc@794 418 filterMime = #filterMime old @ #filterMime new,
adamc@866 419 sources = #sources new @ #sources old,
adamc@866 420 protocol = mergeO #2 (#protocol old, #protocol new),
adamc@866 421 dbms = mergeO #2 (#dbms old, #dbms new)
adamc@794 422 }
adamc@794 423 in
adamc@832 424 foldr (fn (fname, job) => merge (job, pu fname)) job (!libs)
adamc@794 425 end
adamc@794 426
adamc@794 427 fun parsePkind s =
adamc@794 428 case s of
adamc@794 429 "all" => Settings.Any
adamc@794 430 | "url" => Settings.Url
adamc@794 431 | "table" => Settings.Table
adamc@794 432 | "sequence" => Settings.Sequence
adamc@794 433 | "view" => Settings.View
adamc@794 434 | "relation" => Settings.Relation
adamc@794 435 | "cookie" => Settings.Cookie
adamc@794 436 | "style" => Settings.Style
adamc@794 437 | _ => (ErrorMsg.error "Bad path kind spec";
adamc@794 438 Settings.Any)
adamc@794 439
adamc@794 440 fun parseFrom s =
adamc@794 441 if size s > 1 andalso String.sub (s, size s - 2) = #"/" andalso String.sub (s, size s - 1) = #"*" then
adamc@794 442 (Settings.Prefix, String.substring (s, 0, size s - 1))
adamc@794 443 else
adamc@794 444 (Settings.Exact, s)
adamc@794 445
adamc@794 446 fun parseFkind s =
adamc@794 447 case s of
adamc@794 448 "url" => url
adamc@794 449 | "mime" => mime
adamc@794 450 | _ => (ErrorMsg.error "Bad filter kind";
adamc@794 451 url)
adamc@794 452
adamc@794 453 fun parsePattern s =
adamc@794 454 if size s > 0 andalso String.sub (s, size s - 1) = #"*" then
adamc@794 455 (Settings.Prefix, String.substring (s, 0, size s - 1))
adamc@794 456 else
adamc@794 457 (Settings.Exact, s)
adamc@794 458
adamc@794 459 fun read () =
adamc@794 460 case TextIO.inputLine inf of
adamc@794 461 NONE => finish []
adamc@794 462 | SOME "\n" => finish (readSources [])
adamc@794 463 | SOME line =>
adamc@794 464 let
adamc@794 465 val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line)
adamc@794 466 val cmd = Substring.string (trim cmd)
adamc@794 467 val arg = Substring.string (trim arg)
adamc@794 468
adamc@794 469 fun ffiS () =
adamc@794 470 case String.fields (fn ch => ch = #".") arg of
adamc@794 471 [m, x] => (m, x)
adamc@794 472 | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func");
adamc@794 473 ("", ""))
adamc@794 474
adamc@794 475 fun ffiM () =
adamc@794 476 case String.fields (fn ch => ch = #"=") arg of
adamc@794 477 [f, s] =>
adamc@794 478 (case String.fields (fn ch => ch = #".") f of
adamc@794 479 [m, x] => ((m, x), s)
adamc@794 480 | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
adamc@794 481 (("", ""), "")))
adamc@794 482 | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
adamc@794 483 (("", ""), ""))
adamc@794 484 in
adamc@794 485 case cmd of
adamc@794 486 "prefix" =>
adamc@794 487 (case !prefix of
adamc@794 488 NONE => ()
adamc@794 489 | SOME _ => ErrorMsg.error "Duplicate 'prefix' directive";
adamc@794 490 prefix := SOME arg)
adamc@794 491 | "database" =>
adamc@794 492 (case !database of
adamc@891 493 NONE => database := SOME arg
adamc@891 494 | SOME _ => ())
adamc@794 495 | "exe" =>
adamc@794 496 (case !exe of
adamc@891 497 NONE => exe := SOME (relify arg)
adamc@891 498 | SOME _ => ())
adamc@794 499 | "sql" =>
adamc@794 500 (case !sql of
adamc@891 501 NONE => sql := SOME (relify arg)
adamc@891 502 | SOME _ => ())
adamc@794 503 | "debug" => debug := true
adamc@794 504 | "profile" => profile := true
adamc@794 505 | "timeout" =>
adamc@794 506 (case !timeout of
adamc@794 507 NONE => ()
adamc@794 508 | SOME _ => ErrorMsg.error "Duplicate 'timeout' directive";
adamc@794 509 timeout := SOME (valOf (Int.fromString arg)))
adamc@794 510 | "ffi" => ffi := relify arg :: !ffi
adamc@794 511 | "link" => link := relifyA arg :: !link
adamc@794 512 | "include" => headers := relifyA arg :: !headers
adamc@794 513 | "script" => scripts := arg :: !scripts
adamc@794 514 | "clientToServer" => clientToServer := ffiS () :: !clientToServer
adamc@794 515 | "effectful" => effectful := ffiS () :: !effectful
adamc@794 516 | "clientOnly" => clientOnly := ffiS () :: !clientOnly
adamc@794 517 | "serverOnly" => serverOnly := ffiS () :: !serverOnly
adamc@794 518 | "jsFunc" => jsFuncs := ffiM () :: !jsFuncs
adamc@794 519 | "rewrite" =>
adamc@794 520 let
adamc@794 521 fun doit (pkind, from, to) =
adamc@794 522 let
adamc@794 523 val pkind = parsePkind pkind
adamc@794 524 val (kind, from) = parseFrom from
adamc@794 525 in
adamc@794 526 rewrites := {pkind = pkind, kind = kind, from = from, to = to} :: !rewrites
adamc@794 527 end
adamc@794 528 in
adamc@794 529 case String.tokens Char.isSpace arg of
adamc@794 530 [pkind, from, to] => doit (pkind, from, to)
adamc@794 531 | [pkind, from] => doit (pkind, from, "")
adamc@794 532 | _ => ErrorMsg.error "Bad 'rewrite' syntax"
adamc@794 533 end
adamc@794 534 | "allow" =>
adamc@794 535 (case String.tokens Char.isSpace arg of
adamc@794 536 [fkind, pattern] =>
adamc@794 537 let
adamc@794 538 val fkind = parseFkind fkind
adamc@794 539 val (kind, pattern) = parsePattern pattern
adamc@794 540 in
adamc@794 541 fkind := {action = Settings.Allow, kind = kind, pattern = pattern} :: !fkind
adamc@794 542 end
adamc@794 543 | _ => ErrorMsg.error "Bad 'allow' syntax")
adamc@794 544 | "deny" =>
adamc@794 545 (case String.tokens Char.isSpace arg of
adamc@794 546 [fkind, pattern] =>
adamc@794 547 let
adamc@794 548 val fkind = parseFkind fkind
adamc@794 549 val (kind, pattern) = parsePattern pattern
adamc@794 550 in
adamc@794 551 fkind := {action = Settings.Deny, kind = kind, pattern = pattern} :: !fkind
adamc@794 552 end
adamc@794 553 | _ => ErrorMsg.error "Bad 'deny' syntax")
adamc@794 554 | "library" => libs := relify arg :: !libs
adamc@794 555 | "path" =>
adamc@794 556 (case String.fields (fn ch => ch = #"=") arg of
adamc@794 557 [n, v] => pathmap := M.insert (!pathmap, n, v)
adamc@794 558 | _ => ErrorMsg.error "path argument not of the form name=value'")
adamc@794 559 | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
adamc@794 560 read ()
adamc@794 561 end
adamc@794 562
adamc@794 563 val job = read ()
adamc@767 564 in
adamc@794 565 TextIO.closeIn inf;
adamc@794 566 Settings.setUrlPrefix (#prefix job);
adamc@794 567 Settings.setTimeout (#timeout job);
adamc@794 568 Settings.setHeaders (#headers job);
adamc@794 569 Settings.setScripts (#scripts job);
adamc@794 570 Settings.setClientToServer (#clientToServer job);
adamc@794 571 Settings.setEffectful (#effectful job);
adamc@794 572 Settings.setClientOnly (#clientOnly job);
adamc@794 573 Settings.setServerOnly (#serverOnly job);
adamc@794 574 Settings.setJsFuncs (#jsFuncs job);
adamc@794 575 Settings.setRewriteRules (#rewrites job);
adamc@794 576 Settings.setUrlRules (#filterUrl job);
adamc@794 577 Settings.setMimeRules (#filterMime job);
adamc@866 578 Option.app Settings.setProtocol (#protocol job);
adamc@866 579 Option.app Settings.setDbms (#dbms job);
adamc@794 580 job
adamc@767 581 end
adamc@767 582 in
adamc@794 583 pu fname
adamc@767 584 end
adamc@767 585
adamc@270 586 val parseUrp = {
adamc@767 587 func = parseUrp',
adamc@270 588 print = p_job
adamc@270 589 }
adamc@270 590
adamc@270 591 val toParseJob = transform parseUrp "parseJob"
adamc@270 592
adamc@56 593 fun capitalize "" = ""
adamc@56 594 | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
adamc@56 595
adamc@201 596 val parse = {
adamc@764 597 func = fn {database, sources = fnames, ffi, ...} : job =>
adamc@201 598 let
adamc@834 599 val anyErrors = ref false
adamc@834 600 fun checkErrors () = anyErrors := (!anyErrors orelse ErrorMsg.anyErrors ())
adamc@201 601 fun nameOf fname = capitalize (OS.Path.file fname)
adamc@109 602
adamc@764 603 fun parseFfi fname =
adamc@764 604 let
adamc@764 605 val mname = nameOf fname
adamc@764 606 val urs = OS.Path.joinBaseExt {base = fname, ext = SOME "urs"}
adamc@764 607
adamc@764 608 val loc = {file = urs,
adamc@764 609 first = ErrorMsg.dummyPos,
adamc@764 610 last = ErrorMsg.dummyPos}
adamc@764 611
adamc@764 612 val sgn = (Source.SgnConst (#func parseUrs urs), loc)
adamc@764 613 in
adamc@834 614 checkErrors ();
adamc@764 615 (Source.DFfiStr (mname, sgn), loc)
adamc@764 616 end
adamc@764 617
adamc@201 618 fun parseOne fname =
adamc@201 619 let
adamc@201 620 val mname = nameOf fname
adamc@244 621 val ur = OS.Path.joinBaseExt {base = fname, ext = SOME "ur"}
adamc@244 622 val urs = OS.Path.joinBaseExt {base = fname, ext = SOME "urs"}
adamc@56 623
adamc@201 624 val sgnO =
adamc@244 625 if Posix.FileSys.access (urs, []) then
adamc@244 626 SOME (Source.SgnConst (#func parseUrs urs),
adamc@244 627 {file = urs,
adamc@201 628 first = ErrorMsg.dummyPos,
adamc@201 629 last = ErrorMsg.dummyPos})
adamc@834 630 before checkErrors ()
adamc@201 631 else
adamc@201 632 NONE
adamc@56 633
adamc@244 634 val loc = {file = ur,
adamc@201 635 first = ErrorMsg.dummyPos,
adamc@201 636 last = ErrorMsg.dummyPos}
adamc@56 637
adamc@244 638 val ds = #func parseUr ur
adamc@201 639 in
adamc@834 640 checkErrors ();
adamc@201 641 (Source.DStr (mname, sgnO, (Source.StrConst ds, loc)), loc)
adamc@201 642 end
adamc@56 643
adamc@764 644 val dsFfi = map parseFfi ffi
adamc@201 645 val ds = map parseOne fnames
adamc@201 646 in
adamc@834 647 if !anyErrors then
adamc@834 648 ErrorMsg.error "Parse failure"
adamc@834 649 else
adamc@834 650 ();
adamc@834 651
adamc@201 652 let
adamc@201 653 val final = nameOf (List.last fnames)
adamc@271 654
adamc@764 655 val ds = dsFfi @ ds
adamc@764 656 @ [(Source.DExport (Source.StrVar final, ErrorMsg.dummySpan), ErrorMsg.dummySpan)]
adamc@201 657 in
adamc@271 658 case database of
adamc@271 659 NONE => ds
adamc@271 660 | SOME s => (Source.DDatabase s, ErrorMsg.dummySpan) :: ds
adamc@201 661 end handle Empty => ds
adamc@201 662 end,
adamc@201 663 print = SourcePrint.p_file
adamc@201 664 }
adamc@56 665
adamc@270 666 val toParse = transform parse "parse" o toParseJob
adamc@38 667
adamc@378 668 fun libFile s = OS.Path.joinDirFile {dir = Config.libUr,
adamc@378 669 file = s}
adamc@378 670 fun clibFile s = OS.Path.joinDirFile {dir = Config.libC,
adamc@378 671 file = s}
adamc@378 672
adamc@201 673 val elaborate = {
adamc@201 674 func = fn file => let
adamc@378 675 val basis = #func parseUrs (libFile "basis.urs")
adamc@378 676 val topSgn = #func parseUrs (libFile "top.urs")
adamc@378 677 val topStr = #func parseUr (libFile "top.ur")
adamc@201 678 in
adamc@325 679 Elaborate.elabFile basis topStr topSgn ElabEnv.empty file
adamc@201 680 end,
adamc@201 681 print = ElabPrint.p_file ElabEnv.empty
adamc@201 682 }
adamc@5 683
adamc@270 684 val toElaborate = transform elaborate "elaborate" o toParse
adamc@201 685
adamc@448 686 val unnest = {
adamc@448 687 func = Unnest.unnest,
adamc@448 688 print = ElabPrint.p_file ElabEnv.empty
adamc@448 689 }
adamc@448 690
adamc@448 691 val toUnnest = transform unnest "unnest" o toElaborate
adamc@448 692
adamc@313 693 val termination = {
adamc@313 694 func = (fn file => (Termination.check file; file)),
adamc@313 695 print = ElabPrint.p_file ElabEnv.empty
adamc@313 696 }
adamc@313 697
adamc@448 698 val toTermination = transform termination "termination" o toUnnest
adamc@313 699
adamc@201 700 val explify = {
adamc@201 701 func = Explify.explify,
adamc@201 702 print = ExplPrint.p_file ExplEnv.empty
adamc@201 703 }
adamc@201 704
adamc@625 705 val toExplify = transform explify "explify" o toUnnest
adamc@201 706
adamc@201 707 val corify = {
adamc@201 708 func = Corify.corify,
adamc@201 709 print = CorePrint.p_file CoreEnv.empty
adamc@201 710 }
adamc@201 711
adamc@270 712 val toCorify = transform corify "corify" o toExplify
adamc@201 713
adamc@482 714 (*val reduce_local = {
adamc@482 715 func = ReduceLocal.reduce,
adamc@482 716 print = CorePrint.p_file CoreEnv.empty
adamc@482 717 }
adamc@482 718
adamc@482 719 val toReduce_local = transform reduce_local "reduce_local" o toCorify*)
adamc@482 720
adamc@443 721 val especialize = {
adamc@443 722 func = ESpecialize.specialize,
adamc@443 723 print = CorePrint.p_file CoreEnv.empty
adamc@443 724 }
adamc@443 725
adamc@454 726 val core_untangle = {
adamc@454 727 func = CoreUntangle.untangle,
adamc@454 728 print = CorePrint.p_file CoreEnv.empty
adamc@454 729 }
adamc@454 730
adamc@794 731 val toCore_untangle = transform core_untangle "core_untangle" o toCorify
adamc@454 732
adamc@202 733 val shake = {
adamc@202 734 func = Shake.shake,
adamc@202 735 print = CorePrint.p_file CoreEnv.empty
adamc@202 736 }
adamc@39 737
adamc@454 738 val toShake1 = transform shake "shake1" o toCore_untangle
adamc@110 739
adamc@607 740 val rpcify = {
adamc@607 741 func = Rpcify.frob,
adamc@607 742 print = CorePrint.p_file CoreEnv.empty
adamc@607 743 }
adamc@607 744
adamc@607 745 val toRpcify = transform rpcify "rpcify" o toShake1
adamc@607 746
adamc@642 747 val toCore_untangle2 = transform core_untangle "core_untangle2" o toRpcify
adamc@642 748 val toShake2 = transform shake "shake2" o toCore_untangle2
adamc@642 749
adamc@202 750 val tag = {
adamc@202 751 func = Tag.tag,
adamc@202 752 print = CorePrint.p_file CoreEnv.empty
adamc@202 753 }
adamc@193 754
adamc@642 755 val toTag = transform tag "tag" o toCore_untangle2
adamc@20 756
adamc@202 757 val reduce = {
adamc@202 758 func = Reduce.reduce,
adamc@202 759 print = CorePrint.p_file CoreEnv.empty
adamc@202 760 }
adamc@25 761
adamc@692 762 val toReduce = transform reduce "reduce" o toTag
adamc@23 763
adamc@315 764 val unpoly = {
adamc@315 765 func = Unpoly.unpoly,
adamc@315 766 print = CorePrint.p_file CoreEnv.empty
adamc@315 767 }
adamc@315 768
adamc@315 769 val toUnpoly = transform unpoly "unpoly" o toReduce
adamc@315 770
adamc@202 771 val specialize = {
adamc@202 772 func = Specialize.specialize,
adamc@202 773 print = CorePrint.p_file CoreEnv.empty
adamc@202 774 }
adamc@132 775
adamc@315 776 val toSpecialize = transform specialize "specialize" o toUnpoly
adamc@131 777
adamc@642 778 val toShake3 = transform shake "shake3" o toSpecialize
adamc@133 779
adamc@794 780 val toEspecialize = transform especialize "especialize" o toShake3
adamc@794 781
adamc@1020 782 val toReduce2 = transform reduce "reduce2" o toEspecialize
adamc@898 783
adamc@898 784 val toShake4 = transform shake "shake4" o toReduce2
adamc@794 785
adamc@692 786 val marshalcheck = {
adamc@692 787 func = (fn file => (MarshalCheck.check file; file)),
adamc@692 788 print = CorePrint.p_file CoreEnv.empty
adamc@692 789 }
adamc@692 790
adamc@794 791 val toMarshalcheck = transform marshalcheck "marshalcheck" o toShake4
adamc@692 792
adamc@732 793 val effectize = {
adamc@732 794 func = Effective.effectize,
adamc@732 795 print = CorePrint.p_file CoreEnv.empty
adamc@732 796 }
adamc@732 797
adamc@732 798 val toEffectize = transform effectize "effectize" o toMarshalcheck
adamc@732 799
adamc@202 800 val monoize = {
adamc@202 801 func = Monoize.monoize CoreEnv.empty,
adamc@202 802 print = MonoPrint.p_file MonoEnv.empty
adamc@202 803 }
adamc@134 804
adamc@732 805 val toMonoize = transform monoize "monoize" o toEffectize
adamc@96 806
adamc@202 807 val mono_opt = {
adamc@910 808 func = MonoOpt.optimize,
adamc@202 809 print = MonoPrint.p_file MonoEnv.empty
adamc@202 810 }
adamc@29 811
adamc@270 812 val toMono_opt1 = transform mono_opt "mono_opt1" o toMonoize
adamc@5 813
adamc@202 814 val untangle = {
adamc@202 815 func = Untangle.untangle,
adamc@202 816 print = MonoPrint.p_file MonoEnv.empty
adamc@202 817 }
adamc@1 818
adamc@270 819 val toUntangle = transform untangle "untangle" o toMono_opt1
adamc@38 820
adamc@202 821 val mono_reduce = {
adamc@202 822 func = MonoReduce.reduce,
adamc@202 823 print = MonoPrint.p_file MonoEnv.empty
adamc@202 824 }
adamc@16 825
adamc@270 826 val toMono_reduce = transform mono_reduce "mono_reduce" o toUntangle
adamc@39 827
adamc@202 828 val mono_shake = {
adamc@202 829 func = MonoShake.shake,
adamc@202 830 print = MonoPrint.p_file MonoEnv.empty
adamc@202 831 }
adamc@110 832
adamc@270 833 val toMono_shake = transform mono_shake "mono_shake1" o toMono_reduce
adamc@193 834
adamc@572 835 val toMono_opt2 = transform mono_opt "mono_opt2" o toMono_shake
adamc@572 836
adamc@567 837 val jscomp = {
adamc@567 838 func = JsComp.process,
adamc@567 839 print = MonoPrint.p_file MonoEnv.empty
adamc@567 840 }
adamc@567 841
adamc@572 842 val toJscomp = transform jscomp "jscomp" o toMono_opt2
adamc@567 843
adamc@910 844 val toMono_opt3 = transform mono_opt "mono_opt3" o toJscomp
adamc@20 845
adamc@506 846 val fuse = {
adamc@506 847 func = Fuse.fuse,
adamc@506 848 print = MonoPrint.p_file MonoEnv.empty
adamc@506 849 }
adamc@506 850
adamc@572 851 val toFuse = transform fuse "fuse" o toMono_opt3
adamc@506 852
adamc@506 853 val toUntangle2 = transform untangle "untangle2" o toFuse
adamc@506 854
adamc@601 855 val toMono_reduce2 = transform mono_reduce "mono_reduce2" o toUntangle2
adamc@601 856 val toMono_shake2 = transform mono_shake "mono_shake2" o toMono_reduce2
adamc@916 857 val toMono_opt4 = transform mono_opt "mono_opt4" o toMono_shake2
adamc@1017 858 val toMono_reduce3 = transform mono_reduce "mono_reduce3" o toMono_opt4
adamc@1017 859 val toFuse2 = transform fuse "shake2" o toMono_reduce3
adamc@916 860 val toUntangle3 = transform untangle "untangle3" o toFuse2
adamc@916 861 val toMono_shake3 = transform mono_shake "mono_shake3" o toUntangle3
adamc@506 862
adamc@377 863 val pathcheck = {
adamc@377 864 func = (fn file => (PathCheck.check file; file)),
adamc@377 865 print = MonoPrint.p_file MonoEnv.empty
adamc@377 866 }
adamc@377 867
adamc@916 868 val toPathcheck = transform pathcheck "pathcheck" o toMono_shake3
adamc@377 869
adamc@202 870 val cjrize = {
adamc@202 871 func = Cjrize.cjrize,
adamc@202 872 print = CjrPrint.p_file CjrEnv.empty
adamc@202 873 }
adamc@23 874
adamc@377 875 val toCjrize = transform cjrize "cjrize" o toPathcheck
adamc@29 876
adamc@643 877 val scriptcheck = {
adamc@643 878 func = ScriptCheck.classify,
adamc@643 879 print = CjrPrint.p_file CjrEnv.empty
adamc@643 880 }
adamc@643 881
adamc@643 882 val toScriptcheck = transform scriptcheck "scriptcheck" o toCjrize
adamc@643 883
adamc@282 884 val prepare = {
adamc@282 885 func = Prepare.prepare,
adamc@282 886 print = CjrPrint.p_file CjrEnv.empty
adamc@282 887 }
adamc@282 888
adamc@643 889 val toPrepare = transform prepare "prepare" o toScriptcheck
adamc@282 890
adamc@879 891 val checknest = {
adamc@879 892 func = fn f => if #supportsNestedPrepared (Settings.currentDbms ()) then f else Checknest.annotate f,
adamc@879 893 print = CjrPrint.p_file CjrEnv.empty
adamc@879 894 }
adamc@879 895
adamc@879 896 val toChecknest = transform checknest "checknest" o toPrepare
adamc@879 897
adamc@274 898 val sqlify = {
adamc@274 899 func = Cjrize.cjrize,
adamc@274 900 print = CjrPrint.p_sql CjrEnv.empty
adamc@274 901 }
adamc@274 902
adamc@274 903 val toSqlify = transform sqlify "sqlify" o toMono_opt2
adamc@274 904
adamc@764 905 fun compileC {cname, oname, ename, libs, profile, debug, link = link'} =
adamc@183 906 let
adamc@855 907 val proto = Settings.currentProtocol ()
adamc@378 908 val urweb_o = clibFile "urweb.o"
adamc@914 909 val memmem_o = clibFile "memmem.o"
adamc@378 910
adamc@949 911 val compile = "gcc " ^ Config.gccArgs ^ " -Wstrict-prototypes -Werror -O3 -fno-inline -I " ^ Config.includ
adamc@832 912 ^ " -c " ^ cname ^ " -o " ^ oname
adamc@914 913 val link = "gcc -Werror -O3 -lm -lmhash -pthread " ^ Config.gccArgs ^ " " ^ libs ^ " " ^ urweb_o ^ " " ^ oname
adamc@914 914 ^ " " ^ memmem_o ^ " " ^ #link proto ^ " -o " ^ ename
adamc@502 915
adamc@502 916 val (compile, link) =
adamc@502 917 if profile then
adamc@502 918 (compile ^ " -pg", link ^ " -pg")
adamc@502 919 else
adamc@502 920 (compile, link)
adamc@742 921
adamc@742 922 val (compile, link) =
adamc@742 923 if debug then
adamc@742 924 (compile ^ " -g", link ^ " -g")
adamc@742 925 else
adamc@742 926 (compile, link)
adamc@764 927
adamc@764 928 val link = foldl (fn (s, link) => link ^ " " ^ s) link link'
adamc@183 929 in
adamc@183 930 if not (OS.Process.isSuccess (OS.Process.system compile)) then
adamc@183 931 print "C compilation failed\n"
adamc@183 932 else if not (OS.Process.isSuccess (OS.Process.system link)) then
adamc@186 933 print "C linking failed\n"
adamc@183 934 else
adamc@673 935 ()
adamc@183 936 end
adamc@183 937
adamc@202 938 fun compile job =
adamc@879 939 case run toChecknest job of
adamc@244 940 NONE => print "Ur compilation failed\n"
adamc@29 941 | SOME file =>
adamc@202 942 let
adamc@274 943 val job = valOf (run (transform parseUrp "parseUrp") job)
adamc@102 944
adamc@274 945 val (cname, oname, cleanup) =
adamc@274 946 if #debug job then
adamc@457 947 ("/tmp/webapp.c", "/tmp/webapp.o", fn () => ())
adamc@274 948 else
adamc@274 949 let
adamc@274 950 val dir = OS.FileSys.tmpName ()
adamc@403 951 val () = if OS.FileSys.access (dir, []) then
adamc@403 952 OS.FileSys.remove dir
adamc@403 953 else
adamc@403 954 ()
adamc@457 955 val cname = OS.Path.joinDirFile {dir = dir, file = "webapp.c"}
adamc@457 956 val oname = OS.Path.joinDirFile {dir = dir, file = "webapp.o"}
adamc@274 957 in
adamc@274 958 OS.FileSys.mkDir dir;
adamc@274 959 (cname, oname,
adamc@274 960 fn () => (OS.FileSys.remove cname;
adamc@274 961 OS.FileSys.remove oname;
adamc@473 962 OS.FileSys.rmDir dir)
adamc@473 963 handle OS.SysErr _ => OS.FileSys.rmDir dir)
adamc@274 964 end
adamc@274 965 val ename = #exe job
adamc@202 966 in
adamc@274 967 let
adamc@274 968 val outf = TextIO.openOut cname
adamc@274 969 val s = TextIOPP.openOut {dst = outf, wid = 80}
adamc@432 970
adamc@432 971 val hasDb = List.exists (fn (Cjr.DDatabase _, _) => true | _ => false) (#1 file)
adamc@432 972 val libs =
adamc@432 973 if hasDb then
adamc@866 974 #link (Settings.currentDbms ())
adamc@432 975 else
adamc@432 976 ""
adamc@274 977 in
adamc@274 978 Print.fprint s (CjrPrint.p_file CjrEnv.empty file);
adamc@415 979 TextIO.output1 (outf, #"\n");
adamc@274 980 TextIO.closeOut outf;
adamc@102 981
adamc@274 982 case #sql job of
adamc@274 983 NONE => ()
adamc@274 984 | SOME sql =>
adamc@274 985 let
adamc@274 986 val outf = TextIO.openOut sql
adamc@274 987 val s = TextIOPP.openOut {dst = outf, wid = 80}
adamc@274 988 in
adamc@274 989 Print.fprint s (CjrPrint.p_sql CjrEnv.empty file);
adamc@274 990 TextIO.closeOut outf
adamc@274 991 end;
adamc@274 992
adamc@742 993 compileC {cname = cname, oname = oname, ename = ename, libs = libs,
adamc@764 994 profile = #profile job, debug = #debug job, link = #link job};
adamc@274 995
adamc@274 996 cleanup ()
adamc@274 997 end
adamc@274 998 handle ex => (((cleanup ()) handle _ => ()); raise ex)
adamc@202 999 end
adamc@29 1000
adamc@1 1001 end