Mercurial > urweb

comparison src/mono_fooify.sml @ 2256:6f2ea4ed573a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Pure caching sort of works.
author Ziv Scully <ziv@mit.edu>
date Sun, 27 Sep 2015 03:52:14 -0400
parents 44ae2254f8fb
children 03b10c7fab9a
comparison
equal deleted inserted replaced
2255:8428c534913a 2256:6f2ea4ed573a
1 structure MonoFooify :> MONO_FOOIFY = struct 1 structure MonoFooify (* :> MONO_FOOIFY *) = struct
2 2
3 open Mono 3 open Mono
4 4
5 datatype foo_kind = 5 datatype foo_kind =
6 Attr 6 Attr
109 listMap = listMap, 109 listMap = listMap,
110 decls = d :: decls}, n') 110 decls = d :: decls}, n')
111 end 111 end
112 | SOME n' => (t, n') 112 | SOME n' => (t, n')
113 end 113 end
114
115 (* Has to be set at the end of [Monoize]. *)
116 val canonical = ref (empty 0 : t)
117 114
118 end 115 end
119 116
120 fun fk2s fk = 117 fun fk2s fk =
121 case fk of 118 case fk of
164 attrify (args, ft, (EPrim (Prim.String (Prim.Normal, Settings.getUrlPrefix () ^ s)), loc), fm) 161 attrify (args, ft, (EPrim (Prim.String (Prim.Normal, Settings.getUrlPrefix () ^ s)), loc), fm)
165 end 162 end
166 | _ => 163 | _ =>
167 case t of 164 case t of
168 TFfi ("Basis", "unit") => ((EPrim (Prim.String (Prim.Normal, "")), loc), fm) 165 TFfi ("Basis", "unit") => ((EPrim (Prim.String (Prim.Normal, "")), loc), fm)
169 | TFfi (m, x) => ((EFfiApp (m, fk2s fk ^ "ify" ^ capitalize x, [(e, tAll)]), loc), fm) 166 | TFfi (m, x) => (if Settings.mayClientToServer (m, x)
167 (* TODO: better error message. (Then again, user should never see this.) *)
168 then ()
169 else (E.errorAt loc "MonoFooify: can't pass type from client to server";
170 Print.eprefaces' [("Type", MonoPrint.p_typ MonoEnv.empty tAll)]);
171 ((EFfiApp (m, fk2s fk ^ "ify" ^ capitalize x, [(e, tAll)]), loc), fm))
170 172
171 | TRecord [] => ((EPrim (Prim.String (Prim.Normal, "")), loc), fm) 173 | TRecord [] => ((EPrim (Prim.String (Prim.Normal, "")), loc), fm)
172 | TRecord ((x, t) :: xts) => 174 | TRecord ((x, t) :: xts) =>
173 let 175 let
174 val (se, fm) = fooify fm ((EField (e, x), loc), t) 176 val (se, fm) = fooify fm ((EField (e, x), loc), t)
294 (dummyExp, fm)) 296 (dummyExp, fm))
295 in 297 in
296 fooify 298 fooify
297 end 299 end
298 300
301 (* Has to be set at the end of [Monoize]. *)
302 val canonicalFm = ref (Fm.empty 0 : Fm.t)
303
299 fun urlify env expTyp = 304 fun urlify env expTyp =
300 let 305 if ErrorMsg.anyErrors ()
301 val (exp, fm) = 306 then ((* DEBUG *) print "already error"; NONE)
302 fooifyExp 307 else
303 Url 308 let
304 (fn n => 309 val (exp, fm) =
305 let 310 fooifyExp
306 val (_, t, _, s) = MonoEnv.lookupENamed env n 311 Url
307 in 312 (fn n =>
308 (t, s) 313 let
309 end) 314 val (_, t, _, s) = MonoEnv.lookupENamed env n
310 (fn n => MonoEnv.lookupDatatype env n) 315 in
311 (!Fm.canonical) 316 (t, s)
312 expTyp 317 end)
313 in 318 (fn n => MonoEnv.lookupDatatype env n)
314 Fm.canonical := fm; 319 (!canonicalFm)
315 exp 320 expTyp
316 end 321 in
322 if ErrorMsg.anyErrors ()
323 then ((* DEBUG *) print "why"; (ErrorMsg.resetErrors (); NONE))
324 else (canonicalFm := fm; SOME exp)
325 end
326
327 fun getNewFmDecls () =
328 let
329 val fm = !canonicalFm
330 in
331 (* canonicalFm := Fm.enter fm; *)
332 Fm.decls fm
333 end
334
317 end 335 end