summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--include/urweb.h3
-rw-r--r--lib/js/urweb.js2
-rw-r--r--lib/ur/basis.urs5
-rw-r--r--lib/ur/top.ur7
-rw-r--r--lib/ur/top.urs2
-rw-r--r--src/c/urweb.c34
-rw-r--r--src/cjr_print.sml4
-rw-r--r--src/cjrize.sml2
-rw-r--r--src/iflow.sml4
-rw-r--r--src/jscomp.sml11
-rw-r--r--src/mono.sml4
-rw-r--r--src/mono_opt.sml2
-rw-r--r--src/mono_print.sml10
-rw-r--r--src/mono_reduce.sml18
-rw-r--r--src/mono_util.sml4
-rw-r--r--src/monoize.sml30
-rw-r--r--src/settings.sml1
-rw-r--r--src/urweb.grm4
18 files changed, 108 insertions, 39 deletions
diff --git a/include/urweb.h b/include/urweb.h
index 548e77fe..c52e1c26 100644
--- a/include/urweb.h
+++ b/include/urweb.h
@@ -169,6 +169,7 @@ char *uw_Basis_ensqlBool(uw_Basis_bool);
char *uw_Basis_jsifyString(uw_context, uw_Basis_string);
char *uw_Basis_jsifyChar(uw_context, uw_Basis_char);
char *uw_Basis_jsifyChannel(uw_context, uw_Basis_channel);
+char *uw_Basis_jsifyTime(uw_context, uw_Basis_time);
uw_Basis_string uw_Basis_intToString(uw_context, uw_Basis_int);
uw_Basis_string uw_Basis_floatToString(uw_context, uw_Basis_float);
@@ -301,4 +302,6 @@ uw_Basis_string uw_Basis_timef(uw_context, const char *fmt, uw_Basis_time);
uw_Basis_time uw_Basis_stringToTimef(uw_context, const char *fmt, uw_Basis_string);
uw_Basis_time uw_Basis_stringToTimef_error(uw_context, const char *fmt, uw_Basis_string);
+uw_Basis_string uw_Basis_crypt(uw_context, uw_Basis_string key, uw_Basis_string salt);
+
#endif
diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index f98476b7..bba58453 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -19,7 +19,9 @@ function plus(x, y) { return x + y; }
function minus(x, y) { return x - y; }
function times(x, y) { return x * y; }
function div(x, y) { return x / y; }
+function divInt(x, y) { var n = x / y; return n < 0 ? Math.ceil(n) : Math.floor(n); }
function mod(x, y) { return x % y; }
+function modInt(x, y) { var n = x % y; return n < 0 ? Math.ceil(n) : Math.floor(n); }
function lt(x, y) { return x < y; }
function le(x, y) { return x <= y; }
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 8cf516f8..95deb982 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -146,6 +146,11 @@ val minusSeconds : time -> int -> time
val timef : string -> time -> string (* Uses strftime() format string *)
+(** * Encryption *)
+
+val crypt : string -> string -> string
+
+
(** HTTP operations *)
con http_cookie :: Type -> Type
diff --git a/lib/ur/top.ur b/lib/ur/top.ur
index 32d06a43..19259e92 100644
--- a/lib/ur/top.ur
+++ b/lib/ur/top.ur
@@ -89,7 +89,7 @@ fun read_option [t ::: Type] (_ : read t) =
None => None
| v => Some v)
-fun txt [t] [ctx ::: {Unit}] [use ::: {Type}] (_ : show t) (v : t) =
+fun txt [t] [ctx ::: {Unit}] [use ::: {Type}] (_ : show t) (v : t) : xml ctx use [] =
cdata (show v)
fun map0 [K] [tf :: K -> Type] (f : t :: K -> tf t) [r ::: {K}] (fl : folder r) =
@@ -343,3 +343,8 @@ fun eqNullable' [tables ::: {{Type}}] [agg ::: {{Type}}] [exps ::: {Type}]
case e2 of
None => (SQL {e1} IS NULL)
| Some _ => sql_binary sql_eq e1 (sql_inject e2)
+
+fun mkRead' [t ::: Type] (f : string -> option t) (name : string) : read t =
+ mkRead (fn s => case f s of
+ None => error <xml>Invalid {txt name}: {txt s}</xml>
+ | Some v => v) f
diff --git a/lib/ur/top.urs b/lib/ur/top.urs
index a18bf437..74b04ed1 100644
--- a/lib/ur/top.urs
+++ b/lib/ur/top.urs
@@ -231,3 +231,5 @@ val eqNullable' : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
-> sql_exp tables agg exps (option t)
-> option t
-> sql_exp tables agg exps bool
+
+val mkRead' : t ::: Type -> (string -> option t) -> string -> read t
diff --git a/src/c/urweb.c b/src/c/urweb.c
index a09978cd..efe50591 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -13,6 +13,7 @@
#include <stdint.h>
#include <sys/types.h>
#include <sys/socket.h>
+#include <crypt.h>
#include <pthread.h>
@@ -2006,6 +2007,27 @@ uw_unit uw_Basis_htmlifyFloat_w(uw_context ctx, uw_Basis_float n) {
return uw_unit_v;
}
+char *uw_Basis_jsifyTime(uw_context ctx, uw_Basis_time n) {
+ int len;
+ char *r;
+
+ uw_check_heap(ctx, INTS_MAX);
+ r = ctx->heap.front;
+ sprintf(r, "%lld%n", (uw_Basis_int)n, &len);
+ ctx->heap.front += len+1;
+ return r;
+}
+
+uw_unit uw_Basis_jsifyInt_w(uw_context ctx, uw_Basis_time n) {
+ int len;
+
+ uw_check(ctx, INTS_MAX);
+ sprintf(ctx->page.front, "%lld%n", (uw_Basis_int)n, &len);
+ ctx->page.front += len;
+
+ return uw_unit_v;
+}
+
char *uw_Basis_htmlifyString(uw_context ctx, uw_Basis_string s) {
char *r, *s2;
@@ -3568,3 +3590,15 @@ failure_kind uw_runCallback(uw_context ctx, void (*callback)(uw_context)) {
return r;
}
+
+uw_Basis_string uw_Basis_crypt(uw_context ctx, uw_Basis_string key, uw_Basis_string salt) {
+ struct crypt_data *data;
+
+ if ((data = uw_get_global(ctx, "crypt")) == NULL) {
+ data = malloc(sizeof(struct crypt_data));
+ data->initialized = 0;
+ uw_set_global(ctx, "crypt", data, free);
+ }
+
+ return uw_strdup(ctx, crypt_r(key, salt, data));
+}
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index b4f75eb5..53060ab2 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -635,7 +635,9 @@ fun unurlify fromClient env (t, loc) =
string (Int.toString (size x')),
string "] == 0 || request[",
string (Int.toString (size x')),
- string ("] == '/')) ? __uwc_" ^ ident x' ^ "_" ^ Int.toString n),
+ string "] == '/')) ? (request += ",
+ string (Int.toString (size x')),
+ string (", (*request == '/' ? ++request : NULL), __uwc_" ^ ident x' ^ "_" ^ Int.toString n ^ ")"),
space,
string ":",
space,
diff --git a/src/cjrize.sml b/src/cjrize.sml
index 9c297fad..2c13e494 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -300,7 +300,7 @@ fun cifyExp (eAll as (e, loc), sm) =
in
((L'.EUnop (s, e1), loc), sm)
end
- | L.EBinop (s, e1, e2) =>
+ | L.EBinop (_, s, e1, e2) =>
let
val (e1, sm) = cifyExp (e1, sm)
val (e2, sm) = cifyExp (e2, sm)
diff --git a/src/iflow.sml b/src/iflow.sml
index c0e92cb1..f6e03271 100644
--- a/src/iflow.sml
+++ b/src/iflow.sml
@@ -1965,7 +1965,7 @@ fun evalExp env (e as (_, loc)) k =
| EAbs _ => default ()
| EUnop (s, e1) => evalExp env e1 (fn e1 => k (Func (Other s, [e1])))
- | EBinop (s, e1, e2) => evalExp env e1 (fn e1 => evalExp env e2 (fn e2 => k (Func (Other s, [e1, e2]))))
+ | EBinop (_, s, e1, e2) => evalExp env e1 (fn e1 => evalExp env e2 (fn e2 => k (Func (Other s, [e1, e2]))))
| ERecord xets =>
let
fun doFields (xes, acc) =
@@ -2352,7 +2352,7 @@ fun check file =
end
| EAbs (x, t1, t2, e) => (EAbs (x, t1, t2, doExp (Unknown :: env) e), loc)
| EUnop (uo, e1) => (EUnop (uo, doExp env e1), loc)
- | EBinop (bo, e1, e2) => (EBinop (bo, doExp env e1, doExp env e2), loc)
+ | EBinop (bi, bo, e1, e2) => (EBinop (bi, bo, doExp env e1, doExp env e2), loc)
| ERecord xets => (ERecord (map (fn (x, e, t) => (x, doExp env e, t)) xets), loc)
| EField (e1, f) => (EField (doExp env e1, f), loc)
| ECase (e, pes, ts) =>
diff --git a/src/jscomp.sml b/src/jscomp.sml
index 992a2e30..3b859814 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -126,6 +126,7 @@ fun process file =
| TFfi ("Basis", "int") => ((EFfiApp ("Basis", "htmlifyInt", [e]), loc), st)
| TFfi ("Basis", "float") => ((EFfiApp ("Basis", "htmlifyFloat", [e]), loc), st)
| TFfi ("Basis", "channel") => ((EFfiApp ("Basis", "jsifyChannel", [e]), loc), st)
+ | TFfi ("Basis", "time") => ((EFfiApp ("Basis", "jsifyTime", [e]), loc), st)
| TFfi ("Basis", "bool") => ((ECase (e,
[((PCon (Enum, PConFfi {mod = "Basis",
@@ -701,7 +702,7 @@ fun process file =
str ",null)}"],
st)
end
- | EBinop (s, e1, e2) =>
+ | EBinop (bi, s, e1, e2) =>
let
val name = case s of
"==" => "eq"
@@ -709,8 +710,8 @@ fun process file =
| "+" => "plus"
| "-" => "minus"
| "*" => "times"
- | "/" => "div"
- | "%" => "mod"
+ | "/" => (case bi of Int => "divInt" | NotInt => "div")
+ | "%" => (case bi of Int => "modInt" | NotInt => "mod")
| "<" => "lt"
| "<=" => "le"
| "strcmp" => "strcmp"
@@ -1039,12 +1040,12 @@ fun process file =
in
((EUnop (s, e), loc), st)
end
- | EBinop (s, e1, e2) =>
+ | EBinop (bi, s, e1, e2) =>
let
val (e1, st) = exp outer (e1, st)
val (e2, st) = exp outer (e2, st)
in
- ((EBinop (s, e1, e2), loc), st)
+ ((EBinop (bi, s, e1, e2), loc), st)
end
| ERecord xets =>
diff --git a/src/mono.sml b/src/mono.sml
index 1d446dda..bf38c0bc 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -68,6 +68,8 @@ datatype export_kind = datatype Export.export_kind
datatype failure_mode = datatype Settings.failure_mode
+datatype binop_intness = Int | NotInt
+
datatype exp' =
EPrim of Prim.t
| ERel of int
@@ -81,7 +83,7 @@ datatype exp' =
| EAbs of string * typ * typ * exp
| EUnop of string * exp
- | EBinop of string * exp * exp
+ | EBinop of binop_intness * string * exp * exp
| ERecord of (string * exp * typ) list
| EField of exp * string
diff --git a/src/mono_opt.sml b/src/mono_opt.sml
index 34f43143..d05e38fd 100644
--- a/src/mono_opt.sml
+++ b/src/mono_opt.sml
@@ -536,7 +536,7 @@ fun exp e =
| EFfiApp ("Basis", "attrifyString_w", [(EFfiApp ("Basis", "str1", [e]), _)]) =>
EFfiApp ("Basis", "attrifyChar_w", [e])
- | EBinop ("+", (EPrim (Prim.Int n1), _), (EPrim (Prim.Int n2), _)) => EPrim (Prim.Int (Int64.+ (n1, n2)))
+ | EBinop (_, "+", (EPrim (Prim.Int n1), _), (EPrim (Prim.Int n2), _)) => EPrim (Prim.Int (Int64.+ (n1, n2)))
| _ => e
diff --git a/src/mono_print.sml b/src/mono_print.sml
index 63c98f44..2d296745 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -187,11 +187,11 @@ fun p_exp' par env (e, _) =
| EUnop (s, e) => parenIf true (box [string s,
space,
p_exp' true env e])
- | EBinop (s, e1, e2) => parenIf true (box [p_exp' true env e1,
- space,
- string s,
- space,
- p_exp' true env e2])
+ | EBinop (_, s, e1, e2) => parenIf true (box [p_exp' true env e1,
+ space,
+ string s,
+ space,
+ p_exp' true env e2])
| ERecord xes => box [string "{",
p_list (fn (x, e, _) =>
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 59ec5a55..f8b209d5 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -92,7 +92,7 @@ fun impure (e, _) =
| EApp _ => true
| EUnop (_, e) => impure e
- | EBinop (_, e1, e2) => impure e1 orelse impure e2
+ | EBinop (_, _, e1, e2) => impure e1 orelse impure e2
| ERecord xes => List.exists (fn (_, e, _) => impure e) xes
| EField (e, _) => impure e
@@ -365,11 +365,21 @@ fun reduce file =
val size = U.Exp.fold {typ = fn (_, n) => n,
exp = fn (_, n) => n + 1} 0
- fun mayInline (n, e) =
+ val functionInside' = U.Typ.exists (fn c => case c of
+ TFun _ => true
+ | _ => false)
+
+ fun functionInside t =
+ case #1 t of
+ TFun (t1, t2) => functionInside' t1 orelse functionInside t2
+ | _ => functionInside' t
+
+ fun mayInline (n, e, t) =
case IM.find (uses, n) of
NONE => false
| SOME count => count <= 1
orelse size e <= Settings.getMonoInline ()
+ orelse functionInside t
fun summarize d (e, _) =
let
@@ -426,7 +436,7 @@ fun reduce file =
| EAbs _ => []
| EUnop (_, e) => summarize d e
- | EBinop (_, e1, e2) => summarize d e1 @ summarize d e2
+ | EBinop (_, _, e1, e2) => summarize d e1 @ summarize d e2
| ERecord xets => List.concat (map (summarize d o #2) xets)
| EField (e, _) => summarize d e
@@ -701,7 +711,7 @@ fun reduce file =
let
val eo = case eo of
NONE => NONE
- | SOME e => if mayInline (n, e) then
+ | SOME e => if mayInline (n, e, t) then
SOME e
else
NONE
diff --git a/src/mono_util.sml b/src/mono_util.sml
index 56472155..bb09f84d 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -200,12 +200,12 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
S.map2 (mfe ctx e,
fn e' =>
(EUnop (s, e'), loc))
- | EBinop (s, e1, e2) =>
+ | EBinop (bi, s, e1, e2) =>
S.bind2 (mfe ctx e1,
fn e1' =>
S.map2 (mfe ctx e2,
fn e2' =>
- (EBinop (s, e1', e2'), loc)))
+ (EBinop (bi, s, e1', e2'), loc)))
| ERecord xes =>
S.map2 (ListUtil.mapfold (fn (x, e, t) =>
diff --git a/src/monoize.sml b/src/monoize.sml
index 0c0d9d2e..35c6fa83 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -895,42 +895,42 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L'.TFun ((L'.TFfi ("Basis", "int"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
(L'.EAbs ("y", (L'.TFfi ("Basis", "int"), loc),
(L'.TFfi ("Basis", "bool"), loc),
- (L'.EBinop ("==", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
+ (L'.EBinop (L'.Int, "==", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
fm)
| L.EFfi ("Basis", "eq_float") =>
((L'.EAbs ("x", (L'.TFfi ("Basis", "float"), loc),
(L'.TFun ((L'.TFfi ("Basis", "float"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
(L'.EAbs ("y", (L'.TFfi ("Basis", "float"), loc),
(L'.TFfi ("Basis", "bool"), loc),
- (L'.EBinop ("==", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
+ (L'.EBinop (L'.NotInt, "==", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
fm)
| L.EFfi ("Basis", "eq_bool") =>
((L'.EAbs ("x", (L'.TFfi ("Basis", "bool"), loc),
(L'.TFun ((L'.TFfi ("Basis", "bool"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
(L'.EAbs ("y", (L'.TFfi ("Basis", "bool"), loc),
(L'.TFfi ("Basis", "bool"), loc),
- (L'.EBinop ("==", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
+ (L'.EBinop (L'.NotInt, "==", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
fm)
| L.EFfi ("Basis", "eq_string") =>
((L'.EAbs ("x", (L'.TFfi ("Basis", "string"), loc),
(L'.TFun ((L'.TFfi ("Basis", "string"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
(L'.EAbs ("y", (L'.TFfi ("Basis", "string"), loc),
(L'.TFfi ("Basis", "bool"), loc),
- (L'.EBinop ("!strcmp", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
+ (L'.EBinop (L'.NotInt, "!strcmp", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
fm)
| L.EFfi ("Basis", "eq_char") =>
((L'.EAbs ("x", (L'.TFfi ("Basis", "char"), loc),
(L'.TFun ((L'.TFfi ("Basis", "char"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
(L'.EAbs ("y", (L'.TFfi ("Basis", "char"), loc),
(L'.TFfi ("Basis", "bool"), loc),
- (L'.EBinop ("==", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
+ (L'.EBinop (L'.NotInt, "==", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
fm)
| L.EFfi ("Basis", "eq_time") =>
((L'.EAbs ("x", (L'.TFfi ("Basis", "time"), loc),
(L'.TFun ((L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
(L'.EAbs ("y", (L'.TFfi ("Basis", "time"), loc),
(L'.TFfi ("Basis", "bool"), loc),
- (L'.EBinop ("==", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
+ (L'.EBinop (L'.NotInt, "==", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
fm)
| L.ECApp ((L.EFfi ("Basis", "mkEq"), _), t) =>
@@ -999,7 +999,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L'.TFun ((L'.TFfi ("Basis", "int"), loc), (L'.TFfi ("Basis", "int"), loc)), loc),
(L'.EAbs ("y", (L'.TFfi ("Basis", "int"), loc),
(L'.TFfi ("Basis", "int"), loc),
- (L'.EBinop (s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
+ (L'.EBinop (L'.Int, s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
in
numEx ((L'.TFfi ("Basis", "int"), loc),
Prim.Int (Int64.fromInt 0),
@@ -1019,7 +1019,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L'.TFun ((L'.TFfi ("Basis", "float"), loc), (L'.TFfi ("Basis", "float"), loc)), loc),
(L'.EAbs ("y", (L'.TFfi ("Basis", "float"), loc),
(L'.TFfi ("Basis", "float"), loc),
- (L'.EBinop (s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
+ (L'.EBinop (L'.NotInt, s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
in
numEx ((L'.TFfi ("Basis", "float"), loc),
Prim.Float 0.0,
@@ -1086,7 +1086,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L'.TFun ((L'.TFfi ("Basis", "int"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
(L'.EAbs ("y", (L'.TFfi ("Basis", "int"), loc),
(L'.TFfi ("Basis", "bool"), loc),
- (L'.EBinop (s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
+ (L'.EBinop (L'.Int, s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
in
ordEx ((L'.TFfi ("Basis", "int"), loc),
intBin "<",
@@ -1099,7 +1099,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L'.TFun ((L'.TFfi ("Basis", "float"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
(L'.EAbs ("y", (L'.TFfi ("Basis", "float"), loc),
(L'.TFfi ("Basis", "bool"), loc),
- (L'.EBinop (s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
+ (L'.EBinop (L'.NotInt, s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
in
ordEx ((L'.TFfi ("Basis", "float"), loc),
floatBin "<",
@@ -1112,7 +1112,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L'.TFun ((L'.TFfi ("Basis", "bool"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
(L'.EAbs ("y", (L'.TFfi ("Basis", "bool"), loc),
(L'.TFfi ("Basis", "bool"), loc),
- (L'.EBinop (s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
+ (L'.EBinop (L'.NotInt, s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
in
ordEx ((L'.TFfi ("Basis", "bool"), loc),
boolBin "<",
@@ -1125,8 +1125,8 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L'.TFun ((L'.TFfi ("Basis", "string"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
(L'.EAbs ("y", (L'.TFfi ("Basis", "string"), loc),
(L'.TFfi ("Basis", "bool"), loc),
- (L'.EBinop (s,
- (L'.EBinop ("strcmp",
+ (L'.EBinop (L'.NotInt, s,
+ (L'.EBinop (L'.NotInt, "strcmp",
(L'.ERel 1, loc),
(L'.ERel 0, loc)), loc),
(L'.EPrim (Prim.Int (Int64.fromInt 0)), loc)), loc)), loc)), loc)
@@ -1142,7 +1142,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L'.TFun ((L'.TFfi ("Basis", "char"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
(L'.EAbs ("y", (L'.TFfi ("Basis", "char"), loc),
(L'.TFfi ("Basis", "bool"), loc),
- (L'.EBinop (s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
+ (L'.EBinop (L'.NotInt, s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
in
ordEx ((L'.TFfi ("Basis", "char"), loc),
charBin "<",
@@ -1155,7 +1155,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L'.TFun ((L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
(L'.EAbs ("y", (L'.TFfi ("Basis", "time"), loc),
(L'.TFfi ("Basis", "bool"), loc),
- (L'.EBinop (s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
+ (L'.EBinop (L'.NotInt, s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
in
ordEx ((L'.TFfi ("Basis", "time"), loc),
boolBin "<",
diff --git a/src/settings.sml b/src/settings.sml
index 4c611336..97c39abf 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -171,6 +171,7 @@ val jsFuncsBase = basisM [("alert", "alert"),
("stringToInt_error", "pi"),
("urlifyInt", "ts"),
("urlifyFloat", "ts"),
+ ("urlifyTime", "ts"),
("urlifyString", "uf"),
("urlifyBool", "ub"),
("recv", "rv"),
diff --git a/src/urweb.grm b/src/urweb.grm
index 21c4a50c..5803f445 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -1232,7 +1232,9 @@ eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright))
val e = (EApp (e, texp), loc)
in
if length fields <> length sqlexps then
- ErrorMsg.errorAt loc "Length mismatch in INSERT field specification"
+ ErrorMsg.errorAt loc ("Length mismatch in INSERT field specification ("
+ ^ Int.toString (length fields)
+ ^ " vs. " ^ Int.toString (length sqlexps) ^ ")")
else
();
(EApp (e, (ERecord (ListPair.zip (fields, sqlexps)), loc)), loc)
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-04 14:36:01 +0000