changeset 1823:66a58d8501e0

Merge
author Adam Chlipala <adam@chlipala.net>
date Wed, 19 Sep 2012 14:36:12 -0400
parents 8bc16ff91d32 e8149592990e
children 216e92b39fc1
files
diffstat 4 files changed, 32 insertions(+), 10 deletions(-) [+]
line wrap: on
line diff
--- 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;",
--- 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
--- 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)
--- 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