Mercurial > urweb
diff src/mono_fooify.sml @ 2256:6f2ea4ed573a
Pure caching sort of works.
author | Ziv Scully <ziv@mit.edu> |
---|---|
date | Sun, 27 Sep 2015 03:52:14 -0400 |
parents | 44ae2254f8fb |
children | 03b10c7fab9a |
line wrap: on
line diff
--- a/src/mono_fooify.sml Mon Sep 21 16:45:59 2015 -0400 +++ b/src/mono_fooify.sml Sun Sep 27 03:52:14 2015 -0400 @@ -1,4 +1,4 @@ -structure MonoFooify :> MONO_FOOIFY = struct +structure MonoFooify (* :> MONO_FOOIFY *) = struct open Mono @@ -112,9 +112,6 @@ | SOME n' => (t, n') end -(* Has to be set at the end of [Monoize]. *) -val canonical = ref (empty 0 : t) - end fun fk2s fk = @@ -166,7 +163,12 @@ | _ => case t of TFfi ("Basis", "unit") => ((EPrim (Prim.String (Prim.Normal, "")), loc), fm) - | TFfi (m, x) => ((EFfiApp (m, fk2s fk ^ "ify" ^ capitalize x, [(e, tAll)]), loc), fm) + | TFfi (m, x) => (if Settings.mayClientToServer (m, x) + (* TODO: better error message. (Then again, user should never see this.) *) + then () + else (E.errorAt loc "MonoFooify: can't pass type from client to server"; + Print.eprefaces' [("Type", MonoPrint.p_typ MonoEnv.empty tAll)]); + ((EFfiApp (m, fk2s fk ^ "ify" ^ capitalize x, [(e, tAll)]), loc), fm)) | TRecord [] => ((EPrim (Prim.String (Prim.Normal, "")), loc), fm) | TRecord ((x, t) :: xts) => @@ -296,22 +298,38 @@ fooify end +(* Has to be set at the end of [Monoize]. *) +val canonicalFm = ref (Fm.empty 0 : Fm.t) + fun urlify env expTyp = + if ErrorMsg.anyErrors () + then ((* DEBUG *) print "already error"; NONE) + else + let + val (exp, fm) = + fooifyExp + Url + (fn n => + let + val (_, t, _, s) = MonoEnv.lookupENamed env n + in + (t, s) + end) + (fn n => MonoEnv.lookupDatatype env n) + (!canonicalFm) + expTyp + in + if ErrorMsg.anyErrors () + then ((* DEBUG *) print "why"; (ErrorMsg.resetErrors (); NONE)) + else (canonicalFm := fm; SOME exp) + end + +fun getNewFmDecls () = let - val (exp, fm) = - fooifyExp - Url - (fn n => - let - val (_, t, _, s) = MonoEnv.lookupENamed env n - in - (t, s) - end) - (fn n => MonoEnv.lookupDatatype env n) - (!Fm.canonical) - expTyp + val fm = !canonicalFm in - Fm.canonical := fm; - exp + (* canonicalFm := Fm.enter fm; *) + Fm.decls fm end + end