Mercurial > urweb

comparison src/jscomp.sml @ 595:02c8ab9f3e8b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Injected an enumeration
author Adam Chlipala <adamc@hcoop.net>
date Thu, 08 Jan 2009 09:57:45 -0500
parents 55829473f6a7
children d1ec54288b1a
comparison
equal deleted inserted replaced
594:55829473f6a7 595:02c8ab9f3e8b
56 fun ffi k = FM.find (funcs, k) 56 fun ffi k = FM.find (funcs, k)
57 57
58 type state = { 58 type state = {
59 decls : decl list, 59 decls : decl list,
60 script : string list, 60 script : string list,
61 included : IS.set 61 included : IS.set,
62 injectors : int IM.map,
63 maxName : int
62 } 64 }
63 65
64 fun varDepth (e, _) = 66 fun varDepth (e, _) =
65 case e of 67 case e of
66 EPrim _ => 0 68 EPrim _ => 0
145 | [x] => x 147 | [x] => x
146 | x :: es' => (EStrcat (x, strcat loc es'), loc) 148 | x :: es' => (EStrcat (x, strcat loc es'), loc)
147 149
148 fun process file = 150 fun process file =
149 let 151 let
150 val nameds = foldl (fn ((DVal (_, n, t, e, _), _), nameds) => IM.insert (nameds, n, e) 152 val nameds =
151 | ((DValRec vis, _), nameds) => 153 foldl (fn ((DVal (_, n, t, e, _), _), nameds) => IM.insert (nameds, n, e)
152 foldl (fn ((_, n, _, e, _), nameds) => IM.insert (nameds, n, e)) 154 | ((DValRec vis, _), nameds) =>
153 nameds vis 155 foldl (fn ((_, n, _, e, _), nameds) => IM.insert (nameds, n, e))
154 | (_, nameds) => nameds) 156 nameds vis
155 IM.empty file 157 | (_, state) => state)
158 IM.empty file
156 159
157 fun str loc s = (EPrim (Prim.String s), loc) 160 fun str loc s = (EPrim (Prim.String s), loc)
158 161
159 fun isNullable (t, _) = 162 fun isNullable (t, _) =
160 case t of 163 case t of
227 e')], 230 e')],
228 {disc = (TOption t, loc), 231 {disc = (TOption t, loc),
229 result = (TFfi ("Basis", "string"), loc)}), loc), 232 result = (TFfi ("Basis", "string"), loc)}), loc),
230 st) 233 st)
231 end 234 end
235
236 | TDatatype (n, ref (dk, cs)) =>
237 (case IM.find (#injectors st, n) of
238 SOME n' => ((EApp ((ENamed n', loc), e), loc), st)
239 | NONE =>
240 let
241 val dk = ElabUtil.classifyDatatype cs
242
243 val n' = #maxName st
244 val st = {decls = #decls st,
245 script = #script st,
246 included = #included st,
247 injectors = IM.insert (#injectors st, n, n'),
248 maxName = n' + 1}
249
250 val (pes, st) = ListUtil.foldlMap
251 (fn ((_, cn, NONE), st) =>
252 (((PCon (dk, PConVar cn, NONE), loc),
253 str loc (Int.toString cn)),
254 st)
255 | ((_, cn, SOME t), st) =>
256 let
257 val (e, st) = quoteExp loc t ((ERel 0, loc), st)
258 in
259 (((PCon (dk, PConVar cn, SOME (PVar ("x", t), loc)), loc),
260 e),
261 st)
262 end)
263 st cs
264
265 val s = (TFfi ("Basis", "string"), loc)
266 val body = (ECase ((ERel 0, loc), pes,
267 {disc = t, result = s}), loc)
268 val body = (EAbs ("x", t, s, body), loc)
269
270 val st = {decls = (DValRec [("jsify", n', (TFun (t, s), loc),
271 body, "jsify")], loc) :: #decls st,
272 script = #script st,
273 included = #included st,
274 injectors = #injectors st,
275 maxName = #maxName st}
276 in
277 ((EApp ((ENamed n', loc), e), loc), st)
278 end)
232 279
233 | _ => (EM.errorAt loc "Don't know how to embed type in JavaScript"; 280 | _ => (EM.errorAt loc "Don't know how to embed type in JavaScript";
234 Print.prefaces "Can't embed" [("t", MonoPrint.p_typ MonoEnv.empty t)]; 281 Print.prefaces "Can't embed" [("t", MonoPrint.p_typ MonoEnv.empty t)];
235 (str loc "ERROR", st)) 282 (str loc "ERROR", st))
236 283
380 NONE => raise Fail "Jscomp: Unbound ENamed" 427 NONE => raise Fail "Jscomp: Unbound ENamed"
381 | SOME e => 428 | SOME e =>
382 let 429 let
383 val st = {decls = #decls st, 430 val st = {decls = #decls st,
384 script = #script st, 431 script = #script st,
385 included = IS.add (#included st, n)} 432 included = IS.add (#included st, n),
433 injectors = #injectors st,
434 maxName = #maxName st}
386 435
387 val (e, st) = jsExp mode skip [] 0 (e, st) 436 val (e, st) = jsExp mode skip [] 0 (e, st)
388 val e = deStrcat e 437 val e = deStrcat e
389 438
390 val sc = "_n" ^ Int.toString n ^ "=" ^ e ^ ";\n" 439 val sc = "_n" ^ Int.toString n ^ "=" ^ e ^ ";\n"
391 in 440 in
392 {decls = #decls st, 441 {decls = #decls st,
393 script = sc :: #script st, 442 script = sc :: #script st,
394 included = #included st} 443 included = #included st,
444 injectors = #injectors st,
445 maxName = #maxName st}
395 end 446 end
396 in 447 in
397 (str ("_n" ^ Int.toString n), st) 448 (str ("_n" ^ Int.toString n), st)
398 end 449 end
399 450
715 val (d, st) = decl st d 766 val (d, st) = decl st d
716 in 767 in
717 (List.revAppend (#decls st, [d]), 768 (List.revAppend (#decls st, [d]),
718 {decls = [], 769 {decls = [],
719 script = #script st, 770 script = #script st,
720 included = #included st}) 771 included = #included st,
772 injectors = #injectors st,
773 maxName = #maxName st})
721 end 774 end
722 775
723 val (ds, st) = ListUtil.foldlMapConcat doDecl 776 val (ds, st) = ListUtil.foldlMapConcat doDecl
724 {decls = [], 777 {decls = [],
725 script = [], 778 script = [],
726 included = IS.empty} 779 included = IS.empty,
780 injectors = IM.empty,
781 maxName = U.File.maxName file + 1}
727 file 782 file
728 783
729 val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.libJs, file = "urweb.js"}) 784 val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.libJs, file = "urweb.js"})
730 fun lines acc = 785 fun lines acc =
731 case TextIO.inputLine inf of 786 case TextIO.inputLine inf of