Commit 95e31ad5 authored by simonpj's avatar simonpj
Browse files

[project @ 2001-10-17 11:05:36 by simonpj]

-------------------------------------------
	Desugar bindings into Rec groups more often
	-------------------------------------------

In rather obscure cases (involving functional dependencies)
it is possible to get an AbsBinds [] [] (no tyvars, no dicts)
which nevertheless has some "dictionary bindings".  These
come out of the typechecker in non-dependency order, so we
need to Rec them just in case.

It turns out to be a bit awkward.  The smallest fix is
to make dsLet always make a Rec; brutal but correct.
parent 5afd840f
......@@ -90,12 +90,16 @@ dsMonoBinds auto_scc (PatMonoBind pat grhss locn) rest
returnDs (sel_binds ++ rest)
-- Common special case: no type or dictionary abstraction
-- For the (rare) case when there are some mixed-up
-- dictionary bindings (for which a Rec is convenient)
-- we reply on the enclosing dsBind to wrap a Rec around.
dsMonoBinds auto_scc (AbsBinds [] [] exports inlines binds) rest
= dsMonoBinds (addSccs auto_scc exports) binds []`thenDs` \ core_prs ->
let
exports' = [(global, Var local) | (_, global, local) <- exports]
core_prs' = addLocalInlines exports inlines core_prs
exports' = [(global, Var local) | (_, global, local) <- exports]
in
returnDs (addLocalInlines exports inlines core_prs ++ exports' ++ rest)
returnDs (core_prs' ++ exports' ++ rest)
-- Another common case: one exported variable
-- Non-recursive bindings come through this way
......@@ -106,22 +110,26 @@ dsMonoBinds auto_scc
let
-- Always treat the binds as recursive, because the typechecker
-- makes rather mixed-up dictionary bindings
core_binds = [Rec core_prs]
global' = (global, mkInline (idName global `elemNameSet` inlines) $
core_bind = Rec core_prs
-- The mkInline does directly what the
-- addLocalInlines do in the other cases
export' = (global, mkInline (idName global `elemNameSet` inlines) $
mkLams tyvars $ mkLams dicts $
mkDsLets core_binds (Var local))
Let core_bind (Var local))
in
returnDs (global' : rest)
returnDs (export' : rest)
dsMonoBinds auto_scc (AbsBinds all_tyvars dicts exports inlines binds) rest
= dsMonoBinds (addSccs auto_scc exports) binds []`thenDs` \ core_prs ->
let
core_binds = [Rec (addLocalInlines exports inlines core_prs)]
-- Rec because of mixed-up dictionary bindings
core_bind = Rec (addLocalInlines exports inlines core_prs)
tup_expr = mkTupleExpr locals
tup_ty = exprType tup_expr
poly_tup_expr = mkLams all_tyvars $ mkLams dicts $
mkDsLets core_binds tup_expr
Let core_bind tup_expr
locals = [local | (_, _, local) <- exports]
local_tys = map idType locals
in
......
......@@ -33,7 +33,7 @@ import DsBinds ( dsMonoBinds, AutoScc(..) )
import DsGRHSs ( dsGuarded )
import DsCCall ( dsCCall, resultWrapper )
import DsListComp ( dsListComp )
import DsUtils ( mkErrorAppDs, mkDsLets, mkStringLit, mkStringLitFS,
import DsUtils ( mkErrorAppDs, mkStringLit, mkStringLitFS,
mkConsExpr, mkNilExpr, mkIntegerLit
)
import Match ( matchWrapper, matchSimply )
......@@ -106,9 +106,14 @@ dsLet (MonoBind (AbsBinds [] [] binder_triples inlines
-- Ordinary case for bindings
dsLet (MonoBind binds sigs is_rec) body
= dsMonoBinds NoSccs binds [] `thenDs` \ prs ->
case is_rec of
Recursive -> returnDs (Let (Rec prs) body)
NonRecursive -> returnDs (mkDsLets [NonRec b r | (b,r) <- prs] body)
returnDs (Let (Rec prs) body)
-- Use a Rec regardless of is_rec.
-- Why? Because it allows the MonoBinds to be all
-- mixed up, which is what happens in one rare case
-- Namely, for an AbsBind with no tyvars and no dicts,
-- but which does have dictionary bindings.
-- See notes with TcSimplify.inferLoop [NO TYVARS]
-- It turned out that wrapping a Rec here was the easiest solution
\end{code}
%************************************************************************
......
Supports Markdown
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