Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
GHC
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
4,316
Issues
4,316
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
387
Merge Requests
387
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
506fa77d
Commit
506fa77d
authored
May 18, 1999
by
simonpj
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[project @ 1999-05-18 15:03:33 by simonpj]
RULES-NOTES
parent
c415cd35
Changes
28
Hide whitespace changes
Inline
Side-by-side
Showing
28 changed files
with
1280 additions
and
619 deletions
+1280
-619
ghc/compiler/DEPEND-NOTES
ghc/compiler/DEPEND-NOTES
+36
-26
ghc/compiler/Makefile
ghc/compiler/Makefile
+2
-1
ghc/compiler/basicTypes/BasicTypes.lhs
ghc/compiler/basicTypes/BasicTypes.lhs
+21
-14
ghc/compiler/basicTypes/Const.lhs
ghc/compiler/basicTypes/Const.lhs
+23
-3
ghc/compiler/basicTypes/DataCon.hi-boot
ghc/compiler/basicTypes/DataCon.hi-boot
+2
-1
ghc/compiler/basicTypes/DataCon.lhs
ghc/compiler/basicTypes/DataCon.lhs
+56
-7
ghc/compiler/basicTypes/Demand.lhs
ghc/compiler/basicTypes/Demand.lhs
+5
-1
ghc/compiler/basicTypes/Id.lhs
ghc/compiler/basicTypes/Id.lhs
+96
-74
ghc/compiler/basicTypes/IdInfo.lhs
ghc/compiler/basicTypes/IdInfo.lhs
+235
-106
ghc/compiler/basicTypes/MkId.hi-boot
ghc/compiler/basicTypes/MkId.hi-boot
+3
-2
ghc/compiler/basicTypes/MkId.hi-boot-5
ghc/compiler/basicTypes/MkId.hi-boot-5
+3
-1
ghc/compiler/basicTypes/MkId.lhs
ghc/compiler/basicTypes/MkId.lhs
+269
-81
ghc/compiler/basicTypes/Module.lhs
ghc/compiler/basicTypes/Module.lhs
+291
-113
ghc/compiler/basicTypes/Name.lhs
ghc/compiler/basicTypes/Name.lhs
+23
-26
ghc/compiler/basicTypes/NameSet.lhs
ghc/compiler/basicTypes/NameSet.lhs
+3
-1
ghc/compiler/basicTypes/RdrName.lhs
ghc/compiler/basicTypes/RdrName.lhs
+12
-13
ghc/compiler/basicTypes/Unique.lhs
ghc/compiler/basicTypes/Unique.lhs
+5
-1
ghc/compiler/basicTypes/Var.lhs
ghc/compiler/basicTypes/Var.lhs
+20
-23
ghc/compiler/basicTypes/VarEnv.lhs
ghc/compiler/basicTypes/VarEnv.lhs
+59
-1
ghc/compiler/basicTypes/VarSet.lhs
ghc/compiler/basicTypes/VarSet.lhs
+19
-5
ghc/compiler/codeGen/CgCase.lhs
ghc/compiler/codeGen/CgCase.lhs
+11
-45
ghc/compiler/codeGen/CgClosure.lhs
ghc/compiler/codeGen/CgClosure.lhs
+1
-2
ghc/compiler/codeGen/CgCon.lhs
ghc/compiler/codeGen/CgCon.lhs
+0
-1
ghc/compiler/codeGen/CgConTbls.lhs
ghc/compiler/codeGen/CgConTbls.lhs
+2
-8
ghc/compiler/codeGen/CgExpr.lhs
ghc/compiler/codeGen/CgExpr.lhs
+4
-5
ghc/compiler/codeGen/CgMonad.lhs
ghc/compiler/codeGen/CgMonad.lhs
+13
-9
ghc/compiler/codeGen/ClosureInfo.lhs
ghc/compiler/codeGen/ClosureInfo.lhs
+5
-5
ghc/compiler/codeGen/CodeGen.lhs
ghc/compiler/codeGen/CodeGen.lhs
+61
-44
No files found.
ghc/compiler/DEPEND-NOTES
View file @
506fa77d
add types/InstEnv, InstEnv.hi-boot
add coreSyn/CoreRules.*
add coreSyn/CoreTidy.lhs
add coreSyn/CoreFVs.lhs
remove coreSyn/FreeVars.lhs
add coreSyn/Subst.*
remove simplCore/MagicUFs.*
remove specialise/SpecEnv.*
ToDo
~~~~
* Test effect of eta-expanding past (case x of ..)
...
...
@@ -62,45 +74,43 @@ ToDo
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
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
Name, PrimRep, FieldLabel (
uses
Type.Type)
Name, PrimRep, FieldLabel (
loop
Type.Type)
then
Var (uses Const.Con, IdInfo.IdInfo, Type.GenType, Type.Kind)
Var (loop Const.Con, loop IdInfo.IdInfo,
loop Type.GenType, loop Type.Kind)
then
VarEnv, VarSet
VarEnv, VarSet
, ThinAir
then
Class (
uses TyCon.TyCon, Type.Type, SpecEnv.Spec
Env)
Class (
loop TyCon.TyCon, loop Type.Type, loop InstEnv.Inst
Env)
then
TyCon (
uses Type.Type, Type.Kind,
DataCon.DataCon)
TyCon (
loop Type.Type, loop Type.Kind, loop
DataCon.DataCon)
then
Type (
uses [DataCon.DataCon]
)
Type (
loop DataCon.DataCon, loop Subst.substTy
)
then
DataCon, TysPrim, Unify,
SpecEnv,
PprType
DataCon, TysPrim, Unify, PprType
then
I
dInfo, TysWiredIn (uses DataCon.mkDataCon, [MkId.mkDataConId]
)
I
nstEnv (Unify
)
then
PrimOp (uses PprType, TysWiredIn)
IdInfo (loop CoreRules.CoreRules)
TysWiredIn (DataCon.mkDataCon, loop MkId.mkDataConId)
then
Const (needs PrimOp, [TysWiredIn.stringTy]
)
PrimOp (PprType, TysWiredIn, IdInfo.StrictnessInfo
)
then
Id (needs Const.Con(..)), CoreSyn
Const (PrimOp.PrimOp, TysWiredIn.stringTy)
then
CoreUtils, OccurAnal
Id (Const.Con(..)), CoreSyn
then
CoreUnfold (uses OccurAnal)
CoreUtils (loop PprCore.pprCoreExpr), CoreFVs
then
OccurAnal (ThinAir.noRepStrs -- an awkward dependency)
then
MkId (uses CoreUnfold
)
PrimOp uses TysWiredI
n
CoreUnfold (loop OccurAnal.globalOccurAnalyse
)
then
Rules (Unfolding), Subst (Unfolding, CoreFVs), CoreTidy (noUnfolding)
the
n
MkId (CoreUnfold.mkUnfolding, Subst)
Add
~~~
basicTypes/DataCon.lhs
basicTypes/DataCon.hi-boot
Remove
~~~~~~
specialise/SpecUtils.lhs
basicTypes/IdUtils.lhs
ghc/compiler/Makefile
View file @
506fa77d
# -----------------------------------------------------------------------------
# $Id: Makefile,v 1.5
7 1999/05/14 11:23:47 simonm
Exp $
# $Id: Makefile,v 1.5
8 1999/05/18 15:03:34 simonpj
Exp $
TOP
=
..
include
$(TOP)/mk/boilerplate.mk
...
...
@@ -182,6 +182,7 @@ parser/U_literal_HC_OPTS = -fvia-C '-\#include"hspincl.h"'
parser/
U_match_HC_OPTS
=
-fvia-C
'-\#include"hspincl.h"'
parser/
U_maybe_HC_OPTS
=
-fvia-C
'-\#include"hspincl.h"'
parser/
U_qid_HC_OPTS
=
-fvia-C
'-\#include"hspincl.h"'
parser/
U_rulevar_HC_OPTS
=
-fvia-C
'-\#include"hspincl.h"'
parser/
U_tree_HC_OPTS
=
-H12m
-fvia-C
'-\#include"hspincl.h"'
parser/
U_ttype_HC_OPTS
=
-fvia-C
'-\#include"hspincl.h"'
...
...
ghc/compiler/basicTypes/BasicTypes.lhs
View file @
506fa77d
...
...
@@ -16,14 +16,14 @@ types that
module BasicTypes(
Version, Arity,
Unused, unused,
Fixity(..), FixityDirection(..), StrictnessMark(..),
NewOrData(..), TopLevelFlag(..), RecFlag(..)
Fixity(..), FixityDirection(..), defaultFixity,
NewOrData(..),
RecFlag(..), isRec, isNonRec,
TopLevelFlag(..), isTopLevel, isNotTopLevel
) where
#include "HsVersions.h"
import {-# SOURCE #-} DataCon ( DataCon )
import {-# SOURCE #-} Type ( Type )
import Outputable
\end{code}
...
...
@@ -86,6 +86,9 @@ instance Outputable FixityDirection where
instance Eq Fixity where -- Used to determine if two fixities conflict
(Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
defaultFixity = Fixity 9 InfixL
\end{code}
...
...
@@ -113,6 +116,14 @@ data NewOrData
data TopLevelFlag
= TopLevel
| NotTopLevel
isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
isNotTopLevel NotTopLevel = True
isNotTopLevel TopLevel = False
isTopLevel TopLevel = True
isTopLevel NotTopLevel = False
\end{code}
%************************************************************************
...
...
@@ -124,16 +135,12 @@ data TopLevelFlag
\begin{code}
data RecFlag = Recursive
| NonRecursive
\end{code}
%************************************************************************
%* *
\subsection{Strictness indication}
%* *
%************************************************************************
isRec :: RecFlag -> Bool
isRec Recursive = True
isRec NonRecursive = False
\begin{code}
data StrictnessMark = MarkedStrict
| MarkedUnboxed DataCon [Type]
| NotMarkedStrict
isNonRec :: RecFlag -> Bool
isNonRec Recursive = False
isNonRec NonRecursive = True
\end{code}
ghc/compiler/basicTypes/Const.lhs
View file @
506fa77d
...
...
@@ -8,7 +8,8 @@ module Const (
Con(..),
conType, conPrimRep,
conOkForApp, conOkForAlt, isWHNFCon, isDataCon,
conIsTrivial, conIsCheap,
conIsTrivial, conIsCheap, conIsDupable, conStrictness,
conOkForSpeculation,
DataCon, PrimOp, -- For completeness
...
...
@@ -26,12 +27,14 @@ module Const (
import TysPrim ( charPrimTy, addrPrimTy, floatPrimTy, doublePrimTy,
intPrimTy, wordPrimTy, int64PrimTy, word64PrimTy
)
import PrimOp ( PrimOp, primOpType, primOpIsCheap )
import PrimOp ( PrimOp, primOpType, primOpIsDupable,
primOpIsCheap, primOpStrictness, primOpOkForSpeculation )
import PrimRep ( PrimRep(..) )
import DataCon ( DataCon, dataConType, dataConTyCon, isNullaryDataCon )
import DataCon ( DataCon, dataConType, dataConTyCon, isNullaryDataCon
, dataConRepStrictness
)
import TyCon ( isNewTyCon )
import Type ( Type, typePrimRep )
import PprType ( pprParendType )
import Demand ( Demand )
import CStrings ( stringToC, charToC, charToEasyHaskell )
import Outputable
...
...
@@ -74,6 +77,11 @@ conType (DataCon dc) = dataConType dc
conType (Literal lit) = literalType lit
conType (PrimOp op) = primOpType op
conStrictness :: Con -> ([Demand], Bool)
conStrictness (DataCon dc) = (dataConRepStrictness dc, False)
conStrictness (PrimOp op) = primOpStrictness op
conStrictness (Literal lit) = ([], False)
conPrimRep :: Con -> PrimRep -- Only data valued constants
conPrimRep (DataCon dc) = ASSERT( isNullaryDataCon dc) PtrRep
conPrimRep (Literal lit) = literalPrimRep lit
...
...
@@ -113,6 +121,18 @@ conIsTrivial con = True
conIsCheap (Literal lit) = not (isNoRepLit lit)
conIsCheap (DataCon con) = True
conIsCheap (PrimOp op) = primOpIsCheap op
-- conIsDupable is true for constants whose applications we are willing
-- to duplicate in different case branches; i.e no issue about loss of
-- work, just space
conIsDupable (Literal lit) = not (isNoRepLit lit)
conIsDupable (DataCon con) = True
conIsDupable (PrimOp op) = primOpIsDupable op
-- Similarly conOkForSpeculation
conOkForSpeculation (Literal lit) = True
conOkForSpeculation (DataCon con) = True
conOkForSpeculation (PrimOp op) = primOpOkForSpeculation op
\end{code}
...
...
ghc/compiler/basicTypes/DataCon.hi-boot
View file @
506fa77d
_interface_ DataCon 1
_exports_
DataCon DataCon ;
DataCon DataCon
dataConType
;
_declarations_
1 data DataCon ;
1 dataConType _:_ DataCon -> Type.Type ;;
ghc/compiler/basicTypes/DataCon.lhs
View file @
506fa77d
...
...
@@ -11,18 +11,23 @@ module DataCon (
dataConType, dataConSig, dataConName, dataConTag,
dataConOrigArgTys, dataConArgTys, dataConRawArgTys, dataConTyCon,
dataConFieldLabels, dataConStrictMarks, dataConSourceArity,
dataConNumFields, dataConNumInstArgs, dataConId,
dataConNumFields, dataConNumInstArgs, dataConId,
dataConRepStrictness,
isNullaryDataCon, isTupleCon, isUnboxedTupleCon,
isExistentialDataCon
isExistentialDataCon,
StrictnessMark(..), -- Representation visible to MkId only
markedStrict, notMarkedStrict, markedUnboxed, maybeMarkedUnboxed
) where
#include "HsVersions.h"
import {-# SOURCE #-} Subst( substTy, mkTyVarSubst )
import CmdLineOpts ( opt_DictsStrict )
import TysPrim
import Type ( Type, ThetaType, TauType,
mkSigmaTy, mkFunTys, mkTyConApp,
mkTyVarTys, mkDictTy,
substTy,
mkTyVarTys, mkDictTy,
splitAlgTyConApp_maybe
)
import PprType
...
...
@@ -31,9 +36,9 @@ import TyCon ( TyCon, tyConDataCons, isDataTyCon,
import Class ( classTyCon )
import Name ( Name, NamedThing(..), nameUnique, isLocallyDefinedName )
import Var ( TyVar, Id )
import VarEnv
import FieldLabel ( FieldLabel )
import BasicTypes ( StrictnessMark(..), Arity )
import BasicTypes ( Arity )
import Demand ( Demand, wwStrict, wwLazy )
import Outputable
import Unique ( Unique, Uniquable(..) )
import CmdLineOpts ( opt_UnboxStrictFields )
...
...
@@ -136,6 +141,32 @@ but the rep type is
Actually, the unboxed part isn't implemented yet!
%************************************************************************
%* *
\subsection{Strictness indication}
%* *
%************************************************************************
\begin{code}
data StrictnessMark = MarkedStrict
| MarkedUnboxed DataCon [Type]
| NotMarkedStrict
markedStrict = MarkedStrict
notMarkedStrict = NotMarkedStrict
markedUnboxed = MarkedUnboxed (panic "markedUnboxed1") (panic "markedUnboxed2")
maybeMarkedUnboxed (MarkedUnboxed dc tys) = Just (dc,tys)
maybeMarkedUnboxed other = Nothing
\end{code}
%************************************************************************
%* *
\subsection{Instances}
%* *
%************************************************************************
\begin{code}
instance Eq DataCon where
a == b = getUnique a == getUnique b
...
...
@@ -161,6 +192,13 @@ instance Show DataCon where
showsPrec p con = showsPrecSDoc p (ppr con)
\end{code}
%************************************************************************
%* *
\subsection{Consruction}
%* *
%************************************************************************
\begin{code}
mkDataCon :: Name
-> [StrictnessMark] -> [FieldLabel]
...
...
@@ -307,6 +345,17 @@ dataConSourceArity :: DataCon -> Arity
-- Source-level arity of the data constructor
dataConSourceArity dc = length (dcOrigArgTys dc)
dataConRepStrictness :: DataCon -> [Demand]
-- Give the demands on the arguments of a
-- Core constructor application (Con dc args)
dataConRepStrictness dc
= go (dcRealStricts dc)
where
go [] = []
go (MarkedStrict : ss) = wwStrict : go ss
go (NotMarkedStrict : ss) = wwLazy : go ss
go (MarkedUnboxed con _ : ss) = go (dcRealStricts con ++ ss)
dataConSig :: DataCon -> ([TyVar], ThetaType,
[TyVar], ThetaType,
[TauType], TyCon)
...
...
@@ -325,12 +374,12 @@ dataConArgTys, dataConOrigArgTys :: DataCon
dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
dcExTyVars = ex_tyvars, dcExTheta = ex_theta}) inst_tys
= map (substTy (
zipVarEnv
(tyvars ++ ex_tyvars) inst_tys))
= map (substTy (
mkTyVarSubst
(tyvars ++ ex_tyvars) inst_tys))
([mkDictTy cls tys | (cls,tys) <- ex_theta] ++ arg_tys)
dataConOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars,
dcExTyVars = ex_tyvars, dcExTheta = ex_theta}) inst_tys
= map (substTy (
zipVarEnv
(tyvars ++ ex_tyvars) inst_tys))
= map (substTy (
mkTyVarSubst
(tyvars ++ ex_tyvars) inst_tys))
([mkDictTy cls tys | (cls,tys) <- ex_theta] ++ arg_tys)
\end{code}
...
...
ghc/compiler/basicTypes/Demand.lhs
View file @
506fa77d
...
...
@@ -8,7 +8,7 @@ module Demand(
Demand(..),
wwLazy, wwStrict, wwUnpackData, wwUnpackNew, wwPrim, wwEnum,
isStrict, isLazy,
isStrict, isLazy,
isPrim,
pprDemands
) where
...
...
@@ -80,6 +80,10 @@ isStrict WwStrict = True
isStrict WwEnum = True
isStrict WwPrim = True
isStrict _ = False
isPrim :: Demand -> Bool
isPrim WwPrim = True
isPrim other = False
\end{code}
\begin{code}
...
...
ghc/compiler/basicTypes/Id.lhs
View file @
506fa77d
...
...
@@ -8,16 +8,17 @@ module Id (
Id, DictId,
-- Simple construction
mk
VanillaId, mkImported
Id, mkSysLocal, mkUserLocal,
mkTemplateLocals, mk
TemplateLocal, mkWildId, mkUserId
,
mk
Id, mkVanilla
Id, mkSysLocal, mkUserLocal,
mkTemplateLocals, mk
WildId, mkTemplateLocal
,
-- Taking an Id apart
idName, idType, idUnique, idInfo,
idDetails,
idName, idType, idUnique, idInfo,
idPrimRep, isId,
recordSelectorFieldLabel,
-- Modifying an Id
setIdName, setIdUnique, setIdType, setIdInfo,
setIdName, setIdUnique, setIdType, setIdNoDiscard,
setIdInfo, modifyIdInfo, maybeModifyIdInfo,
-- Predicates
omitIfaceSigForId,
...
...
@@ -26,14 +27,12 @@ module Id (
-- Inline pragma stuff
getInlinePragma, setInlinePragma, modifyInlinePragma,
idWantsToBeINLINEd, idMustBeINLINEd, idMustNotBeINLINEd,
isSpecPragmaId,
idMustBeINLINEd, idMustNotBeINLINEd,
isRecordSelector,
is
SpecPragmaId, is
RecordSelector,
isPrimitiveId_maybe, isDataConId_maybe,
isConstantId,
is
BottomingId, idAppIsBottom
,
isConstantId,
isBottomingId, idAppIsBottom,
is
ExportedId, isUserExportedId
,
-- IdInfo stuff
setIdUnfolding,
...
...
@@ -61,20 +60,22 @@ module Id (
#include "HsVersions.h"
import {-# SOURCE #-} CoreUnfold ( Unfolding )
import {-# SOURCE #-} CoreSyn ( CoreRules )
import Var ( Id, DictId, VarDetails(..),
isId, mkId,
idName, idType, idUnique, idInfo, idDetails,
setIdName, setVarType, setIdUnique, setIdInfo, modifyIdInfo,
import Var ( Id, DictId,
isId, mkIdVar,
idName, idType, idUnique, idInfo,
setIdName, setVarType, setIdUnique,
setIdInfo, modifyIdInfo, maybeModifyIdInfo,
externallyVisibleId
)
import VarSet
import Type ( Type, tyVarsOfType, typePrimRep, addFreeTyVars )
import IdInfo
import Demand ( Demand )
import Demand ( Demand
, isStrict, wwLazy
)
import Name ( Name, OccName,
mkSysLocalName, mkLocalName,
isWiredInName
isWiredInName
, isUserExportedName
)
import Const ( Con(..) )
import PrimRep ( PrimRep )
...
...
@@ -106,15 +107,22 @@ infixl 1 `setIdUnfolding`,
%* *
%************************************************************************
\begin{code}
mkVanillaId :: Name -> Type -> Id
mkVanillaId name ty = mkId name (addFreeTyVars ty) VanillaId noIdInfo
Absolutely all Ids are made by mkId. It
a) Pins free-tyvar-info onto the Id's type,
where it can easily be found.
b) Ensures that exported Ids are
mkImportedId :: Name -> Type -> IdInfo -> Id
mkImportedId name ty info = mkId name (addFreeTyVars ty) VanillaId info
\begin{code}
mkId :: Name -> Type -> IdInfo -> Id
mkId name ty info = mkIdVar name (addFreeTyVars ty) info'
where
info' | isUserExportedName name = setNoDiscardInfo info
| otherwise = info
\end{code}
mkUserId :: Name -> Type -> Id
mkUserId name ty = mkVanillaId name ty
\begin{code}
mkVanillaId :: Name -> Type -> Id
mkVanillaId name ty = mkId name ty vanillaIdInfo
-- SysLocal: for an Id being created by the compiler out of thin air...
-- UserLocal: an Id with a name the user might recognize...
...
...
@@ -163,27 +171,6 @@ idPrimRep :: Id -> PrimRep
idPrimRep id = typePrimRep (idType id)
\end{code}
omitIfaceSigForId tells whether an Id's info is implied by other declarations,
so we don't need to put its signature in an interface file, even if it's mentioned
in some other interface unfolding.
\begin{code}
omitIfaceSigForId :: Id -> Bool
omitIfaceSigForId id
| isWiredInName (idName id)
= True
| otherwise
= case idDetails id of
RecordSelId _ -> True -- Includes dictionary selectors
ConstantId _ -> True
-- ConstantIds are implied by their type or class decl;
-- remember that all type and class decls appear in the interface file.
-- The dfun id must *not* be omitted, because it carries version info for
-- the instance decl
other -> False -- Don't omit!
\end{code}
%************************************************************************
%* *
...
...
@@ -192,28 +179,75 @@ omitIfaceSigForId id
%************************************************************************
\begin{code}
idFlavour :: Id -> IdFlavour
idFlavour id = flavourInfo (idInfo id)
setIdNoDiscard :: Id -> Id
setIdNoDiscard id -- Make an Id into a NoDiscardId, unless it is already
= modifyIdInfo setNoDiscardInfo id
recordSelectorFieldLabel :: Id -> FieldLabel
recordSelectorFieldLabel id = case id
Details
id of
recordSelectorFieldLabel id = case id
Flavour
id of
RecordSelId lbl -> lbl
isRecordSelector id = case id
Details
id of
isRecordSelector id = case id
Flavour
id of
RecordSelId lbl -> True
other -> False
isPrimitiveId_maybe id = case id
Details
id of
isPrimitiveId_maybe id = case id
Flavour
id of
ConstantId (PrimOp op) -> Just op
other -> Nothing
isDataConId_maybe id = case id
Details
id of
isDataConId_maybe id = case id
Flavour
id of
ConstantId (DataCon con) -> Just con
other -> Nothing
isConstantId id = case id
Details
id of
isConstantId id = case id
Flavour
id of
ConstantId _ -> True
other -> False
isSpecPragmaId id = case idFlavour id of
SpecPragmaId -> True
other -> False
-- Don't drop a binding for an exported Id,
-- if it otherwise looks dead.
isExportedId :: Id -> Bool
isExportedId id = case idFlavour id of
VanillaId -> False
other -> True -- All the others are no-discard
-- Say if an Id was exported by the user
-- Implies isExportedId (see mkId above)
isUserExportedId :: Id -> Bool
isUserExportedId id = isUserExportedName (idName id)
\end{code}
omitIfaceSigForId tells whether an Id's info is implied by other declarations,
so we don't need to put its signature in an interface file, even if it's mentioned
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
ConstantId _ -> True
-- ConstantIds are implied by their type or class decl;
-- remember that all type and class decls appear in the interface file.
-- The dfun id must *not* be omitted, because it carries version info for
-- the instance decl
other -> False -- Don't omit!
\end{code}
%************************************************************************
%* *
\subsection{IdInfo stuff}
...
...
@@ -227,7 +261,7 @@ getIdArity :: Id -> ArityInfo
getIdArity id = arityInfo (idInfo id)
setIdArity :: Id -> ArityInfo -> Id
setIdArity id arity = modifyIdInfo
id (arity `setArityInfo`)
setIdArity id arity = modifyIdInfo
(`setArityInfo` arity) id
---------------------------------
-- STRICTNESS
...
...
@@ -235,7 +269,7 @@ getIdStrictness :: Id -> StrictnessInfo
getIdStrictness id = strictnessInfo (idInfo id)
setIdStrictness :: Id -> StrictnessInfo -> Id
setIdStrictness id strict_info = modifyIdInfo
id (strict_info `setStrictnessInfo`)
setIdStrictness id strict_info = modifyIdInfo
(`setStrictnessInfo` strict_info) id
-- isBottomingId returns true if an application to n args would diverge
isBottomingId :: Id -> Bool
...
...
@@ -250,7 +284,7 @@ getIdWorkerInfo :: Id -> WorkerInfo
getIdWorkerInfo id = workerInfo (idInfo id)
setIdWorkerInfo :: Id -> WorkerInfo -> Id
setIdWorkerInfo id work_info = modifyIdInfo
id (work_info `setWorkerInfo`)
setIdWorkerInfo id work_info = modifyIdInfo
(`setWorkerInfo` work_info) id
---------------------------------
-- UNFOLDING
...
...
@@ -258,7 +292,7 @@ getIdUnfolding :: Id -> Unfolding
getIdUnfolding id = unfoldingInfo (idInfo id)
setIdUnfolding :: Id -> Unfolding -> Id
setIdUnfolding id unfolding = modifyIdInfo
id (unfolding `setUnfoldingInfo`)
setIdUnfolding id unfolding = modifyIdInfo
(`setUnfoldingInfo` unfolding) id
---------------------------------
-- DEMAND
...
...
@@ -266,7 +300,7 @@ getIdDemandInfo :: Id -> Demand
getIdDemandInfo id = demandInfo (idInfo id)
setIdDemandInfo :: Id -> Demand -> Id
setIdDemandInfo id demand_info = modifyIdInfo
id (demand_info `setDemandInfo`)
setIdDemandInfo id demand_info = modifyIdInfo
(`setDemandInfo` demand_info) id
---------------------------------
-- UPDATE INFO
...
...
@@ -274,15 +308,15 @@ getIdUpdateInfo :: Id -> UpdateInfo
getIdUpdateInfo id = updateInfo (idInfo id)
setIdUpdateInfo :: Id -> UpdateInfo -> Id
setIdUpdateInfo id upd_info = modifyIdInfo
id (upd_info `setUpdateInfo`)
setIdUpdateInfo id upd_info = modifyIdInfo
(`setUpdateInfo` upd_info) id
---------------------------------
-- SPECIALISATION
getIdSpecialisation :: Id ->
IdSpecEnv
getIdSpecialisation :: Id ->
CoreRules
getIdSpecialisation id = specInfo (idInfo id)
setIdSpecialisation :: Id ->
IdSpecEnv
-> Id
setIdSpecialisation id spec_info = modifyIdInfo
id (spec_info `setSpecInfo`)
setIdSpecialisation :: Id ->
CoreRules
-> Id
setIdSpecialisation id spec_info = modifyIdInfo
(`setSpecInfo` spec_info) id
---------------------------------
-- CAF INFO
...
...
@@ -290,7 +324,7 @@ getIdCafInfo :: Id -> CafInfo
getIdCafInfo id = cafInfo (idInfo id)
setIdCafInfo :: Id -> CafInfo -> Id
setIdCafInfo id caf_info = modifyIdInfo
id (caf_info `setCafInfo`)
setIdCafInfo id caf_info = modifyIdInfo
(`setCafInfo` caf_info) id
---------------------------------
-- CPR INFO
...
...
@@ -298,8 +332,7 @@ getIdCprInfo :: Id -> CprInfo
getIdCprInfo id = cprInfo (idInfo id)
setIdCprInfo :: Id -> CprInfo -> Id
setIdCprInfo id cpr_info = modifyIdInfo id (cpr_info `setCprInfo`)
setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
\end{code}
...
...
@@ -313,28 +346,17 @@ getInlinePragma :: Id -> InlinePragInfo
getInlinePragma id = inlinePragInfo (idInfo id)
setInlinePragma :: Id -> InlinePragInfo -> Id
setInlinePragma id prag = modifyIdInfo
id (setInlinePragInfo prag)
setInlinePragma id prag = modifyIdInfo
(`setInlinePragInfo` prag) id
modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
modifyInlinePragma id fn = modifyIdInfo id (\info -> setInlinePragInfo (fn (inlinePragInfo info)) info)
idWantsToBeINLINEd :: Id -> Bool
idWantsToBeINLINEd id = case getInlinePragma id of
IWantToBeINLINEd -> True
IMustBeINLINEd -> True
other -> False
modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id