diff options
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/GHC/Builtin/PrimOps.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/Builtin/Types.hs | 5 | ||||
-rw-r--r-- | compiler/GHC/Builtin/Types.hs-boot | 2 | ||||
-rw-r--r-- | compiler/GHC/Builtin/Types/Prim.hs | 48 | ||||
-rw-r--r-- | compiler/GHC/Builtin/primops.txt.pp | 17 | ||||
-rw-r--r-- | compiler/GHC/Types/Id/Make.hs | 2 |
6 files changed, 62 insertions, 20 deletions
diff --git a/compiler/GHC/Builtin/PrimOps.hs b/compiler/GHC/Builtin/PrimOps.hs index bbedb6f2c8..067f0e0d7c 100644 --- a/compiler/GHC/Builtin/PrimOps.hs +++ b/compiler/GHC/Builtin/PrimOps.hs @@ -109,14 +109,14 @@ data PrimOpInfo = Compare OccName -- string :: T -> T -> Int# Type | GenPrimOp OccName -- string :: \/a1..an . T1 -> .. -> Tk -> T - [TyVar] + [TyVarBinder] [Type] Type mkCompare :: FastString -> Type -> PrimOpInfo mkCompare str ty = Compare (mkVarOccFS str) ty -mkGenPrimOp :: FastString -> [TyVar] -> [Type] -> Type -> PrimOpInfo +mkGenPrimOp :: FastString -> [TyVarBinder] -> [Type] -> Type -> PrimOpInfo mkGenPrimOp str tvs tys ty = GenPrimOp (mkVarOccFS str) tvs tys ty {- @@ -607,7 +607,7 @@ primOpType op Compare _occ ty -> compare_fun_ty ty GenPrimOp _occ tyvars arg_tys res_ty -> - mkSpecForAllTys tyvars (mkVisFunTysMany arg_tys res_ty) + mkForAllTys tyvars (mkVisFunTysMany arg_tys res_ty) primOpResultType :: PrimOp -> Type primOpResultType op @@ -722,7 +722,7 @@ isComparisonPrimOp op = case primOpInfo op of -- (type variables, argument types, result type) -- It also gives arity, strictness info -primOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, DmdSig) +primOpSig :: PrimOp -> ([TyVarBinder], [Type], Type, Arity, DmdSig) primOpSig op = (tyvars, arg_tys, res_ty, arity, primOpStrictness op arity) where diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs index e6f988e841..dd0c8f4a0b 100644 --- a/compiler/GHC/Builtin/Types.hs +++ b/compiler/GHC/Builtin/Types.hs @@ -114,7 +114,7 @@ module GHC.Builtin.Types ( runtimeRepTyCon, levityTyCon, vecCountTyCon, vecElemTyCon, boxedRepDataConTyCon, - runtimeRepTy, liftedRepTy, unliftedRepTy, + runtimeRepTy, levityTy, liftedRepTy, unliftedRepTy, vecRepDataConTyCon, tupleRepDataConTyCon, sumRepDataConTyCon, @@ -1478,8 +1478,9 @@ unrestrictedFunTyConName = mkWiredInTyConName BuiltInSyntax gHC_TYPES (fsLit "-> -- For information about the usage of the following type, -- see Note [TYPE and RuntimeRep] in module GHC.Builtin.Types.Prim -runtimeRepTy :: Type +runtimeRepTy, levityTy :: Type runtimeRepTy = mkTyConTy runtimeRepTyCon +levityTy = mkTyConTy levityTyCon -- Type synonyms; see Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim -- and Note [Prefer Type over TYPE 'LiftedRep] in GHC.Core.TyCo.Rep. diff --git a/compiler/GHC/Builtin/Types.hs-boot b/compiler/GHC/Builtin/Types.hs-boot index 1c341de418..e2b279d7ae 100644 --- a/compiler/GHC/Builtin/Types.hs-boot +++ b/compiler/GHC/Builtin/Types.hs-boot @@ -28,7 +28,7 @@ unliftedRepTyCon :: TyCon constraintKind :: Kind runtimeRepTyCon, levityTyCon, vecCountTyCon, vecElemTyCon :: TyCon -runtimeRepTy :: Type +runtimeRepTy, levityTy :: Type boxedRepDataConTyCon :: TyCon liftedDataConTyCon :: TyCon diff --git a/compiler/GHC/Builtin/Types/Prim.hs b/compiler/GHC/Builtin/Types/Prim.hs index 45140e60f2..eaeda97f69 100644 --- a/compiler/GHC/Builtin/Types/Prim.hs +++ b/compiler/GHC/Builtin/Types/Prim.hs @@ -20,15 +20,21 @@ module GHC.Builtin.Types.Prim( mkTemplateAnonTyConBinders, alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar, + alphaTyVarSpec, betaTyVarSpec, gammaTyVarSpec, deltaTyVarSpec, alphaTys, alphaTy, betaTy, gammaTy, deltaTy, alphaTyVarsUnliftedRep, alphaTyVarUnliftedRep, alphaTysUnliftedRep, alphaTyUnliftedRep, runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep3TyVar, + runtimeRep1TyVarInf, runtimeRep2TyVarInf, runtimeRep1Ty, runtimeRep2Ty, runtimeRep3Ty, + levity1TyVar, levity1TyVarInf, levity1Ty, openAlphaTyVar, openBetaTyVar, openGammaTyVar, + openAlphaTyVarSpec, openBetaTyVarSpec, openGammaTyVarSpec, openAlphaTy, openBetaTy, openGammaTy, + levPolyTyVar1, levPolyTyVar1Spec, levPolyTy1, + multiplicityTyVar1, multiplicityTyVar2, -- Kind constructors... @@ -97,8 +103,8 @@ module GHC.Builtin.Types.Prim( import GHC.Prelude import {-# SOURCE #-} GHC.Builtin.Types - ( runtimeRepTy, unboxedTupleKind, liftedTypeKind - , vecRepDataConTyCon, tupleRepDataConTyCon + ( runtimeRepTy, levityTy, unboxedTupleKind, liftedTypeKind + , boxedRepDataConTyCon, vecRepDataConTyCon, tupleRepDataConTyCon , liftedRepTy, unliftedRepTy , intRepDataConTy , int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy @@ -114,7 +120,8 @@ import {-# SOURCE #-} GHC.Builtin.Types , doubleElemRepDataConTy , mkPromotedListTy, multiplicityTy ) -import GHC.Types.Var ( TyVar, mkTyVar ) +import GHC.Types.Var ( TyVarBinder, TyVar + , mkTyVar, mkTyVarBinder, mkTyVarBinders ) import GHC.Types.Name import {-# SOURCE #-} GHC.Types.TyThing import GHC.Core.TyCon @@ -127,7 +134,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Core.TyCo.Rep -- Doesn't need special access, but this is easier to avoid -- import loops which show up if you import Type instead -import {-# SOURCE #-} GHC.Core.Type ( mkTyConTy, tYPE ) +import {-# SOURCE #-} GHC.Core.Type ( mkTyConTy, mkTyConApp, tYPE ) import Data.Char @@ -360,6 +367,9 @@ alphaTyVars = mkTemplateTyVars $ repeat liftedTypeKind alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar :: TyVar (alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars +alphaTyVarSpec, betaTyVarSpec, gammaTyVarSpec, deltaTyVarSpec :: TyVarBinder +(alphaTyVarSpec:betaTyVarSpec:gammaTyVarSpec:deltaTyVarSpec:_) = mkTyVarBinders Specified alphaTyVars + alphaTys :: [Type] alphaTys = mkTyVarTys alphaTyVars alphaTy, betaTy, gammaTy, deltaTy :: Type @@ -380,11 +390,14 @@ runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep3TyVar :: TyVar (runtimeRep1TyVar : runtimeRep2TyVar : runtimeRep3TyVar : _) = drop 16 (mkTemplateTyVars (repeat runtimeRepTy)) -- selects 'q','r' +runtimeRep1TyVarInf, runtimeRep2TyVarInf :: TyVarBinder +runtimeRep1TyVarInf = mkTyVarBinder Inferred runtimeRep1TyVar +runtimeRep2TyVarInf = mkTyVarBinder Inferred runtimeRep2TyVar + runtimeRep1Ty, runtimeRep2Ty, runtimeRep3Ty :: Type runtimeRep1Ty = mkTyVarTy runtimeRep1TyVar runtimeRep2Ty = mkTyVarTy runtimeRep2TyVar runtimeRep3Ty = mkTyVarTy runtimeRep3TyVar - openAlphaTyVar, openBetaTyVar, openGammaTyVar :: TyVar -- alpha :: TYPE r1 -- beta :: TYPE r2 @@ -392,11 +405,36 @@ openAlphaTyVar, openBetaTyVar, openGammaTyVar :: TyVar [openAlphaTyVar,openBetaTyVar,openGammaTyVar] = mkTemplateTyVars [tYPE runtimeRep1Ty, tYPE runtimeRep2Ty, tYPE runtimeRep3Ty] +openAlphaTyVarSpec, openBetaTyVarSpec, openGammaTyVarSpec :: TyVarBinder +openAlphaTyVarSpec = mkTyVarBinder Specified openAlphaTyVar +openBetaTyVarSpec = mkTyVarBinder Specified openBetaTyVar +openGammaTyVarSpec = mkTyVarBinder Specified openGammaTyVar + openAlphaTy, openBetaTy, openGammaTy :: Type openAlphaTy = mkTyVarTy openAlphaTyVar openBetaTy = mkTyVarTy openBetaTyVar openGammaTy = mkTyVarTy openGammaTyVar +levity1TyVar :: TyVar +(levity1TyVar : _) + = drop 11 (mkTemplateTyVars (repeat levityTy)) -- selects 'l' + +levity1TyVarInf :: TyVarBinder +levity1TyVarInf = mkTyVarBinder Inferred levity1TyVar + +levity1Ty :: Type +levity1Ty = mkTyVarTy levity1TyVar + +levPolyTyVar1 :: TyVar +[levPolyTyVar1] = mkTemplateTyVars [tYPE (mkTyConApp boxedRepDataConTyCon [levity1Ty])] +-- tv :: TYPE ('BoxedRep l) + +levPolyTyVar1Spec :: TyVarBinder +levPolyTyVar1Spec = mkTyVarBinder Specified levPolyTyVar1 + +levPolyTy1 :: Type +levPolyTy1 = mkTyVarTy levPolyTyVar1 + multiplicityTyVar1, multiplicityTyVar2 :: TyVar (multiplicityTyVar1 : multiplicityTyVar2 : _) = drop 13 (mkTemplateTyVars (repeat multiplicityTy)) -- selects 'n', 'm' diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp index 3bddd10285..f56687c351 100644 --- a/compiler/GHC/Builtin/primops.txt.pp +++ b/compiler/GHC/Builtin/primops.txt.pp @@ -2463,8 +2463,9 @@ primop CatchOp "catch#" GenPrimOp has_side_effects = True primop RaiseOp "raise#" GenPrimOp - b -> o - -- NB: the type variable "o" is "a", but with OpenKind + a -> p + -- NB: "p" is the same as "b" except it is representation-polymorphic + -- (we shouldn't use "o" here as that would conflict with "a") with -- In contrast to 'raiseIO#', which throws a *precise* exception, -- exceptions thrown by 'raise#' are considered *imprecise*. @@ -2831,10 +2832,10 @@ section "Weak pointers" primtype Weak# b --- note that tyvar "o" denotes openAlphaTyVar +-- Note: "v" denotes a levity-polymorphic type variable primop MkWeakOp "mkWeak#" GenPrimOp - o -> b -> (State# RealWorld -> (# State# RealWorld, c #)) + v -> b -> (State# RealWorld -> (# State# RealWorld, c #)) -> State# RealWorld -> (# State# RealWorld, Weak# b #) { {\tt mkWeak# k v finalizer s} creates a weak reference to value {\tt k}, with an associated reference to some value {\tt v}. If {\tt k} is still @@ -2846,7 +2847,7 @@ primop MkWeakOp "mkWeak#" GenPrimOp out_of_line = True primop MkWeakNoFinalizerOp "mkWeakNoFinalizer#" GenPrimOp - o -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #) + v -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #) with has_side_effects = True out_of_line = True @@ -2883,7 +2884,7 @@ primop FinalizeWeakOp "finalizeWeak#" GenPrimOp out_of_line = True primop TouchOp "touch#" GenPrimOp - o -> State# RealWorld -> State# RealWorld + v -> State# RealWorld -> State# RealWorld with code_size = { 0 } has_side_effects = True @@ -3131,8 +3132,10 @@ section "Controlling object lifetime" ------------------------------------------------------------------------ -- See Note [keepAlive# magic] in GHC.CoreToStg.Prep. +-- NB: "v" is the same as "a" except levity-polymorphic, +-- and "p" is the same as "b" except representation-polymorphic primop KeepAliveOp "keepAlive#" GenPrimOp - o -> State# RealWorld -> (State# RealWorld -> p) -> p + v -> State# RealWorld -> (State# RealWorld -> p) -> p { \tt{keepAlive# x s k} keeps the value \tt{x} alive during the execution of the computation \tt{k}. } with diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs index b34c0fc8cb..d179c53ed3 100644 --- a/compiler/GHC/Types/Id/Make.hs +++ b/compiler/GHC/Types/Id/Make.hs @@ -1311,7 +1311,7 @@ mkPrimOpId prim_op = id where (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op - ty = mkSpecForAllTys tyvars (mkVisFunTysMany arg_tys res_ty) + ty = mkForAllTys tyvars (mkVisFunTysMany arg_tys res_ty) name = mkWiredInName gHC_PRIM (primOpOcc prim_op) (mkPrimOpIdUnique (primOpTag prim_op)) (AnId id) UserSyntax |