Mercurial > urweb

comparison src/mono_reduce.sml @ 1805:d12192c7aa3e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Revert last changeset for now; needs more thought
author Adam Chlipala <adam@chlipala.net>
date Sun, 05 Aug 2012 17:11:39 -0400
parents 62c18ecbfec4
children 148203744882
comparison
equal deleted inserted replaced
1804:62c18ecbfec4 1805:d12192c7aa3e
177 e 177 e
178 | _ => e, 178 | _ => e,
179 bind = fn ((lower, len), U.Exp.RelE _) => (lower+1, len) 179 bind = fn ((lower, len), U.Exp.RelE _) => (lower+1, len)
180 | (st, _) => st} 180 | (st, _) => st}
181 181
182 datatype result = Yes of (string * typ * exp) list | No | Maybe 182 datatype result = Yes of exp list | No | Maybe
183 183
184 fun match (env, p : pat, e : exp) = 184 fun match (env, p : pat, e : exp) =
185 case (#1 p, #1 e) of 185 case (#1 p, #1 e) of
186 (PWild, _) => Yes env 186 (PWild, _) => Yes env
187 | (PVar (x, t), _) => Yes ((x, t, e) :: env) 187 | (PVar (x, t), _) => Yes (e :: env)
188 188
189 | (PPrim (Prim.String s), EStrcat ((EPrim (Prim.String s'), _), _)) => 189 | (PPrim (Prim.String s), EStrcat ((EPrim (Prim.String s'), _), _)) =>
190 if String.isPrefix s' s then 190 if String.isPrefix s' s then
191 Maybe 191 Maybe
192 else 192 else
517 let 517 let
518 (*val () = Print.prefaces "exp" [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan))]*) 518 (*val () = Print.prefaces "exp" [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan))]*)
519 519
520 fun doLet (x, t, e', b) = 520 fun doLet (x, t, e', b) =
521 let 521 let
522 val notValue = U.Exp.exists {typ = fn _ => false,
523 exp = fn e =>
524 case e of
525 EPrim _ => false
526 | ECon _ => false
527 | ENone _ => false
528 | ESome _ => false
529 | ERecord _ => false
530 | _ => true}
531
532
533 fun doSub () = 522 fun doSub () =
534 let 523 let
535 val r = subExpInExp (0, e') b 524 val r = subExpInExp (0, e') b
536 in 525 in
537 (*Print.prefaces "doSub" [("e'", MonoPrint.p_exp env e'), 526 (*Print.prefaces "doSub" [("e'", MonoPrint.p_exp env e'),
606 andalso not (freeInAbs b) then 595 andalso not (freeInAbs b) then
607 trySub () 596 trySub ()
608 else 597 else
609 e 598 e
610 end 599 end
611 else if countFree 0 0 b > 1 andalso notValue e' then
612 e
613 else 600 else
614 trySub () 601 trySub ()
615 end 602 end
616 603
617 val r = 604 val r =
670 No => search pes 657 No => search pes
671 | Maybe => push () 658 | Maybe => push ()
672 | Yes subs => 659 | Yes subs =>
673 let 660 let
674 val (body, remaining) = 661 val (body, remaining) =
675 foldl (fn ((x, t, e), (body, remaining)) => 662 foldl (fn (e, (body, remaining)) =>
676 (if countFree 0 0 body > 1 then 663 (subExpInExp (0, multiLift remaining e) body, remaining - 1))
677 (ELet (x, t, multiLift remaining e, body), #2 e')
678 else
679 subExpInExp (0, multiLift remaining e) body, remaining - 1))
680 (body, length subs - 1) subs 664 (body, length subs - 1) subs
681 val r = reduceExp (E.patBinds env p) body 665 val r = reduceExp (E.patBinds env p) body
682 in 666 in
683 (*Print.preface ("subs", Print.p_list (MonoPrint.p_exp env) subs);*) 667 (*Print.preface ("subs", Print.p_list (MonoPrint.p_exp env) subs);*)
684 (*Print.prefaces "ECase" 668 (*Print.prefaces "ECase"