changeset 589:102e81d975e3

Included a recursive function in JavaScript
author Adam Chlipala <adamc@hcoop.net>
date Thu, 01 Jan 2009 11:58:00 -0500
parents 5803b4f041cb
children 57f476c934da
files jslib/urweb.js src/jscomp.sml tests/stypes.ur
diffstat 3 files changed, 465 insertions(+), 413 deletions(-) [+]
line wrap: on
line diff
--- a/jslib/urweb.js	Thu Jan 01 11:26:34 2009 -0500
+++ b/jslib/urweb.js	Thu Jan 01 11:58:00 2009 -0500
@@ -45,3 +45,4 @@
 function bs(b) { return (b ? "True" : "False") }
 
 function pf() { alert("Pattern match failure") }
+
--- a/src/jscomp.sml	Thu Jan 01 11:26:34 2009 -0500
+++ b/src/jscomp.sml	Thu Jan 01 11:58:00 2009 -0500
@@ -33,6 +33,9 @@
 structure E = MonoEnv
 structure U = MonoUtil
 
+structure IS = IntBinarySet
+structure IM = IntBinaryMap
+
 val funcs = [(("Basis", "alert"), "alert"),
              (("Basis", "htmlifyBool"), "bs"),
              (("Basis", "htmlifyFloat"), "ts"),
@@ -54,7 +57,8 @@
 
 type state = {
      decls : decl list,
-     script : string
+     script : string list,
+     included : IS.set
 }
 
 fun varDepth (e, _) =
@@ -98,454 +102,500 @@
       | [x] => x
       | x :: es' => (EStrcat (x, strcat loc es'), loc)
 
-fun jsExp mode skip outer =
+fun process file =
     let
-        val len = length outer
+        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
 
-        fun jsE inner (e as (_, loc), st) =
+        fun jsExp mode skip outer =
             let
-                fun str s = (EPrim (Prim.String s), loc)
+                val len = length outer
 
-                fun var n = Int.toString (len + inner - n - 1)
+                fun jsE inner (e as (_, loc), st) =
+                    let
+                        fun str s = (EPrim (Prim.String s), loc)
 
-                fun patCon pc =
-                    case pc of
-                        PConVar n => str (Int.toString n)
-                      | PConFfi {mod = "Basis", con = "True", ...} => str "true"
-                      | PConFfi {mod = "Basis", con = "False", ...} => str "false"
-                      | PConFfi {con, ...} => str ("\"_" ^ con ^ "\"")
+                        fun var n = Int.toString (len + inner - n - 1)
 
-                fun isNullable (t, _) =
-                    case t of
-                        TOption _ => true
-                      | TRecord [] => true
-                      | _ => false
+                        fun patCon pc =
+                            case pc of
+                                PConVar n => str (Int.toString n)
+                              | PConFfi {mod = "Basis", con = "True", ...} => str "true"
+                              | PConFfi {mod = "Basis", con = "False", ...} => str "false"
+                              | PConFfi {con, ...} => str ("\"_" ^ con ^ "\"")
 
-                fun unsupported s =
-                  (EM.errorAt loc (s ^ " in code to be compiled to JavaScript");
-                   (str "ERROR", st))
+                        fun isNullable (t, _) =
+                            case t of
+                                TOption _ => true
+                              | TRecord [] => true
+                              | _ => false
 
-                val strcat = strcat loc
+                        fun unsupported s =
+                            (EM.errorAt loc (s ^ " in code to be compiled to JavaScript");
+                             (str "ERROR", st))
 
-                fun quoteExp (t : typ) e =
-                    case #1 t of
-                        TSource => strcat [str "s",
-                                           (EFfiApp ("Basis", "htmlifyInt", [e]), loc)]
-                      | TRecord [] => str "null"
-                      | TFfi ("Basis", "string") => e
-                      | _ => (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 "ERROR")
+                        val strcat = strcat loc
 
-                fun jsPrim p =
-                    case p of
-                        Prim.String s =>
-                        str ("\""
-                             ^ String.translate (fn #"'" =>
-                                                    if mode = Attribute then
-                                                        "\\047"
-                                                    else
-                                                        "'"
-                                                  | #"\"" => "\\\""
-                                                  | #"<" =>
-                                                    if mode = Script then
-                                                        "<"
-                                                    else
-                                                        "\\074"
-                                                  | #"\\" => "\\\\"
-                                                  | ch => String.str ch) s
-                             ^ "\"")
-                      | _ => str (Prim.toString p)
+                        fun quoteExp (t : typ) e =
+                            case #1 t of
+                                TSource => strcat [str "s",
+                                                   (EFfiApp ("Basis", "htmlifyInt", [e]), loc)]
+                              | TRecord [] => str "null"
+                              | TFfi ("Basis", "string") => e
+                              | _ => (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 "ERROR")
 
-                fun jsPat depth inner (p, _) succ fail =
-                    case p of
-                        PWild => succ
-                      | PVar _ => strcat [str ("(_" ^ Int.toString (len + inner) ^ "=d" ^ Int.toString depth ^ ","),
-                                          succ,
-                                          str ")"]
-                      | PPrim p => strcat [str ("(d" ^ Int.toString depth ^ "=="),
-                                           jsPrim p,
-                                           str "?",
-                                           succ,
-                                           str ":",
-                                           fail,
-                                           str ")"]
-                      | PCon (_, PConFfi {mod = "Basis", con = "True", ...}, NONE) =>
-                        strcat [str ("(d" ^ Int.toString depth ^ "?"),
-                                succ,
-                                str ":",
-                                fail,
-                                str ")"]
-                      | PCon (_, PConFfi {mod = "Basis", con = "False", ...}, NONE) =>
-                        strcat [str ("(d" ^ Int.toString depth ^ "?"),
-                                fail,
-                                str ":",
-                                succ,
-                                str ")"]
-                      | PCon (_, pc, NONE) =>
-                        strcat [str ("(d" ^ Int.toString depth ^ "=="),
-                                patCon pc,
-                                str "?",
-                                succ,
-                                str ":",
-                                fail,
-                                str ")"]
-                      | PCon (_, pc, SOME p) =>
-                        strcat [str ("(d" ^ Int.toString depth ^ ".n=="),
-                                patCon pc,
-                                str ("?(d" ^ Int.toString depth ^ "=d" ^ Int.toString depth ^ ".v,"),
-                                succ,
-                                str "):",
-                                fail,
-                                str ")"]
-                      | PRecord xps =>
-                        let
-                            val (_, succ) = foldl
-                                            (fn ((x, p, _), (inner, succ)) =>
-                                                (inner + E.patBindsN p,
-                                                 strcat [str ("(d" ^ Int.toString (depth+1) ^ "=d"
-                                                              ^ Int.toString depth ^ "._" ^ x ^ ","),
-                                                         jsPat (depth+1) inner p succ fail,
-                                                         str ")"]))
-                                            (inner, succ) xps
-                        in
-                            succ
-                        end
-                      | PNone _ => strcat [str ("(d" ^ Int.toString depth ^ "?"),
-                                           fail,
-                                           str ":",
-                                           succ,
-                                           str ")"]
-                      | PSome (_, p) => strcat [str ("(d" ^ Int.toString depth ^ "?"),
-                                                jsPat depth inner p succ fail,
-                                                str ":",
-                                                fail,
-                                                str ")"]
-            in
-                case #1 e of
-                    EPrim p => (jsPrim p, st)
-                  | ERel n =>
-                    if n < inner then
-                        (str ("_" ^ var n), st)
-                    else
-                        let
-                            val n = n - inner
-                        in
-                            (quoteExp (List.nth (outer, n)) (ERel (n - skip), loc), st)
-                        end
-                  | ENamed _ => raise Fail "Named"
-                  | ECon (_, pc, NONE) => (patCon pc, st)
-                  | ECon (_, pc, SOME e) =>
-                    let
-                        val (s, st) = jsE inner (e, st)
+                        fun jsPrim p =
+                            case p of
+                                Prim.String s =>
+                                str ("\""
+                                     ^ String.translate (fn #"'" =>
+                                                            if mode = Attribute then
+                                                                "\\047"
+                                                            else
+                                                                "'"
+                                                          | #"\"" => "\\\""
+                                                          | #"<" =>
+                                                            if mode = Script then
+                                                                "<"
+                                                            else
+                                                                "\\074"
+                                                          | #"\\" => "\\\\"
+                                                          | ch => String.str ch) s
+                                     ^ "\"")
+                              | _ => str (Prim.toString p)
+
+                        fun jsPat depth inner (p, _) succ fail =
+                            case p of
+                                PWild => succ
+                              | PVar _ => strcat [str ("(_" ^ Int.toString (len + inner) ^ "=d"
+                                                       ^ Int.toString depth ^ ","),
+                                                  succ,
+                                                  str ")"]
+                              | PPrim p => strcat [str ("(d" ^ Int.toString depth ^ "=="),
+                                                   jsPrim p,
+                                                   str "?",
+                                                   succ,
+                                                   str ":",
+                                                   fail,
+                                                   str ")"]
+                              | PCon (_, PConFfi {mod = "Basis", con = "True", ...}, NONE) =>
+                                strcat [str ("(d" ^ Int.toString depth ^ "?"),
+                                        succ,
+                                        str ":",
+                                        fail,
+                                        str ")"]
+                              | PCon (_, PConFfi {mod = "Basis", con = "False", ...}, NONE) =>
+                                strcat [str ("(d" ^ Int.toString depth ^ "?"),
+                                        fail,
+                                        str ":",
+                                        succ,
+                                        str ")"]
+                              | PCon (_, pc, NONE) =>
+                                strcat [str ("(d" ^ Int.toString depth ^ "=="),
+                                        patCon pc,
+                                        str "?",
+                                        succ,
+                                        str ":",
+                                        fail,
+                                        str ")"]
+                              | PCon (_, pc, SOME p) =>
+                                strcat [str ("(d" ^ Int.toString depth ^ ".n=="),
+                                        patCon pc,
+                                        str ("?(d" ^ Int.toString depth ^ "=d" ^ Int.toString depth ^ ".v,"),
+                                        jsPat depth inner p succ fail,
+                                        str "):",
+                                        fail,
+                                        str ")"]
+                              | PRecord xps =>
+                                let
+                                    val (_, succ) = foldl
+                                                        (fn ((x, p, _), (inner, succ)) =>
+                                                            (inner + E.patBindsN p,
+                                                             strcat [str ("(d" ^ Int.toString (depth+1) ^ "=d"
+                                                                          ^ Int.toString depth ^ "._" ^ x ^ ","),
+                                                                     jsPat (depth+1) inner p succ fail,
+                                                                     str ")"]))
+                                                        (inner, succ) xps
+                                in
+                                    succ
+                                end
+                              | PNone _ => strcat [str ("(d" ^ Int.toString depth ^ "?"),
+                                                   fail,
+                                                   str ":",
+                                                   succ,
+                                                   str ")"]
+                              | PSome (_, p) => strcat [str ("(d" ^ Int.toString depth ^ "?"),
+                                                        jsPat depth inner p succ fail,
+                                                        str ":",
+                                                        fail,
+                                                        str ")"]
+
+                        fun deStrcat (e, _) =
+                            case e of
+                                EPrim (Prim.String s) => s
+                              | EStrcat (e1, e2) => deStrcat e1 ^ deStrcat e2
+                              | _ => raise Fail "Jscomp: deStrcat"
                     in
-                        (strcat [str "{n:",
-                                 patCon pc,
-                                 str ",v:",
-                                 s,
-                                 str "}"], st)
-                    end
-                  | ENone _ => (str "null", st)
-                  | ESome (t, e) =>
-                    let
-                        val (e, st) = jsE inner (e, st)
-                    in
-                        (if isNullable t then
-                             strcat [str "{v:", e, str "}"]
-                         else
-                             e, st)
-                    end
+                        case #1 e of
+                            EPrim p => (jsPrim p, st)
+                          | ERel n =>
+                            if n < inner then
+                                (str ("_" ^ var n), st)
+                            else
+                                let
+                                    val n = n - inner
+                                in
+                                    (quoteExp (List.nth (outer, n)) (ERel (n - skip), loc), st)
+                                end
 
-                  | EFfi k =>
-                    let
-                        val name = case ffi k of
-                                       NONE => (EM.errorAt loc ("Unsupported FFI identifier " ^ #2 k ^ " in JavaScript");
-                                                "ERROR")
-                                     | SOME s => s
-                    in
-                        (str name, st)
-                    end
-                  | EFfiApp (m, x, args) =>
-                    let
-                        val args =
-                            case (m, x, args) of
-                                ("Basis", "new_client_source", [(EJavaScript (_, e, _), _)]) => [e]
-                              | ("Basis", "set_client_source", [e1, (EJavaScript (_, e2, _), _)]) => [e1, e2]
-                              | _ => args
+                          | ENamed n =>
+                            let
+                                val st =
+                                    if IS.member (#included st, n) then
+                                        st
+                                    else
+                                        case IM.find (nameds, n) of
+                                            NONE => raise Fail "Jscomp: Unbound ENamed"
+                                          | SOME e =>
+                                            let
+                                                val st = {decls = #decls st,
+                                                          script = #script st,
+                                                          included = IS.add (#included st, n)}
 
-                        val name = case ffi (m, x) of
-                                       NONE => (EM.errorAt loc ("Unsupported FFI function " ^ x ^ " in JavaScript");
-                                                "ERROR")
-                                     | SOME s => s
-                    in
-                        case args of
-                            [] => (str (name ^ "()"), st)
-                          | [e] =>
+                                                val (e, st) = jsExp mode skip [] 0 (e, st)
+                                                val e = deStrcat e
+                                                
+                                                val sc = "_n" ^ Int.toString n ^ "=" ^ e ^ ";\n"
+                                            in
+                                                {decls = #decls st,
+                                                 script = sc :: #script st,
+                                                 included = #included st}
+                                            end
+                            in
+                                (str ("_n" ^ Int.toString n), st)
+                            end
+
+                          | ECon (_, pc, NONE) => (patCon pc, st)
+                          | ECon (_, pc, SOME e) =>
+                            let
+                                val (s, st) = jsE inner (e, st)
+                            in
+                                (strcat [str "{n:",
+                                         patCon pc,
+                                         str ",v:",
+                                         s,
+                                         str "}"], st)
+                            end
+                          | ENone _ => (str "null", st)
+                          | ESome (t, e) =>
                             let
                                 val (e, st) = jsE inner (e, st)
                             in
-                                (strcat [str (name ^ "("),
+                                (if isNullable t then
+                                     strcat [str "{v:", e, str "}"]
+                                 else
+                                     e, st)
+                            end
+
+                          | EFfi k =>
+                            let
+                                val name = case ffi k of
+                                               NONE => (EM.errorAt loc ("Unsupported FFI identifier " ^ #2 k
+                                                                        ^ " in JavaScript");
+                                                        "ERROR")
+                                             | SOME s => s
+                            in
+                                (str name, st)
+                            end
+                          | EFfiApp (m, x, args) =>
+                            let
+                                val args =
+                                    case (m, x, args) of
+                                        ("Basis", "new_client_source", [(EJavaScript (_, e, _), _)]) => [e]
+                                      | ("Basis", "set_client_source", [e1, (EJavaScript (_, e2, _), _)]) => [e1, e2]
+                                      | _ => args
+
+                                val name = case ffi (m, x) of
+                                               NONE => (EM.errorAt loc ("Unsupported FFI function "
+                                                                        ^ x ^ " in JavaScript");
+                                                        "ERROR")
+                                             | SOME s => s
+                            in
+                                case args of
+                                    [] => (str (name ^ "()"), st)
+                                  | [e] =>
+                                    let
+                                        val (e, st) = jsE inner (e, st)
+                                    in
+                                        (strcat [str (name ^ "("),
+                                                 e,
+                                                 str ")"], st)
+                                    end
+                                  | e :: es =>
+                                    let
+                                        val (e, st) = jsE inner (e, st)
+                                        val (es, st) = ListUtil.foldlMapConcat
+                                                           (fn (e, st) =>
+                                                               let
+                                                                   val (e, st) = jsE inner (e, st)
+                                                               in
+                                                                   ([str ",", e], st)
+                                                               end)
+                                                           st es
+                                    in
+                                        (strcat (str (name ^ "(")
+                                                 :: e
+                                                 :: es
+                                                 @ [str ")"]), st)
+                                    end
+                            end
+
+                          | EApp (e1, e2) =>
+                            let
+                                val (e1, st) = jsE inner (e1, st)
+                                val (e2, st) = jsE inner (e2, st)
+                            in
+                                (strcat [e1, str "(", e2, str ")"], st)
+                            end
+                          | EAbs (_, _, _, e) =>
+                            let
+                                val locals = List.tabulate
+                                                 (varDepth e,
+                                               fn i => str ("var _" ^ Int.toString (len + inner + i + 1) ^ ";"))
+                                val (e, st) = jsE (inner + 1) (e, st)
+                            in
+                                (strcat (str ("function(_"
+                                              ^ Int.toString (len + inner)
+                                              ^ "){")
+                                         :: locals
+                                         @ [str "return ",
+                                            e,
+                                            str "}"]),
+                                 st)
+                            end
+
+                          | EUnop (s, e) =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                            in
+                                (strcat [str ("(" ^ s),
                                          e,
+                                         str ")"],
+                                 st)
+                            end
+                          | EBinop (s, e1, e2) =>
+                            let
+                                val (e1, st) = jsE inner (e1, st)
+                                val (e2, st) = jsE inner (e2, st)
+                            in
+                                (strcat [str "(",
+                                         e1,
+                                         str s,
+                                         e2,
+                                         str ")"],
+                                 st)
+                            end
+
+                          | ERecord [] => (str "null", st)
+                          | ERecord [(x, e, _)] =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                            in
+                                (strcat [str "{_x:", e, str "}"], st)
+                            end
+                          | ERecord ((x, e, _) :: xes) =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+
+                                val (es, st) =
+                                    foldr (fn ((x, e, _), (es, st)) =>
+                                              let
+                                                  val (e, st) = jsE inner (e, st)
+                                              in
+                                                  (str (",_" ^ x ^ ":")
+                                                   :: e
+                                                   :: es,
+                                                   st)
+                                              end)
+                                          ([str "}"], st) xes
+                            in
+                                (strcat (str ("{_" ^ x ^ ":")
+                                         :: e
+                                         :: es),
+                                 st)
+                            end
+                          | EField (e, x) =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                            in
+                                (strcat [e,
+                                         str ("._" ^ x)], st)
+                            end
+
+                          | ECase (e, pes, _) =>
+                            let
+                                val plen = length pes
+
+                                val (cases, st) = ListUtil.foldliMap
+                                                      (fn (i, (p, e), st) =>
+                                                          let
+                                                              val (e, st) = jsE (inner + E.patBindsN p) (e, st)
+                                                              val fail =
+                                                                  if i = plen - 1 then
+                                                                      str "pf()"
+                                                                  else
+                                                                      str ("c" ^ Int.toString (i+1) ^ "()")
+                                                              val c = jsPat 0 inner p e fail
+                                                          in
+                                                              (strcat [str ("c" ^ Int.toString i ^ "=function(){return "),
+                                                                       c,
+                                                                       str "},"],
+                                                               st)
+                                                          end)
+                                                      st pes
+
+                                val (e, st) = jsE inner (e, st)
+                            in
+                                (strcat (str "("
+                                         :: List.revAppend (cases,
+                                                            [str "d0=",
+                                                             e,
+                                                             str ",c0())"])), st)
+                            end
+
+                          | EStrcat (e1, e2) =>
+                            let
+                                val (e1, st) = jsE inner (e1, st)
+                                val (e2, st) = jsE inner (e2, st)
+                            in
+                                (strcat [str "(", e1, str "+", e2, str ")"], st)
+                            end
+
+                          | EError (e, _) =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                            in
+                                (strcat [str "alert(\"ERROR: \"+", e, str ")"],
+                                 st)
+                            end
+
+                          | EWrite e =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                            in
+                                (strcat [str "document.write(",
+                                         e,
+                                         str ".v)"], st)
+                            end
+
+                          | ESeq (e1, e2) =>
+                            let
+                                val (e1, st) = jsE inner (e1, st)
+                                val (e2, st) = jsE inner (e2, st)
+                            in
+                                (strcat [str "(", e1, str ",", e2, str ")"], st)
+                            end
+                          | ELet (_, _, e1, e2) =>
+                            let
+                                val (e1, st) = jsE inner (e1, st)
+                                val (e2, st) = jsE (inner + 1) (e2, st)
+                            in
+                                (strcat [str ("(_" ^ Int.toString (len + inner) ^ "="),
+                                         e1,
+                                         str ",",
+                                         e2,
                                          str ")"], st)
                             end
-                          | e :: es =>
+
+                          | EClosure _ => unsupported "EClosure"
+                          | EQuery _ => unsupported "Query"
+                          | EDml _ => unsupported "DML"
+                          | ENextval _ => unsupported "Nextval"
+                          | EUnurlify _ => unsupported "EUnurlify"
+                          | EJavaScript _ => unsupported "Nested JavaScript"
+                          | ESignalReturn e =>
                             let
                                 val (e, st) = jsE inner (e, st)
-                                val (es, st) = ListUtil.foldlMapConcat
-                                                   (fn (e, st) =>
-                                                       let
-                                                           val (e, st) = jsE inner (e, st)
-                                                       in
-                                                           ([str ",", e], st)
-                                                       end)
-                                                   st es
                             in
-                                (strcat (str (name ^ "(")
-                                         :: e
-                                         :: es
-                                         @ [str ")"]), st)
+                                (strcat [str "sr(",
+                                         e,
+                                         str ")"],
+                                 st)
+                            end
+                          | ESignalBind (e1, e2) =>
+                            let
+                                val (e1, st) = jsE inner (e1, st)
+                                val (e2, st) = jsE inner (e2, st)
+                            in
+                                (strcat [str "sb(",
+                                         e1,
+                                         str ",",
+                                         e2,
+                                         str ")"],
+                                 st)
+                            end
+                          | ESignalSource e =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                            in
+                                (strcat [str "ss(",
+                                         e,
+                                         str ")"],
+                                 st)
                             end
                     end
+            in
+                jsE
+            end
 
-                  | EApp (e1, e2) =>
-                    let
-                        val (e1, st) = jsE inner (e1, st)
-                        val (e2, st) = jsE inner (e2, st)
-                    in
-                        (strcat [e1, str "(", e2, str ")"], st)
-                    end
-                  | EAbs (_, _, _, e) =>
-                    let
-                        val locals = List.tabulate
-                                     (varDepth e,
-                                   fn i => str ("var _" ^ Int.toString (len + inner + i + 1) ^ ";"))
-                        val (e, st) = jsE (inner + 1) (e, st)
-                    in
-                        (strcat (str ("function(_"
-                                      ^ Int.toString (len + inner)
-                                      ^ "){")
-                                 :: locals
-                                 @ [str "return ",
-                                    e,
-                                    str "}"]),
-                         st)
-                    end
+        val decl : state -> decl -> decl * state =
+            U.Decl.foldMapB {typ = fn x => x,
+                             exp = fn (env, e, st) =>
+                                      let
+                                          fun doCode m skip env orig e =
+                                              let
+                                                  val len = length env
+                                                  fun str s = (EPrim (Prim.String s), #2 e)
 
-                  | EUnop (s, e) =>
-                    let
-                        val (e, st) = jsE inner (e, st)
-                    in
-                        (strcat [str ("(" ^ s),
-                                 e,
-                                 str ")"],
-                         st)
-                    end
-                  | EBinop (s, e1, e2) =>
-                    let
-                        val (e1, st) = jsE inner (e1, st)
-                        val (e2, st) = jsE inner (e2, st)
-                    in
-                        (strcat [str "(",
-                                 e1,
-                                 str s,
-                                 e2,
-                                 str ")"],
-                         st)
-                    end
+                                                  val locals = List.tabulate
+                                                                   (varDepth e,
+                                                                 fn i => str ("var _" ^ Int.toString (len + i) ^ ";"))
+                                                  val (e, st) = jsExp m skip env 0 (e, st)
+                                              in
+                                                  (EJavaScript (m, orig, SOME (strcat (#2 e) (locals @ [e]))), st)
+                                              end
+                                      in
+                                          case e of
+                                              EJavaScript (m, orig as (EAbs (_, t, _, e), _), _) =>
+                                              doCode m 1 (t :: env) orig e
+                                            | EJavaScript (m, e, _) => doCode m 0 env e e
+                                            | _ => (e, st)
+                                      end,
+                             decl = fn (_, e, st) => (e, st),
+                             bind = fn (env, U.Decl.RelE (_, t)) => t :: env
+                                     | (env, _) => env}
+                            []
 
-                  | ERecord [] => (str "null", st)
-                  | ERecord [(x, e, _)] =>
-                    let
-                        val (e, st) = jsE inner (e, st)
-                    in
-                        (strcat [str "{_x:", e, str "}"], st)
-                    end
-                  | ERecord ((x, e, _) :: xes) =>
-                    let
-                        val (e, st) = jsE inner (e, st)
-
-                        val (es, st) =
-                            foldr (fn ((x, e, _), (es, st)) =>
-                                      let
-                                          val (e, st) = jsE inner (e, st)
-                                      in
-                                          (str (",_" ^ x ^ ":")
-                                           :: e
-                                           :: es,
-                                           st)
-                                      end)
-                                  ([str "}"], st) xes
-                    in
-                        (strcat (str ("{_" ^ x ^ ":")
-                                 :: e
-                                 :: es),
-                         st)
-                    end
-                  | EField (e, x) =>
-                    let
-                        val (e, st) = jsE inner (e, st)
-                    in
-                        (strcat [e,
-                                 str ("._" ^ x)], st)
-                    end
-
-                  | ECase (e, pes, _) =>
-                    let
-                        val plen = length pes
-
-                        val (cases, st) = ListUtil.foldliMap
-                                              (fn (i, (p, e), st) =>
-                                                  let
-                                                      val (e, st) = jsE (inner + E.patBindsN p) (e, st)
-                                                      val fail =
-                                                          if i = plen - 1 then
-                                                              str "pf()"
-                                                          else
-                                                              str ("c" ^ Int.toString (i+1) ^ "()")
-                                                      val c = jsPat 0 inner p e fail
-                                                  in
-                                                      (strcat [str ("c" ^ Int.toString i ^ "=function(){return "),
-                                                               c,
-                                                               str "},"],
-                                                       st)
-                                                  end)
-                                              st pes
-
-                        val (e, st) = jsE inner (e, st)
-                    in
-                        (strcat (str "("
-                                 :: List.revAppend (cases,
-                                                    [str "d0=",
-                                                     e,
-                                                     str ",c0())"])), st)
-                    end
-
-                  | EStrcat (e1, e2) =>
-                    let
-                        val (e1, st) = jsE inner (e1, st)
-                        val (e2, st) = jsE inner (e2, st)
-                    in
-                        (strcat [str "(", e1, str "+", e2, str ")"], st)
-                    end
-
-                  | EError (e, _) =>
-                    let
-                        val (e, st) = jsE inner (e, st)
-                    in
-                        (strcat [str "alert(\"ERROR: \"+", e, str ")"],
-                         st)
-                    end
-
-                  | EWrite e =>
-                    let
-                        val (e, st) = jsE inner (e, st)
-                    in
-                        (strcat [str "document.write(",
-                                 e,
-                                 str ".v)"], st)
-                    end
-
-                  | ESeq (e1, e2) =>
-                    let
-                        val (e1, st) = jsE inner (e1, st)
-                        val (e2, st) = jsE inner (e2, st)
-                    in
-                        (strcat [str "(", e1, str ",", e2, str ")"], st)
-                    end
-                  | ELet (_, _, e1, e2) =>
-                    let
-                        val (e1, st) = jsE inner (e1, st)
-                        val (e2, st) = jsE (inner + 1) (e2, st)
-                    in
-                        (strcat [str ("(_" ^ Int.toString (len + inner) ^ "="),
-                                 e1,
-                                 str ",",
-                                 e2,
-                                 str ")"], st)
-                    end
-
-                  | EClosure _ => unsupported "EClosure"
-                  | EQuery _ => unsupported "Query"
-                  | EDml _ => unsupported "DML"
-                  | ENextval _ => unsupported "Nextval"
-                  | EUnurlify _ => unsupported "EUnurlify"
-                  | EJavaScript _ => unsupported "Nested JavaScript"
-                  | ESignalReturn e =>
-                    let
-                        val (e, st) = jsE inner (e, st)
-                    in
-                        (strcat [str "sr(",
-                                 e,
-                                 str ")"],
-                         st)
-                    end
-                  | ESignalBind (e1, e2) =>
-                    let
-                        val (e1, st) = jsE inner (e1, st)
-                        val (e2, st) = jsE inner (e2, st)
-                    in
-                        (strcat [str "sb(",
-                                 e1,
-                                 str ",",
-                                 e2,
-                                 str ")"],
-                         st)
-                    end
-                  | ESignalSource e =>
-                    let
-                        val (e, st) = jsE inner (e, st)
-                    in
-                        (strcat [str "ss(",
-                                 e,
-                                 str ")"],
-                         st)
-                    end
-            end
-    in
-        jsE
-    end
-
-val decl : state -> decl -> decl * state =
-    U.Decl.foldMapB {typ = fn x => x,
-                     exp = fn (env, e, st) =>
-                              let
-                                  fun doCode m skip env orig e =
-                                      let
-                                          val len = length env
-                                          fun str s = (EPrim (Prim.String s), #2 e)
-
-                                          val locals = List.tabulate
-                                                           (varDepth e,
-                                                         fn i => str ("var _" ^ Int.toString (len + i) ^ ";"))
-                                          val (e, st) = jsExp m skip env 0 (e, st)
-                                      in
-                                          (EJavaScript (m, orig, SOME (strcat (#2 e) (locals @ [e]))), st)
-                                      end
-                              in
-                                  case e of
-                                      EJavaScript (m, orig as (EAbs (_, t, _, e), _), _) => doCode m 1 (t :: env) orig e
-                                    | EJavaScript (m, e, _) => doCode m 0 env e e
-                                    | _ => (e, st)
-                              end,
-                     decl = fn (_, e, st) => (e, st),
-                     bind = fn (env, U.Decl.RelE (_, t)) => t :: env
-                             | (env, _) => env}
-                    []
-
-fun process file =
-    let
         fun doDecl (d, st) =
             let
                 val (d, st) = decl st d
             in
                 (List.revAppend (#decls st, [d]),
                  {decls = [],
-                  script = #script st})
+                  script = #script st,
+                  included = #included st})
             end
 
         val (ds, st) = ListUtil.foldlMapConcat doDecl
                        {decls = [],
-                        script = ""}
+                        script = [],
+                        included = IS.empty}
                        file
 
         val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.libJs, file = "urweb.js"})
@@ -556,7 +606,7 @@
         val lines = lines []
     in
         TextIO.closeIn inf;
-        (DJavaScript lines, ErrorMsg.dummySpan) :: ds
+        (DJavaScript (lines ^ String.concat (rev (#script st))), ErrorMsg.dummySpan) :: ds
     end
 
 end
--- a/tests/stypes.ur	Thu Jan 01 11:26:34 2009 -0500
+++ b/tests/stypes.ur	Thu Jan 01 11:58:00 2009 -0500
@@ -56,6 +56,7 @@
       <a onclick={set sColor White}>White</a>
       <a onclick={set sColor Blue}>Blue</a><br/>
 
-      <dyn signal={ls <- signal sList; return <xml>{[isNil ls]}</xml>}/>
+      <dyn signal={ls <- signal sList; return <xml>{[isNil ls]}</xml>}/>;
+      <dyn signal={ls <- signal sList; return <xml>{delist ls}</xml>}/>
       <a onclick={set sList (Cons ("A", Cons ("B", Nil)))}>Change</a><br/>
     </body></xml>