Commit a56fe4a1 authored by Austin Seipp's avatar Austin Seipp

compiler: de-lhs basicTypes/

Signed-off-by: default avatarAustin Seipp <austin@well-typed.com>
parent 29a52104
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1998
%
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1998
\section[ConLike]{@ConLike@: Constructor-like things}
-}
\begin{code}
{-# LANGUAGE CPP, DeriveDataTypeable #-}
module ConLike (
......@@ -23,29 +23,28 @@ import Name
import Data.Function (on)
import qualified Data.Data as Data
import qualified Data.Typeable
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
\subsection{Constructor-like things}
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
-- | A constructor-like thing
data ConLike = RealDataCon DataCon
| PatSynCon PatSyn
deriving Data.Typeable.Typeable
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
\subsection{Instances}
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
instance Eq ConLike where
(==) = (==) `on` getUnique
(/=) = (/=) `on` getUnique
......@@ -80,4 +79,3 @@ instance Data.Data ConLike where
toConstr _ = abstractConstr "ConLike"
gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNoRepType "ConLike"
\end{code}
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1998
%
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1998
\section[DataCon]{@DataCon@: Data Constructors}
-}
\begin{code}
{-# LANGUAGE CPP, DeriveDataTypeable #-}
module DataCon (
......@@ -71,9 +71,8 @@ import qualified Data.Typeable
import Data.Maybe
import Data.Char
import Data.Word
\end{code}
{-
Data constructor representation
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider the following Haskell data type declaration
......@@ -238,13 +237,13 @@ Does the C constructor in Core contain the Ord dictionary? Yes, it must:
Note that (Foo a) might not be an instance of Ord.
%************************************************************************
%* *
************************************************************************
* *
\subsection{Data constructors}
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
-- | A data constructor
--
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
......@@ -460,8 +459,8 @@ data HsBang
-- StrictnessMark is internal only, used to indicate strictness
-- of the DataCon *worker* fields
data StrictnessMark = MarkedStrict | NotMarkedStrict
\end{code}
{-
Note [Data con representation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The dcRepType field contains the type of the representation of a contructor
......@@ -502,13 +501,13 @@ For imported data types, the dcArgBangs field is just the same as the
dcr_bangs field; we don't know what the user originally said.
%************************************************************************
%* *
************************************************************************
* *
\subsection{Instances}
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
instance Eq DataCon where
a == b = getUnique a == getUnique b
a /= b = getUnique a /= getUnique b
......@@ -572,16 +571,15 @@ isBanged _ = True
isMarkedStrict :: StrictnessMark -> Bool
isMarkedStrict NotMarkedStrict = False
isMarkedStrict _ = True -- All others are strict
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
\subsection{Construction}
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
-- | Build a new data constructor
mkDataCon :: Name
-> Bool -- ^ Is the constructor declared infix?
......@@ -659,8 +657,8 @@ mkDataCon name declared_infix
eqSpecPreds :: [(TyVar,Type)] -> ThetaType
eqSpecPreds spec = [ mkEqPred (mkTyVarTy tv) ty | (tv,ty) <- spec ]
\end{code}
{-
Note [Unpack equality predicates]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If we have a GADT with a contructor C :: (a~[b]) => b -> T a
......@@ -669,8 +667,8 @@ takes no space at all. This is easily done: just give it
an UNPACK pragma. The rest of the unpack/repack code does the
heavy lifting. This one line makes every GADT take a word less
space for each equality predicate, so it's pretty important!
-}
\begin{code}
-- | The 'Name' of the 'DataCon', giving it a unique, rooted identification
dataConName :: DataCon -> Name
dataConName = dcName
......@@ -911,9 +909,7 @@ dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
map (substTyWith tyvars inst_tys) arg_tys
where
tyvars = univ_tvs ++ ex_tvs
\end{code}
\begin{code}
-- | Returns the argument types of the wrapper, excluding all dictionary arguments
-- and without substituting for any type variables
dataConOrigArgTys :: DataCon -> [Type]
......@@ -929,9 +925,7 @@ dataConRepArgTys (MkData { dcRep = rep
= case rep of
NoDataConRep -> ASSERT( null eq_spec ) theta ++ orig_arg_tys
DCR { dcr_arg_tys = arg_tys } -> arg_tys
\end{code}
\begin{code}
-- | The string @package:module.name@ identifying a constructor, which is attached
-- to its info table and used by the GHCi debugger and the heap profiler
dataConIdentity :: DataCon -> [Word8]
......@@ -941,9 +935,7 @@ dataConIdentity dc = bytesFS (packageKeyFS (modulePackageKey mod)) ++
fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name))
where name = dataConName dc
mod = ASSERT( isExternalName name ) nameModule name
\end{code}
\begin{code}
isTupleDataCon :: DataCon -> Bool
isTupleDataCon (MkData {dcRepTyCon = tc}) = isTupleTyCon tc
......@@ -953,16 +945,12 @@ isUnboxedTupleCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc
-- | Vanilla 'DataCon's are those that are nice boring Haskell 98 constructors
isVanillaDataCon :: DataCon -> Bool
isVanillaDataCon dc = dcVanilla dc
\end{code}
\begin{code}
classDataCon :: Class -> DataCon
classDataCon clas = case tyConDataCons (classTyCon clas) of
(dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
[] -> panic "classDataCon"
\end{code}
\begin{code}
dataConCannotMatch :: [Type] -> DataCon -> Bool
-- Returns True iff the data con *definitely cannot* match a
-- scrutinee of type (T tys)
......@@ -986,18 +974,18 @@ dataConCannotMatch tys con
EqPred ty1 ty2 -> [(ty1, ty2)]
TuplePred ts -> concatMap predEqs ts
_ -> []
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
Building an algebraic data type
%* *
%************************************************************************
* *
************************************************************************
buildAlgTyCon is here because it is called from TysWiredIn, which in turn
depends on DataCon, but not on BuildTyCl.
-}
\begin{code}
buildAlgTyCon :: Name
-> [TyVar] -- ^ Kind variables and type variables
-> [Role]
......@@ -1024,28 +1012,27 @@ buildAlgTyCon tc_name ktvs roles cType stupid_theta rhs
mb_promoted_tc
| is_promotable = Just (mkPromotedTyCon tc (promoteKind kind))
| otherwise = Nothing
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
Promoting of data types to the kind level
%* *
%************************************************************************
* *
************************************************************************
These two 'promoted..' functions are here because
* They belong together
* 'promoteDataCon' depends on DataCon stuff
-}
\begin{code}
promoteDataCon :: DataCon -> TyCon
promoteDataCon (MkData { dcPromoted = Just tc }) = tc
promoteDataCon dc = pprPanic "promoteDataCon" (ppr dc)
promoteDataCon_maybe :: DataCon -> Maybe TyCon
promoteDataCon_maybe (MkData { dcPromoted = mb_tc }) = mb_tc
\end{code}
{-
Note [Promoting a Type to a Kind]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Suppsoe we have a data constructor D
......@@ -1062,8 +1049,8 @@ The transformation from type to kind is done by promoteType
* Ensure that all type constructors mentioned (Maybe and T
in the example) are promotable; that is, they have kind
* -> ... -> * -> *
-}
\begin{code}
-- | Promotes a type to a kind.
-- Assumes the argument satisfies 'isPromotableType'
promoteType :: Type -> Kind
......@@ -1088,15 +1075,15 @@ promoteKind (TyConApp tc [])
| tc `hasKey` liftedTypeKindTyConKey = superKind
promoteKind (FunTy arg res) = FunTy (promoteKind arg) (promoteKind res)
promoteKind k = pprPanic "promoteKind" (ppr k)
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
\subsection{Splitting products}
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
-- | Extract the type constructor, type argument, data constructor and it's
-- /representation/ argument types from a type if it is a product type.
--
......@@ -1126,4 +1113,3 @@ splitDataProductType_maybe ty
= Just (tycon, ty_args, con, dataConInstArgTys con ty_args)
| otherwise
= Nothing
\end{code}
\begin{code}
module DataCon where
import Name( Name, NamedThing )
import {-# SOURCE #-} TyCon( TyCon )
......@@ -17,4 +16,3 @@ instance Uniquable DataCon
instance NamedThing DataCon
instance Outputable DataCon
instance OutputableBndr DataCon
\end{code}
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
\section[Id]{@Ids@: Value and constructor identifiers}
-}
\begin{code}
{-# LANGUAGE CPP #-}
-- |
......@@ -41,15 +41,15 @@ module Id (
recordSelectorFieldLabel,
-- ** Modifying an Id
setIdName, setIdUnique, Id.setIdType,
setIdExported, setIdNotExported,
globaliseId, localiseId,
setIdName, setIdUnique, Id.setIdType,
setIdExported, setIdNotExported,
globaliseId, localiseId,
setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
zapLamIdInfo, zapDemandIdInfo, zapFragileIdInfo, transferPolyIdInfo,
zapIdStrictness,
-- ** Predicates on Ids
isImplicitId, isDeadBinder,
isImplicitId, isDeadBinder,
isStrictId,
isExportedId, isLocalId, isGlobalId,
isRecordSelector, isNaughtyRecordSelector,
......@@ -69,7 +69,7 @@ module Id (
-- ** One-shot lambdas
isOneShotBndr, isOneShotLambda, isProbablyOneShotLambda,
setOneShotLambda, clearOneShotLambda,
setOneShotLambda, clearOneShotLambda,
updOneShotInfo, setIdOneShotInfo,
isStateHackType, stateHackOneShot, typeOneShot,
......@@ -92,10 +92,10 @@ module Id (
setIdCafInfo,
setIdOccInfo, zapIdOccInfo,
setIdDemandInfo,
setIdStrictness,
setIdDemandInfo,
setIdStrictness,
idDemandInfo,
idDemandInfo,
idStrictness,
) where
......@@ -147,15 +147,15 @@ infixl 1 `setIdUnfoldingLazily`,
`setIdDemandInfo`,
`setIdStrictness`
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
\subsection{Basic Id manipulation}
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
idName :: Id -> Name
idName = Var.varName
......@@ -207,13 +207,13 @@ modifyIdInfo fn id = setIdInfo id (fn (idInfo id))
maybeModifyIdInfo :: Maybe IdInfo -> Id -> Id
maybeModifyIdInfo (Just new_info) id = lazySetIdInfo id new_info
maybeModifyIdInfo Nothing id = id
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
\subsection{Simple Id construction}
%* *
%************************************************************************
* *
************************************************************************
Absolutely all Ids are made by mkId. It is just like Var.mkId,
but in addition it pins free-tyvar-info onto the Id's type,
......@@ -228,8 +228,8 @@ the compiler overall. I don't quite know why; perhaps finding free
type variables of an Id isn't all that common whereas applying a
substitution (which changes the free type variables) is more common.
Anyway, we removed it in March 2008.
-}
\begin{code}
-- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
mkGlobalId :: IdDetails -> Name -> Type -> IdInfo -> Id
mkGlobalId = Var.mkGlobalVar
......@@ -283,13 +283,13 @@ mkDerivedLocalM deriv_name id ty
mkWiredInIdName :: Module -> FastString -> Unique -> Id -> Name
mkWiredInIdName mod fs uniq id
= mkWiredInName mod (mkOccNameFS varName fs) uniq (AnId id) UserSyntax
\end{code}
{-
Make some local @Ids@ for a template @CoreExpr@. These have bogus
@Uniques@, but that's OK because the templates are supposed to be
instantiated before use.
-}
\begin{code}
-- | Workers get local names. "CoreTidy" will externalise these if necessary
mkWorkerId :: Unique -> Id -> Type -> Id
mkWorkerId uniq unwrkr ty
......@@ -306,8 +306,8 @@ mkTemplateLocals = mkTemplateLocalsNum 1
-- | Create a template local for a series of type, but start from a specified template local
mkTemplateLocalsNum :: Int -> [Type] -> [Id]
mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
\end{code}
{-
Note [Exported LocalIds]
~~~~~~~~~~~~~~~~~~~~~~~~
We use mkExportedLocalId for things like
......@@ -343,13 +343,13 @@ In CoreTidy we must make all these LocalIds into GlobalIds, so that in
importing modules (in --make mode) we treat them as properly global.
That is what is happening in, say tidy_insts in TidyPgm.
%************************************************************************
%* *
************************************************************************
* *
\subsection{Special Ids}
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
-- | If the 'Id' is that for a record selector, extract the 'sel_tycon' and label. Panic otherwise
recordSelectorFieldLabel :: Id -> (TyCon, FieldLabel)
recordSelectorFieldLabel id
......@@ -459,8 +459,8 @@ isImplicitId id
idIsFrom :: Module -> Id -> Bool
idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
\end{code}
{-
Note [Primop wrappers]
~~~~~~~~~~~~~~~~~~~~~~
Currently hasNoBinding claims that PrimOpIds don't have a curried
......@@ -473,36 +473,34 @@ applications of GHC.Prim.plusInt# to GHC.PrimopWrappers.plusInt#.
Nota Bene: GHC.PrimopWrappers is needed *regardless*, because it's
used by GHCi, which does not implement primops direct at all.
-}
\begin{code}
isDeadBinder :: Id -> Bool
isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
| otherwise = False -- TyVars count as not dead
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
Evidence variables
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
isEvVar :: Var -> Bool
isEvVar var = isPredTy (varType var)
isDictId :: Id -> Bool
isDictId id = isDictTy (idType id)
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
\subsection{IdInfo stuff}
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
---------------------------------
-- ARITY
idArity :: Id -> Arity
......@@ -543,7 +541,7 @@ isStrictId :: Id -> Bool
isStrictId id
= ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id )
(isStrictType (idType id)) ||
-- Take the best of both strictnesses - old and new
-- Take the best of both strictnesses - old and new
(isStrictDmd (idDemandInfo id))
---------------------------------
......@@ -607,15 +605,14 @@ setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
zapIdOccInfo :: Id -> Id
zapIdOccInfo b = b `setIdOccInfo` NoOccInfo
\end{code}
{-
---------------------------------
-- INLINING
The inline pragma tells us to be very keen to inline this Id, but it's still
OK not to if optimisation is switched off.
-}
\begin{code}
idInlinePragma :: Id -> InlinePragma
idInlinePragma id = inlinePragInfo (idInfo id)
......@@ -636,12 +633,12 @@ idRuleMatchInfo id = inlinePragmaRuleMatchInfo (idInlinePragma id)
isConLikeId :: Id -> Bool
isConLikeId id = isDataConWorkId id || isConLike (idRuleMatchInfo id)
\end{code}
{-
---------------------------------
-- ONE-SHOT LAMBDAS
\begin{code}
-}
idOneShotInfo :: Id -> OneShotInfo
idOneShotInfo id = oneShotInfo (idInfo id)
......@@ -728,9 +725,7 @@ updOneShotInfo id one_shot
-- But watch out: this may change the type of something else
-- f = \x -> e
-- If we change the one-shot-ness of x, f's type changes
\end{code}
\begin{code}
zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id
zapInfo zapper id = maybeModifyIdInfo (zapper (idInfo id)) id
......@@ -738,12 +733,12 @@ zapLamIdInfo :: Id -> Id
zapLamIdInfo = zapInfo zapLamInfo
zapFragileIdInfo :: Id -> Id
zapFragileIdInfo = zapInfo zapFragileInfo
zapFragileIdInfo = zapInfo zapFragileInfo
zapDemandIdInfo :: Id -> Id
zapDemandIdInfo = zapInfo zapDemandInfo
\end{code}
{-
Note [transferPolyIdInfo]
~~~~~~~~~~~~~~~~~~~~~~~~~
This transfer is used in two places:
......@@ -791,8 +786,8 @@ arity and strictness info before transferring it. E.g.
g' = \y. \x. e
+ substitute (g' y) for g
Notice that g' has an arity one more than the original g
-}
\begin{code}
transferPolyIdInfo :: Id -- Original Id
-> [Var] -- Abstract wrt these variables
-> Id -- New Id
......@@ -816,4 +811,3 @@ transferPolyIdInfo old_id abstract_wrt new_id
`setInlinePragInfo` old_inline_prag
`setOccInfo` old_occ_info
`setStrictnessInfo` new_strictness
\end{code}
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1993-1998
\section[IdInfo]{@IdInfos@: Non-essential information about @Ids@}
(And a pretty good illustration of quite a few things wrong with
Haskell. [WDP 94/11])
-}
\begin{code}
module IdInfo (
-- * The IdDetails type
IdDetails(..), pprIdDetails, coVarDetails,
......@@ -93,15 +93,15 @@ infixl 1 `setSpecInfo`,
`setCafInfo`,
`setStrictnessInfo`,
`setDemandInfo`
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
IdDetails
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
-- | The 'IdDetails' of an 'Id' give stable, and necessary,
-- information about the Id.
data IdDetails
......@@ -165,16 +165,15 @@ pprIdDetails other = brackets (pp other)
pp (RecSelId { sel_naughty = is_naughty })
= brackets $ ptext (sLit "RecSel")