Mercurial > urweb

comparison src/mono_reduce.sml @ 2048:4d64af730e35

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Differentiate between HTML and normal string literals
author Adam Chlipala <adam@chlipala.net>
date Fri, 01 Aug 2014 15:44:17 -0400
parents ec7a1fa5e88f
children 04d7d563a36f
comparison
equal deleted inserted replaced
2047:6be31671911b 2048:4d64af730e35
188 fun match (env, p : pat, e : exp) = 188 fun match (env, p : pat, e : exp) =
189 case (#1 p, #1 e) of 189 case (#1 p, #1 e) of
190 (PWild, _) => Yes env 190 (PWild, _) => Yes env
191 | (PVar (x, t), _) => Yes ((x, t, e) :: env) 191 | (PVar (x, t), _) => Yes ((x, t, e) :: env)
192 192
193 | (PPrim (Prim.String s), EStrcat ((EPrim (Prim.String s'), _), _)) => 193 | (PPrim (Prim.String (_, s)), EStrcat ((EPrim (Prim.String (_, s')), _), _)) =>
194 if String.isPrefix s' s then 194 if String.isPrefix s' s then
195 Maybe 195 Maybe
196 else 196 else
197 No 197 No
198 198
199 | (PPrim (Prim.String s), EStrcat (_, (EPrim (Prim.String s'), _))) => 199 | (PPrim (Prim.String (_, s)), EStrcat (_, (EPrim (Prim.String (_, s')), _))) =>
200 if String.isSuffix s' s then 200 if String.isSuffix s' s then
201 Maybe 201 Maybe
202 else 202 else
203 No 203 No
204 204
754 EAbs (x', t', ran, reduceExp (E.pushERel env x' t' NONE) 754 EAbs (x', t', ran, reduceExp (E.pushERel env x' t' NONE)
755 (ELet (x, t, liftExpInExp 0 e', swapExpVars 0 e''), loc)) 755 (ELet (x, t, liftExpInExp 0 e', swapExpVars 0 e''), loc))
756 756
757 | ELet (x, t, e', b) => doLet (x, t, e', b) 757 | ELet (x, t, e', b) => doLet (x, t, e', b)
758 758
759 | EStrcat ((EPrim (Prim.String s1), _), (EPrim (Prim.String s2), _)) => 759 | EStrcat ((EPrim (Prim.String (k1, s1)), _), (EPrim (Prim.String (k2, s2)), _)) =>
760 EPrim (Prim.String (s1 ^ s2)) 760 EPrim (Prim.String ((case (k1, k2) of
761 (Prim.Html, Prim.Html) => Prim.Html
762 | _ => Prim.Normal), s1 ^ s2))
761 763
762 | ESignalBind ((ESignalReturn e1, loc), e2) => 764 | ESignalBind ((ESignalReturn e1, loc), e2) =>
763 #1 (reduceExp env (EApp (e2, e1), loc)) 765 #1 (reduceExp env (EApp (e2, e1), loc))
764 766
765 | _ => e 767 | _ => e