summaryrefslogtreecommitdiff
path: root/src/compiler.sml
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler.sml')
-rw-r--r--src/compiler.sml60
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}
generated by cgit v1.2.3 (git 2.39.1) at 2024-04-29 22:02:24 +0000