# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1226269654 18000
# Node ID 3ce20b0b6914c4e8923d216667f7f9316993cc34
# Parent  685b41e85634a3d652a3384877e708f8752cc7b1
Prevent overzealous Especialization

diff -r 685b41e85634 -r 3ce20b0b6914 src/defunc.sml
--- a/src/defunc.sml	Sun Nov 09 16:54:42 2008 -0500
+++ b/src/defunc.sml	Sun Nov 09 17:27:34 2008 -0500
@@ -113,7 +113,10 @@
             val (xes, st) =
                 ListUtil.foldlMap
                     (fn (tup as (fnam as (CName x, loc), e, xt), st) =>
-                         if x <> "Link" andalso x <> "Action" then
+                         if (x <> "Link" andalso x <> "Action")
+                            orelse case #1 e of
+                                       ENamed _ => true
+                                     | _ => false then
                              (tup, st)
                          else
                              let
diff -r 685b41e85634 -r 3ce20b0b6914 src/especialize.sml
--- a/src/especialize.sml	Sun Nov 09 16:54:42 2008 -0500
+++ b/src/especialize.sml	Sun Nov 09 17:27:34 2008 -0500
@@ -135,11 +135,11 @@
 
         fun exp (e, st : state) =
             let
-                fun getApp e =
+                fun getApp' e =
                     case e of
                         ENamed f => SOME (f, [], [])
                       | EApp (e1, e2) =>
-                        (case getApp (#1 e1) of
+                        (case getApp' (#1 e1) of
                              NONE => NONE
                            | SOME (f, xs, xs') =>
                              let
@@ -154,6 +154,15 @@
                                    | SOME k => SOME (f, xs @ [k], xs')
                              end)
                       | _ => NONE
+
+                fun getApp e =
+                    case getApp' e of
+                        NONE => NONE
+                      | SOME (f, xs, xs') =>
+                        if List.all (fn (ERecord [], _) => true | _ => false) xs then
+                            SOME (f, [], xs @ xs')
+                        else
+                            SOME (f, xs, xs')
             in
                 case getApp e of
                     NONE => (e, st)
@@ -176,6 +185,7 @@
                                    | _ => false
                          in
                              if List.all (fn (ERel _, _) => false | _ => true) xs'
+                                andalso List.exists (fn (ERecord [], _) => false | _ => true) xs'
                                 andalso not (IS.member (actionable, f))
                                 andalso hasFunarg (typ, xs') then
                                  (#1 (foldl (fn (arg, e) => (EApp (e, arg), ErrorMsg.dummySpan))
@@ -184,57 +194,57 @@
                              else
                                  (e, st)
                          end)
-                                   | SOME (f, xs, xs') =>
-                                     case IM.find (#funcs st, f) of
-                                         NONE => (e, st)
-                                       | SOME {name, args, body, typ, tag} =>
-                                         case KM.find (args, xs) of
-                                             SOME f' => (#1 (foldl (fn (arg, e) => (EApp (e, arg), ErrorMsg.dummySpan))
-                                                                   (ENamed f', ErrorMsg.dummySpan) xs'),
-                                                         st)
-                                           | NONE =>
-                                             let
-                                                 fun subBody (body, typ, xs) =
-                                                     case (#1 body, #1 typ, xs) of
-                                                         (_, _, []) => SOME (body, typ)
-                                                       | (EAbs (_, _, _, body'), TFun (_, typ'), x :: xs) =>
-                                                         let
-                                                             val body'' = E.subExpInExp (0, skeyOut x) body'
-                                                         in
-                                                             subBody (body'',
-                                                                      typ',
-                                                                      xs)
-                                                         end
-                                                       | _ => NONE
-                                             in
-                                                 case subBody (body, typ, xs) of
-                                                     NONE => (e, st)
-                                                   | SOME (body', typ') =>
-                                                     let
-                                                         val f' = #maxName st
-                                                         val funcs = IM.insert (#funcs st, f, {name = name,
-                                                                                               args = KM.insert (args,
-                                                                                                                 xs, f'),
-                                                                                               body = body,
-                                                                                               typ = typ,
-                                                                                               tag = tag})
-                                                         val st = {
-                                                             maxName = f' + 1,
-                                                             funcs = funcs,
-                                                             decls = #decls st
-                                                         }
+                  | SOME (f, xs, xs') =>
+                    case IM.find (#funcs st, f) of
+                        NONE => (e, st)
+                      | SOME {name, args, body, typ, tag} =>
+                        case KM.find (args, xs) of
+                            SOME f' => (#1 (foldl (fn (arg, e) => (EApp (e, arg), ErrorMsg.dummySpan))
+                                                  (ENamed f', ErrorMsg.dummySpan) xs'),
+                                        st)
+                          | NONE =>
+                            let
+                                fun subBody (body, typ, xs) =
+                                    case (#1 body, #1 typ, xs) of
+                                        (_, _, []) => SOME (body, typ)
+                                      | (EAbs (_, _, _, body'), TFun (_, typ'), x :: xs) =>
+                                        let
+                                            val body'' = E.subExpInExp (0, skeyOut x) body'
+                                        in
+                                            subBody (body'',
+                                                     typ',
+                                                     xs)
+                                        end
+                                      | _ => NONE
+                            in
+                                case subBody (body, typ, xs) of
+                                    NONE => (e, st)
+                                  | SOME (body', typ') =>
+                                    let
+                                        val f' = #maxName st
+                                        val funcs = IM.insert (#funcs st, f, {name = name,
+                                                                              args = KM.insert (args,
+                                                                                                xs, f'),
+                                                                              body = body,
+                                                                              typ = typ,
+                                                                              tag = tag})
+                                        val st = {
+                                            maxName = f' + 1,
+                                            funcs = funcs,
+                                            decls = #decls st
+                                        }
 
-                                                         val (body', st) = specExp st body'
-                                                         val e' = foldl (fn (arg, e) => (EApp (e, arg), ErrorMsg.dummySpan))
-                                                                        (ENamed f', ErrorMsg.dummySpan) xs'
-                                                     in
-                                                         (#1 e',
-                                                          {maxName = #maxName st,
-                                                           funcs = #funcs st,
-                                                           decls = (name, f', typ', body', tag) :: #decls st})
-                                                     end
-                                             end
-                         end
+                                        val (body', st) = specExp st body'
+                                        val e' = foldl (fn (arg, e) => (EApp (e, arg), ErrorMsg.dummySpan))
+                                                       (ENamed f', ErrorMsg.dummySpan) xs'
+                                    in
+                                        (#1 e',
+                                         {maxName = #maxName st,
+                                          funcs = #funcs st,
+                                          decls = (name, f', typ', body', tag) :: #decls st})
+                                    end
+                            end
+            end
 
         and specExp st = U.Exp.foldMap {kind = kind, con = con, exp = exp} st