Mercurial > urweb

comparison src/mono_reduce.sml @ 827:497c7dbcc695

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix variable adjustment bug in fn/case alternation
author Adam Chlipala <adamc@hcoop.net>
date Thu, 28 May 2009 13:47:05 -0400
parents 493f44759879
children 20fe00fd81da
comparison
equal deleted inserted replaced
826:78504d97410b 827:497c7dbcc695
129 U.Exp.mapB {typ = fn t => t, 129 U.Exp.mapB {typ = fn t => t,
130 exp = fn (lower, len) => fn e => 130 exp = fn (lower, len) => fn e =>
131 case e of 131 case e of
132 ERel xn => 132 ERel xn =>
133 if xn = lower then 133 if xn = lower then
134 ERel (lower + 1) 134 ERel (lower + len)
135 else if xn >= lower + 1 andalso xn < lower + 1 + len then 135 else if xn >= lower + 1 andalso xn < lower + 1 + len then
136 ERel (xn - 1) 136 ERel (xn - 1)
137 else 137 else
138 e 138 e
139 | _ => e, 139 | _ => e,
390 let 390 let
391 fun push () = 391 fun push () =
392 case result of 392 case result of
393 (TFun (dom, result), loc) => 393 (TFun (dom, result), loc) =>
394 if List.all (fn (_, (EAbs _, _)) => true | _ => false) pes then 394 if List.all (fn (_, (EAbs _, _)) => true | _ => false) pes then
395 EAbs ("_", dom, result, 395 let
396 (ECase (liftExpInExp 0 e', 396 val r =
397 map (fn (p, (EAbs (_, _, _, e), _)) => 397 EAbs ("y", dom, result,
398 (p, swapExpVarsPat (0, patBinds p) e) 398 (ECase (liftExpInExp 0 e',
399 | _ => raise Fail "MonoReduce ECase") pes, 399 map (fn (p, (EAbs (_, _, _, e), _)) =>
400 {disc = disc, result = result}), loc)) 400 (p, swapExpVarsPat (0, patBinds p) e)
401 | _ => raise Fail "MonoReduce ECase") pes,
402 {disc = disc, result = result}), loc))
403 in
404 (*Print.prefaces "Swapped"
405 [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)),
406 ("r", MonoPrint.p_exp env (r, ErrorMsg.dummySpan))];*)
407 r
408 end
401 else 409 else
402 e 410 e
403 | _ => e 411 | _ => e
404 412
405 fun search pes = 413 fun search pes =