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

7 files changed, 32 insertions, 29 deletions

diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs
index 69c2cc32b0..3934ae7dce 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 27c1217e15..0fabad3bbb 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 2b728afa4f..2bdd5f0539 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 b781863e36..2616e6f605 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 30de5d2a61..ddece8dd4b 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 e8507804b2..97a933e463 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 cabdc3b430..4d5a564257 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