Revert accidental change to collectTyAndValBinders
authorSimon Peyton Jones <simonpj@microsoft.com>
Thu, 31 Mar 2016 09:47:47 +0000 (10:47 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Thu, 31 Mar 2016 09:50:19 +0000 (10:50 +0100)
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.

compiler/coreSyn/CoreSyn.hs

index f06097a..7479dcd 100644 (file)
@@ -1622,14 +1622,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
@@ -1637,16 +1635,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