diff src/jscomp.sml @ 595:02c8ab9f3e8b

Injected an enumeration
author Adam Chlipala <adamc@hcoop.net>
date Thu, 08 Jan 2009 09:57:45 -0500
parents 55829473f6a7
children d1ec54288b1a
line wrap: on
line diff
--- a/src/jscomp.sml	Fri Jan 02 13:03:22 2009 -0500
+++ b/src/jscomp.sml	Thu Jan 08 09:57:45 2009 -0500
@@ -58,7 +58,9 @@
 type state = {
      decls : decl list,
      script : string list,
-     included : IS.set
+     included : IS.set,
+     injectors : int IM.map,
+     maxName : int
 }
 
 fun varDepth (e, _) =
@@ -147,12 +149,13 @@
 
 fun process file =
     let
-        val nameds = foldl (fn ((DVal (_, n, t, e, _), _), nameds) => IM.insert (nameds, n, e)
-                             | ((DValRec vis, _), nameds) =>
-                               foldl (fn ((_, n, _, e, _), nameds) => IM.insert (nameds, n, e))
-                                     nameds vis
-                             | (_, nameds) => nameds)
-                           IM.empty file
+        val nameds =
+            foldl (fn ((DVal (_, n, t, e, _), _), nameds) => IM.insert (nameds, n, e)
+                    | ((DValRec vis, _), nameds) =>
+                      foldl (fn ((_, n, _, e, _), nameds) => IM.insert (nameds, n, e))
+                            nameds vis
+                    | (_, state) => state)
+                  IM.empty file
 
         fun str loc s = (EPrim (Prim.String s), loc)
 
@@ -230,6 +233,50 @@
                      st)
                 end
 
+              | TDatatype (n, ref (dk, cs)) =>
+                (case IM.find (#injectors st, n) of
+                     SOME n' => ((EApp ((ENamed n', loc), e), loc), st)
+                   | NONE =>
+                     let
+                         val dk = ElabUtil.classifyDatatype cs
+
+                         val n' = #maxName st
+                         val st = {decls = #decls st,
+                                   script = #script st,
+                                   included = #included st,
+                                   injectors = IM.insert (#injectors st, n, n'),
+                                   maxName = n' + 1}
+
+                         val (pes, st) = ListUtil.foldlMap
+                                             (fn ((_, cn, NONE), st) =>
+                                                 (((PCon (dk, PConVar cn, NONE), loc),
+                                                   str loc (Int.toString cn)),
+                                                  st)
+                                               | ((_, cn, SOME t), st) =>
+                                                 let
+                                                     val (e, st) = quoteExp loc t ((ERel 0, loc), st)
+                                                 in
+                                                     (((PCon (dk, PConVar cn, SOME (PVar ("x", t), loc)), loc),
+                                                       e),
+                                                      st)
+                                                 end)
+                                             st cs
+
+                         val s = (TFfi ("Basis", "string"), loc)
+                         val body = (ECase ((ERel 0, loc), pes,
+                                            {disc = t, result = s}), loc)
+                         val body = (EAbs ("x", t, s, body), loc)
+
+                         val st = {decls = (DValRec [("jsify", n', (TFun (t, s), loc),
+                                                      body, "jsify")], loc) :: #decls st,
+                                   script = #script st,
+                                   included = #included st,
+                                   injectors = #injectors st,
+                                   maxName = #maxName st}
+                     in
+                         ((EApp ((ENamed n', loc), e), loc), st)
+                     end)
+
               | _ => (EM.errorAt loc "Don't know how to embed type in JavaScript";
                       Print.prefaces "Can't embed" [("t", MonoPrint.p_typ MonoEnv.empty t)];
                       (str loc "ERROR", st))
@@ -382,7 +429,9 @@
                                             let
                                                 val st = {decls = #decls st,
                                                           script = #script st,
-                                                          included = IS.add (#included st, n)}
+                                                          included = IS.add (#included st, n),
+                                                          injectors = #injectors st,
+                                                          maxName = #maxName st}
 
                                                 val (e, st) = jsExp mode skip [] 0 (e, st)
                                                 val e = deStrcat e
@@ -391,7 +440,9 @@
                                             in
                                                 {decls = #decls st,
                                                  script = sc :: #script st,
-                                                 included = #included st}
+                                                 included = #included st,
+                                                 injectors = #injectors st,
+                                                 maxName = #maxName st}
                                             end
                             in
                                 (str ("_n" ^ Int.toString n), st)
@@ -717,13 +768,17 @@
                 (List.revAppend (#decls st, [d]),
                  {decls = [],
                   script = #script st,
-                  included = #included st})
+                  included = #included st,
+                  injectors = #injectors st,
+                  maxName = #maxName st})
             end
 
         val (ds, st) = ListUtil.foldlMapConcat doDecl
                        {decls = [],
                         script = [],
-                        included = IS.empty}
+                        included = IS.empty,
+                        injectors = IM.empty,
+                        maxName = U.File.maxName file + 1}
                        file
 
         val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.libJs, file = "urweb.js"})