Basis.debug; more restrictive type for Basis.form; weaken definition of polymorphic-ness for especialization

5 files changed, 39 insertions, 10 deletions

diff --git a/include/urweb.h b/include/urweb.h
index 4b5ab273..f9e06cb1 100644
--- a/include/urweb.h
+++ b/include/urweb.h
@@ -270,4 +270,6 @@ extern int uw_time;
 void uw_set_deadline(uw_context, int);
 void uw_check_deadline(uw_context);
 
+uw_Basis_unit uw_Basis_debug(uw_context, uw_Basis_string);
+
 #endif
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 5eae9306..d61763af 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -657,7 +657,7 @@ val img : bodyTag ([Src = url, Onabort = transaction unit, Onerror = transaction
                     Onload = transaction unit] ++ boxAttrs)
           
 val form : ctx ::: {Unit} -> bind ::: {Type}
-           -> [[Body, Form] ~ ctx] =>
+           -> [[Body, Form, Table] ~ ctx] =>
     xml ([Body, Form] ++ ctx) [] bind
     -> xml ([Body] ++ ctx) [] []
        
@@ -777,3 +777,6 @@ val show_xml : ctx ::: {Unit} -> use ::: {Type} -> bind ::: {Type} -> show (xml
 
 type task_kind
 val initialize : task_kind
+
+
+val debug : string -> transaction unit
diff --git a/src/c/urweb.c b/src/c/urweb.c
index e63b2060..6e8c64de 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -3375,3 +3375,9 @@ void uw_check_deadline(uw_context ctx) {
 }
 
 size_t uw_database_max = SIZE_MAX;
+
+uw_Basis_unit uw_Basis_debug(uw_context ctx, uw_Basis_string s) {
+  fprintf(stderr, "%s\n", s);
+
+  return uw_unit_v;
+}
diff --git a/src/especialize.sml b/src/especialize.sml
index acabe973..7d129b8b 100644
--- a/src/especialize.sml
+++ b/src/especialize.sml
@@ -59,12 +59,18 @@ val freeVars = U.Exp.foldB {kind = fn (_, _, xs) => xs,
                                         | _ => bound}
                            0 IS.empty
 
-val isPoly = U.Decl.exists {kind = fn _ => false,
-                            con = fn _ => false,
-                            exp = fn ECAbs _ => true
-                                   | EKAbs _ => true
-                                   | _ => false,
-                            decl = fn _ => false}
+fun isPolyT (t, _) =
+    case t of
+        TFun (_, ran) => isPolyT ran
+      | TCFun _ => true
+      | TKFun _ => true
+      | _ => false
+
+fun isPoly (d, _) =
+    case d of
+        DVal (_, _, t, _, _) => isPolyT t
+      | DValRec vis => List.exists (isPolyT o #3) vis
+      | _ => false
 
 fun positionOf (v : int, ls) =
     let
@@ -184,8 +190,8 @@ fun specialize' (funcs, specialized) file =
                         in
                             ((ECApp (e, c), loc), st)
                         end
-                      | ECAbs _ => raise Fail "Especialize: Impossible ECAbs"
-                      | EKAbs _ => raise Fail "Especialize: Impossible EKAbs"
+                      | ECAbs _ => (e, st)
+                      | EKAbs _ => (e, st)
                       | EKApp (e, k) =>
                         let
                             val (e, st) = exp (env, e, st)
@@ -325,6 +331,7 @@ fun specialize' (funcs, specialized) file =
                                orelse (IS.numItems fvs >= length fxs
                                        andalso IS.exists (fn n => functionInside (#2 (List.nth (env, n)))) fvs) then
                                 ((*Print.prefaces "No" [("name", Print.PD.string name),
+                                                      ("f", Print.PD.string (Int.toString f)),
                                                       ("fxs'",
                                                        Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs')];*)
                                  default ())
@@ -417,6 +424,7 @@ fun specialize' (funcs, specialized) file =
                                                                   e' fvs
                                                 val e' = foldl (fn (arg, e) => (EApp (e, arg), loc))
                                                                e' xs
+                                                (*val () = print ("NEW: " ^ name ^ "__" ^ Int.toString f' ^ "\n");*)
                                                 (*val () = Print.prefaces "Brand new"
                                                                         [("e'", CorePrint.p_exp CoreEnv.empty e'),
                                                                          ("e", CorePrint.p_exp CoreEnv.empty e),
@@ -471,8 +479,15 @@ fun specialize' (funcs, specialized) file =
                             end
                           | DValRec vis =>
                             let
+                                (*val () = Print.preface ("Visiting", Print.p_list (fn vi =>
+                                                                                     Print.PD.string (#1 vi ^ "__"
+                                                                                                      ^ Int.toString
+                                                                                                            (#2 vi)))
+                                                                                 vis)*)
+
                                 val (vis, st) = ListUtil.foldlMap (fn ((x, n, t, e, s), st) =>
                                                                       let
+                                                                          val () = mayNotSpec := SS.empty
                                                                           val (e, st) = exp ([], e, st)
                                                                       in
                                                                           ((x, n, t, e, s), st)
@@ -537,6 +552,7 @@ fun specialize' (funcs, specialized) file =
                        specialized = #specialized st}, changed))
             end
 
+        (*val () = Print.preface ("RESET", CorePrint.p_file CoreEnv.empty file)*)
         val (ds, (st, changed)) = ListUtil.foldlMapConcat doDecl
                                                             ({maxName = U.File.maxName file + 1,
                                                               funcs = funcs,
@@ -545,6 +561,7 @@ fun specialize' (funcs, specialized) file =
                                                              false)
                                                             file
     in
+        (*print ("Changed = " ^ Bool.toString changed ^ "\n");*)
         (changed, ds, #funcs st, #specialized st)
     end
 
diff --git a/src/settings.sml b/src/settings.sml
index 5edfb3ff..0bbe3961 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -95,7 +95,8 @@ val effectfulBase = basis ["dml",
                            "onConnectFail",
                            "onDisconnect",
                            "onServerError",
-                           "kc"]
+                           "kc",
+                           "debug"]
 
 val effectful = ref effectfulBase
 fun setEffectful ls = effectful := S.addList (effectfulBase, ls)