From: Roman Leshchinskiy <rl@cse.unsw.edu.au>
Date: Thu, 3 Dec 2009 03:14:52 +0000 (+0000)
Subject: Generate INLINE pragmas for PA methods
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=95d4b4c552cef8a33bbfb37361e90c079d65134b

Generate INLINE pragmas for PA methods
---

diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs
index 849d507..15725fd 100644
--- a/compiler/basicTypes/BasicTypes.lhs
+++ b/compiler/basicTypes/BasicTypes.lhs
@@ -57,7 +57,7 @@ module BasicTypes(
 	CompilerPhase, 
 	Activation(..), isActive, isNeverActive, isAlwaysActive, isEarlyActive,
         RuleMatchInfo(..), isConLike, isFunLike, 
-        InlinePragma(..), defaultInlinePragma, neverInlinePragma, dfunInlinePragma,
+        InlinePragma(..), defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma,
 	isDefaultInlinePragma, isInlinePragma,
         inlinePragmaActivation, inlinePragmaRuleMatchInfo,
         setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
@@ -660,9 +660,12 @@ isFunLike :: RuleMatchInfo -> Bool
 isFunLike FunLike = True
 isFunLike _            = False
 
-defaultInlinePragma, neverInlinePragma, dfunInlinePragma :: InlinePragma
+defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
+  :: InlinePragma
 defaultInlinePragma 
   = InlinePragma { inl_act = AlwaysActive, inl_rule = FunLike, inl_inline = False }
+alwaysInlinePragma
+  = InlinePragma { inl_act = AlwaysActive, inl_rule = FunLike, inl_inline = True }
 neverInlinePragma   
    = InlinePragma { inl_act = NeverActive, inl_rule = FunLike, inl_inline = False }
 dfunInlinePragma   
diff --git a/compiler/vectorise/VectType.hs b/compiler/vectorise/VectType.hs
index 16ac82a..f31ecd8 100644
--- a/compiler/vectorise/VectType.hs
+++ b/compiler/vectorise/VectType.hs
@@ -24,7 +24,7 @@ import OccName
 import Id
 import MkId
 import BasicTypes        ( StrictnessMark(..), boolToRecFlag,
-                           dfunInlinePragma )
+                           alwaysInlinePragma, dfunInlinePragma )
 import Var               ( Var, TyVar, varType )
 import Name              ( Name, getOccName )
 import NameEnv
@@ -831,6 +831,7 @@ buildPADict vect_tc prepr_tc arr_tc repr
           raw_var <- newExportedVar (method_name name) (exprType body)
           let var = raw_var
                       `setIdUnfolding` mkInlineRule needSaturated body (length args)
+                      `setInlinePragma` alwaysInlinePragma
           hoistBinding var body
           return var