Mercurial > urweb

comparison src/mono_reduce.sml @ 800:e92cfac1608f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Proper lifting of MonoEnv stored expressions; avoidance of onchange clobbering
author Adam Chlipala <adamc@hcoop.net>
date Thu, 14 May 2009 13:18:31 -0400
parents a28982de5645
children 5f49a6b759cb
comparison
equal deleted inserted replaced
799:9330ba3a2799 800:e92cfac1608f
407 [] => push () 407 [] => push ()
408 | (p, body) :: pes => 408 | (p, body) :: pes =>
409 case match (env, p, e') of 409 case match (env, p, e') of
410 No => search pes 410 No => search pes
411 | Maybe => push () 411 | Maybe => push ()
412 | Yes env => #1 (reduceExp env body) 412 | Yes env' =>
413 let
414 val r = reduceExp env' body
415 in
416 (*Print.prefaces "ECase"
417 [("body", MonoPrint.p_exp env' body),
418 ("r", MonoPrint.p_exp env r)];*)
419 #1 r
420 end
413 in 421 in
414 search pes 422 search pes
415 end 423 end
416 424
417 | EField ((ERecord xes, _), x) => 425 | EField ((ERecord xes, _), x) =>
441 EAbs (x', t', ran, (ELet (x, t, liftExpInExp 0 e', swapExpVars 0 e''), loc)) 449 EAbs (x', t', ran, (ELet (x, t, liftExpInExp 0 e', swapExpVars 0 e''), loc))
442 450
443 | ELet (x, t, e', b) => 451 | ELet (x, t, e', b) =>
444 let 452 let
445 fun doSub () = 453 fun doSub () =
446 #1 (reduceExp env (subExpInExp (0, e') b)) 454 let
455 val r = subExpInExp (0, e') b
456 in
457 (*Print.prefaces "doSub" [("e'", MonoPrint.p_exp env e'),
458 ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
459 ("r", MonoPrint.p_exp env r)];*)
460 #1 (reduceExp env r)
461 end
447 462
448 fun trySub () = 463 fun trySub () =
449 case t of 464 case t of
450 (TFfi ("Basis", "string"), _) => doSub () 465 (TFfi ("Basis", "string"), _) => doSub ()
451 | (TSignal _, _) => e 466 | (TSignal _, _) => e