diff src/mono_reduce.sml @ 1804:62c18ecbfec4

Tweaking treatment of function application: substitute or introduce a 'let'?
author Adam Chlipala <adam@chlipala.net>
date Sun, 05 Aug 2012 14:55:28 -0400
parents 0577be31a435
children d12192c7aa3e
line wrap: on
line diff
--- a/src/mono_reduce.sml	Fri Aug 03 12:39:04 2012 -0400
+++ b/src/mono_reduce.sml	Sun Aug 05 14:55:28 2012 -0400
@@ -179,12 +179,12 @@
                 bind = fn ((lower, len), U.Exp.RelE _) => (lower+1, len)
                         | (st, _) => st}
 
-datatype result = Yes of exp list | No | Maybe
+datatype result = Yes of (string * typ * exp) list | No | Maybe
 
 fun match (env, p : pat, e : exp) =
     case (#1 p, #1 e) of
         (PWild, _) => Yes env
-      | (PVar (x, t), _) => Yes (e :: env)
+      | (PVar (x, t), _) => Yes ((x, t, e) :: env)
 
       | (PPrim (Prim.String s), EStrcat ((EPrim (Prim.String s'), _), _)) =>
         if String.isPrefix s' s then
@@ -519,6 +519,17 @@
 
                 fun doLet (x, t, e', b) =
                     let
+                        val notValue = U.Exp.exists {typ = fn _ => false,
+                                                     exp = fn e =>
+                                                              case e of
+                                                                  EPrim _ => false
+                                                                | ECon _ => false
+                                                                | ENone _ => false
+                                                                | ESome _ => false
+                                                                | ERecord _ => false
+                                                                | _ => true}
+
+
                         fun doSub () =
                             let
                                 val r = subExpInExp (0, e') b
@@ -597,6 +608,8 @@
                                 else
                                     e
                             end
+                        else if countFree 0 0 b > 1 andalso notValue e' then
+                            e
                         else
                             trySub ()
                     end
@@ -659,8 +672,11 @@
                                       | Yes subs =>
                                         let
                                             val (body, remaining) =
-                                                foldl (fn (e, (body, remaining)) =>
-                                                          (subExpInExp (0, multiLift remaining e) body, remaining - 1))
+                                                foldl (fn ((x, t, e), (body, remaining)) =>
+                                                          (if countFree 0 0 body > 1 then
+                                                               (ELet (x, t, multiLift remaining e, body), #2 e')
+                                                           else
+                                                               subExpInExp (0, multiLift remaining e) body, remaining - 1))
                                                       (body, length subs - 1) subs
                                             val r = reduceExp (E.patBinds env p) body
                                         in