summaryrefslogtreecommitdiff
path: root/compiler/GHC/Types/Cpr.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Types/Cpr.hs')
-rw-r--r--compiler/GHC/Types/Cpr.hs10
1 files changed, 9 insertions, 1 deletions
diff --git a/compiler/GHC/Types/Cpr.hs b/compiler/GHC/Types/Cpr.hs
index 2405b8f524..c486f24bd6 100644
--- a/compiler/GHC/Types/Cpr.hs
+++ b/compiler/GHC/Types/Cpr.hs
@@ -10,7 +10,8 @@ module GHC.Types.Cpr (
CprType (..), topCprType, botCprType, flatConCprType,
lubCprType, applyCprTy, abstractCprTy, trimCprTy,
UnpackConFieldsResult (..), unpackConFieldsCpr,
- CprSig (..), topCprSig, isTopCprSig, mkCprSigForArity, mkCprSig, seqCprSig
+ CprSig (..), topCprSig, isTopCprSig, mkCprSigForArity, mkCprSig,
+ seqCprSig, prependArgsCprSig
) where
import GHC.Prelude
@@ -187,6 +188,13 @@ mkCprSig arty cpr = CprSig (CprType arty cpr)
seqCprSig :: CprSig -> ()
seqCprSig (CprSig ty) = seqCprTy ty
+prependArgsCprSig :: Arity -> CprSig -> CprSig
+-- ^ Add extra value args to CprSig
+prependArgsCprSig n_extra cpr_sig@(CprSig (CprType arity cpr))
+ | n_extra == 0 = cpr_sig
+ | otherwise = assertPpr (n_extra > 0) (ppr n_extra) $
+ CprSig (CprType (arity + n_extra) cpr)
+
-- | BNF:
--
-- > cpr ::= '' -- TopCpr