Mercurial > urweb
comparison 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 |
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 |