From: simonmar Date: Thu, 12 Oct 2000 14:41:17 +0000 (+0000) Subject: [project @ 2000-10-12 14:41:15 by simonmar] X-Git-Tag: Approximately_9120_patches~3614 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=69b29b57f29e775ffbe2108f8315aca3a690a1bc;p=ghc-hetmet.git [project @ 2000-10-12 14:41:15 by simonmar] Remove wired-in names. Partially propogated. --- diff --git a/ghc/compiler/DEPEND-NOTES b/ghc/compiler/DEPEND-NOTES index 2135879..6610879 100644 --- a/ghc/compiler/DEPEND-NOTES +++ b/ghc/compiler/DEPEND-NOTES @@ -5,10 +5,10 @@ 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) then diff --git a/ghc/compiler/HsVersions.h b/ghc/compiler/HsVersions.h index d1bad70..3da1db1 100644 --- a/ghc/compiler/HsVersions.h +++ b/ghc/compiler/HsVersions.h @@ -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" diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs index d32cd53..ae1b799 100644 --- a/ghc/compiler/basicTypes/Id.lhs +++ b/ghc/compiler/basicTypes/Id.lhs @@ -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 diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs index a645419..aa72a0c 100644 --- a/ghc/compiler/basicTypes/Name.lhs +++ b/ghc/compiler/basicTypes/Name.lhs @@ -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 diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index 34e8882..d0e8859 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -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 diff --git a/ghc/compiler/nativeGen/MachRegs.lhs b/ghc/compiler/nativeGen/MachRegs.lhs index 5c9bcc9..35dc741 100644 --- a/ghc/compiler/nativeGen/MachRegs.lhs +++ b/ghc/compiler/nativeGen/MachRegs.lhs @@ -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} diff --git a/ghc/compiler/prelude/PrelNames.lhs b/ghc/compiler/prelude/PrelNames.lhs index 35792ed..a152ade 100644 --- a/ghc/compiler/prelude/PrelNames.lhs +++ b/ghc/compiler/prelude/PrelNames.lhs @@ -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 diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs index bf2aaea..82e1f0d 100644 --- a/ghc/compiler/prelude/PrimOp.lhs +++ b/ghc/compiler/prelude/PrimOp.lhs @@ -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) diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs index 8b96d6e..71b69ba 100644 --- a/ghc/compiler/prelude/TysPrim.lhs +++ b/ghc/compiler/prelude/TysPrim.lhs @@ -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 diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs index afd537f..f538da6 100644 --- a/ghc/compiler/prelude/TysWiredIn.lhs +++ b/ghc/compiler/prelude/TysWiredIn.lhs @@ -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 isAddrTy :: Type -> Bool isAddrTy = isTyCon addrTyConKey @@ -340,8 +332,8 @@ 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 @@ -353,27 +345,27 @@ doubleTy = mkTyConTy doubleTyCon 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 @@ -391,12 +383,12 @@ isForeignObjTy = isTyCon foreignObjTyConKey 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 @@ -555,11 +547,11 @@ primitive counterpart. \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 @@ -586,12 +578,12 @@ mkListTy ty = mkTyConApp listTyCon [ty] 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) @@ -666,23 +658,23 @@ because -well- there is nothing to pass to these functions. \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} diff --git a/ghc/compiler/stranal/StrictAnal.lhs b/ghc/compiler/stranal/StrictAnal.lhs index 15520cb..8e87ba7 100644 --- a/ghc/compiler/stranal/StrictAnal.lhs +++ b/ghc/compiler/stranal/StrictAnal.lhs @@ -390,9 +390,9 @@ addDemandInfoToCaseBndr dmd str_env abs_env alts binder \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) @@ -424,15 +424,15 @@ returnSa x stats = (x, stats) 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) diff --git a/ghc/compiler/types/TypeRep.lhs b/ghc/compiler/types/TypeRep.lhs index 98cca95..6bf53ae 100644 --- a/ghc/compiler/types/TypeRep.lhs +++ b/ghc/compiler/types/TypeRep.lhs @@ -28,7 +28,7 @@ import VarEnv import VarSet import Name ( Name, Provenance(..), ExportFlag(..), - mkWiredInTyConName, mkGlobalName, mkKindOccFS, tcName, + mkGlobalName, mkKindOccFS, tcName, ) import OccName ( mkOccFS, tcName ) import TyCon ( TyCon, KindCon, @@ -38,8 +38,8 @@ import Class ( Class ) -- 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} @@ -298,7 +298,6 @@ mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind arg_kinds 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}