From 555b6a066f6a4a2396ead20e673b363c3706e713 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Sat, 6 Jun 2009 15:29:34 -0400
Subject: Fix unbound name problem in Jscomp injectors; more List stuff

---
 lib/ur/list.ur  | 11 +++++++++++
 lib/ur/list.urs |  3 +++
 src/jscomp.sml  | 17 +++++++++++------
 3 files changed, 25 insertions(+), 6 deletions(-)

diff --git a/lib/ur/list.ur b/lib/ur/list.ur
index 0aae9010..89dc8bbd 100644
--- a/lib/ur/list.ur
+++ b/lib/ur/list.ur
@@ -150,3 +150,14 @@ fun search [a] [b] f =
         search'
     end
 
+fun foldlM [m] (_ : monad m) [a] [b] f =
+    let
+        fun foldlM' acc ls =
+            case ls of
+                [] => return acc
+              | x :: ls =>
+                acc <- f x acc;
+                foldlM' acc ls
+    in
+        foldlM'
+    end
diff --git a/lib/ur/list.urs b/lib/ur/list.urs
index 1b80a9d3..89e7eecb 100644
--- a/lib/ur/list.urs
+++ b/lib/ur/list.urs
@@ -24,6 +24,9 @@ val filter : a ::: Type -> (a -> bool) -> t a -> t a
 
 val exists : a ::: Type -> (a -> bool) -> t a -> bool
 
+val foldlM : m ::: (Type -> Type) -> monad m -> a ::: Type -> b ::: Type
+             -> (a -> b -> m b) -> b -> t a -> m b
+
 val foldlMap : a ::: Type -> b ::: Type -> c ::: Type
                -> (a -> b -> c * b) -> b -> t a -> t c * b
 
diff --git a/src/jscomp.sml b/src/jscomp.sml
index 0178888a..b66cdaf2 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -42,7 +42,7 @@ structure TM = BinaryMapFn(struct
                            end)
 
 type state = {
-     decls : decl list,
+     decls : (string * int * (string * int * typ option) list) list,
      script : string list,
      included : IS.set,
      injectors : int IM.map,
@@ -301,8 +301,8 @@ fun process file =
                                             {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,
+                         val st = {decls = ("jsify", n', (TFun (t, s), loc),
+                                            body, "jsify") :: #decls st,
                                    script = #script st,
                                    included = #included st,
                                    injectors = #injectors st,
@@ -362,8 +362,8 @@ fun process file =
                                             {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,
+                         val st = {decls = ("jsify", n', (TFun (t, s), loc),
+                                            body, "jsify") :: #decls st,
                                    script = #script st,
                                    included = #included st,
                                    injectors = #injectors st,
@@ -1337,8 +1337,13 @@ fun process file =
             let
                 (*val () = Print.preface ("doDecl", MonoPrint.p_decl MonoEnv.empty d)*)
                 val (d, st) = decl (d, st)
+
+                val ds =
+                    case #decls st of
+                        [] => [d]
+                      | vis => [(DValRec vis, #2 d), d]
             in
-                (List.revAppend (#decls st, [d]),
+                (ds,
                  {decls = [],
                   script = #script st,
                   included = #included st,
-- 
cgit v1.2.3