Mercurial > urweb
changeset 1120:74f2eb3b0606
Basis.debug; more restrictive type for Basis.form; weaken definition of polymorphic-ness for especialization
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 07 Jan 2010 14:02:58 -0500 |
| parents | 951fced704d6 |
| children | 0cee0c8d8c37 |
| files | include/urweb.h lib/ur/basis.urs src/c/urweb.c src/especialize.sml src/settings.sml |
| diffstat | 5 files changed, 39 insertions(+), 10 deletions(-) [+] |
line wrap: on
line diff
--- a/include/urweb.h Tue Jan 05 15:53:35 2010 -0500 +++ b/include/urweb.h Thu Jan 07 14:02:58 2010 -0500 @@ -270,4 +270,6 @@ 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
--- a/lib/ur/basis.urs Tue Jan 05 15:53:35 2010 -0500 +++ b/lib/ur/basis.urs Thu Jan 07 14:02:58 2010 -0500 @@ -657,7 +657,7 @@ 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 @@ type task_kind val initialize : task_kind + + +val debug : string -> transaction unit
--- a/src/c/urweb.c Tue Jan 05 15:53:35 2010 -0500 +++ b/src/c/urweb.c Thu Jan 07 14:02:58 2010 -0500 @@ -3375,3 +3375,9 @@ } 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; +}
--- a/src/especialize.sml Tue Jan 05 15:53:35 2010 -0500 +++ b/src/especialize.sml Thu Jan 07 14:02:58 2010 -0500 @@ -59,12 +59,18 @@ | _ => 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ false) file in + (*print ("Changed = " ^ Bool.toString changed ^ "\n");*) (changed, ds, #funcs st, #specialized st) end
--- a/src/settings.sml Tue Jan 05 15:53:35 2010 -0500 +++ b/src/settings.sml Thu Jan 07 14:02:58 2010 -0500 @@ -95,7 +95,8 @@ "onConnectFail", "onDisconnect", "onServerError", - "kc"] + "kc", + "debug"] val effectful = ref effectfulBase fun setEffectful ls = effectful := S.addList (effectfulBase, ls)