summaryrefslogtreecommitdiff
path: root/compiler/basicTypes
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-02-24 20:59:43 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-02-26 15:10:58 -0500
commit817f93eac4d13f680e8e3e7a25eb403b1864f82e (patch)
treef7014721e49627f15d76f44a5bf663043e35fafc /compiler/basicTypes
parentb2b49a0aad353201678970c76d8305a5dcb1bfab (diff)
downloadhaskell-817f93eac4d13f680e8e3e7a25eb403b1864f82e.tar.gz
Modules: Core (#13009)
Update haddock submodule
Diffstat (limited to 'compiler/basicTypes')
-rw-r--r--compiler/basicTypes/BasicTypes.hs6
-rw-r--r--compiler/basicTypes/DataCon.hs2
-rw-r--r--compiler/basicTypes/Id.hs8
-rw-r--r--compiler/basicTypes/IdInfo.hs8
-rw-r--r--compiler/basicTypes/Literal.hs4
-rw-r--r--compiler/basicTypes/MkId.hs20
6 files changed, 24 insertions, 24 deletions
diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs
index 83ebb67c5c..9bae45365e 100644
--- a/compiler/basicTypes/BasicTypes.hs
+++ b/compiler/basicTypes/BasicTypes.hs
@@ -154,7 +154,7 @@ instance Outputable LeftOrRight where
-- "real work". So:
-- fib 100 has arity 0
-- \x -> fib x has arity 1
--- See also Note [Definition of arity] in CoreArity
+-- See also Note [Definition of arity] in GHC.Core.Arity
type Arity = Int
-- | Representation Arity
@@ -1377,13 +1377,13 @@ The main effects of CONLIKE are:
- The occurrence analyser (OccAnal) and simplifier (Simplify) treat
CONLIKE thing like constructors, by ANF-ing them
- - New function CoreUtils.exprIsExpandable is like exprIsCheap, but
+ - New function GHC.Core.Utils.exprIsExpandable is like exprIsCheap, but
additionally spots applications of CONLIKE functions
- A CoreUnfolding has a field that caches exprIsExpandable
- The rule matcher consults this field. See
- Note [Expanding variables] in Rules.hs.
+ Note [Expanding variables] in GHC.Core.Rules.
-}
isConLike :: RuleMatchInfo -> Bool
diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs
index c89dab3349..7db26f1c94 100644
--- a/compiler/basicTypes/DataCon.hs
+++ b/compiler/basicTypes/DataCon.hs
@@ -461,7 +461,7 @@ data DataCon
-- It's convenient to apply the rep-type of MkT to 't', to get
-- forall x y. (t~(x,y), x~y, Ord x) => x -> y -> T t
-- and use that to check the pattern. Mind you, this is really only
- -- used in CoreLint.
+ -- used in GHC.Core.Lint.
dcInfix :: Bool, -- True <=> declared infix
diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs
index dddc23da10..cc693e2f44 100644
--- a/compiler/basicTypes/Id.hs
+++ b/compiler/basicTypes/Id.hs
@@ -120,7 +120,7 @@ module Id (
import GhcPrelude
import GHC.Driver.Session
-import CoreSyn ( CoreRule, isStableUnfolding, evaldUnfolding,
+import GHC.Core ( CoreRule, isStableUnfolding, evaldUnfolding,
isCompulsoryUnfolding, Unfolding( NoUnfolding ) )
import IdInfo
@@ -374,7 +374,7 @@ It's very important that they are *LocalIds*, not GlobalIds, for lots
of reasons:
* We want to treat them as free variables for the purpose of
- dependency analysis (e.g. CoreFVs.exprFreeVars).
+ dependency analysis (e.g. GHC.Core.FVs.exprFreeVars).
* Look them up in the current substitution when we come across
occurrences of them (in Subst.lookupIdSubst). Lacking this we
@@ -778,7 +778,7 @@ idOneShotInfo :: Id -> OneShotInfo
idOneShotInfo id = oneShotInfo (idInfo id)
-- | Like 'idOneShotInfo', but taking the Horrible State Hack in to account
--- See Note [The state-transformer hack] in CoreArity
+-- See Note [The state-transformer hack] in GHC.Core.Arity
idStateHackOneShotInfo :: Id -> OneShotInfo
idStateHackOneShotInfo id
| isStateHackType (idType id) = stateHackOneShot
@@ -788,7 +788,7 @@ idStateHackOneShotInfo id
-- This one is the "business end", called externally.
-- It works on type variables as well as Ids, returning True
-- Its main purpose is to encapsulate the Horrible State Hack
--- See Note [The state-transformer hack] in CoreArity
+-- See Note [The state-transformer hack] in GHC.Core.Arity
isOneShotBndr :: Var -> Bool
isOneShotBndr var
| isTyVar var = True
diff --git a/compiler/basicTypes/IdInfo.hs b/compiler/basicTypes/IdInfo.hs
index d3c5abdea0..ea778ca87e 100644
--- a/compiler/basicTypes/IdInfo.hs
+++ b/compiler/basicTypes/IdInfo.hs
@@ -86,7 +86,7 @@ module IdInfo (
import GhcPrelude
-import CoreSyn
+import GHC.Core
import Class
import {-# SOURCE #-} PrimOp (PrimOp)
@@ -165,7 +165,7 @@ data IdDetails
-- This only covers /un-lifted/ coercions, of type
-- (t1 ~# t2) or (t1 ~R# t2), not their lifted variants
| JoinId JoinArity -- ^ An 'Id' for a join point taking n arguments
- -- Note [Join points] in CoreSyn
+ -- Note [Join points] in GHC.Core
-- | Recursive Selector Parent
data RecSelParent = RecSelData TyCon | RecSelPatSyn PatSyn deriving Eq
@@ -242,7 +242,7 @@ pprIdDetails other = brackets (pp other)
data IdInfo
= IdInfo {
arityInfo :: !ArityInfo,
- -- ^ 'Id' arity, as computed by 'CoreArity'. Specifies how many
+ -- ^ 'Id' arity, as computed by 'GHC.Core.Arity'. Specifies how many
-- arguments this 'Id' has to be applied to before it doesn any
-- meaningful work.
ruleInfo :: RuleInfo,
@@ -617,7 +617,7 @@ Ids store whether or not they can be levity-polymorphic at any amount
of saturation. This is helpful in optimizing the levity-polymorphism check
done in the desugarer, where we can usually learn that something is not
levity-polymorphic without actually figuring out its type. See
-isExprLevPoly in CoreUtils for where this info is used. Storing
+isExprLevPoly in GHC.Core.Utils for where this info is used. Storing
this is required to prevent perf/compiler/T5631 from blowing up.
-}
diff --git a/compiler/basicTypes/Literal.hs b/compiler/basicTypes/Literal.hs
index 708a85bb2f..035ba3b4b9 100644
--- a/compiler/basicTypes/Literal.hs
+++ b/compiler/basicTypes/Literal.hs
@@ -599,7 +599,7 @@ rubbishLit = LitRubbish
-- structured, ensuring that the compiler can't inline in ways that will break
-- user code. One approach to this is described in #8472.
litIsTrivial :: Literal -> Bool
--- c.f. CoreUtils.exprIsTrivial
+-- c.f. GHC.Core.Utils.exprIsTrivial
litIsTrivial (LitString _) = False
litIsTrivial (LitNumber nt _ _) = case nt of
LitNumInteger -> False
@@ -612,7 +612,7 @@ litIsTrivial _ = True
-- | True if code space does not go bad if we duplicate this literal
litIsDupable :: DynFlags -> Literal -> Bool
--- c.f. CoreUtils.exprIsDupable
+-- c.f. GHC.Core.Utils.exprIsDupable
litIsDupable _ (LitString _) = False
litIsDupable dflags (LitNumber nt i _) = case nt of
LitNumInteger -> inIntRange dflags i
diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs
index 683d136b99..499b0347e1 100644
--- a/compiler/basicTypes/MkId.hs
+++ b/compiler/basicTypes/MkId.hs
@@ -42,7 +42,7 @@ module MkId (
import GhcPrelude
-import Rules
+import GHC.Core.Rules
import TysPrim
import TysWiredIn
import PrelRules
@@ -51,9 +51,9 @@ import TyCoRep
import FamInstEnv
import Coercion
import TcType
-import MkCore
-import CoreUtils ( mkCast, mkDefaultCase )
-import CoreUnfold
+import GHC.Core.Make
+import GHC.Core.Utils ( mkCast, mkDefaultCase )
+import GHC.Core.Unfold
import Literal
import TyCon
import Class
@@ -66,7 +66,7 @@ import Id
import IdInfo
import Demand
import Cpr
-import CoreSyn
+import GHC.Core
import Unique
import UniqSupply
import PrelNames
@@ -100,7 +100,7 @@ There are several reasons why an Id might appear in the wiredInIds:
* magicIds: see Note [magicIds]
-* errorIds, defined in coreSyn/MkCore.hs.
+* errorIds, defined in GHC.Core.Make.
These error functions (e.g. rUNTIME_ERROR_ID) are wired in
because the desugarer generates code that mentions them directly
@@ -144,7 +144,7 @@ wiredInIds :: [Id]
wiredInIds
= magicIds
++ ghcPrimIds
- ++ errorIds -- Defined in MkCore
+ ++ errorIds -- Defined in GHC.Core.Make
magicIds :: [Id] -- See Note [magicIds]
magicIds = [lazyId, oneShotId, noinlineId]
@@ -352,7 +352,7 @@ With -XUnliftedNewtypes, this is allowed -- even though MkN is levity-
polymorphic. It's OK because MkN evaporates in the compiled code, becoming
just a cast. That is, it has a compulsory unfolding. As long as its
argument is not levity-polymorphic (which it can't be, according to
-Note [Levity polymorphism invariants] in CoreSyn), and it's saturated,
+Note [Levity polymorphism invariants] in GHC.Core), and it's saturated,
no levity-polymorphic code ends up in the code generator. The saturation
condition is effectively checked by Note [Detecting forced eta expansion]
in GHC.HsToCore.Expr.
@@ -1387,7 +1387,7 @@ seqId = pcMiscPrelId seqName ty info
= alwaysInlinePragma `setInlinePragmaActivation` ActiveAfter
NoSourceText 0
-- Make 'seq' not inline-always, so that simpleOptExpr
- -- (see CoreSubst.simple_app) won't inline 'seq' on the
+ -- (see GHC.Core.Subst.simple_app) won't inline 'seq' on the
-- LHS of rules. That way we can have rules for 'seq';
-- see Note [seqId magic]
@@ -1611,7 +1611,7 @@ which is what we want.
It is only effective if the one-shot info survives as long as possible; in
particular it must make it into the interface in unfoldings. See Note [Preserve
-OneShotInfo] in CoreTidy.
+OneShotInfo] in GHC.Core.Op.Tidy.
Also see https://gitlab.haskell.org/ghc/ghc/wikis/one-shot.