Commit 2ab6ce78 authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by David Feuer
Browse files

Move isJoinId, isJoinId_maybe to Id

This is just a refactoring, moving these two functions where
they belong.

The reason they were there was because 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

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D3207
parent 777b7707
......@@ -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.
--
......
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
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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 )
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment