[commit: ghc] ghc-8.0: Revert accidental change to collectTyAndValBinders (036bda3)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/036bda33654e7b9ae4b8dde32bc28bb1646c7e92/ghc

>---------------------------------------------------------------

commit 036bda33654e7b9ae4b8dde32bc28bb1646c7e92
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Mar 31 10:47:47 2016 +0100

    Revert accidental change to collectTyAndValBinders
    
    Richard accidetally introduced this change in his big kind-equality
    patch.  The code is wrong, and potentially could cause binders to
    be re-ordered.
    
    Worth merging to 8.0.
    
    (cherry picked from commit da260a5bddf990959f639a3551b335ee26c766f6)


>---------------------------------------------------------------

036bda33654e7b9ae4b8dde32bc28bb1646c7e92
 compiler/coreSyn/CoreSyn.hs | 39 ++++++++++++++++++++++-----------------
 1 file changed, 22 insertions(+), 17 deletions(-)

diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs
index 772359f..88f88e7 100644
--- a/compiler/coreSyn/CoreSyn.hs
+++ b/compiler/coreSyn/CoreSyn.hs
@@ -1612,14 +1612,12 @@ flattenBinds (Rec prs1   : binds) = prs1 ++ flattenBinds binds
 flattenBinds []                   = []
 
 -- | We often want to strip off leading lambdas before getting down to
--- business. This function is your friend.
-collectBinders               :: Expr b -> ([b],         Expr b)
--- | Collect type and value binders from nested lambdas, stopping
--- right before any "forall"s within a non-forall. For example,
--- forall (a :: *) (b :: Foo ~ Bar) (c :: *). Baz -> forall (d :: *). Blob
--- will pull out the binders for a, b, c, and Baz, but not for d or anything
--- within Blob. This is to coordinate with tcSplitSigmaTy.
-collectTyAndValBinders       :: CoreExpr -> ([TyVar], [Id], CoreExpr)
+-- business. Variants are 'collectTyBinders', 'collectValBinders',
+-- and 'collectTyAndValBinders'
+collectBinders         :: Expr b   -> ([b],     Expr b)
+collectTyBinders       :: CoreExpr -> ([TyVar], CoreExpr)
+collectValBinders      :: CoreExpr -> ([Id],    CoreExpr)
+collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
 
 collectBinders expr
   = go [] expr
@@ -1627,16 +1625,23 @@ collectBinders expr
     go bs (Lam b e) = go (b:bs) e
     go bs e          = (reverse bs, e)
 
+collectTyBinders expr
+  = go [] expr
+  where
+    go tvs (Lam b e) | isTyVar b = go (b:tvs) e
+    go tvs e                     = (reverse tvs, e)
+
+collectValBinders expr
+  = go [] expr
+  where
+    go ids (Lam b e) | isId b = go (b:ids) e
+    go ids body               = (reverse ids, body)
+
 collectTyAndValBinders expr
-  = go_forall [] [] expr
-  where go_forall tvs ids (Lam b e)
-          | isTyVar b       = go_forall (b:tvs) ids e
-          | isCoVar b       = go_forall tvs (b:ids) e
-        go_forall tvs ids e = go_fun tvs ids e
-
-        go_fun tvs ids (Lam b e)
-          | isId b          = go_fun tvs (b:ids) e
-        go_fun tvs ids e    = (reverse tvs, reverse ids, e)
+  = (tvs, ids, body)
+  where
+    (tvs, body1) = collectTyBinders expr
+    (ids, body)  = collectValBinders body1
 
 -- | Takes a nested application expression and returns the the function
 -- being applied and the arguments to which it is applied