Mercurial > urweb

comparison src/mono_reduce.sml @ 316:04ebfe929a98

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Unpolyed a polymorphic function of two arguments
author Adam Chlipala <adamc@hcoop.net>
date Thu, 11 Sep 2008 10:14:59 -0400
parents 52d4c60518d4
children 60907c06b4c4
comparison
equal deleted inserted replaced
315:e21d0dddda09 316:04ebfe929a98
93 r 93 r
94 end 94 end
95 95
96 fun typ c = c 96 fun typ c = c
97 97
98 val swapExpVars =
99 U.Exp.mapB {typ = fn t => t,
100 exp = fn lower => fn e =>
101 case e of
102 ERel xn =>
103 if xn = lower then
104 ERel (lower + 1)
105 else if xn = lower + 1 then
106 ERel lower
107 else
108 e
109 | _ => e,
110 bind = fn (lower, U.Exp.RelE _) => lower+1
111 | (lower, _) => lower}
112
98 datatype result = Yes of E.env | No | Maybe 113 datatype result = Yes of E.env | No | Maybe
99 114
100 fun match (env, p : pat, e : exp) = 115 fun match (env, p : pat, e : exp) =
101 case (#1 p, #1 e) of 116 case (#1 p, #1 e) of
102 (PWild, _) => Yes env 117 (PWild, _) => Yes env
206 #1 (reduceExp env e') 221 #1 (reduceExp env e')
207 end 222 end
208 | EApp ((ELet (x, t, e, b), loc), e') => 223 | EApp ((ELet (x, t, e, b), loc), e') =>
209 #1 (reduceExp env (ELet (x, t, e, 224 #1 (reduceExp env (ELet (x, t, e,
210 (EApp (b, liftExpInExp 0 e'), loc)), loc)) 225 (EApp (b, liftExpInExp 0 e'), loc)), loc))
226
227 | ELet (x, t, e, (EAbs (x', t' as (TRecord [], _), ran, e'), loc)) =>
228 EAbs (x', t', ran, (ELet (x, t, liftExpInExp 0 e, swapExpVars 0 e'), loc))
229
211 | ELet (x, t, e', b) => 230 | ELet (x, t, e', b) =>
212 if impure e' then 231 if impure e' then
213 e 232 e
214 else 233 else
215 #1 (reduceExp env (subExpInExp (0, e') b)) 234 #1 (reduceExp env (subExpInExp (0, e') b))