Mercurial > urweb
diff src/mono_reduce.sml @ 2211:ef766ef6e242
Merge.
| author | Ziv Scully <ziv@mit.edu> |
|---|---|
| date | Sat, 13 Sep 2014 19:16:07 -0400 |
| parents | 04d7d563a36f |
| children | 1b76ae703cbb |
line wrap: on
line diff
--- a/src/mono_reduce.sml Sat May 31 22:23:25 2014 -0400 +++ b/src/mono_reduce.sml Sat Sep 13 19:16:07 2014 -0400 @@ -1,4 +1,4 @@ -(* Copyright (c) 2008, 2013, Adam Chlipala +(* Copyright (c) 2008, 2013-2014, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without @@ -190,13 +190,13 @@ (PWild, _) => Yes env | (PVar (x, t), _) => Yes ((x, t, e) :: env) - | (PPrim (Prim.String s), EStrcat ((EPrim (Prim.String s'), _), _)) => + | (PPrim (Prim.String (_, s)), EStrcat ((EPrim (Prim.String (_, s')), _), _)) => if String.isPrefix s' s then Maybe else No - | (PPrim (Prim.String s), EStrcat (_, (EPrim (Prim.String s'), _))) => + | (PPrim (Prim.String (_, s)), EStrcat (_, (EPrim (Prim.String (_, s')), _))) => if String.isSuffix s' s then Maybe else @@ -471,7 +471,7 @@ | ECase (e, pes, _) => let - val lss = map (fn (p, e) => summarize (d + patBinds p) e) pes + val lss = map (fn (p, e) => summarize (if d = ~1 then ~1 else d + patBinds p) e) pes fun splitRel ls acc = case ls of @@ -502,7 +502,7 @@ | EWrite e => summarize d e @ [WritePage] | ESeq (e1, e2) => summarize d e1 @ summarize d e2 - | ELet (_, _, e1, e2) => summarize d e1 @ summarize (d + 1) e2 + | ELet (_, _, e1, e2) => summarize d e1 @ summarize (if d = ~1 then ~1 else d + 1) e2 | EClosure (_, es) => List.concat (map (summarize d) es) @@ -510,7 +510,7 @@ List.concat [summarize d query, summarize d initial, [ReadDb], - summarize (d + 2) body] + summarize (if d = ~1 then ~1 else d + 2) body] | EDml (e, _) => summarize d e @ [WriteDb] | ENextval e => summarize d e @ [WriteDb] @@ -585,7 +585,7 @@ val effs_e' = List.filter (fn x => x <> UseRel) effs_e' val effs_b = summarize 0 b - (*val () = Print.fprefaces outf "Try" + (*val () = Print.prefaces "Try" [(*("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)),*) ("e'", MonoPrint.p_exp env e'), ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b), @@ -685,7 +685,7 @@ map (fn (p, (EAbs (_, _, _, e), _)) => (p, swapExpVarsPat (0, patBinds p) e) | (p, (EError (e, (TFun (_, t), _)), loc)) => - (p, (EError (e, t), loc)) + (p, (EError (liftExpInExp (patBinds p) e, t), loc)) | (p, e) => (p, (EApp (liftExpInExp (patBinds p) e, (ERel (patBinds p), loc)), loc))) @@ -756,8 +756,10 @@ | ELet (x, t, e', b) => doLet (x, t, e', b) - | EStrcat ((EPrim (Prim.String s1), _), (EPrim (Prim.String s2), _)) => - EPrim (Prim.String (s1 ^ s2)) + | EStrcat ((EPrim (Prim.String (k1, s1)), _), (EPrim (Prim.String (k2, s2)), _)) => + EPrim (Prim.String ((case (k1, k2) of + (Prim.Html, Prim.Html) => Prim.Html + | _ => Prim.Normal), s1 ^ s2)) | ESignalBind ((ESignalReturn e1, loc), e2) => #1 (reduceExp env (EApp (e2, e1), loc))