diff options
Diffstat (limited to 'compiler/GHC/CoreToByteCode.hs')
| -rw-r--r-- | compiler/GHC/CoreToByteCode.hs | 10 |
1 files changed, 6 insertions, 4 deletions
diff --git a/compiler/GHC/CoreToByteCode.hs b/compiler/GHC/CoreToByteCode.hs index 96f1f96e63..5c6b034360 100644 --- a/compiler/GHC/CoreToByteCode.hs +++ b/compiler/GHC/CoreToByteCode.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP, MagicHash, RecordWildCards, BangPatterns #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE PatternSynonyms #-} {-# OPTIONS_GHC -fprof-auto-top #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- @@ -28,7 +29,7 @@ import GHC.Platform import GHC.Types.Name import GHC.Types.Id.Make import GHC.Types.Id -import GHC.Types.Var ( updateVarType ) +import GHC.Types.Var ( updateVarTypeButNotMult ) import GHC.Types.ForeignCall import GHC.Driver.Types import GHC.Core.Utils @@ -37,6 +38,7 @@ import GHC.Core.Ppr import GHC.Types.Literal import GHC.Builtin.PrimOps import GHC.Core.FVs +import GHC.Core.Multiplicity ( pattern Many ) import GHC.Core.Type import GHC.Types.RepType import GHC.Core.DataCon @@ -625,7 +627,7 @@ schemeE d s p exp@(AnnTick (Breakpoint _id _fvs) _rhs) -- Here (k n) :: a :: Type r, so we don't know if it's lifted -- or not; but that should be fine provided we add that void arg. - id <- newId (mkVisFunTy realWorldStatePrimTy ty) + id <- newId (mkVisFunTyMany realWorldStatePrimTy ty) st <- newId realWorldStatePrimTy let letExp = AnnLet (AnnNonRec id (fvs, AnnLam st (emptyDVarSet, exp))) (emptyDVarSet, (AnnApp (emptyDVarSet, AnnVar id) @@ -708,7 +710,7 @@ protectNNLJoinPointBind x rhs@(fvs, _) protectNNLJoinPointId :: Id -> Id protectNNLJoinPointId x = ASSERT( isNNLJoinPoint x ) - updateVarType (voidPrimTy `mkVisFunTy`) x + updateVarTypeButNotMult (voidPrimTy `mkVisFunTyMany`) x {- Ticked Expressions @@ -2060,7 +2062,7 @@ getTopStrings = BcM $ \st -> return (st, topStrings st) newId :: Type -> BcM Id newId ty = do uniq <- newUnique - return $ mkSysLocal tickFS uniq ty + return $ mkSysLocal tickFS uniq Many ty tickFS :: FastString tickFS = fsLit "ticked" |