summaryrefslogtreecommitdiff
path: root/src/monoize.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-08-03 13:30:27 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-08-03 13:30:27 -0400
commitb6123d25d202d3cbe1f12d24dec129a90d5051ec (patch)
tree5537d58d7dba623127804b35813d7c0ec673f8b9 /src/monoize.sml
parent6314b4c27a14576b356258dad74607168135cb51 (diff)
Optimizing 'case' in Mono_reduce
Diffstat (limited to 'src/monoize.sml')
-rw-r--r--src/monoize.sml6
1 files changed, 4 insertions, 2 deletions
diff --git a/src/monoize.sml b/src/monoize.sml
index dfd727f7..94442132 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -63,6 +63,8 @@ fun monoType env (all as (c, loc)) =
| L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _) =>
(L'.TFfi ("Basis", "string"), loc)
+ | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) =>
+ (L'.TFfi ("Basis", "string"), loc)
| L.CRel _ => poly ()
| L.CNamed n =>
@@ -164,7 +166,7 @@ fun fooifyExp fk env =
let
val (_, _, _, s) = Env.lookupENamed env fnam
in
- ((L'.EPrim (Prim.String s), loc), fm)
+ ((L'.EPrim (Prim.String ("/" ^ s)), loc), fm)
end
| L'.EClosure (fnam, args) =>
let
@@ -187,7 +189,7 @@ fun fooifyExp fk env =
| _ => (E.errorAt loc "Type mismatch encoding attribute";
(e, fm))
in
- attrify (args, ft, (L'.EPrim (Prim.String s), loc), fm)
+ attrify (args, ft, (L'.EPrim (Prim.String ("/" ^ s)), loc), fm)
end
| _ =>
case t of