aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/js/urweb.js5
-rw-r--r--lib/ur/list.ur24
-rw-r--r--lib/ur/list.urs2
-rw-r--r--lib/ur/string.ur11
-rw-r--r--lib/ur/string.urs2
-rw-r--r--src/compiler.sml4
-rw-r--r--src/jscomp.sml24
-rw-r--r--src/settings.sml1
8 files changed, 46 insertions, 27 deletions
diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index 98b615c0..863271d9 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -505,6 +505,7 @@ function eh(x) {
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 @@ function exec1(env, stack, e) {
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;
}
diff --git a/lib/ur/list.ur b/lib/ur/list.ur
index 58f9e23e..3abd8b97 100644
--- a/lib/ur/list.ur
+++ b/lib/ur/list.ur
@@ -21,7 +21,7 @@ val eq = fn [a] (_ : eq a) =>
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 @@ fun foldl [a] [b] f =
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 @@ val length = fn [a] =>
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 =
diff --git a/lib/ur/list.urs b/lib/ur/list.urs
index df1c8a52..5f3fad9c 100644
--- a/lib/ur/list.urs
+++ b/lib/ur/list.urs
@@ -8,6 +8,8 @@ val foldlAbort : a ::: Type -> b ::: Type -> (a -> b -> option b) -> b -> t a ->
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
diff --git a/lib/ur/string.ur b/lib/ur/string.ur
index fb5a3f97..41ec666d 100644
--- a/lib/ur/string.ur
+++ b/lib/ur/string.ur
@@ -26,3 +26,14 @@ fun msplit {Haystack = s, Needle = chs} =
| 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
diff --git a/lib/ur/string.urs b/lib/ur/string.urs
index 1b584c08..fda30ad9 100644
--- a/lib/ur/string.urs
+++ b/lib/ur/string.urs
@@ -18,3 +18,5 @@ val substring : t -> {Start : int, Len : int} -> string
val split : t -> char -> option (string * string)
val msplit : {Haystack : t, Needle : t} -> option (string * char * string)
+
+val all : (char -> bool) -> string -> bool
diff --git a/src/compiler.sml b/src/compiler.sml
index dcb5fdad..0d61b361 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -421,7 +421,7 @@ fun parseUrp' fname =
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 @@ fun parseUrp' fname =
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)
diff --git a/src/jscomp.sml b/src/jscomp.sml
index 8b946b39..4be870cb 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -657,7 +657,7 @@ fun process file =
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 @@ fun process file =
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 @@ fun process file =
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 @@ fun process file =
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 @@ fun process file =
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 @@ fun process file =
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 @@ fun process file =
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 @@ fun process file =
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 @@ fun process file =
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 @@ fun process file =
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 @@ fun process file =
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)
diff --git a/src/settings.sml b/src/settings.sml
index 009e2b0a..4b226a7b 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -160,6 +160,7 @@ val jsFuncsBase = basisM [("alert", "alert"),
("attrifyFloat", "ts"),
("attrifyBool", "bs"),
("boolToString", "ts"),
+ ("str1", "id"),
("strsub", "sub"),
("strsuffix", "suf"),
("strlen", "slen"),
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-20 12:38:46 +0000