diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-06-07 16:45:00 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-06-07 16:45:00 -0400 |
| commit | 005fbe2dd67c6ec77282179032f94ffa6cb7788c (patch) | |
| tree | 30300e247037398cd77a827ae1c38b96d19baec7 /src | |
| parent | 07249bc2c07b2af3b9decb84ce968e3005a19c0f (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.c | 6 | ||||
| -rw-r--r-- | src/elaborate.sml | 4 | ||||
| -rw-r--r-- | src/monoize.sml | 42 |
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 |