# HG changeset patch # User Adam Chlipala # Date 1348079772 14400 # Node ID 66a58d8501e02ff6fc146bcd252f22c33bbbc33c # Parent 8bc16ff91d320a74fb78c4209579b6e873f4aaaa# Parent e8149592990e2ed82f960bbcf7e1908a9305f820 Merge diff -r 8bc16ff91d32 -r 66a58d8501e0 src/cjr_print.sml --- a/src/cjr_print.sml Wed Sep 19 14:20:47 2012 -0400 +++ b/src/cjr_print.sml Wed Sep 19 14:36:12 2012 -0400 @@ -3239,7 +3239,7 @@ 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 @@ 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 -r 8bc16ff91d32 -r 66a58d8501e0 src/cjrize.sml --- a/src/cjrize.sml Wed Sep 19 14:20:47 2012 -0400 +++ b/src/cjrize.sml Wed Sep 19 14:36:12 2012 -0400 @@ -162,7 +162,9 @@ ((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 -r 8bc16ff91d32 -r 66a58d8501e0 src/mono_reduce.sml --- a/src/mono_reduce.sml Wed Sep 19 14:20:47 2012 -0400 +++ b/src/mono_reduce.sml Wed Sep 19 14:36:12 2012 -0400 @@ -313,10 +313,28 @@ 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 @@ 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 @@ 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 -r 8bc16ff91d32 -r 66a58d8501e0 src/settings.sml --- a/src/settings.sml Wed Sep 19 14:20:47 2012 -0400 +++ b/src/settings.sml Wed Sep 19 14:36:12 2012 -0400 @@ -615,11 +615,11 @@ 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