comparison src/compiler.sml @ 866:03e7f111fe99

Start of multi-DBMS support
author Adam Chlipala <adamc@hcoop.net>
date Sun, 28 Jun 2009 13:49:32 -0400
parents 3d2f6cb6d54a
children b2a175a0f2ef
comparison
equal deleted inserted replaced
865:ebefb0609ac3 866:03e7f111fe99
51 clientOnly : Settings.ffi list, 51 clientOnly : Settings.ffi list,
52 serverOnly : Settings.ffi list, 52 serverOnly : Settings.ffi list,
53 jsFuncs : (Settings.ffi * string) list, 53 jsFuncs : (Settings.ffi * string) list,
54 rewrites : Settings.rewrite list, 54 rewrites : Settings.rewrite list,
55 filterUrl : Settings.rule list, 55 filterUrl : Settings.rule list,
56 filterMime : Settings.rule list 56 filterMime : Settings.rule list,
57 protocol : string option,
58 dbms : string option
57 } 59 }
58 60
59 type ('src, 'dst) phase = { 61 type ('src, 'dst) phase = {
60 func : 'src -> 'dst, 62 func : 'src -> 'dst,
61 print : 'dst -> Print.PD.pp_desc 63 print : 'dst -> Print.PD.pp_desc
347 val jsFuncs = ref [] 349 val jsFuncs = ref []
348 val rewrites = ref [] 350 val rewrites = ref []
349 val url = ref [] 351 val url = ref []
350 val mime = ref [] 352 val mime = ref []
351 val libs = ref [] 353 val libs = ref []
354 val protocol = ref NONE
355 val dbms = ref NONE
352 356
353 fun finish sources = 357 fun finish sources =
354 let 358 let
355 val job = { 359 val job = {
356 prefix = Option.getOpt (!prefix, "/"), 360 prefix = Option.getOpt (!prefix, "/"),
371 serverOnly = rev (!serverOnly), 375 serverOnly = rev (!serverOnly),
372 jsFuncs = rev (!jsFuncs), 376 jsFuncs = rev (!jsFuncs),
373 rewrites = rev (!rewrites), 377 rewrites = rev (!rewrites),
374 filterUrl = rev (!url), 378 filterUrl = rev (!url),
375 filterMime = rev (!mime), 379 filterMime = rev (!mime),
376 sources = sources 380 sources = sources,
381 protocol = !protocol,
382 dbms = !dbms
377 } 383 }
378 384
379 fun mergeO f (old, new) = 385 fun mergeO f (old, new) =
380 case (old, new) of 386 case (old, new) of
381 (NONE, _) => new 387 (NONE, _) => new
408 serverOnly = #serverOnly old @ #serverOnly new, 414 serverOnly = #serverOnly old @ #serverOnly new,
409 jsFuncs = #jsFuncs old @ #jsFuncs new, 415 jsFuncs = #jsFuncs old @ #jsFuncs new,
410 rewrites = #rewrites old @ #rewrites new, 416 rewrites = #rewrites old @ #rewrites new,
411 filterUrl = #filterUrl old @ #filterUrl new, 417 filterUrl = #filterUrl old @ #filterUrl new,
412 filterMime = #filterMime old @ #filterMime new, 418 filterMime = #filterMime old @ #filterMime new,
413 sources = #sources new @ #sources old 419 sources = #sources new @ #sources old,
420 protocol = mergeO #2 (#protocol old, #protocol new),
421 dbms = mergeO #2 (#dbms old, #dbms new)
414 } 422 }
415 in 423 in
416 foldr (fn (fname, job) => merge (job, pu fname)) job (!libs) 424 foldr (fn (fname, job) => merge (job, pu fname)) job (!libs)
417 end 425 end
418 426
568 Settings.setServerOnly (#serverOnly job); 576 Settings.setServerOnly (#serverOnly job);
569 Settings.setJsFuncs (#jsFuncs job); 577 Settings.setJsFuncs (#jsFuncs job);
570 Settings.setRewriteRules (#rewrites job); 578 Settings.setRewriteRules (#rewrites job);
571 Settings.setUrlRules (#filterUrl job); 579 Settings.setUrlRules (#filterUrl job);
572 Settings.setMimeRules (#filterMime job); 580 Settings.setMimeRules (#filterMime job);
581 Option.app Settings.setProtocol (#protocol job);
582 Option.app Settings.setDbms (#dbms job);
573 job 583 job
574 end 584 end
575 in 585 in
576 pu fname 586 pu fname
577 end 587 end
947 val s = TextIOPP.openOut {dst = outf, wid = 80} 957 val s = TextIOPP.openOut {dst = outf, wid = 80}
948 958
949 val hasDb = List.exists (fn (Cjr.DDatabase _, _) => true | _ => false) (#1 file) 959 val hasDb = List.exists (fn (Cjr.DDatabase _, _) => true | _ => false) (#1 file)
950 val libs = 960 val libs =
951 if hasDb then 961 if hasDb then
952 "-lpq" 962 #link (Settings.currentDbms ())
953 else 963 else
954 "" 964 ""
955 in 965 in
956 Print.fprint s (CjrPrint.p_file CjrEnv.empty file); 966 Print.fprint s (CjrPrint.p_file CjrEnv.empty file);
957 TextIO.output1 (outf, #"\n"); 967 TextIO.output1 (outf, #"\n");