diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2015-07-20 16:18:05 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2015-07-21 14:21:40 +0100 |
| commit | efa7b3a474bc373201ab145c129262a73c86f959 (patch) | |
| tree | 1fcc99378ad4a86b98ab91c770e9325058c79476 /compiler/typecheck/TcClassDcl.hs | |
| parent | 3c44a46b352a4eb7ff72eb3aa5495b25dee8351f (diff) | |
| download | haskell-efa7b3a474bc373201ab145c129262a73c86f959.tar.gz | |
Add NOINLINE for hs-boot functions
This fixes Trac #10083.
The key change is in TcBinds.tcValBinds, where we construct
the prag_fn. With this patch we add a NOINLINE pragma for
any functions that were exported by the hs-boot file for this
module.
See Note [Inlining and hs-boot files], and #10083, for details.
The commit touches several other files becuase I also changed the
representation of the "pragma function" from a function TcPragFun
to an environment, TcPragEnv. This makes it easer to extend
during construction.
Diffstat (limited to 'compiler/typecheck/TcClassDcl.hs')
| -rw-r--r-- | compiler/typecheck/TcClassDcl.hs | 12 |
1 files changed, 6 insertions, 6 deletions
diff --git a/compiler/typecheck/TcClassDcl.hs b/compiler/typecheck/TcClassDcl.hs index bc1bac291c..e868da2638 100644 --- a/compiler/typecheck/TcClassDcl.hs +++ b/compiler/typecheck/TcClassDcl.hs @@ -19,7 +19,7 @@ module TcClassDcl ( tcClassSigs, tcClassDecl2, import HsSyn import TcEnv -import TcPat( addInlinePrags, completeSigPolyId ) +import TcPat( addInlinePrags, completeSigPolyId, lookupPragEnv, emptyPragEnv ) import TcEvidence( idHsWrapper ) import TcBinds import TcUnify @@ -157,7 +157,7 @@ tcClassDecl2 (L loc (ClassDecl {tcdLName = class_name, tcdSigs = sigs, -- And since ds is big, it doesn't get inlined, so we don't get good -- default methods. Better to make separate AbsBinds for each ; let (tyvars, _, _, op_items) = classBigSig clas - prag_fn = mkPragFun sigs default_binds + prag_fn = mkPragEnv sigs default_binds sig_fn = mkHsSigFun sigs clas_tyvars = snd (tcSuperSkolTyVars tyvars) pred = mkClassPred clas (mkTyVarTys clas_tyvars) @@ -171,7 +171,7 @@ tcClassDecl2 (L loc (ClassDecl {tcdLName = class_name, tcdSigs = sigs, -- with redundant constraints; but not for DefMeth, where -- the default method may well be 'error' or something NoDefMeth -> do { mapM_ (addLocM (badDmPrag sel_id)) - (prag_fn (idName sel_id)) + (lookupPragEnv prag_fn (idName sel_id)) ; return emptyBag } tc_dm = tcDefMeth clas clas_tyvars this_dict default_binds sig_fn prag_fn @@ -184,7 +184,7 @@ tcClassDecl2 (L loc (ClassDecl {tcdLName = class_name, tcdSigs = sigs, tcClassDecl2 d = pprPanic "tcClassDecl2" (ppr d) tcDefMeth :: Class -> [TyVar] -> EvVar -> LHsBinds Name - -> HsSigFun -> PragFun -> Id -> Name -> Bool + -> HsSigFun -> TcPragEnv -> Id -> Name -> Bool -> TcM (LHsBinds TcId) -- Generate code for polymorphic default methods only (hence DefMeth) -- (Generic default methods have turned into instance decls by now.) @@ -250,8 +250,8 @@ tcDefMeth clas tyvars this_dict binds_in | otherwise = pprPanic "tcDefMeth" (ppr sel_id) where sel_name = idName sel_id - prags = prag_fn sel_name - no_prag_fn _ = [] -- No pragmas for local_meth_id; + prags = lookupPragEnv prag_fn sel_name + no_prag_fn = emptyPragEnv -- No pragmas for local_meth_id; -- they are all for meth_id --------------- |