Mercurial > urweb
comparison src/reduce.sml @ 2195:18e6fb487880
Reduce: add reduction in some spots previously missed, associated with 'case' return types
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Wed, 25 Nov 2015 18:48:17 -0500 |
| parents | f463c773ed6a |
| children |
comparison
equal
deleted
inserted
replaced
| 2194:f6e16c308566 | 2195:18e6fb487880 |
|---|---|
| 586 val body' = exp env' (EApp (body, multiLiftExpInExp (patBinds p) e2), #2 body) | 586 val body' = exp env' (EApp (body, multiLiftExpInExp (patBinds p) e2), #2 body) |
| 587 in | 587 in |
| 588 (p, body') | 588 (p, body') |
| 589 end) pes | 589 end) pes |
| 590 | 590 |
| 591 val cc' = {disc = disc, result = c2} | 591 val cc' = {disc = con env' disc, result = con env' c2} |
| 592 in | 592 in |
| 593 (ECase (e, pes', cc'), loc) | 593 (ECase (e, pes', cc'), loc) |
| 594 end | 594 end |
| 595 | _ => (EApp (e1, e2), loc) | 595 | _ => (EApp (e1, e2), loc) |
| 596 end | 596 end |
| 624 in | 624 in |
| 625 (p, body') | 625 (p, body') |
| 626 end) pes | 626 end) pes |
| 627 | 627 |
| 628 val c' = E.subConInCon (0, c) c' | 628 val c' = E.subConInCon (0, c) c' |
| 629 val cc' = {disc = disc, result = c'} | 629 val cc' = {disc = con env disc, result = con env c'} |
| 630 in | 630 in |
| 631 (ECase (e, pes', cc'), loc) | 631 (ECase (e, pes', cc'), loc) |
| 632 end | 632 end |
| 633 | _ => (ECApp (e, c), loc) | 633 | _ => (ECApp (e, c), loc) |
| 634 end | 634 end |