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