projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (from parent 1:
a7ecdf9
)
[project @ 2005-07-19 22:53:37 by simonpj]
author
simonpj
<unknown>
Tue, 19 Jul 2005 22:53:37 +0000
(22:53 +0000)
committer
simonpj
<unknown>
Tue, 19 Jul 2005 22:53:37 +0000
(22:53 +0000)
Wibble
ghc/compiler/deSugar/DsBinds.lhs
patch
|
blob
|
history
diff --git
a/ghc/compiler/deSugar/DsBinds.lhs
b/ghc/compiler/deSugar/DsBinds.lhs
index
fe3276f
..
87fda8e
100644
(file)
--- a/
ghc/compiler/deSugar/DsBinds.lhs
+++ b/
ghc/compiler/deSugar/DsBinds.lhs
@@
-30,7
+30,7
@@
import OccurAnal ( occurAnalyseExpr )
import CostCentre ( mkAutoCC, IsCafCC(..) )
import Id ( Id, idType, idName, isExportedId, mkLocalId, setInlinePragma )
import Rules ( addIdSpecialisations, mkLocalRule )
import CostCentre ( mkAutoCC, IsCafCC(..) )
import Id ( Id, idType, idName, isExportedId, mkLocalId, setInlinePragma )
import Rules ( addIdSpecialisations, mkLocalRule )
-import Var ( Var, isGlobalId )
+import Var ( Var, isGlobalId, setIdNotExported )
import VarEnv
import Type ( mkTyVarTy, substTyWith )
import TysWiredIn ( voidTy )
import VarEnv
import Type ( mkTyVarTy, substTyWith )
import TysWiredIn ( voidTy )
@@
-183,6
+183,8
@@
dsHsBind auto_scc rest (AbsBinds all_tyvars dicts exports binds)
--
-- Spec bind: f_spec = Let f = /\ab \(d1:Eq a)(d2:Ix b). let binds in f_mono
-- /\b.\(d:Ix b). in f Int b dInt d
--
-- Spec bind: f_spec = Let f = /\ab \(d1:Eq a)(d2:Ix b). let binds in f_mono
-- /\b.\(d:Ix b). in f Int b dInt d
+-- The idea is that f occurs just once, so it'll be
+-- inlined and specialised
dsSpec all_tvs dicts tvs poly_id mono_id mono_bind (InlinePrag {})
= return Nothing
dsSpec all_tvs dicts tvs poly_id mono_id mono_bind (InlinePrag {})
= return Nothing
@@
-200,8
+202,11
@@
dsSpec all_tvs dicts tvs poly_id mono_id mono_bind
Just (bndrs', var, args) -> return (Just ((spec_id, spec_rhs), rule))
where
Just (bndrs', var, args) -> return (Just ((spec_id, spec_rhs), rule))
where
+ local_poly = setIdNotExported poly_id
+ -- Very important to make the 'f' non-exported,
+ -- else it won't be inlined!
spec_id = mkLocalId spec_name spec_ty
spec_id = mkLocalId spec_name spec_ty
- spec_rhs = Let (NonRec poly_id poly_f_body) ds_spec_expr
+ spec_rhs = Let (NonRec local_poly poly_f_body) ds_spec_expr
poly_f_body = mkLams (tvs ++ dicts) $
fix_up (Let mono_bind (Var mono_id))
poly_f_body = mkLams (tvs ++ dicts) $
fix_up (Let mono_bind (Var mono_id))