mkDictFunId, mkDefaultMethodId,
mkDictSelId,
- mkDataConId, mkDataConWrapId,
+ mkDataConWorkId, mkDataConWrapId,
mkRecordSelId,
mkPrimOpId, mkFCallId,
-- And some particular Ids; see below for why they are wired in
wiredInIds, ghcPrimIds,
unsafeCoerceId, realWorldPrimId, voidArgId, nullAddrId, seqId,
+ lazyId, lazyIdUnfolding, lazyIdKey,
mkRuntimeErrorApp,
rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID, rUNTIME_ERROR_ID,
import BasicTypes ( Arity, StrictnessMark(..), isMarkedUnboxed, isMarkedStrict )
-import TysPrim ( openAlphaTyVars, alphaTyVar, alphaTy, betaTyVar, betaTy,
- intPrimTy, realWorldStatePrimTy, addrPrimTy
+import TysPrim ( openAlphaTyVars, alphaTyVar, alphaTy,
+ realWorldStatePrimTy, addrPrimTy
)
import TysWiredIn ( charTy, mkListTy )
import PrelRules ( primOpRules )
isUnLiftedType, mkForAllTys, mkTyVarTy, tyVarsOfType,
tcSplitFunTys, tcSplitForAllTys, mkPredTy
)
-import Module ( Module )
import CoreUtils ( exprType )
import CoreUnfold ( mkTopUnfolding, mkCompulsoryUnfolding, mkOtherCon )
import Literal ( Literal(..), nullAddrLit )
import Class ( Class, classTyCon, classTyVars, classSelIds )
import Var ( Id, TyVar, Var )
import VarSet ( isEmptyVarSet )
-import Name ( mkWiredInName, mkFCallName, Name )
-import OccName ( mkVarOcc )
-import PrimOp ( PrimOp(DataToTagOp), primOpSig, mkPrimOpIdName )
+import Name ( mkFCallName, Name )
+import PrimOp ( PrimOp, primOpSig, mkPrimOpIdName )
import ForeignCall ( ForeignCall )
import DataCon ( DataCon,
dataConFieldLabels, dataConRepArity, dataConTyCon,
dataConArgTys, dataConRepType,
dataConOrigArgTys,
- dataConName, dataConTheta,
+ dataConTheta,
dataConSig, dataConStrictMarks, dataConWorkId,
splitProductType
)
-import Id ( idType, mkGlobalId, mkVanillaGlobal, mkSysLocal,
- mkTemplateLocals, mkTemplateLocalsNum,
+import Id ( idType, mkGlobalId, mkVanillaGlobal, mkSysLocal, mkLocalId,
+ mkTemplateLocals, mkTemplateLocalsNum, setIdLocalExported,
mkTemplateLocal, idNewStrictness, idName
)
-import IdInfo ( IdInfo, noCafNoTyGenIdInfo,
+import IdInfo ( IdInfo, noCafIdInfo, hasCafIdInfo,
setUnfoldingInfo,
setArityInfo, setSpecInfo, setCafInfo,
setAllStrictnessInfo,
GlobalIdDetails(..), CafInfo(..)
)
import NewDemand ( mkStrictSig, strictSigResInfo, DmdResult(..),
- mkTopDmdType, topDmd, evalDmd, lazyDmd,
+ mkTopDmdType, topDmd, evalDmd, lazyDmd, retCPR,
Demand(..), Demands(..) )
import FieldLabel ( mkFieldLabel, fieldLabelName,
firstFieldLabelTag, allFieldLabelTags, fieldLabelType
import Maybe ( isJust )
import Util ( dropList, isSingleton )
import Outputable
+import FastString
import ListSetOps ( assoc, assocMaybe )
import UnicodeUtil ( stringToUtf8 )
import List ( nubBy )
-import Char ( ord )
\end{code}
%************************************************************************
-- error-reporting functions that they have an 'open'
-- result type. -- sof 1/99]
+ eRROR_ID, -- This one isn't used anywhere else in the compiler
+ -- But we still need it in wiredInIds so that when GHC
+ -- compiles a program that mentions 'error' we don't
+ -- import its type from the interface file; we just get
+ -- the Id defined here. Which has an 'open-tyvar' type.
+
rUNTIME_ERROR_ID,
iRREFUT_PAT_ERROR_ID,
nON_EXHAUSTIVE_GUARDS_ERROR_ID,
nO_METHOD_BINDING_ERROR_ID,
pAT_ERROR_ID,
- rEC_CON_ERROR_ID
+ rEC_CON_ERROR_ID,
+
+ lazyId
] ++ ghcPrimIds
-- These Ids are exported from GHC.Prim
realWorldPrimId,
unsafeCoerceId,
nullAddrId,
- getTagId,
seqId
]
\end{code}
%************************************************************************
\begin{code}
-mkDataConId :: Name -> DataCon -> Id
+mkDataConWorkId :: Name -> DataCon -> Id
-- Makes the *worker* for the data constructor; that is, the function
-- that takes the reprsentation arguments and builds the constructor.
-mkDataConId work_name data_con
- = mkGlobalId (DataConId data_con) work_name (dataConRepType data_con) info
+mkDataConWorkId wkr_name data_con
+ = mkGlobalId (DataConWorkId data_con) wkr_name
+ (dataConRepType data_con) info
where
- info = noCafNoTyGenIdInfo
+ info = noCafIdInfo
`setArityInfo` arity
`setAllStrictnessInfo` Just strict_sig
arity = dataConRepArity data_con
-
strict_sig = mkStrictSig (mkTopDmdType (replicate arity topDmd) cpr_info)
-- Notice that we do *not* say the worker is strict
-- even if the data constructor is declared strict
cpr_info | isProductTyCon tycon &&
isDataTyCon tycon &&
arity > 0 &&
- arity <= mAX_CPR_SIZE = RetCPR
+ arity <= mAX_CPR_SIZE = retCPR
| otherwise = TopRes
-- RetCPR is only true for products that are real data types;
-- that is, not unboxed tuples or [non-recursive] newtypes
it in the (common) case where the constructor arg is already evaluated.
\begin{code}
-mkDataConWrapId data_con
- = mkGlobalId (DataConWrapId data_con) (dataConName data_con) wrap_ty info
+mkDataConWrapId :: Name -> DataCon -> Maybe Id
+-- Only make a wrapper Id if necessary
+
+mkDataConWrapId wrap_name data_con
+ | is_newtype || any isMarkedStrict strict_marks
+ = -- We need a wrapper function
+ Just (mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty info)
+
+ | otherwise
+ = Nothing -- The common case, where there is no point in
+ -- having a wrapper function. Not only is this efficient,
+ -- but it also ensures that the wrapper is replaced
+ -- by the worker (becuase it *is* the wroker)
+ -- even when there are no args. E.g. in
+ -- f (:) x
+ -- the (:) *is* the worker.
+ -- This is really important in rule matching,
+ -- (We could match on the wrappers,
+ -- but that makes it less likely that rules will match
+ -- when we bring bits of unfoldings together.)
where
- work_id = dataConWorkId data_con
+ (tyvars, _, ex_tyvars, ex_theta, orig_arg_tys, tycon) = dataConSig data_con
+ is_newtype = isNewTyCon tycon
+ all_tyvars = tyvars ++ ex_tyvars
+ work_id = dataConWorkId data_con
- info = noCafNoTyGenIdInfo
- `setUnfoldingInfo` wrap_unf
- -- The NoCaf-ness is set by noCafNoTyGenIdInfo
- `setArityInfo` arity
+ common_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo
+ `setArityInfo` arity
-- It's important to specify the arity, so that partial
-- applications are treated as values
- `setAllStrictnessInfo` Just wrap_sig
+
+ info | is_newtype = common_info `setUnfoldingInfo` newtype_unf
+ | otherwise = common_info `setUnfoldingInfo` data_unf
+ `setAllStrictnessInfo` Just wrap_sig
wrap_sig = mkStrictSig (mkTopDmdType arg_dmds res_info)
res_info = strictSigResInfo (idNewStrictness work_id)
-- ...(let w = C x in ...(w p q)...)...
-- we want to see that w is strict in its two arguments
- wrap_unf | isNewTyCon tycon
- = ASSERT( null ex_tyvars && null ex_dict_args && isSingleton orig_arg_tys )
- -- No existentials on a newtype, but it can have a context
- -- e.g. newtype Eq a => T a = MkT (...)
- mkTopUnfolding $ Note InlineMe $
- mkLams tyvars $ Lam id_arg1 $
- mkNewTypeBody tycon result_ty (Var id_arg1)
-
- | not (any isMarkedStrict strict_marks)
- = mkCompulsoryUnfolding (Var work_id)
- -- The common case. Not only is this efficient,
- -- but it also ensures that the wrapper is replaced
- -- by the worker even when there are no args.
- -- f (:) x
- -- becomes
- -- f $w: x
- -- This is really important in rule matching,
- -- (We could match on the wrappers,
- -- but that makes it less likely that rules will match
- -- when we bring bits of unfoldings together.)
- --
- -- NB: because of this special case, (map (:) ys) turns into
- -- (map $w: ys). The top-level defn for (:) is never used.
- -- This is somewhat of a bore, but I'm currently leaving it
- -- as is, so that there still is a top level curried (:) for
- -- the interpreter to call.
-
- | otherwise
- = mkTopUnfolding $ Note InlineMe $
+ newtype_unf = ASSERT( null ex_tyvars && null ex_dict_args &&
+ isSingleton orig_arg_tys )
+ -- No existentials on a newtype, but it can have a context
+ -- e.g. newtype Eq a => T a = MkT (...)
+ mkTopUnfolding $ Note InlineMe $
+ mkLams tyvars $ Lam id_arg1 $
+ mkNewTypeBody tycon result_ty (Var id_arg1)
+
+ data_unf = mkTopUnfolding $ Note InlineMe $
mkLams all_tyvars $
mkLams ex_dict_args $ mkLams id_args $
foldr mk_case con_app
con_app i rep_ids = mkApps (Var work_id)
(map varToCoreExpr (all_tyvars ++ reverse rep_ids))
- (tyvars, _, ex_tyvars, ex_theta, orig_arg_tys, tycon) = dataConSig data_con
- all_tyvars = tyvars ++ ex_tyvars
-
ex_dict_tys = mkPredTys ex_theta
all_arg_tys = ex_dict_tys ++ orig_arg_tys
result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
(not f :: R -> forall a. a->a, which gives the type inference mechanism
problems at call sites)
-Similarly for newtypes
+Similarly for (recursive) newtypes
newtype N = MkN { unN :: forall a. a->a }
- unN :: forall a. N -> a -> a
- unN = /\a -> \n:N -> coerce (a->a) n
+ unN :: forall b. N -> b -> b
+ unN = /\b -> \n:N -> (coerce (forall a. a->a) n)
\begin{code}
mkRecordSelId tycon field_label
-- Use the demand analyser to work out strictness.
-- With all this unpackery it's not easy!
- info = noCafNoTyGenIdInfo
+ info = noCafIdInfo
`setCafInfo` caf_info
`setArityInfo` arity
`setUnfoldingInfo` mkTopUnfolding rhs_w_str
default_alt | no_default = []
| otherwise = [(DEFAULT, [], error_expr)]
- -- the default branch may have CAF refs, because it calls recSelError etc.
+ -- The default branch may have CAF refs, because it calls recSelError etc.
caf_info | no_default = NoCafRefs
| otherwise = MayHaveCafRefs
mkLams dict_ids $ mkLams field_dict_ids $
Lam data_id $ sel_body
- sel_body | isNewTyCon tycon = mkNewTypeBody tycon field_tau (mk_result data_id)
+ sel_body | isNewTyCon tycon = mk_result (mkNewTypeBody tycon field_ty (Var data_id))
| otherwise = Case (Var data_id) data_id (default_alt ++ the_alts)
- mk_result result_id = mkVarApps (mkVarApps (Var result_id) field_tyvars) field_dict_ids
+ mk_result poly_result = mkVarApps (mkVarApps poly_result field_tyvars) field_dict_ids
-- We pull the field lambdas to the top, so we need to
-- apply them in the body. For example:
-- data T = MkT { foo :: forall a. a->a }
Nothing -> Nothing
Just the_arg_id -> Just (mkReboxingAlt uniqs data_con arg_ids body)
where
- body = mk_result the_arg_id
+ body = mk_result (Var the_arg_id)
where
arg_ids = mkTemplateLocalsNum field_base (dataConOrigArgTys data_con)
-- No need to instantiate; same tyvars in datacon as tycon
Selecting a field for a dictionary. If there is just one field, then
there's nothing to do.
-ToDo: unify with mkRecordSelId.
+Dictionary selectors may get nested forall-types. Thus:
+
+ class Foo a where
+ op :: forall b. Ord b => a -> b -> b
+
+Then the top-level type for op is
+
+ op :: forall a. Foo a =>
+ forall b. Ord b =>
+ a -> b -> b
+
+This is unlike ordinary record selectors, which have all the for-alls
+at the outside. When dealing with classes it's very convenient to
+recover the original type signature from the class op selector.
\begin{code}
mkDictSelId :: Name -> Class -> Id
mkDictSelId name clas
- = mkGlobalId (RecordSelId field_lbl) name sel_ty info
+ = mkGlobalId (ClassOpId clas) name sel_ty info
where
sel_ty = mkForAllTys tyvars (mkFunTy (idType dict_id) (idType the_arg_id))
-- We can't just say (exprType rhs), because that would give a type
field_lbl = mkFieldLabel name tycon sel_ty tag
tag = assoc "MkId.mkDictSelId" (map idName (classSelIds clas) `zip` allFieldLabelTags) name
- info = noCafNoTyGenIdInfo
+ info = noCafIdInfo
`setArityInfo` 1
`setUnfoldingInfo` mkTopUnfolding rhs
`setAllStrictnessInfo` Just strict_sig
name = mkPrimOpIdName prim_op
id = mkGlobalId (PrimOpId prim_op) name ty info
- info = noCafNoTyGenIdInfo
+ info = noCafIdInfo
`setSpecInfo` rules
`setArityInfo` arity
`setAllStrictnessInfo` Just strict_sig
name = mkFCallName uniq occ_str
- info = noCafNoTyGenIdInfo
+ info = noCafIdInfo
`setArityInfo` arity
`setAllStrictnessInfo` Just strict_sig
that they aren't discarded by the occurrence analyser.
\begin{code}
-mkDefaultMethodId dm_name ty = mkVanillaGlobal dm_name ty noCafNoTyGenIdInfo
+mkDefaultMethodId dm_name ty
+ = setIdLocalExported (mkLocalId dm_name ty)
mkDictFunId :: Name -- Name to use for the dict fun;
- -> Class
-> [TyVar]
- -> [Type]
-> ThetaType
+ -> Class
+ -> [Type]
-> Id
-mkDictFunId dfun_name clas inst_tyvars inst_tys dfun_theta
- = mkVanillaGlobal dfun_name dfun_ty noCafNoTyGenIdInfo
+mkDictFunId dfun_name inst_tyvars dfun_theta clas inst_tys
+ = setIdLocalExported (mkLocalId dfun_name dfun_ty)
where
dfun_ty = mkSigmaTy inst_tyvars dfun_theta (mkDictTy clas inst_tys)
\begin{code}
-- unsafeCoerce# :: forall a b. a -> b
unsafeCoerceId
- = pcMiscPrelId unsafeCoerceIdKey gHC_PRIM FSLIT("unsafeCoerce#") ty info
+ = pcMiscPrelId unsafeCoerceName ty info
where
- info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
+ info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
ty = mkForAllTys [openAlphaTyVar,openBetaTyVar]
-- The reason is is here is because we don't provide
-- a way to write this literal in Haskell.
nullAddrId
- = pcMiscPrelId nullAddrIdKey gHC_PRIM FSLIT("nullAddr#") addrPrimTy info
+ = pcMiscPrelId nullAddrName addrPrimTy info
where
- info = noCafNoTyGenIdInfo `setUnfoldingInfo`
+ info = noCafIdInfo `setUnfoldingInfo`
mkCompulsoryUnfolding (Lit nullAddrLit)
seqId
- = pcMiscPrelId seqIdKey gHC_PRIM FSLIT("seq") ty info
+ = pcMiscPrelId seqName ty info
where
- info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
+ info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
- ty = mkForAllTys [alphaTyVar,betaTyVar]
- (mkFunTy alphaTy (mkFunTy betaTy betaTy))
- [x,y] = mkTemplateLocals [alphaTy, betaTy]
- rhs = mkLams [alphaTyVar,betaTyVar,x,y] (Case (Var x) x [(DEFAULT, [], Var y)])
-\end{code}
-
-@getTag#@ is another function which can't be defined in Haskell. It needs to
-evaluate its argument and call the dataToTag# primitive.
-
-\begin{code}
-getTagId
- = pcMiscPrelId getTagIdKey gHC_PRIM FSLIT("getTag#") ty info
+ ty = mkForAllTys [alphaTyVar,openBetaTyVar]
+ (mkFunTy alphaTy (mkFunTy openBetaTy openBetaTy))
+ [x,y] = mkTemplateLocals [alphaTy, openBetaTy]
+ rhs = mkLams [alphaTyVar,openBetaTyVar,x,y] (Case (Var x) x [(DEFAULT, [], Var y)])
+
+-- lazy :: forall a?. a? -> a? (i.e. works for unboxed types too)
+-- Used to lazify pseq: pseq a b = a `seq` lazy b
+-- No unfolding: it gets "inlined" by the worker/wrapper pass
+-- Also, no strictness: by being a built-in Id, it overrides all
+-- the info in PrelBase.hi. This is important, because the strictness
+-- analyser will spot it as strict!
+lazyId
+ = pcMiscPrelId lazyIdName ty info
where
- info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
- -- We don't provide a defn for this; you must inline it
-
- ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy intPrimTy)
- [x,y] = mkTemplateLocals [alphaTy,alphaTy]
- rhs = mkLams [alphaTyVar,x] $
- Case (Var x) y [ (DEFAULT, [], mkApps (Var dataToTagId) [Type alphaTy, Var y]) ]
+ info = noCafIdInfo
+ ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
-dataToTagId = mkPrimOpId DataToTagOp
+lazyIdUnfolding :: CoreExpr -- Used to expand LazyOp after strictness anal
+lazyIdUnfolding = mkLams [openAlphaTyVar,x] (Var x)
+ where
+ [x] = mkTemplateLocals [openAlphaTy]
\end{code}
@realWorld#@ used to be a magic literal, \tr{void#}. If things get
\begin{code}
realWorldPrimId -- :: State# RealWorld
- = pcMiscPrelId realWorldPrimIdKey gHC_PRIM FSLIT("realWorld#")
- realWorldStatePrimTy
- (noCafNoTyGenIdInfo `setUnfoldingInfo` mkOtherCon [])
+ = pcMiscPrelId realWorldName realWorldStatePrimTy
+ (noCafIdInfo `setUnfoldingInfo` mkOtherCon [])
-- The mkOtherCon makes it look that realWorld# is evaluated
-- which in turn makes Simplify.interestingArg return True,
-- which in turn makes INLINE things applied to realWorld# likely
mkRuntimeErrorApp err_id res_ty err_msg
= mkApps (Var err_id) [Type res_ty, err_string]
where
- err_string = Lit (MachStr (_PK_ (stringToUtf8 err_msg)))
+ err_string = Lit (MachStr (mkFastString (stringToUtf8 err_msg)))
-rEC_SEL_ERROR_ID = mkRuntimeErrorId recSelErrIdKey FSLIT("recSelError")
-rUNTIME_ERROR_ID = mkRuntimeErrorId runtimeErrorIdKey FSLIT("runtimeError")
-
-iRREFUT_PAT_ERROR_ID = mkRuntimeErrorId irrefutPatErrorIdKey FSLIT("irrefutPatError")
-rEC_CON_ERROR_ID = mkRuntimeErrorId recConErrorIdKey FSLIT("recConError")
-nON_EXHAUSTIVE_GUARDS_ERROR_ID = mkRuntimeErrorId nonExhaustiveGuardsErrorIdKey FSLIT("nonExhaustiveGuardsError")
-pAT_ERROR_ID = mkRuntimeErrorId patErrorIdKey FSLIT("patError")
-nO_METHOD_BINDING_ERROR_ID = mkRuntimeErrorId noMethodBindingErrorIdKey FSLIT("noMethodBindingError")
+rEC_SEL_ERROR_ID = mkRuntimeErrorId recSelErrorName
+rUNTIME_ERROR_ID = mkRuntimeErrorId runtimeErrorName
+iRREFUT_PAT_ERROR_ID = mkRuntimeErrorId irrefutPatErrorName
+rEC_CON_ERROR_ID = mkRuntimeErrorId recConErrorName
+nON_EXHAUSTIVE_GUARDS_ERROR_ID = mkRuntimeErrorId nonExhaustiveGuardsErrorName
+pAT_ERROR_ID = mkRuntimeErrorId patErrorName
+nO_METHOD_BINDING_ERROR_ID = mkRuntimeErrorId noMethodBindingErrorName
-- The runtime error Ids take a UTF8-encoded string as argument
-mkRuntimeErrorId key name = pc_bottoming_Id key pREL_ERR name runtimeErrorTy
-runtimeErrorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTy addrPrimTy openAlphaTy)
+mkRuntimeErrorId name = pc_bottoming_Id name runtimeErrorTy
+runtimeErrorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTy addrPrimTy openAlphaTy)
+\end{code}
+
+\begin{code}
+eRROR_ID = pc_bottoming_Id errorName errorTy
+
+errorTy :: Type
+errorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] openAlphaTy)
+ -- Notice the openAlphaTyVar. It says that "error" can be applied
+ -- to unboxed as well as boxed types. This is OK because it never
+ -- returns, so the return type is irrelevant.
\end{code}
%************************************************************************
\begin{code}
-pcMiscPrelId :: Unique{-IdKey-} -> Module -> FAST_STRING -> Type -> IdInfo -> Id
-pcMiscPrelId key mod str ty info
- = let
- name = mkWiredInName mod (mkVarOcc str) key
- imp = mkVanillaGlobal name ty info -- the usual case...
- in
- imp
+pcMiscPrelId :: Name -> Type -> IdInfo -> Id
+pcMiscPrelId name ty info
+ = mkVanillaGlobal name ty info
-- We lie and say the thing is imported; otherwise, we get into
-- a mess with dependency analysis; e.g., core2stg may heave in
-- random calls to GHCbase.unpackPS__. If GHCbase is the module
-- being compiled, then it's just a matter of luck if the definition
-- will be in "the right place" to be in scope.
-pc_bottoming_Id key mod name ty
- = pcMiscPrelId key mod name ty bottoming_info
+pc_bottoming_Id name ty
+ = pcMiscPrelId name ty bottoming_info
where
- strict_sig = mkStrictSig (mkTopDmdType [evalDmd] BotRes)
- bottoming_info = noCafNoTyGenIdInfo `setAllStrictnessInfo` Just strict_sig
- -- these "bottom" out, no matter what their arguments
+ bottoming_info = hasCafIdInfo `setAllStrictnessInfo` Just strict_sig
+ -- Do *not* mark them as NoCafRefs, because they can indeed have
+ -- CAF refs. For example, pAT_ERROR_ID calls GHC.Err.untangle,
+ -- which has some CAFs
+ -- In due course we may arrange that these error-y things are
+ -- regarded by the GC as permanently live, in which case we
+ -- can give them NoCaf info. As it is, any function that calls
+ -- any pc_bottoming_Id will itself have CafRefs, which bloats
+ -- SRTs.
-generic_ERROR_ID u n = pc_bottoming_Id u pREL_ERR n errorTy
+ strict_sig = mkStrictSig (mkTopDmdType [evalDmd] BotRes)
+ -- These "bottom" out, no matter what their arguments
(openAlphaTyVar:openBetaTyVar:_) = openAlphaTyVars
openAlphaTy = mkTyVarTy openAlphaTyVar
openBetaTy = mkTyVarTy openBetaTyVar
-
-errorTy :: Type
-errorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy]
- openAlphaTy)
- -- Notice the openAlphaTyVar. It says that "error" can be applied
- -- to unboxed as well as boxed types. This is OK because it never
- -- returns, so the return type is irrelevant.
\end{code}