Commit 95d4b4c5 authored by rl@cse.unsw.edu.au's avatar rl@cse.unsw.edu.au

Generate INLINE pragmas for PA methods

parent d305c6b6
......@@ -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
......
......@@ -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
......
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