Mercurial > urweb
changeset 1057:eaba663fd6aa
Represent FFI function names as strings, to deal with cross-file recursion
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sat, 05 Dec 2009 14:01:34 -0500 |
| parents | c42bfbd75ca9 |
| children | 86b831978b8d |
| files | lib/js/urweb.js lib/ur/list.ur lib/ur/list.urs lib/ur/string.ur lib/ur/string.urs src/compiler.sml src/jscomp.sml src/settings.sml |
| diffstat | 8 files changed, 46 insertions(+), 27 deletions(-) [+] |
line wrap: on
line diff
--- a/lib/js/urweb.js Thu Dec 03 14:32:47 2009 -0500 +++ b/lib/js/urweb.js Sat Dec 05 14:01:34 2009 -0500 @@ -505,6 +505,7 @@ function ts(x) { return x.toString() } function bs(b) { return (b ? "True" : "False") } +function id(x) { return x; } function sub(s, i) { return s.charAt(i); } function suf(s, i) { return s.substring(i); } function slen(s) { return s.length; } @@ -1049,10 +1050,10 @@ break; case "f": if (e.a == null) - e = {c: "c", v: e.f()}; + e = {c: "c", v: (eval(e.f))()}; else { var args = []; - stack = cons({c: "f", f: e.f, args: args, pos: 0, a: e.a.next}, stack); + stack = cons({c: "f", f: eval(e.f), args: args, pos: 0, a: e.a.next}, stack); if (!e.a.data.c) alert("[2] fr.f = " + e.f + "; 0 = " + e.a.data); e = e.a.data; }
--- a/lib/ur/list.ur Thu Dec 03 14:32:47 2009 -0500 +++ b/lib/ur/list.ur Sat Dec 05 14:01:34 2009 -0500 @@ -21,7 +21,7 @@ mkEq eq' end -fun foldl [a] [b] f = +fun foldl [a] [b] (f : a -> b -> b) = let fun foldl' acc ls = case ls of @@ -31,6 +31,18 @@ foldl' end +val rev = fn [a] => + let + fun rev' acc (ls : list a) = + case ls of + [] => acc + | x :: ls => rev' (x :: acc) ls + in + rev' [] + end + +fun foldr [a] [b] f (acc : b) (ls : list a) = foldl f acc (rev ls) + fun foldlAbort [a] [b] f = let fun foldlAbort' acc ls = @@ -54,16 +66,6 @@ length' 0 end -val rev = fn [a] => - let - fun rev' acc (ls : list a) = - case ls of - [] => acc - | x :: ls => rev' (x :: acc) ls - in - rev' [] - end - fun foldlMapAbort [a] [b] [c] f = let fun foldlMapAbort' ls' acc ls =
--- a/lib/ur/list.urs Thu Dec 03 14:32:47 2009 -0500 +++ b/lib/ur/list.urs Sat Dec 05 14:01:34 2009 -0500 @@ -8,6 +8,8 @@ val foldlMapAbort : a ::: Type -> b ::: Type -> c ::: Type -> (a -> b -> option (c * b)) -> b -> t a -> option (t c * b) +val foldr : a ::: Type -> b ::: Type -> (a -> b -> b) -> b -> t a -> b + val length : a ::: Type -> t a -> int val rev : a ::: Type -> t a -> t a
--- a/lib/ur/string.ur Thu Dec 03 14:32:47 2009 -0500 +++ b/lib/ur/string.ur Sat Dec 05 14:01:34 2009 -0500 @@ -26,3 +26,14 @@ | Some i => Some (substring s {Start = 0, Len = i}, sub s i, substring s {Start = i + 1, Len = length s - i - 1}) + +fun all f s = + let + val len = length s + + fun al i = + i >= len + || (f (sub s i) && al (i + 1)) + in + al 0 + end
--- a/lib/ur/string.urs Thu Dec 03 14:32:47 2009 -0500 +++ b/lib/ur/string.urs Sat Dec 05 14:01:34 2009 -0500 @@ -18,3 +18,5 @@ val split : t -> char -> option (string * string) val msplit : {Haystack : t, Needle : t} -> option (string * char * string) + +val all : (char -> bool) -> string -> bool
--- a/src/compiler.sml Thu Dec 03 14:32:47 2009 -0500 +++ b/src/compiler.sml Sat Dec 05 14:01:34 2009 -0500 @@ -421,7 +421,7 @@ dbms = mergeO #2 (#dbms old, #dbms new) } in - foldr (fn (fname, job) => merge (job, pu fname)) job (!libs) + foldr (fn (job', job) => merge (job, job')) job (!libs) end fun parsePkind s = @@ -551,7 +551,7 @@ fkind := {action = Settings.Deny, kind = kind, pattern = pattern} :: !fkind end | _ => ErrorMsg.error "Bad 'deny' syntax") - | "library" => libs := relify arg :: !libs + | "library" => libs := pu (relify arg) :: !libs | "path" => (case String.fields (fn ch => ch = #"=") arg of [n, v] => pathmap := M.insert (!pathmap, n, v)
--- a/src/jscomp.sml Thu Dec 03 14:32:47 2009 -0500 +++ b/src/jscomp.sml Sat Dec 05 14:01:34 2009 -0500 @@ -657,7 +657,7 @@ end) (str "null", st) args in - (strcat [str ("{c:\"f\",f:" ^ name ^ ",a:"), + (strcat [str ("{c:\"f\",f:\"" ^ name ^ "\",a:"), e, str "}"], st) @@ -692,7 +692,7 @@ val (e, st) = jsE inner (e, st) in - (strcat [str ("{c:\"f\",f:" ^ name ^ ",a:cons("), + (strcat [str ("{c:\"f\",f:\"" ^ name ^ "\",a:cons("), e, str ",null)}"], st) @@ -715,7 +715,7 @@ val (e1, st) = jsE inner (e1, st) val (e2, st) = jsE inner (e2, st) in - (strcat [str ("{c:\"f\",f:" ^ name ^ ",a:cons("), + (strcat [str ("{c:\"f\",f:\"" ^ name ^ "\",a:cons("), e1, str ",cons(", e2, @@ -819,14 +819,14 @@ val (e1, st) = jsE inner (e1, st) val (e2, st) = jsE inner (e2, st) in - (strcat [str "{c:\"f\",f:cat,a:cons(", e1, str ",cons(", e2, str ",null))}"], st) + (strcat [str "{c:\"f\",f:\"cat\",a:cons(", e1, str ",cons(", e2, str ",null))}"], st) end | EError (e, _) => let val (e, st) = jsE inner (e, st) in - (strcat [str "{c:\"f\",f:er,a:cons(", e, str ",null)}"], + (strcat [str "{c:\"f\",f:\"er\",a:cons(", e, str ",null)}"], st) end @@ -875,7 +875,7 @@ let val (e, st) = jsE inner (e, st) in - (strcat [str "{c:\"f\",f:sr,a:cons(", + (strcat [str "{c:\"f\",f:\"sr\",a:cons(", e, str ",null)}"], st) @@ -885,7 +885,7 @@ val (e1, st) = jsE inner (e1, st) val (e2, st) = jsE inner (e2, st) in - (strcat [str "{c:\"f\",f:sb,a:cons(", + (strcat [str "{c:\"f\",f:\"sb\",a:cons(", e1, str ",cons(", e2, @@ -896,7 +896,7 @@ let val (e, st) = jsE inner (e, st) in - (strcat [str "{c:\"f\",f:ss,a:cons(", + (strcat [str "{c:\"f\",f:\"ss\",a:cons(", e, str ",null)}"], st) @@ -907,7 +907,7 @@ val (e, st) = jsE inner (e, st) val (unurl, st) = unurlifyExp loc (t, st) in - (strcat [str ("{c:\"f\",f:rc,a:cons({c:\"c\",v:\"" + (strcat [str ("{c:\"f\",f:\"rc\",a:cons({c:\"c\",v:\"" ^ Settings.getUrlPrefix () ^ "\"},cons("), e, @@ -925,7 +925,7 @@ val (e, st) = jsE inner (e, st) val (unurl, st) = unurlifyExp loc (t, st) in - (strcat [str ("{c:\"f\",f:rv,a:cons("), + (strcat [str ("{c:\"f\",f:\"rv\",a:cons("), e, str (",cons({c:\"c\",v:function(s){var t=s.split(\"/\");var i=0;return " ^ unurl ^ "}},cons({c:\"K\"},null)))}")], @@ -936,7 +936,7 @@ let val (e, st) = jsE inner (e, st) in - (strcat [str "{c:\"f\",f:sl,a:cons(", + (strcat [str "{c:\"f\",f:\"sl\",a:cons(", e, str ",cons({c:\"K\"},null))}"], st) @@ -946,7 +946,7 @@ let val (e, st) = jsE inner (e, st) in - (strcat [str "{c:\"f\",f:sp,a:cons(", + (strcat [str "{c:\"f\",f:\"sp\",a:cons(", e, str ",null)}"], st)