Commit da260a5b authored by Simon Peyton Jones's avatar Simon Peyton Jones

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.
parent 28fe0eea
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment