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)
--- a/src/settings.sml	Thu Dec 03 14:32:47 2009 -0500
+++ b/src/settings.sml	Sat Dec 05 14:01:34 2009 -0500
@@ -160,6 +160,7 @@
                           ("attrifyFloat", "ts"),
                           ("attrifyBool", "bs"),
                           ("boolToString", "ts"),
+                          ("str1", "id"),
                           ("strsub", "sub"),
                           ("strsuffix", "suf"),
                           ("strlen", "slen"),