diff options
author | Benjamin Barenblat <bbaren@mit.edu> | 2020-05-31 18:29:03 -0400 |
---|---|---|
committer | Benjamin Barenblat <bbaren@mit.edu> | 2020-05-31 18:29:03 -0400 |
commit | 6cc104634ef64be3be88c1fccbe98208d95d8a1a (patch) | |
tree | 9001e5333e808808125978a52669a8bff3639438 /src/compiler.sml | |
parent | 82fde07cef0e41b700b9a30137562eb05f2f2c6d (diff) | |
parent | c2f1e1096f602b1cbd4531352f3e1ea6d656a186 (diff) |
Merge branch 'dfsg_clean'
Diffstat (limited to 'src/compiler.sml')
-rw-r--r-- | src/compiler.sml | 108 |
1 files changed, 90 insertions, 18 deletions
diff --git a/src/compiler.sml b/src/compiler.sml index c13de304..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, @@ -64,9 +65,12 @@ type job = { protocol : string option, dbms : string option, sigFile : string option, + fileCache : string option, + safeGetDefault : bool, safeGets : string list, onError : (string * string list * string) option, - minHeap : int + minHeap : int, + mimeTypes : string option } type ('src, 'dst) phase = { @@ -272,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 @@ -301,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, @@ -383,10 +391,13 @@ 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); - Settings.setSigFile (#sigFile job)) + Settings.setSigFile (#sigFile job); + Settings.setFileCache (#fileCache job); + Settings.setMimeFilePath (Option.getOpt (#mimeTypes job, "/etc/mime.types"))) datatype commentableLine = EndOfFile @@ -437,6 +448,7 @@ fun parseUrp' accLibs fname = sources = [fname], exe = fname ^ ".exe", sql = NONE, + endpoints = Settings.getEndpoints (), debug = Settings.getDebug (), profile = false, timeout = 120, @@ -465,9 +477,12 @@ fun parseUrp' accLibs fname = protocol = NONE, dbms = NONE, sigFile = NONE, + fileCache = NONE, + safeGetDefault = false, safeGets = [], onError = NONE, - minHeap = 0} + minHeap = 0, + mimeTypes = NONE} in institutionalizeJob job; {Job = job, Libs = []} @@ -572,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 @@ -598,9 +614,12 @@ fun parseUrp' accLibs fname = val protocol = ref NONE 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 + val mimeTypes = ref NONE fun finish sources = let @@ -610,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), @@ -636,9 +656,12 @@ fun parseUrp' accLibs fname = protocol = !protocol, dbms = !dbms, sigFile = !sigFile, + fileCache = !fileCache, + safeGetDefault = !safeGetDefault, safeGets = rev (!safeGets), onError = !onError, - minHeap = !minHeap + minHeap = !minHeap, + mimeTypes = !mimeTypes } fun mergeO f (old, new) = @@ -669,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, @@ -697,9 +721,12 @@ fun parseUrp' accLibs fname = protocol = mergeO #2 (#protocol old, #protocol new), 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) + minHeap = Int.max (#minHeap old, #minHeap new), + mimeTypes = mergeO #2 (#mimeTypes old, #mimeTypes new) } in if accLibs then @@ -718,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 = @@ -784,6 +811,10 @@ fun parseUrp' accLibs fname = (case !sigFile of NONE => sigFile := SOME arg | SOME _ => ()) + | "filecache" => + (case !fileCache of + NONE => fileCache := SOME arg + | SOME _ => ()) | "exe" => (case !exe of NONE => exe := SOME (relify arg) @@ -813,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 @@ -914,18 +946,25 @@ fun parseUrp' accLibs fname = | "html5" => Settings.setIsHtml5 true | "xhtml" => Settings.setIsHtml5 false | "lessSafeFfi" => Settings.setLessSafeFfi true + | "mimeTypes" => Settings.setMimeFilePath (relify arg) | "file" => (case String.fields Char.isSpace arg of - [uri, fname] => (Settings.setFilePath thisPath; - Settings.addFile {Uri = uri, - LoadFromFilename = fname}; - url := {action = Settings.Allow, kind = Settings.Exact, pattern = uri} :: !url) + uri :: fname :: rest => + (Settings.setFilePath thisPath; + Settings.addFile {Uri = uri, + LoadFromFilename = pathify fname, + MimeType = case rest of + [] => NONE + | [ty] => SOME ty + | _ => (ErrorMsg.error "Bad 'file' arguments"; + NONE)}; + url := {action = Settings.Allow, kind = Settings.Exact, pattern = uri} :: !url) | _ => ErrorMsg.error "Bad 'file' arguments") | "jsFile" => (Settings.setFilePath thisPath; - Settings.addJsFile arg) + Settings.addJsFile (pathify arg)) | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'"); read () @@ -1161,6 +1200,7 @@ val parse = { else (); ErrorMsg.error ("Missing source file: " ^ fname); + anyErrors := true; (Source.DSequence "", ErrorMsg.dummySpan)) val dsFfi = map parseFfi ffi @@ -1243,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 } @@ -1360,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 @@ -1398,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, @@ -1500,6 +1548,13 @@ val sigcheck = { val toSigcheck = transform sigcheck "sigcheck" o toSidecheck +val filecache = { + func = FileCache.instrument, + print = MonoPrint.p_file MonoEnv.empty +} + +val toFilecache = transform filecache "filecache" o toSigcheck + val sqlcache = { func = (fn file => if Settings.getSqlcache () @@ -1508,7 +1563,7 @@ val sqlcache = { print = MonoPrint.p_file MonoEnv.empty } -val toSqlcache = transform sqlcache "sqlcache" o toSigcheck +val toSqlcache = transform sqlcache "sqlcache" o toFilecache val cjrize = { func = Cjrize.cjrize, @@ -1555,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" @@ -1568,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 @@ -1680,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} |