Remove wired-in names. Partially propogated.
Things in brackets are what the module *uses*.
A 'loop' indicates a use from a module compiled later
- PrelNames
-then
Name, PrimRep, FieldLabel (loop Type.Type)
then
+ PrelNames
+then
Var (Name, loop CoreSyn.CoreExpr, loop IdInfo.IdInfo,
loop Type.GenType, loop Type.Kind)
then
# define MkIOError(h,errt,msg) (errt msg)
#endif
-#if defined(__GLASGOW_HASKELL__)
-
--- Import the beggars
-import GlaExts
- ( Int(..), Int#, (+#), (-#), (*#),
- quotInt#, negateInt#, (==#), (<#), (<=#), (>=#), (>#)
- )
-
-#define FAST_INT Int#
-#define ILIT(x) (x#)
-#define IBOX(x) (I# (x))
-#define _ADD_ +#
-#define _SUB_ -#
-#define _MUL_ *#
-#define _QUOT_ `quotInt#`
-#define _NEG_ negateInt#
-#define _EQ_ ==#
-#define _LT_ <#
-#define _LE_ <=#
-#define _GE_ >=#
-#define _GT_ >#
-
-#define FAST_BOOL Int#
-#define _TRUE_ 1#
-#define _FALSE_ 0#
-#define _IS_TRUE_(x) ((x) _EQ_ 1#)
-
-#else {- ! __GLASGOW_HASKELL__ -}
-
-#define FAST_INT Int
-#define ILIT(x) (x)
-#define IBOX(x) (x)
-#define _ADD_ +
-#define _SUB_ -
-#define _MUL_ *
-#define _DIV_ `div`
-#define _QUOT_ `quot`
-#define _NEG_ -
-#define _EQ_ ==
-#define _LT_ <
-#define _LE_ <=
-#define _GE_ >=
-#define _GT_ >
-
-#define FAST_BOOL Bool
-#define _TRUE_ True
-#define _FALSE_ False
-#define _IS_TRUE_(x) (x)
-
-#endif {- ! __GLASGOW_HASKELL__ -}
-
#if __GLASGOW_HASKELL__ >= 23
-- This #ifndef lets us switch off the "import FastString"
import Demand ( Demand, isStrict, wwLazy )
import Name ( Name, OccName,
mkSysLocalName, mkLocalName,
- isWiredInName, isUserExportedName,
- getOccName, isIPOcc
+ isUserExportedName, getOccName, isIPOcc
)
import OccName ( UserFS )
import PrimRep ( PrimRep )
\begin{code}
omitIfaceSigForId :: Id -> Bool
omitIfaceSigForId id
- | isWiredInName (idName id)
- = True
-
| otherwise
= case idFlavour id of
RecordSelId _ -> True -- Includes dictionary selectors
Name, -- Abstract
mkLocalName, mkImportedLocalName, mkSysLocalName, mkCCallName,
mkTopName, mkIPName,
- mkDerivedName, mkGlobalName, mkKnownKeyGlobal,
- mkWiredInIdName, mkWiredInTyConName,
+ mkDerivedName, mkGlobalName, mkKnownKeyGlobal, mkWiredInName,
- maybeWiredInIdName, maybeWiredInTyConName,
- isWiredInName, hashName,
-
- nameUnique, setNameUnique, setNameProvenance, getNameProvenance, setNameImportReason,
- tidyTopName,
- nameOccName, nameModule, setNameOcc, nameRdrName, setNameModule, toRdrName,
+ nameUnique, setNameUnique, setNameProvenance, getNameProvenance,
+ setNameImportReason, tidyTopName,
+ nameOccName, nameModule, setNameOcc, nameRdrName, setNameModule,
+ toRdrName, hashName,
isUserExportedName, isUserImportedName, isUserImportedExplicitlyName,
maybeUserImportedFrom,
#include "HsVersions.h"
-import {-# SOURCE #-} Var ( Id )
-import {-# SOURCE #-} TyCon ( TyCon )
-
import OccName -- All of it
-import Module ( Module, moduleName, pprModule, mkVanillaModule, isLocalModule )
-import RdrName ( RdrName, mkRdrQual, mkRdrUnqual, rdrNameOcc, rdrNameModule )
-import CmdLineOpts ( opt_Static, opt_PprStyle_NoPrags, opt_OmitInterfacePragmas, opt_EnsureSplittableC )
+import Module ( Module, moduleName, pprModule, mkVanillaModule,
+ isLocalModule )
+import RdrName ( RdrName, mkRdrQual, mkRdrUnqual, rdrNameOcc,
+ rdrNameModule )
+import CmdLineOpts ( opt_Static, opt_PprStyle_NoPrags,
+ opt_OmitInterfacePragmas, opt_EnsureSplittableC )
import SrcLoc ( noSrcLoc, SrcLoc )
-import Unique ( Unique, Uniquable(..), u2i, hasKey, pprUnique )
+import Unique ( Unique, Uniquable(..), u2i, pprUnique )
import Maybes ( expectJust )
import FastTypes
import UniqFM
import Outputable
\end{code}
-
%************************************************************************
%* *
\subsection[Name-datatype]{The @Name@ datatype, and name construction}
data NameSort
= Local
| Global Module
- | WiredInId Module Id
- | WiredInTyCon Module TyCon
\end{code}
Things with a @Global@ name are given C static labels, so they finally
mkImportedLocalName :: Unique -> OccName -> SrcLoc -> Name
-- Just the same as mkLocalName, except the provenance is different
- -- Reason: this flags the name as one that came in from an interface file.
- -- This is useful when trying to decide which of two type variables
- -- should 'win' when unifying them.
+ -- Reason: this flags the name as one that came in from an interface
+ -- file. This is useful when trying to decide which of two type
+ -- variables should 'win' when unifying them.
-- NB: this is only for non-top-level names, so we use ImplicitImport
mkImportedLocalName uniq occ loc = Name { n_uniq = uniq, n_sort = Local, n_occ = occ,
n_prov = NonLocalDef ImplicitImport True }
(rdrNameOcc rdr_name)
systemProvenance
+mkWiredInName :: Module -> OccName -> Unique -> Name
+mkWiredInName mod occ uniq = mkGlobalName uniq mod occ systemProvenance
+
mkSysLocalName :: Unique -> UserFS -> Name
mkSysLocalName uniq fs = Name { n_uniq = uniq, n_sort = Local,
n_occ = mkVarOcc fs, n_prov = systemProvenance }
-- ZZ is this an appropriate provinence?
n_prov = SystemProv }
-------------------------- Wired in names -------------------------
-
-mkWiredInIdName :: Unique -> Module -> OccName -> Id -> Name
-mkWiredInIdName uniq mod occ id = Name { n_uniq = uniq, n_sort = WiredInId mod id,
- n_occ = occ, n_prov = SystemProv }
-
-mkWiredInTyConName :: Unique -> Module -> OccName -> TyCon -> Name
-mkWiredInTyConName uniq mod occ tycon
- = Name { n_uniq = uniq, n_sort = WiredInTyCon mod tycon,
- n_occ = occ, n_prov = SystemProv }
-
-
---------------------------------------------------------------------
mkDerivedName :: (OccName -> OccName)
-> Name -- Base name
setNameModule name mod = name {n_sort = set (n_sort name)}
where
set (Global _) = Global mod
- set (WiredInId _ id) = WiredInId mod id
- set (WiredInTyCon _ tycon) = WiredInTyCon mod tycon
\end{code}
nameSrcLoc :: Name -> SrcLoc
isLocallyDefinedName :: Name -> Bool
isUserExportedName :: Name -> Bool
-isWiredInName :: Name -> Bool
isLocalName :: Name -> Bool
isGlobalName :: Name -> Bool
isExternallyVisibleName :: Name -> Bool
x -> nameSortModule x
nameSortModule (Global mod) = mod
-nameSortModule (WiredInId mod _) = mod
-nameSortModule (WiredInTyCon mod _) = mod
nameRdrName :: Name -> RdrName
-- Makes a qualified name for top-level (Global) names, whether locally defined or not
isLocallyDefinedName (Name {n_prov = LocalDef _ _}) = True -- Global, but defined here
isLocallyDefinedName other = False -- Other
--- Things the compiler "knows about" are in some sense
--- "imported". When we are compiling the module where
--- the entities are defined, we need to be able to pick
--- them out, often in combination with isLocallyDefined.
-isWiredInName (Name {n_sort = WiredInTyCon _ _}) = True
-isWiredInName (Name {n_sort = WiredInId _ _}) = True
-isWiredInName _ = False
-
-maybeWiredInIdName :: Name -> Maybe Id
-maybeWiredInIdName (Name {n_sort = WiredInId _ id}) = Just id
-maybeWiredInIdName other = Nothing
-
-maybeWiredInTyConName :: Name -> Maybe TyCon
-maybeWiredInTyConName (Name {n_sort = WiredInTyCon _ tc}) = Just tc
-maybeWiredInTyConName other = Nothing
-
-
isLocalName (Name {n_sort = Local}) = True
isLocalName _ = False
pp_mod_dot sty
= case prov of
- SystemProv -> pp_qual mod user_sty
- -- Hack alert! Omit the qualifier on SystemProv things in user style
- -- I claim such SystemProv things will also be WiredIn things.
- -- We can't get the omit flag right
- -- on wired in tycons etc (sigh) so we just leave it out in user style,
- -- and hope that leaving it out isn't too consfusing.
- -- (e.g. if the programmer hides Bool and redefines it. If so, use -dppr-debug.)
-
- LocalDef _ _ -> pp_qual mod (user_sty || iface_sty)
+ SystemProv -> pp_qual mod user_sty
+ -- ToDo (SDM): the following comment is out of date - do
+ -- we need to do anything different now that WiredInNames
+ -- don't exist any more?
+
+ -- Hack alert! Omit the qualifier on SystemProv things in
+ -- user style. I claim such SystemProv things will also be
+ -- WiredIn things. We can't get the omit flag right
+ -- on wired in tycons etc (sigh) so we just leave it out in
+ -- user style, and hope that leaving it out isn't too
+ -- consfusing. (e.g. if the programmer hides Bool and
+ -- redefines it. If so, use -dppr-debug.)
+
+ LocalDef _ _ -> pp_qual mod (user_sty || iface_sty)
NonLocalDef (UserImport imp_mod _ _) omit
| user_sty -> pp_qual imp_mod omit
#endif
}
where
- mk_assoc_elem k@(MaxSimplifierIterations lvl) = (_IBOX(tagOf_SimplSwitch k), SwInt lvl)
- mk_assoc_elem k@(SimplInlinePhase n) = (_IBOX(tagOf_SimplSwitch k), SwInt n)
- mk_assoc_elem k = (_IBOX(tagOf_SimplSwitch k), SwBool True) -- I'm here, Mom!
+ mk_assoc_elem k@(MaxSimplifierIterations lvl)
+ = (iBox (tagOf_SimplSwitch k), SwInt lvl)
+ mk_assoc_elem k@(SimplInlinePhase n)
+ = (iBox (tagOf_SimplSwitch k), SwInt n)
+ mk_assoc_elem k
+ = (iBox (tagOf_SimplSwitch k), SwBool True) -- I'm here, Mom!
-- cannot have duplicates if we are going to use the array thing
rm_dups switches_so_far switch
\end{code}
\begin{code}
-freeReg :: FAST_INT -> FAST_BOOL
+freeReg :: FastInt -> FastBool
#if alpha_TARGET_ARCH
-freeReg ILIT(26) = _FALSE_ -- return address (ra)
-freeReg ILIT(28) = _FALSE_ -- reserved for the assembler (at)
-freeReg ILIT(29) = _FALSE_ -- global pointer (gp)
-freeReg ILIT(30) = _FALSE_ -- stack pointer (sp)
-freeReg ILIT(31) = _FALSE_ -- always zero (zeroh)
-freeReg ILIT(63) = _FALSE_ -- always zero (f31)
+freeReg ILIT(26) = fastBool False -- return address (ra)
+freeReg ILIT(28) = fastBool False -- reserved for the assembler (at)
+freeReg ILIT(29) = fastBool False -- global pointer (gp)
+freeReg ILIT(30) = fastBool False -- stack pointer (sp)
+freeReg ILIT(31) = fastBool False -- always zero (zeroh)
+freeReg ILIT(63) = fastBool False -- always zero (f31)
#endif
#if i386_TARGET_ARCH
-freeReg ILIT(esp) = _FALSE_ -- %esp is the C stack pointer
+freeReg ILIT(esp) = fastBool False -- %esp is the C stack pointer
#endif
#if sparc_TARGET_ARCH
-freeReg ILIT(g0) = _FALSE_ -- %g0 is always 0.
-freeReg ILIT(g5) = _FALSE_ -- %g5 is reserved (ABI).
-freeReg ILIT(g6) = _FALSE_ -- %g6 is reserved (ABI).
-freeReg ILIT(g7) = _FALSE_ -- %g7 is reserved (ABI).
-freeReg ILIT(i6) = _FALSE_ -- %i6 is our frame pointer.
-freeReg ILIT(o6) = _FALSE_ -- %o6 is our stack pointer.
-freeReg ILIT(f0) = _FALSE_ -- %f0/%f1 are the C fp return registers.
-freeReg ILIT(f1) = _FALSE_
+freeReg ILIT(g0) = fastBool False -- %g0 is always 0.
+freeReg ILIT(g5) = fastBool False -- %g5 is reserved (ABI).
+freeReg ILIT(g6) = fastBool False -- %g6 is reserved (ABI).
+freeReg ILIT(g7) = fastBool False -- %g7 is reserved (ABI).
+freeReg ILIT(i6) = fastBool False -- %i6 is our frame pointer.
+freeReg ILIT(o6) = fastBool False -- %o6 is our stack pointer.
+freeReg ILIT(f0) = fastBool False -- %f0/%f1 are the C fp return registers.
+freeReg ILIT(f1) = fastBool False
#endif
#ifdef REG_Base
-freeReg ILIT(REG_Base) = _FALSE_
+freeReg ILIT(REG_Base) = fastBool False
#endif
#ifdef REG_R1
-freeReg ILIT(REG_R1) = _FALSE_
+freeReg ILIT(REG_R1) = fastBool False
#endif
#ifdef REG_R2
-freeReg ILIT(REG_R2) = _FALSE_
+freeReg ILIT(REG_R2) = fastBool False
#endif
#ifdef REG_R3
-freeReg ILIT(REG_R3) = _FALSE_
+freeReg ILIT(REG_R3) = fastBool False
#endif
#ifdef REG_R4
-freeReg ILIT(REG_R4) = _FALSE_
+freeReg ILIT(REG_R4) = fastBool False
#endif
#ifdef REG_R5
-freeReg ILIT(REG_R5) = _FALSE_
+freeReg ILIT(REG_R5) = fastBool False
#endif
#ifdef REG_R6
-freeReg ILIT(REG_R6) = _FALSE_
+freeReg ILIT(REG_R6) = fastBool False
#endif
#ifdef REG_R7
-freeReg ILIT(REG_R7) = _FALSE_
+freeReg ILIT(REG_R7) = fastBool False
#endif
#ifdef REG_R8
-freeReg ILIT(REG_R8) = _FALSE_
+freeReg ILIT(REG_R8) = fastBool False
#endif
#ifdef REG_F1
-freeReg ILIT(REG_F1) = _FALSE_
+freeReg ILIT(REG_F1) = fastBool False
#endif
#ifdef REG_F2
-freeReg ILIT(REG_F2) = _FALSE_
+freeReg ILIT(REG_F2) = fastBool False
#endif
#ifdef REG_F3
-freeReg ILIT(REG_F3) = _FALSE_
+freeReg ILIT(REG_F3) = fastBool False
#endif
#ifdef REG_F4
-freeReg ILIT(REG_F4) = _FALSE_
+freeReg ILIT(REG_F4) = fastBool False
#endif
#ifdef REG_D1
-freeReg ILIT(REG_D1) = _FALSE_
+freeReg ILIT(REG_D1) = fastBool False
#endif
#ifdef REG_D2
-freeReg ILIT(REG_D2) = _FALSE_
+freeReg ILIT(REG_D2) = fastBool False
#endif
#ifdef REG_Sp
-freeReg ILIT(REG_Sp) = _FALSE_
+freeReg ILIT(REG_Sp) = fastBool False
#endif
#ifdef REG_Su
-freeReg ILIT(REG_Su) = _FALSE_
+freeReg ILIT(REG_Su) = fastBool False
#endif
#ifdef REG_SpLim
-freeReg ILIT(REG_SpLim) = _FALSE_
+freeReg ILIT(REG_SpLim) = fastBool False
#endif
#ifdef REG_Hp
-freeReg ILIT(REG_Hp) = _FALSE_
+freeReg ILIT(REG_Hp) = fastBool False
#endif
#ifdef REG_HpLim
-freeReg ILIT(REG_HpLim) = _FALSE_
+freeReg ILIT(REG_HpLim) = fastBool False
#endif
-freeReg n = _TRUE_
+freeReg n = fastBool True
\end{code}
intDataConName = dataQual pREL_BASE_Name SLIT("I#") intDataConKey
orderingTyConName = tcQual pREL_BASE_Name SLIT("Ordering") orderingTyConKey
boolTyConName = tcQual pREL_BASE_Name SLIT("Bool") boolTyConKey
-falseName = dataQual pREL_BASE_Name SLIT("False") falseDataConKey
-trueName = dataQual pREL_BASE_Name SLIT("True") trueDataConKey
+falseDataConName = dataQual pREL_BASE_Name SLIT("False") falseDataConKey
+trueDataConName = dataQual pREL_BASE_Name SLIT("True") trueDataConKey
listTyConName = tcQual pREL_BASE_Name SLIT("[]") listTyConKey
nilDataConName = dataQual pREL_BASE_Name SLIT("[]") nilDataConKey
consDataConName = dataQual pREL_BASE_Name SLIT(":") consDataConKey
import TysWiredIn
import Demand ( wwLazy, wwPrim, wwStrict, StrictnessInfo(..) )
-import Var ( TyVar, Id )
+import Var ( TyVar )
import CallConv ( CallConv, pprCallConv )
-import Name ( Name, mkWiredInIdName )
+import Name ( Name, mkWiredInName )
import RdrName ( RdrName, mkRdrQual )
import OccName ( OccName, pprOccName, mkVarOcc )
import TyCon ( TyCon, tyConArity )
import PrelNames ( pREL_GHC, pREL_GHC_Name )
import Outputable
import Util ( zipWithEqual )
-import GlaExts ( Int(..), Int#, (==#) )
+import FastTypes
\end{code}
%************************************************************************
\begin{code}
primOpTag :: PrimOp -> Int
-primOpTag op = IBOX( tagOf_PrimOp op )
+primOpTag op = iBox (tagOf_PrimOp op)
-- supplies
-- tagOf_PrimOp :: PrimOp -> FastInt
GenPrimOp occ tyvars arg_tys res_ty ->
mkForAllTys tyvars (mkFunTys arg_tys res_ty)
-mkPrimOpIdName :: PrimOp -> Id -> Name
+mkPrimOpIdName :: PrimOp -> Name
-- Make the name for the PrimOp's Id
-- We have to pass in the Id itself because it's a WiredInId
-- and hence recursive
-mkPrimOpIdName op id
- = mkWiredInIdName key pREL_GHC occ_name id
- where
- occ_name = primOpOcc op
- key = mkPrimOpIdUnique (primOpTag op)
-
+mkPrimOpIdName op
+ = mkWiredInName pREL_GHC (primOpOcc op) (mkPrimOpIdUnique (primOpTag op))
primOpRdrName :: PrimOp -> RdrName
primOpRdrName op = mkRdrQual pREL_GHC_Name (primOpOcc op)
#include "HsVersions.h"
import Var ( TyVar, mkSysTyVar )
-import Name ( mkWiredInTyConName )
-import OccName ( mkOccFS, tcName )
+import OccName ( tcName )
import PrimRep ( PrimRep(..), isFollowableRep )
import TyCon ( mkPrimTyCon, TyCon, ArgVrcs )
-import Type ( Type,
- mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy,
+import Type ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy,
unboxedTypeKind, boxedTypeKind, openTypeKind, mkArrowKinds
)
import Unique ( Unique, mkAlphaTyVarUnique )
+import Name ( mkKnownKeyGlobal )
+import RdrName ( mkPreludeQual )
import PrelNames
import Outputable
\end{code}
pcPrimTyCon key str arity arg_vrcs rep
= the_tycon
where
- name = mkWiredInTyConName key pREL_GHC (mkOccFS tcName str) the_tycon
+ name = mkKnownKeyGlobal (mkPreludeQual tcName pREL_GHC_Name str) key
the_tycon = mkPrimTyCon name kind arity arg_vrcs rep
kind = mkArrowKinds (take arity (repeat boxedTypeKind)) result_kind
result_kind | isFollowableRep rep = boxedTypeKind -- Represented by a GC-ish ptr
-- others:
import Constants ( mAX_TUPLE_SIZE )
-import Module ( Module, mkPrelModule )
-import Name ( mkWiredInTyConName, mkWiredInIdName, nameOccName )
+import Module ( mkPrelModule )
+import Name ( Name, nameRdrName, nameUnique, nameOccName,
+ nameModule, mkWiredInName )
import OccName ( mkOccFS, tcName, dataName, mkWorkerOcc, mkGenOcc1, mkGenOcc2 )
-import RdrName ( RdrName, mkPreludeQual, rdrNameOcc, rdrNameModule )
+import RdrName ( rdrNameOcc )
import DataCon ( DataCon, StrictnessMark(..), mkDataCon, dataConId )
import Var ( TyVar, tyVarKind )
-import TyCon ( TyCon, AlgTyConFlavour(..), ArgVrcs, tyConDataCons,
- mkSynTyCon, mkTupleTyCon,
- isUnLiftedTyCon, mkAlgTyConRep,tyConName
+import TyCon ( TyCon, AlgTyConFlavour(..), tyConDataCons,
+ mkTupleTyCon, isUnLiftedTyCon, mkAlgTyConRep
)
import BasicTypes ( Arity, RecFlag(..), EP(..), Boxity(..), isBoxed )
import Type ( Type, mkTyConTy, mkTyConApp, mkSigmaTy, mkTyVarTys,
mkArrowKinds, boxedTypeKind, unboxedTypeKind,
- mkFunTy, mkFunTys,
- splitTyConApp_maybe, repType, mkTyVarTy,
+ splitTyConApp_maybe, repType,
TauType, ClassContext )
import Unique ( incrUnique, mkTupleTyConUnique, mkTupleDataConUnique )
import PrelNames
import CmdLineOpts ( DynFlags, dopt_GlasgowExts )
import Array
-import Maybe ( fromJust )
-import FiniteMap ( lookupFM )
alpha_tyvar = [alphaTyVar]
alpha_ty = [alphaTy]
pcNonRecDataTyCon = pcTyCon DataTyCon NonRecursive
pcRecDataTyCon = pcTyCon DataTyCon Recursive
-pcTyCon new_or_data is_rec key rdr_name tyvars argvrcs cons
+pcTyCon new_or_data is_rec name tyvars argvrcs cons
= tycon
where
tycon = mkAlgTyConRep name kind
is_rec
gen_info
- mod = mkPrelModule (rdrNameModule rdr_name)
- occ = rdrNameOcc rdr_name
- name = mkWiredInTyConName key mod occ tycon
+ mod = nameModule name
kind = mkArrowKinds (map tyVarKind tyvars) boxedTypeKind
- gen_info = mk_tc_gen_info mod key name tycon
+ gen_info = mk_tc_gen_info mod (nameUnique name) name tycon
-pcDataCon :: Unique -- DataConKey
- -> RdrName -- Qualified
- -> [TyVar] -> ClassContext -> [TauType] -> TyCon -> DataCon
+pcDataCon :: Name -> [TyVar] -> ClassContext -> [TauType] -> TyCon -> DataCon
-- The unique is the first of two free uniques;
-- the first is used for the datacon itself and the worker;
-- the second is used for the wrapper.
-pcDataCon wrap_key rdr_name tyvars context arg_tys tycon
+pcDataCon name tyvars context arg_tys tycon
= data_con
where
- mod = mkPrelModule (rdrNameModule rdr_name)
- wrap_occ = rdrNameOcc rdr_name
-
- data_con = mkDataCon wrap_name
+ data_con = mkDataCon name
[ NotMarkedStrict | a <- arg_tys ]
[ {- no labelled fields -} ]
tyvars context [] [] arg_tys tycon work_id wrap_id
+ wrap_rdr = nameRdrName name
+ wrap_occ = rdrNameOcc wrap_rdr
+ mod = nameModule name
+ wrap_id = mkDataConWrapId data_con
+
work_occ = mkWorkerOcc wrap_occ
- work_key = incrUnique wrap_key
- work_name = mkWiredInIdName work_key mod work_occ work_id
+ work_key = incrUnique (nameUnique name)
+ work_name = mkWiredInName mod work_occ work_key
work_id = mkDataConId work_name data_con
-
- wrap_name = mkWiredInIdName wrap_key mod wrap_occ wrap_id
- wrap_id = mkDataConWrapId data_con
\end{code}
mk_tuple boxity arity = (tycon, tuple_con)
where
tycon = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con boxity gen_info
- tc_name = mkWiredInTyConName tc_uniq mod (mkOccFS tcName name_str) tycon
+ tc_name = mkWiredInName mod (mkOccFS tcName name_str) tc_uniq
tc_kind = mkArrowKinds (map tyVarKind tyvars) res_kind
res_kind | isBoxed boxity = boxedTypeKind
| otherwise = unboxedTypeKind
tyvars | isBoxed boxity = take arity alphaTyVars
| otherwise = take arity openAlphaTyVars
- tuple_con = pcDataCon dc_uniq rdr_name tyvars [] tyvar_tys tycon
+ tuple_con = pcDataCon name tyvars [] tyvar_tys tycon
tyvar_tys = mkTyVarTys tyvars
(mod_name, name_str) = mkTupNameStr boxity arity
- rdr_name = mkPreludeQual dataName mod_name name_str
+ name = mkWiredInName mod (mkOccFS dataName name_str) dc_uniq
tc_uniq = mkTupleTyConUnique boxity arity
dc_uniq = mkTupleDataConUnique boxity arity
mod = mkPrelModule mod_name
occ_name2 = mkGenOcc2 tc_occ_name
fn1_key = incrUnique tc_uniq
fn2_key = incrUnique fn1_key
- name1 = mkWiredInIdName fn1_key mod occ_name1 id1
- name2 = mkWiredInIdName fn2_key mod occ_name2 id2
+ name1 = mkWiredInName mod occ_name1 fn1_key
+ name2 = mkWiredInName mod occ_name2 fn2_key
gen_info = mkTyConGenInfo tycon name1 name2
Just (EP id1 id2) = gen_info
\begin{code}
charTy = mkTyConTy charTyCon
-charTyCon = pcNonRecDataTyCon charTyConKey charTyCon_RDR [] [] [charDataCon]
-charDataCon = pcDataCon charDataConKey charDataCon_RDR [] [] [charPrimTy] charTyCon
+charTyCon = pcNonRecDataTyCon charTyConName [] [] [charDataCon]
+charDataCon = pcDataCon charDataConName [] [] [charPrimTy] charTyCon
stringTy = mkListTy charTy -- convenience only
\end{code}
\begin{code}
intTy = mkTyConTy intTyCon
-intTyCon = pcNonRecDataTyCon intTyConKey intTyCon_RDR [] [] [intDataCon]
-intDataCon = pcDataCon intDataConKey mkInt_RDR [] [] [intPrimTy] intTyCon
+intTyCon = pcNonRecDataTyCon intTyConName [] [] [intDataCon]
+intDataCon = pcDataCon intDataConName [] [] [intPrimTy] intTyCon
isIntTy :: Type -> Bool
isIntTy = isTyCon intTyConKey
wordTy = mkTyConTy wordTyCon
-wordTyCon = pcNonRecDataTyCon wordTyConKey wordTyCon_RDR [] [] [wordDataCon]
-wordDataCon = pcDataCon wordDataConKey wordDataCon_RDR [] [] [wordPrimTy] wordTyCon
+wordTyCon = pcNonRecDataTyCon wordTyConName [] [] [wordDataCon]
+wordDataCon = pcDataCon wordDataConName [] [] [wordPrimTy] wordTyCon
\end{code}
\begin{code}
addrTy = mkTyConTy addrTyCon
-addrTyCon = pcNonRecDataTyCon addrTyConKey addrTyCon_RDR [] [] [addrDataCon]
-addrDataCon = pcDataCon addrDataConKey addrDataCon_RDR [] [] [addrPrimTy] addrTyCon
+addrTyCon = pcNonRecDataTyCon addrTyConName [] [] [addrDataCon]
+addrDataCon = pcDataCon addrDataConName [] [] [addrPrimTy] addrTyCon
isAddrTy :: Type -> Bool
isAddrTy = isTyCon addrTyConKey
\begin{code}
floatTy = mkTyConTy floatTyCon
-floatTyCon = pcNonRecDataTyCon floatTyConKey floatTyCon_RDR [] [] [floatDataCon]
-floatDataCon = pcDataCon floatDataConKey floatDataCon_RDR [] [] [floatPrimTy] floatTyCon
+floatTyCon = pcNonRecDataTyCon floatTyConName [] [] [floatDataCon]
+floatDataCon = pcDataCon floatDataConName [] [] [floatPrimTy] floatTyCon
isFloatTy :: Type -> Bool
isFloatTy = isTyCon floatTyConKey
isDoubleTy :: Type -> Bool
isDoubleTy = isTyCon doubleTyConKey
-doubleTyCon = pcNonRecDataTyCon doubleTyConKey doubleTyCon_RDR [] [] [doubleDataCon]
-doubleDataCon = pcDataCon doubleDataConKey doubleDataCon_RDR [] [] [doublePrimTy] doubleTyCon
+doubleTyCon = pcNonRecDataTyCon doubleTyConName [] [] [doubleDataCon]
+doubleDataCon = pcDataCon doubleDataConName [] [] [doublePrimTy] doubleTyCon
\end{code}
\begin{code}
stablePtrTyCon
- = pcNonRecDataTyCon stablePtrTyConKey stablePtrTyCon_RDR
+ = pcNonRecDataTyCon stablePtrTyConName
alpha_tyvar [(True,False)] [stablePtrDataCon]
where
stablePtrDataCon
- = pcDataCon stablePtrDataConKey stablePtrDataCon_RDR
+ = pcDataCon stablePtrDataConName
alpha_tyvar [] [mkStablePtrPrimTy alphaTy] stablePtrTyCon
\end{code}
\begin{code}
foreignObjTyCon
- = pcNonRecDataTyCon foreignObjTyConKey foreignObjTyCon_RDR
+ = pcNonRecDataTyCon foreignObjTyConName
[] [] [foreignObjDataCon]
where
foreignObjDataCon
- = pcDataCon foreignObjDataConKey foreignObjDataCon_RDR
+ = pcDataCon foreignObjDataConName
[] [] [foreignObjPrimTy] foreignObjTyCon
isForeignObjTy :: Type -> Bool
integerTy :: Type
integerTy = mkTyConTy integerTyCon
-integerTyCon = pcNonRecDataTyCon integerTyConKey integerTyCon_RDR
+integerTyCon = pcNonRecDataTyCon integerTyConName
[] [] [smallIntegerDataCon, largeIntegerDataCon]
-smallIntegerDataCon = pcDataCon smallIntegerDataConKey smallIntegerDataCon_RDR
+smallIntegerDataCon = pcDataCon smallIntegerDataConName
[] [] [intPrimTy] integerTyCon
-largeIntegerDataCon = pcDataCon largeIntegerDataConKey largeIntegerDataCon_RDR
+largeIntegerDataCon = pcDataCon largeIntegerDataConName
[] [] [intPrimTy, byteArrayPrimTy] integerTyCon
\begin{code}
boolTy = mkTyConTy boolTyCon
-boolTyCon = pcTyCon EnumTyCon NonRecursive boolTyConKey
- boolTyCon_RDR [] [] [falseDataCon, trueDataCon]
+boolTyCon = pcTyCon EnumTyCon NonRecursive boolTyConName
+ [] [] [falseDataCon, trueDataCon]
-falseDataCon = pcDataCon falseDataConKey false_RDR [] [] [] boolTyCon
-trueDataCon = pcDataCon trueDataConKey true_RDR [] [] [] boolTyCon
+falseDataCon = pcDataCon falseDataConName [] [] [] boolTyCon
+trueDataCon = pcDataCon trueDataConName [] [] [] boolTyCon
falseDataConId = dataConId falseDataCon
trueDataConId = dataConId trueDataCon
alphaListTy = mkSigmaTy alpha_tyvar [] (mkTyConApp listTyCon alpha_ty)
-listTyCon = pcRecDataTyCon listTyConKey listTyCon_RDR
+listTyCon = pcRecDataTyCon listTyConName
alpha_tyvar [(True,False)] [nilDataCon, consDataCon]
-nilDataCon = pcDataCon nilDataConKey nil_RDR alpha_tyvar [] [] listTyCon
-consDataCon = pcDataCon consDataConKey cons_RDR
- alpha_tyvar [] [alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon
+nilDataCon = pcDataCon nilDataConName alpha_tyvar [] [] listTyCon
+consDataCon = pcDataCon consDataConName
+ alpha_tyvar [] [alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon
-- Interesting: polymorphic recursion would help here.
-- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy
-- gets the over-specific type (Type -> Type)
\begin{code}
crossTyCon :: TyCon
-crossTyCon = pcNonRecDataTyCon crossTyConKey crossTyCon_RDR alpha_beta_tyvars [] [crossDataCon]
+crossTyCon = pcNonRecDataTyCon crossTyConName alpha_beta_tyvars [] [crossDataCon]
crossDataCon :: DataCon
-crossDataCon = pcDataCon crossDataConKey crossDataCon_RDR alpha_beta_tyvars [] [alphaTy, betaTy] crossTyCon
+crossDataCon = pcDataCon crossDataConName alpha_beta_tyvars [] [alphaTy, betaTy] crossTyCon
plusTyCon :: TyCon
-plusTyCon = pcNonRecDataTyCon plusTyConKey plusTyCon_RDR alpha_beta_tyvars [] [inlDataCon, inrDataCon]
+plusTyCon = pcNonRecDataTyCon plusTyConName alpha_beta_tyvars [] [inlDataCon, inrDataCon]
inlDataCon, inrDataCon :: DataCon
-inlDataCon = pcDataCon inlDataConKey inlDataCon_RDR alpha_beta_tyvars [] [alphaTy] plusTyCon
-inrDataCon = pcDataCon inrDataConKey inrDataCon_RDR alpha_beta_tyvars [] [betaTy] plusTyCon
+inlDataCon = pcDataCon inlDataConName alpha_beta_tyvars [] [alphaTy] plusTyCon
+inrDataCon = pcDataCon inrDataConName alpha_beta_tyvars [] [betaTy] plusTyCon
genUnitTyCon :: TyCon -- The "1" type constructor for generics
-genUnitTyCon = pcNonRecDataTyCon genUnitTyConKey genUnitTyCon_RDR [] [] [genUnitDataCon]
+genUnitTyCon = pcNonRecDataTyCon genUnitTyConName [] [] [genUnitDataCon]
genUnitDataCon :: DataCon
-genUnitDataCon = pcDataCon genUnitDataConKey genUnitDataCon_RDR [] [] [] genUnitTyCon
+genUnitDataCon = pcDataCon genUnitDataConName [] [] [] genUnitTyCon
\end{code}
\begin{code}
data SaStats
- = SaStats FAST_INT FAST_INT -- total/marked-demanded lambda-bound
- FAST_INT FAST_INT -- total/marked-demanded case-bound
- FAST_INT FAST_INT -- total/marked-demanded let-bound
+ = SaStats FastInt FastInt -- total/marked-demanded lambda-bound
+ FastInt FastInt -- total/marked-demanded case-bound
+ FastInt FastInt -- total/marked-demanded let-bound
-- (excl. top-level; excl. letrecs)
nullSaStats = SaStats ILIT(0) ILIT(0) ILIT(0) ILIT(0) ILIT(0) ILIT(0)
tickLambda var (SaStats tlam dlam tc dc tlet dlet)
= case (tick_demanded var (0,0)) of { (IBOX(tot), IBOX(demanded)) ->
- ((), SaStats (tlam _ADD_ tot) (dlam _ADD_ demanded) tc dc tlet dlet) }
+ ((), SaStats (tlam +# tot) (dlam +# demanded) tc dc tlet dlet) }
tickCases vars (SaStats tlam dlam tc dc tlet dlet)
= case (foldr tick_demanded (0,0) vars) of { (IBOX(tot), IBOX(demanded)) ->
- ((), SaStats tlam dlam (tc _ADD_ tot) (dc _ADD_ demanded) tlet dlet) }
+ ((), SaStats tlam dlam (tc +# tot) (dc +# demanded) tlet dlet) }
tickLet var (SaStats tlam dlam tc dc tlet dlet)
= case (tick_demanded var (0,0)) of { (IBOX(tot),IBOX(demanded)) ->
- ((), SaStats tlam dlam tc dc (tlet _ADD_ tot) (dlet _ADD_ demanded)) }
+ ((), SaStats tlam dlam tc dc (tlet +# tot) (dlet +# demanded)) }
tick_demanded var (tot, demanded)
| isTyVar var = (tot, demanded)
import VarSet
import Name ( Name, Provenance(..), ExportFlag(..),
- mkWiredInTyConName, mkGlobalName, mkKindOccFS, tcName,
+ mkGlobalName, mkKindOccFS, tcName,
)
import OccName ( mkOccFS, tcName )
import TyCon ( TyCon, KindCon,
-- others
import SrcLoc ( mkBuiltinSrcLoc )
-import PrelNames ( pREL_GHC, kindConKey, boxityConKey, boxedConKey, unboxedConKey,
- typeConKey, anyBoxConKey, funTyConKey
+import PrelNames ( pREL_GHC, kindConKey, boxityConKey, boxedConKey,
+ unboxedConKey, typeConKey, anyBoxConKey, funTyConName
)
\end{code}
We define a few wired-in type constructors here to avoid module knots
\begin{code}
-funTyConName = mkWiredInTyConName funTyConKey pREL_GHC (mkOccFS tcName SLIT("(->)")) funTyCon
funTyCon = mkFunTyCon funTyConName (mkArrowKinds [boxedTypeKind, boxedTypeKind] boxedTypeKind)
\end{code}
projects / ghc-hetmet.git / commitdiff