summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-06-06 15:29:34 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-06-06 15:29:34 -0400
commit555b6a066f6a4a2396ead20e673b363c3706e713 (patch)
tree7fa1f1bba387c1d98289cf2bb1fd8fdd717bb55f
parent4d4d6e4aea6565fa167296d16f94f4b768d5414e (diff)
Fix unbound name problem in Jscomp injectors; more List stuff
-rw-r--r--lib/ur/list.ur11
-rw-r--r--lib/ur/list.urs3
-rw-r--r--src/jscomp.sml17
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,