summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-06-07 16:45:00 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-06-07 16:45:00 -0400
commit005fbe2dd67c6ec77282179032f94ffa6cb7788c (patch)
tree30300e247037398cd77a827ae1c38b96d19baec7 /src
parent07249bc2c07b2af3b9decb84ce968e3005a19c0f (diff)
Fix datatype import bug in Elaborate; fix server-side source setting; more standard library stuff
Diffstat (limited to 'src')
-rw-r--r--src/c/urweb.c6
-rw-r--r--src/elaborate.sml4
-rw-r--r--src/monoize.sml42
3 files changed, 49 insertions, 3 deletions
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 0c6eefd5..864a5daa 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -1278,12 +1278,12 @@ uw_unit uw_Basis_set_client_source(uw_context ctx, uw_Basis_int n, uw_Basis_stri
size_t s_len = strlen(s);
uw_check_script(ctx, 6 + INTS_MAX + s_len);
- sprintf(ctx->script.front, "s%d.v=%n", (int)n, &len);
+ sprintf(ctx->script.front, "sv(s%d,%n", (int)n, &len);
ctx->script.front += len;
strcpy(ctx->script.front, s);
ctx->script.front += s_len;
- strcpy(ctx->script.front, ";");
- ctx->script.front++;
+ strcpy(ctx->script.front, ");");
+ ctx->script.front += 2;
return uw_unit_v;
}
diff --git a/src/elaborate.sml b/src/elaborate.sml
index 92792cd5..3b147e00 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -3271,6 +3271,10 @@ and elabDecl (dAll as (d, loc), (env, denv, gs)) =
val env = E.pushDatatype env n' xs xncs
val t = (L'.CNamed n', loc)
+ val nxs = length xs
+ val t = ListUtil.foldli (fn (i, _, t) =>
+ (L'.CApp (t, (L'.CRel (nxs - 1 - i), loc)), loc))
+ t xs
val env = foldl (fn ((x, n, to), env) =>
let
val t = case to of
diff --git a/src/monoize.sml b/src/monoize.sml
index bdc8ef82..e0795b84 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -778,6 +778,48 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L'.TFfi ("Basis", "bool"), loc),
(L'.EBinop ("==", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
fm)
+ | L.ECApp ((L.EFfi ("Basis", "eq_option"), _), t) =>
+ let
+ val t = monoType env t
+ val t' = (L'.TOption t, loc)
+ val bool = (L'.TFfi ("Basis", "bool"), loc)
+ in
+ ((L'.EAbs ("f", (L'.TFun (t, (L'.TFun (t, bool), loc)), loc),
+ (L'.TFun (t', (L'.TFun (t', bool), loc)), loc),
+ (L'.EAbs ("x", t', (L'.TFun (t', bool), loc),
+ (L'.EAbs ("y", t', bool,
+ (L'.ECase ((L'.ERecord [("1", (L'.ERel 1, loc), t'),
+ ("2", (L'.ERel 0, loc), t')], loc),
+ [((L'.PRecord [("1", (L'.PNone t, loc), t'),
+ ("2", (L'.PNone t, loc), t')], loc),
+ (L'.ECon (L'.Enum, L'.PConFfi {mod = "Basis",
+ datatyp = "bool",
+ con = "True",
+ arg = NONE},
+ NONE), loc)),
+ ((L'.PRecord [("1", (L'.PSome (t,
+ (L'.PVar ("x1",
+ t), loc)),
+ loc), t'),
+ ("2", (L'.PSome (t,
+ (L'.PVar ("x2",
+ t), loc)),
+ loc), t')], loc),
+ (L'.EApp ((L'.EApp ((L'.ERel 4, loc),
+ (L'.ERel 1, loc)), loc),
+ (L'.ERel 0, loc)), loc)),
+ ((L'.PWild, loc),
+ (L'.ECon (L'.Enum, L'.PConFfi {mod = "Basis",
+ datatyp = "bool",
+ con = "False",
+ arg = NONE},
+ NONE), loc))],
+ {disc = (L'.TRecord [("1", t'), ("2", t')], loc),
+ result = (L'.TFfi ("Basis", "bool"), loc)}),
+ loc)), loc)), loc)), loc),
+ fm)
+ end
+
| L.ECApp ((L.EFfi ("Basis", "mkEq"), _), t) =>
let
val t = monoType env t