Mercurial > urweb
changeset 850:1c2f335297b7
Fix a variable capture bug in nested JavaScript; some more list stuff
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Tue, 16 Jun 2009 17:52:44 -0400 |
| parents | e571fb150a9f |
| children | 20a364c4a6dc |
| files | lib/ur/list.ur lib/ur/list.urs lib/ur/listPair.ur lib/ur/listPair.urs src/elab_err.sml src/jscomp.sml |
| diffstat | 6 files changed, 37 insertions(+), 16 deletions(-) [+] |
line wrap: on
line diff
--- a/lib/ur/list.ur Tue Jun 16 14:38:01 2009 -0400 +++ b/lib/ur/list.ur Tue Jun 16 17:52:44 2009 -0400 @@ -31,17 +31,17 @@ foldl' end -fun foldlPartial [a] [b] f = +fun foldlAbort [a] [b] f = let - fun foldlPartial' acc ls = + fun foldlAbort' acc ls = case ls of [] => Some acc | x :: ls => case f x acc of None => None - | Some acc' => foldlPartial' acc' ls + | Some acc' => foldlAbort' acc' ls in - foldlPartial' + foldlAbort' end val rev = fn [a] => @@ -54,6 +54,19 @@ rev' [] end +fun foldlMapAbort [a] [b] [c] f = + let + fun foldlMapAbort' ls' acc ls = + case ls of + [] => Some (rev ls', acc) + | x :: ls => + case f x acc of + None => None + | Some (x', acc') => foldlMapAbort' (x' :: ls') acc' ls + in + foldlMapAbort' [] + end + val revAppend = fn [a] => let fun ra (ls : list a) acc =
--- a/lib/ur/list.urs Tue Jun 16 14:38:01 2009 -0400 +++ b/lib/ur/list.urs Tue Jun 16 17:52:44 2009 -0400 @@ -4,7 +4,9 @@ val eq : a ::: Type -> eq a -> eq (t a) val foldl : a ::: Type -> b ::: Type -> (a -> b -> b) -> b -> t a -> b -val foldlPartial : a ::: Type -> b ::: Type -> (a -> b -> option b) -> b -> t a -> option b +val foldlAbort : a ::: Type -> b ::: Type -> (a -> b -> option b) -> b -> t a -> option b +val foldlMapAbort : a ::: Type -> b ::: Type -> c ::: Type + -> (a -> b -> option (c * b)) -> b -> t a -> option (t c * b) val rev : a ::: Type -> t a -> t a
--- a/lib/ur/listPair.ur Tue Jun 16 14:38:01 2009 -0400 +++ b/lib/ur/listPair.ur Tue Jun 16 17:52:44 2009 -0400 @@ -1,15 +1,15 @@ -fun foldlPartial [a] [b] [c] f = +fun foldlAbort [a] [b] [c] f = let - fun foldlPartial' acc ls1 ls2 = + fun foldlAbort' acc ls1 ls2 = case (ls1, ls2) of ([], []) => Some acc | (x1 :: ls1, x2 :: ls2) => (case f x1 x2 acc of None => None - | Some acc' => foldlPartial' acc' ls1 ls2) + | Some acc' => foldlAbort' acc' ls1 ls2) | _ => None in - foldlPartial' + foldlAbort' end fun mapX [a] [b] [ctx ::: {Unit}] f =
--- a/lib/ur/listPair.urs Tue Jun 16 14:38:01 2009 -0400 +++ b/lib/ur/listPair.urs Tue Jun 16 17:52:44 2009 -0400 @@ -1,5 +1,5 @@ -val foldlPartial : a ::: Type -> b ::: Type -> c ::: Type - -> (a -> b -> c -> option c) -> c -> list a -> list b -> option c +val foldlAbort : a ::: Type -> b ::: Type -> c ::: Type + -> (a -> b -> c -> option c) -> c -> list a -> list b -> option c val mapX : a ::: Type -> b ::: Type -> ctx ::: {Unit} -> (a -> b -> xml ctx [] []) -> list a -> list b -> xml ctx [] []
--- a/src/elab_err.sml Tue Jun 16 14:38:01 2009 -0400 +++ b/src/elab_err.sml Tue Jun 16 17:52:44 2009 -0400 @@ -218,7 +218,7 @@ ("Type", p_con env c)]) co) | Unresolvable (loc, c) => (ErrorMsg.errorAt loc "Can't resolve type class instance"; - eprefaces' [("Class constraint", p_con env c), + eprefaces' [("Class constraint", p_con env c)(*, ("Class database", p_list (fn (c, rules) => box [P.p_con env c, PD.string ":", @@ -228,7 +228,7 @@ PD.string ":", space, P.p_con env c]) rules]) - (E.listClasses env))]) + (E.listClasses env))*)]) | IllegalRec (x, e) => (ErrorMsg.errorAt (#2 e) "Illegal 'val rec' righthand side (must be a function abstraction)"; eprefaces' [("Variable", PD.string x),
--- a/src/jscomp.sml Tue Jun 16 14:38:01 2009 -0400 +++ b/src/jscomp.sml Tue Jun 16 17:52:44 2009 -0400 @@ -980,12 +980,18 @@ jsE inner (e, st)) | EJavaScript (_, e) => let + val locals = List.tabulate + (varDepth e, + fn i => str ("var _" ^ Int.toString (len + inner + i) ^ ";")) + val (e, st) = jsE inner (e, st) in foundJavaScript := true; - (strcat [str "cs(function(){return ", - compact inner e, - str "})"], + (strcat (str "cs(function(){" + :: locals + @ [str "return ", + compact inner e, + str "})"]), st) end