summaryrefslogtreecommitdiff
path: root/src/compiler.sml
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler.sml')
-rw-r--r--src/compiler.sml108
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}
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-07 23:45:57 +0000