Mercurial > urweb
comparison src/mono_reduce.sml @ 1445:6e6f1643c4e9
To generate server-side source JavaScript, try both the old and new strategies; remove an unsound optimization from MonoOpt and make MonoReduce work harder to compensate
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Mon, 28 Mar 2011 10:37:49 -0400 |
parents | bd6c90f5a428 |
children | 4437b008e0ab |
comparison
equal
deleted
inserted
replaced
1444:0fc7b676b88b | 1445:6e6f1643c4e9 |
---|---|
633 (TFun (dom, result), loc) => | 633 (TFun (dom, result), loc) => |
634 let | 634 let |
635 fun safe (e, _) = | 635 fun safe (e, _) = |
636 case e of | 636 case e of |
637 EAbs _ => true | 637 EAbs _ => true |
638 | EError _ => true | |
638 | _ => false | 639 | _ => false |
639 in | 640 in |
640 if List.all (safe o #2) pes then | 641 if List.all (safe o #2) pes then |
641 EAbs ("y", dom, result, | 642 EAbs ("y", dom, result, |
642 (ECase (liftExpInExp 0 e', | 643 (ECase (liftExpInExp 0 e', |
643 map (fn (p, (EAbs (_, _, _, e), _)) => | 644 map (fn (p, (EAbs (_, _, _, e), _)) => |
644 (p, swapExpVarsPat (0, patBinds p) e) | 645 (p, swapExpVarsPat (0, patBinds p) e) |
646 | (p, (EError (e, (TFun (_, t), _)), loc)) => | |
647 (p, (EError (e, t), loc)) | |
645 | _ => raise Fail "MonoReduce ECase") pes, | 648 | _ => raise Fail "MonoReduce ECase") pes, |
646 {disc = disc, result = result}), loc)) | 649 {disc = disc, result = result}), loc)) |
647 else | 650 else |
648 e | 651 e |
649 end | 652 end |