summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2012-09-19 14:36:12 -0400
committerGravatar Adam Chlipala <adam@chlipala.net>2012-09-19 14:36:12 -0400
commitceeeb72da04265f1f12ee0e988aaba5dcb1c3060 (patch)
tree0e07d84546dc0f15d057225c3d4fd648f76f8640 /src
parent00753a70dadf871654fa4f805bf3a409ad8bfbd7 (diff)
parentb1ae41e16f100084d9a1676335e4947d4484c040 (diff)
Merge
Diffstat (limited to 'src')
-rw-r--r--src/cjr_print.sml4
-rw-r--r--src/cjrize.sml4
-rw-r--r--src/mono_reduce.sml30
-rw-r--r--src/settings.sml4
4 files changed, 32 insertions, 10 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index c1198ccf..33980f69 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -3239,7 +3239,7 @@ fun p_file env (ds, ps) =
val now = Time.now ()
val nowD = Date.fromTimeUniv now
- val rfcFmt = "%a, %d %b %Y %H:%M:%S"
+ val rfcFmt = "%a, %d %b %Y %H:%M:%S GMT"
in
box [string "#include \"",
string (OS.Path.joinDirFile {dir = !Settings.configInclude,
@@ -3430,6 +3430,8 @@ fun p_file env (ds, ps) =
newline,
string ("uw_write_header(ctx, \"Last-modified: " ^ Date.fmt rfcFmt nowD ^ "\\r\\n\");"),
newline,
+ string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"),
+ newline,
string "uw_write(ctx, jslib);",
newline,
string "return;",
diff --git a/src/cjrize.sml b/src/cjrize.sml
index a0ec2ece..9e41fda4 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -162,7 +162,9 @@ fun cifyTyp x =
((L'.TList (t', si), loc), sm)
end
| L.TSource => ((L'.TFfi ("Basis", "source"), loc), sm)
- | L.TSignal _ => raise Fail "Cjrize: TSignal remains"
+ | L.TSignal _ => (ErrorMsg.errorAt loc "TSignal remains";
+ Print.epreface ("Full type", MonoPrint.p_typ MonoEnv.empty (#1 x));
+ ((L'.TFfi ("Basis", "bogus"), loc), sm))
in
cify IM.empty x
end
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index af61489c..c633bfce 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -313,10 +313,28 @@ fun reduce file =
val (timpures, impures, absCounts) =
foldl (fn ((d, _), (timpures, impures, absCounts)) =>
let
- fun countAbs (e, _) =
- case e of
- EAbs (_, _, _, e) => 1 + countAbs e
- | _ => 0
+ fun countAbs env e =
+ case #1 e of
+ EAbs (x, t, _, e) => 1 + countAbs (E.pushERel env x t NONE) e
+ | _ =>
+ let
+ fun remaining e =
+ case #1 e of
+ ENamed n => IM.find (absCounts, n)
+ | EApp (e, arg) =>
+ if simpleImpure (timpures, impures) env arg then
+ NONE
+ else
+ (case remaining e of
+ NONE => NONE
+ | SOME n => if n > 0 then
+ SOME (n - 1)
+ else
+ NONE)
+ | _ => NONE
+ in
+ getOpt (remaining e, 0)
+ end
in
case d of
DDatatype dts =>
@@ -335,7 +353,7 @@ fun reduce file =
IS.add (impures, n)
else
impures,
- IM.insert (absCounts, n, countAbs e))
+ IM.insert (absCounts, n, countAbs E.empty e))
| DValRec vis =>
(timpures,
if List.exists (fn (_, _, _, e, _) => simpleImpure (timpures, impures) E.empty e) vis then
@@ -344,7 +362,7 @@ fun reduce file =
else
impures,
foldl (fn ((x, n, _, e, _), absCounts) =>
- IM.insert (absCounts, n, countAbs e))
+ IM.insert (absCounts, n, countAbs E.empty e))
absCounts vis)
| _ => (timpures, impures, absCounts)
end)
diff --git a/src/settings.sml b/src/settings.sml
index 45e8640a..6839d39e 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -615,11 +615,11 @@ val sql = ref (NONE : string option)
fun setSql so = sql := so
fun getSql () = !sql
-val coreInline = ref 20
+val coreInline = ref 5
fun setCoreInline n = coreInline := n
fun getCoreInline () = !coreInline
-val monoInline = ref 100
+val monoInline = ref 5
fun setMonoInline n = monoInline := n
fun getMonoInline () = !monoInline