diff options
Diffstat (limited to 'src/compiler.sml')
-rw-r--r-- | src/compiler.sml | 60 |
1 files changed, 51 insertions, 9 deletions
diff --git a/src/compiler.sml b/src/compiler.sml index f724bf56..9cbe9949 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -39,6 +39,7 @@ type job = { sources : string list, exe : string, sql : string option, + endpoints : string option, debug : bool, profile : bool, timeout : int, @@ -65,6 +66,7 @@ type job = { dbms : string option, sigFile : string option, fileCache : string option, + safeGetDefault : bool, safeGets : string list, onError : (string * string list * string) option, minHeap : int, @@ -274,7 +276,7 @@ val parseUr = { handle LrParser.ParseError => [], print = SourcePrint.p_file} -fun p_job ({prefix, database, exe, sql, sources, debug, profile, +fun p_job ({prefix, database, exe, sql, endpoints, sources, debug, profile, timeout, ffi, link, headers, scripts, clientToServer, effectful, benignEffectful, clientOnly, serverOnly, jsModule, jsFuncs, ...} : job) = let @@ -303,6 +305,10 @@ fun p_job ({prefix, database, exe, sql, sources, debug, profile, NONE => string "No SQL file." | SOME sql => string ("SQL fle: " ^ sql), newline, + case endpoints of + NONE => string "No endpoints file." + | SOME ep => string ("Endpoints fle: " ^ ep), + newline, string "Timeout: ", string (Int.toString timeout), newline, @@ -385,6 +391,7 @@ fun institutionalizeJob (job : job) = Settings.setMetaRules (#filterMeta job); Option.app Settings.setProtocol (#protocol job); Option.app Settings.setDbms (#dbms job); + Settings.setSafeGetDefault (#safeGetDefault job); Settings.setSafeGets (#safeGets job); Settings.setOnError (#onError job); Settings.setMinHeap (#minHeap job); @@ -441,6 +448,7 @@ fun parseUrp' accLibs fname = sources = [fname], exe = fname ^ ".exe", sql = NONE, + endpoints = Settings.getEndpoints (), debug = Settings.getDebug (), profile = false, timeout = 120, @@ -470,6 +478,7 @@ fun parseUrp' accLibs fname = dbms = NONE, sigFile = NONE, fileCache = NONE, + safeGetDefault = false, safeGets = [], onError = NONE, minHeap = 0, @@ -578,6 +587,7 @@ fun parseUrp' accLibs fname = val database = ref (Settings.getDbstring ()) val exe = ref (Settings.getExe ()) val sql = ref (Settings.getSql ()) + val endpoints = ref (Settings.getEndpoints ()) val debug = ref (Settings.getDebug ()) val profile = ref false val timeout = ref NONE @@ -605,6 +615,7 @@ fun parseUrp' accLibs fname = val dbms = ref NONE val sigFile = ref (Settings.getSigFile ()) val fileCache = ref (Settings.getFileCache ()) + val safeGetDefault = ref false val safeGets = ref [] val onError = ref NONE val minHeap = ref 0 @@ -618,6 +629,7 @@ fun parseUrp' accLibs fname = exe = Option.getOpt (!exe, OS.Path.joinBaseExt {base = OS.Path.base filename, ext = SOME "exe"}), sql = !sql, + endpoints = !endpoints, debug = !debug, profile = !profile, timeout = Option.getOpt (!timeout, 60), @@ -645,6 +657,7 @@ fun parseUrp' accLibs fname = dbms = !dbms, sigFile = !sigFile, fileCache = !fileCache, + safeGetDefault = !safeGetDefault, safeGets = rev (!safeGets), onError = !onError, minHeap = !minHeap, @@ -679,6 +692,7 @@ fun parseUrp' accLibs fname = database = mergeO (fn (old, _) => old) (#database old, #database new), exe = #exe old, sql = #sql old, + endpoints = #endpoints old, debug = #debug old orelse #debug new, profile = #profile old orelse #profile new, timeout = #timeout old, @@ -708,6 +722,7 @@ fun parseUrp' accLibs fname = dbms = mergeO #2 (#dbms old, #dbms new), sigFile = mergeO #2 (#sigFile old, #sigFile new), fileCache = mergeO #2 (#fileCache old, #fileCache new), + safeGetDefault = #safeGetDefault old orelse #safeGetDefault new, safeGets = #safeGets old @ #safeGets new, onError = mergeO #2 (#onError old, #onError new), minHeap = Int.max (#minHeap old, #minHeap new), @@ -730,7 +745,7 @@ fun parseUrp' accLibs fname = | "relation" => Settings.Relation | "cookie" => Settings.Cookie | "style" => Settings.Style - | _ => (ErrorMsg.error "Bad path kind spec"; + | _ => (ErrorMsg.error ("Bad path kind spec \"" ^ s ^ "\""); Settings.Any) fun parsePattern s = @@ -829,6 +844,7 @@ fun parseUrp' accLibs fname = | "include" => headers := relifyA arg :: !headers | "script" => scripts := arg :: !scripts | "clientToServer" => clientToServer := ffiS () :: !clientToServer + | "safeGetDefault" => safeGetDefault := true | "safeGet" => safeGets := arg :: !safeGets | "effectful" => effectful := ffiS () :: !effectful | "benignEffectful" => benignEffectful := ffiS () :: !benignEffectful @@ -937,7 +953,7 @@ fun parseUrp' accLibs fname = uri :: fname :: rest => (Settings.setFilePath thisPath; Settings.addFile {Uri = uri, - LoadFromFilename = fname, + LoadFromFilename = pathify fname, MimeType = case rest of [] => NONE | [ty] => SOME ty @@ -948,7 +964,7 @@ fun parseUrp' accLibs fname = | "jsFile" => (Settings.setFilePath thisPath; - Settings.addJsFile arg) + Settings.addJsFile (pathify arg)) | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'"); read () @@ -1184,6 +1200,7 @@ val parse = { else (); ErrorMsg.error ("Missing source file: " ^ fname); + anyErrors := true; (Source.DSequence "", ErrorMsg.dummySpan)) val dsFfi = map parseFfi ffi @@ -1266,7 +1283,7 @@ val elaborate = { in Elaborate.elabFile basis (OS.FileSys.modTime basisF) topStr topSgn (if Time.< (tm1, tm2) then tm2 else tm1) - ElabEnv.empty file + ElabEnv.empty (fn env => env) file end, print = ElabPrint.p_file ElabEnv.empty } @@ -1383,8 +1400,9 @@ val toUnpoly2 = transform unpoly "unpoly2" o toShake4' val toSpecialize2 = transform specialize "specialize2" o toUnpoly2 val toShake4'' = transform shake "shake4'" o toSpecialize2 val toEspecialize3 = transform especialize "especialize3" o toShake4'' +val toSpecialize3 = transform specialize "specialize3" o toEspecialize3 -val toReduce2 = transform reduce "reduce2" o toEspecialize3 +val toReduce2 = transform reduce "reduce2" o toSpecialize3 val toShake5 = transform shake "shake5" o toReduce2 @@ -1421,7 +1439,14 @@ val mono_opt = { print = MonoPrint.p_file MonoEnv.empty } -val toMono_opt1 = transform mono_opt "mono_opt1" o toMonoize +val endpoints = { + func = Endpoints.collect, + print = MonoPrint.p_file MonoEnv.empty +} + +val toEndpoints = transform endpoints "endpoints" o toMonoize + +val toMono_opt1 = transform mono_opt "mono_opt1" o toEndpoints val untangle = { func = Untangle.untangle, @@ -1585,9 +1610,13 @@ fun compileC {cname, oname, ename, libs, profile, debug, linker, link = link'} = val proto = Settings.currentProtocol () val lib = if Settings.getBootLinking () then - !Settings.configLib ^ "/" ^ #linkStatic proto ^ " " ^ !Settings.configLib ^ "/liburweb.a" + !Settings.configLib ^ "/" ^ #linkStatic proto ^ " " ^ + !Settings.configLib ^ "/liburweb.a " ^ + !Settings.configIcuLibs ^ " -licui18n -licuuc -licudata -licuio" else if Settings.getStaticLinking () then - " -static " ^ !Settings.configLib ^ "/" ^ #linkStatic proto ^ " " ^ !Settings.configLib ^ "/liburweb.a" + " -static " ^ !Settings.configLib ^ "/" ^ #linkStatic + proto ^ " " ^ !Settings.configLib ^ "/liburweb.a " ^ + !Settings.configIcuLibs ^ " -licui18n -licuuc -licudata -licuio" else "-L" ^ !Settings.configLib ^ " " ^ #linkDynamic proto ^ " -lurweb" @@ -1598,6 +1627,7 @@ fun compileC {cname, oname, ename, libs, profile, debug, linker, link = link'} = val compile = (Settings.getCCompiler ()) ^ " " ^ Config.ccArgs ^ " " ^ Config.pthreadCflags ^ " -Wimplicit -Werror -Wno-unused-value" ^ opt ^ " -I " ^ !Settings.configInclude + ^ " " ^ !Settings.configIcuIncludes ^ " " ^ #compile proto ^ " -c " ^ escapeFilename cname ^ " -o " ^ escapeFilename oname @@ -1710,6 +1740,18 @@ fun compile job = TextIO.closeOut outf end; + case #endpoints job of + NONE => () + | SOME endpoints => + let + val report = Endpoints.summarize () + val outf = TextIO.openOut endpoints + val s = TextIOPP.openOut {dst = outf, wid = 80} + in + Print.fprint s (Endpoints.p_report report); + TextIO.closeOut outf + end; + compileC {cname = cname, oname = oname, ename = ename, libs = libs, profile = #profile job, debug = #debug job, linker = #linker job, link = #link job} |