Commit 69b29b57 authored by simonmar's avatar simonmar

[project @ 2000-10-12 14:41:15 by simonmar]

Remove wired-in names.  Partially propogated.
parent 2ee4f4b4
......@@ -5,9 +5,9 @@ The Name/Var/Type group is a bit complicated. Here's the deal
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)
......
......@@ -43,57 +43,6 @@ name = global (value) :: IORef (ty); \
# 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"
......
......@@ -91,8 +91,7 @@ import IdInfo
import Demand ( Demand, isStrict, wwLazy )
import Name ( Name, OccName,
mkSysLocalName, mkLocalName,
isWiredInName, isUserExportedName,
getOccName, isIPOcc
isUserExportedName, getOccName, isIPOcc
)
import OccName ( UserFS )
import PrimRep ( PrimRep )
......@@ -278,9 +277,6 @@ in some other interface unfolding.
\begin{code}
omitIfaceSigForId :: Id -> Bool
omitIfaceSigForId id
| isWiredInName (idName id)
= True
| otherwise
= case idFlavour id of
RecordSelId _ -> True -- Includes dictionary selectors
......
......@@ -12,15 +12,12 @@ module Name (
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,
......@@ -49,23 +46,22 @@ module Name (
#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}
......@@ -83,8 +79,6 @@ data Name = Name {
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
......@@ -107,9 +101,9 @@ mkLocalName uniq occ loc = Name { n_uniq = uniq, n_sort = Local, n_occ = occ,
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 }
......@@ -126,6 +120,9 @@ mkKnownKeyGlobal rdr_name uniq
(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 }
......@@ -159,18 +156,6 @@ mkIPName uniq occ
-- 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
......@@ -196,8 +181,6 @@ setNameModule :: Name -> Module -> 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}
......@@ -395,7 +378,6 @@ nameModule :: Name -> Module
nameSrcLoc :: Name -> SrcLoc
isLocallyDefinedName :: Name -> Bool
isUserExportedName :: Name -> Bool
isWiredInName :: Name -> Bool
isLocalName :: Name -> Bool
isGlobalName :: Name -> Bool
isExternallyVisibleName :: Name -> Bool
......@@ -414,8 +396,6 @@ nameModule name =
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
......@@ -458,23 +438,6 @@ isLocallyDefinedName (Name {n_sort = Local}) = True -- Local (might have
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
......@@ -621,15 +584,20 @@ pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ, n_prov = prov})
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
......
......@@ -701,9 +701,12 @@ isAmongSimpl on_switches -- Switches mentioned later occur *earlier*
#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
......
......@@ -894,91 +894,91 @@ allArgRegs = panic "MachRegs.allArgRegs(x86): should not be used!"
\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}
......@@ -264,8 +264,8 @@ intTyConName = tcQual pREL_BASE_Name SLIT("Int") intTyConKey
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
......
......@@ -30,9 +30,9 @@ import TysPrim
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 )
......@@ -47,7 +47,7 @@ import CStrings ( CLabelString, pprCLabelString )
import PrelNames ( pREL_GHC, pREL_GHC_Name )
import Outputable
import Util ( zipWithEqual )
import GlaExts ( Int(..), Int#, (==#) )
import FastTypes
\end{code}
%************************************************************************
......@@ -70,7 +70,7 @@ Used for the Ord instance
\begin{code}
primOpTag :: PrimOp -> Int
primOpTag op = IBOX( tagOf_PrimOp op )
primOpTag op = iBox (tagOf_PrimOp op)
-- supplies
-- tagOf_PrimOp :: PrimOp -> FastInt
......@@ -437,16 +437,12 @@ primOpType op
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)
......
......@@ -49,15 +49,15 @@ module TysPrim(
#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}
......@@ -151,7 +151,7 @@ pcPrimTyCon :: Unique{-TyConKey-} -> FAST_STRING -> Int -> ArgVrcs -> PrimRep ->
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
......
......@@ -91,30 +91,27 @@ import TysPrim
-- 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]
......@@ -163,7 +160,7 @@ unboxed_tuple_tycons = [tupleTyCon Unboxed i | i <- [1..37] ]
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
......@@ -177,37 +174,32 @@ pcTyCon new_or_data is_rec key rdr_name tyvars argvrcs cons
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}
......@@ -236,7 +228,7 @@ mk_tuple :: Boxity -> Int -> (TyCon,DataCon)
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
......@@ -244,10 +236,10 @@ mk_tuple boxity arity = (tycon, tuple_con)
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
......@@ -261,8 +253,8 @@ mk_tc_gen_info mod tc_uniq tc_name tycon
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
......@@ -303,8 +295,8 @@ voidTy = unitTy
\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}
......@@ -312,8 +304,8 @@ stringTy = mkListTy charTy -- convenience only
\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
......@@ -323,15 +315,15 @@ 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
<