[commit: ghc] wip/spj-early-inline4: Move isJoinId, isJoinId_maybe to Id (bf3aab7)
git at git.haskell.org
git at git.haskell.org
Sun Feb 26 18:06:23 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/spj-early-inline4
Link : http://ghc.haskell.org/trac/ghc/changeset/bf3aab760edb06ebd4d7e8d2ac02fd14c4fa27e8/ghc
>---------------------------------------------------------------
commit bf3aab760edb06ebd4d7e8d2ac02fd14c4fa27e8
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Fri Feb 24 16:39:19 2017 +0000
Move isJoinId, isJoinId_maybe to Id
Summary:
This is just a refactoring, moving these two functions where
they belong.
The reason they were there was becuase of the use of isJoinId_maybe
in the OutputableBndr instance of TaggedBndr, which was in CoreSyn.
I moved it to PprCore, to join the OutputableBndr instance for
Var. That makes more sense anyway.
Reviewers: austin, bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D3207
>---------------------------------------------------------------
bf3aab760edb06ebd4d7e8d2ac02fd14c4fa27e8
compiler/basicTypes/Id.hs | 23 ++++++++++++++++++++---
compiler/basicTypes/IdInfo.hs-boot | 2 --
compiler/basicTypes/Var.hs | 12 ------------
compiler/coreSyn/CoreSyn.hs | 9 ---------
compiler/coreSyn/PprCore.hs | 8 ++++++++
compiler/simplCore/CSE.hs | 5 +++--
compiler/simplCore/FloatIn.hs | 2 +-
7 files changed, 32 insertions(+), 29 deletions(-)
diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs
index 69c2cc3..3934ae7 100644
--- a/compiler/basicTypes/Id.hs
+++ b/compiler/basicTypes/Id.hs
@@ -5,7 +5,7 @@
\section[Id]{@Ids@: Value and constructor identifiers}
-}
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE ImplicitParams, CPP #-}
-- |
-- #name_types#
@@ -127,8 +127,7 @@ import Var( Id, CoVar, DictId, JoinId,
InId, InVar,
OutId, OutVar,
idInfo, idDetails, setIdDetails, globaliseId, varType,
- isId, isLocalId, isGlobalId, isExportedId,
- isJoinId, isJoinId_maybe )
+ isId, isLocalId, isGlobalId, isExportedId )
import qualified Var
import Type
@@ -478,6 +477,24 @@ isDataConId_maybe id = case Var.idDetails id of
DataConWrapId con -> Just con
_ -> Nothing
+isJoinId :: Var -> Bool
+-- It is convenient in SetLevels.lvlMFE to apply isJoinId
+-- to the free vars of an expression, so it's convenient
+-- if it returns False for type variables
+isJoinId id
+ | isId id = case Var.idDetails id of
+ JoinId {} -> True
+ _ -> False
+ | otherwise = False
+
+isJoinId_maybe :: Var -> Maybe JoinArity
+isJoinId_maybe id
+ | isId id = ASSERT2( isId id, ppr id )
+ case Var.idDetails id of
+ JoinId arity -> Just arity
+ _ -> Nothing
+ | otherwise = Nothing
+
idDataCon :: Id -> DataCon
-- ^ Get from either the worker or the wrapper 'Id' to the 'DataCon'. Currently used only in the desugarer.
--
diff --git a/compiler/basicTypes/IdInfo.hs-boot b/compiler/basicTypes/IdInfo.hs-boot
index 27c1217..0fabad3 100644
--- a/compiler/basicTypes/IdInfo.hs-boot
+++ b/compiler/basicTypes/IdInfo.hs-boot
@@ -1,5 +1,4 @@
module IdInfo where
-import BasicTypes
import Outputable
data IdInfo
data IdDetails
@@ -7,6 +6,5 @@ data IdDetails
vanillaIdInfo :: IdInfo
coVarDetails :: IdDetails
isCoVarDetails :: IdDetails -> Bool
-isJoinIdDetails_maybe :: IdDetails -> Maybe JoinArity
pprIdDetails :: IdDetails -> SDoc
diff --git a/compiler/basicTypes/Var.hs b/compiler/basicTypes/Var.hs
index 2b728af..2bdd5f0 100644
--- a/compiler/basicTypes/Var.hs
+++ b/compiler/basicTypes/Var.hs
@@ -57,7 +57,6 @@ module Var (
-- ** Predicates
isId, isTyVar, isTcTyVar,
isLocalVar, isLocalId, isCoVar, isNonCoVarId, isTyCoVar,
- isJoinId, isJoinId_maybe,
isGlobalId, isExportedId,
mustHaveLocalBinding,
@@ -85,10 +84,8 @@ module Var (
import {-# SOURCE #-} TyCoRep( Type, Kind, pprKind )
import {-# SOURCE #-} TcType( TcTyVarDetails, pprTcTyVarDetails, vanillaSkolemTv )
import {-# SOURCE #-} IdInfo( IdDetails, IdInfo, coVarDetails, isCoVarDetails,
- isJoinIdDetails_maybe,
vanillaIdInfo, pprIdDetails )
-import BasicTypes ( JoinArity )
import Name hiding (varName)
import Unique ( Uniquable, Unique, getKey, getUnique
, mkUniqueGrimily, nonDetCmpUnique )
@@ -96,7 +93,6 @@ import Util
import Binary
import DynFlags
import Outputable
-import Maybes
import Data.Data
@@ -618,14 +614,6 @@ isNonCoVarId :: Var -> Bool
isNonCoVarId (Id { id_details = details }) = not (isCoVarDetails details)
isNonCoVarId _ = False
-isJoinId :: Var -> Bool
-isJoinId (Id { id_details = details }) = isJust (isJoinIdDetails_maybe details)
-isJoinId _ = False
-
-isJoinId_maybe :: Var -> Maybe JoinArity
-isJoinId_maybe (Id { id_details = details }) = isJoinIdDetails_maybe details
-isJoinId_maybe _ = Nothing
-
isLocalId :: Var -> Bool
isLocalId (Id { idScope = LocalId _ }) = True
isLocalId _ = False
diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs
index b781863..2616e6f 100644
--- a/compiler/coreSyn/CoreSyn.hs
+++ b/compiler/coreSyn/CoreSyn.hs
@@ -1717,15 +1717,6 @@ type TaggedAlt t = Alt (TaggedBndr t)
instance Outputable b => Outputable (TaggedBndr b) where
ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
--- OutputableBndr Var is declared separately in PprCore; using a FlexibleContext
--- to avoid circularity
-instance (OutputableBndr Var, Outputable b) =>
- OutputableBndr (TaggedBndr b) where
- pprBndr _ b = ppr b -- Simple
- pprInfixOcc b = ppr b
- pprPrefixOcc b = ppr b
- bndrIsJoin_maybe (TB b _) = isJoinId_maybe b
-
deTagExpr :: TaggedExpr t -> CoreExpr
deTagExpr (Var v) = Var v
deTagExpr (Lit l) = Lit l
diff --git a/compiler/coreSyn/PprCore.hs b/compiler/coreSyn/PprCore.hs
index 30de5d2..ddece8d 100644
--- a/compiler/coreSyn/PprCore.hs
+++ b/compiler/coreSyn/PprCore.hs
@@ -338,12 +338,20 @@ Furthermore, a dead case-binder is completely ignored, while otherwise, dead
binders are printed as "_".
-}
+-- THese instances are sadly orphans
+
instance OutputableBndr Var where
pprBndr = pprCoreBinder
pprInfixOcc = pprInfixName . varName
pprPrefixOcc = pprPrefixName . varName
bndrIsJoin_maybe = isJoinId_maybe
+instance Outputable b => OutputableBndr (TaggedBndr b) where
+ pprBndr _ b = ppr b -- Simple
+ pprInfixOcc b = ppr b
+ pprPrefixOcc b = ppr b
+ bndrIsJoin_maybe (TB b _) = isJoinId_maybe b
+
pprCoreBinder :: BindingSite -> Var -> SDoc
pprCoreBinder LetBind binder
| isTyVar binder = pprKindedTyVarBndr binder
diff --git a/compiler/simplCore/CSE.hs b/compiler/simplCore/CSE.hs
index e850780..97a933e 100644
--- a/compiler/simplCore/CSE.hs
+++ b/compiler/simplCore/CSE.hs
@@ -11,10 +11,11 @@ module CSE (cseProgram, cseOneExpr) where
#include "HsVersions.h"
import CoreSubst
-import Var ( Var, isJoinId )
+import Var ( Var )
import VarEnv ( elemInScopeSet )
import Id ( Id, idType, idInlineActivation, isDeadBinder
- , zapIdOccInfo, zapIdUsageInfo, idInlinePragma )
+ , zapIdOccInfo, zapIdUsageInfo, idInlinePragma
+ , isJoinId )
import CoreUtils ( mkAltExpr, eqExpr
, exprIsLiteralString
, stripTicksE, stripTicksT, mkTicks )
diff --git a/compiler/simplCore/FloatIn.hs b/compiler/simplCore/FloatIn.hs
index cabdc3b..4d5a564 100644
--- a/compiler/simplCore/FloatIn.hs
+++ b/compiler/simplCore/FloatIn.hs
@@ -25,7 +25,7 @@ import CoreUtils ( exprIsDupable, exprIsExpandable,
exprOkForSideEffects, mkTicks )
import CoreFVs
import CoreMonad ( CoreM )
-import Id ( isOneShotBndr, idType )
+import Id ( isOneShotBndr, idType, isJoinId, isJoinId_maybe )
import Var
import Type ( isUnliftedType )
import VarSet
More information about the ghc-commits
mailing list