- primitive operations
\begin{code}
-{-# OPTIONS -fno-warn-missing-signatures #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- <http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings>
--- for details
-
module MkId (
mkDictFunId, mkDefaultMethodId,
mkDictSelId,
data instance T [a] where
T1 :: forall b. b -> T [Maybe b]
-Hence
- Co7T a :: T [a] ~ :R7T a
-Now we want
+Hence we translate to
-- Wrapper
$WT1 :: forall b. b -> T [Maybe b]
-- Worker
T1 :: forall c b. (c ~ Maybe b) => b -> :R7T c
+ -- Coercion from family type to representation type
+ Co7T a :: T [a] ~ :R7T a
+
\begin{code}
mkDataConIds :: Name -> Name -> DataCon -> DataConIds
mkDataConIds wrap_name wkr_name data_con
-- by the caller. So doing CPR for them may in fact make
-- things worse.
+mkLocals :: Int -> [Type] -> ([Id], Int)
mkLocals i tys = (zipWith mkTemplateLocal [i..i+n-1] tys, i+n)
where
n = length tys
mkBreakPointOpId uniq mod ix = mkTickBox' uniq mod ix ty
where ty = mkSigmaTy [openAlphaTyVar] [] openAlphaTy
+mkTickBox' :: Unique -> Module -> TickBoxId -> Type -> Id
mkTickBox' uniq mod ix ty = mkGlobalId (TickBoxOpId tickbox) name ty info
where
tickbox = TickBox mod ix
that they aren't discarded by the occurrence analyser.
\begin{code}
-mkDefaultMethodId dm_name ty = mkExportedLocalId dm_name ty
+mkDefaultMethodId :: Id -- Selector Id
+ -> Name -- Default method name
+ -> Id -- Default method Id
+mkDefaultMethodId sel_id dm_name = mkExportedLocalId dm_name (idType sel_id)
mkDictFunId :: Name -- Name to use for the dict fun;
-> [TyVar]
another gun with which to shoot yourself in the foot.
\begin{code}
+mkWiredInIdName :: Module -> FastString -> Unique -> Id -> Name
mkWiredInIdName mod fs uniq id
= mkWiredInName mod (mkOccNameFS varName fs) uniq (AnId id) UserSyntax
+unsafeCoerceName, nullAddrName, seqName, realWorldName :: Name
+lazyIdName, errorName, recSelErrorName, runtimeErrorName :: Name
+irrefutPatErrorName, recConErrorName, patErrorName :: Name
+nonExhaustiveGuardsErrorName, noMethodBindingErrorName :: Name
unsafeCoerceName = mkWiredInIdName gHC_PRIM (fsLit "unsafeCoerce#") unsafeCoerceIdKey unsafeCoerceId
nullAddrName = mkWiredInIdName gHC_PRIM (fsLit "nullAddr#") nullAddrIdKey nullAddrId
seqName = mkWiredInIdName gHC_PRIM (fsLit "seq") seqIdKey seqId
\begin{code}
------------------------------------------------
-- unsafeCoerce# :: forall a b. a -> b
+unsafeCoerceId :: Id
unsafeCoerceId
= pcMiscPrelId unsafeCoerceName ty info
where
info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
- ty = mkForAllTys [openAlphaTyVar,openBetaTyVar]
- (mkFunTy openAlphaTy openBetaTy)
- [x] = mkTemplateLocals [openAlphaTy]
- rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
- Cast (Var x) (mkUnsafeCoercion openAlphaTy openBetaTy)
+ ty = mkForAllTys [argAlphaTyVar,openBetaTyVar]
+ (mkFunTy argAlphaTy openBetaTy)
+ [x] = mkTemplateLocals [argAlphaTy]
+ rhs = mkLams [argAlphaTyVar,openBetaTyVar,x] $
+ Cast (Var x) (mkUnsafeCoercion argAlphaTy openBetaTy)
------------------------------------------------
nullAddrId :: Id
`setSpecInfo` mkSpecInfo [seq_cast_rule]
- ty = mkForAllTys [alphaTyVar,openBetaTyVar]
- (mkFunTy alphaTy (mkFunTy openBetaTy openBetaTy))
- [x,y] = mkTemplateLocals [alphaTy, openBetaTy]
- rhs = mkLams [alphaTyVar,openBetaTyVar,x,y] (Case (Var x) x openBetaTy [(DEFAULT, [], Var y)])
+ ty = mkForAllTys [alphaTyVar,argBetaTyVar]
+ (mkFunTy alphaTy (mkFunTy argBetaTy argBetaTy))
+ [x,y] = mkTemplateLocals [alphaTy, argBetaTy]
+ rhs = mkLams [alphaTyVar,argBetaTyVar,x,y] (Case (Var x) x argBetaTy [(DEFAULT, [], Var y)])
-- See Note [Built-in RULES for seq]
seq_cast_rule = BuiltinRule { ru_name = fsLit "seq of cast"
This comes up in strictness analysis
\begin{code}
+realWorldPrimId :: Id
realWorldPrimId -- :: State# RealWorld
= pcMiscPrelId realWorldName realWorldStatePrimTy
(noCafIdInfo `setUnfoldingInfo` evaldUnfolding)
mkImpossibleExpr res_ty
= mkRuntimeErrorApp rUNTIME_ERROR_ID res_ty "Impossible case alternative"
+rEC_SEL_ERROR_ID, rUNTIME_ERROR_ID, iRREFUT_PAT_ERROR_ID, rEC_CON_ERROR_ID :: Id
+pAT_ERROR_ID, nO_METHOD_BINDING_ERROR_ID, nON_EXHAUSTIVE_GUARDS_ERROR_ID :: Id
rEC_SEL_ERROR_ID = mkRuntimeErrorId recSelErrorName
rUNTIME_ERROR_ID = mkRuntimeErrorId runtimeErrorName
iRREFUT_PAT_ERROR_ID = mkRuntimeErrorId irrefutPatErrorName
\end{code}
\begin{code}
+eRROR_ID :: Id
eRROR_ID = pc_bottoming_Id errorName errorTy
errorTy :: Type