[Git][ghc/ghc][wip/T22717] Avoid orphans

Simon Peyton Jones (@simonpj) gitlab at gitlab.haskell.org
Mon Jan 23 10:12:00 UTC 2023



Simon Peyton Jones pushed to branch wip/T22717 at Glasgow Haskell Compiler / GHC


Commits:
9a1f54d1 by Simon Peyton Jones at 2023-01-23T10:12:14+00:00
Avoid orphans

- - - - -


2 changed files:

- compiler/GHC/Stg/InferTags/Types.hs
- compiler/GHC/Stg/Syntax.hs


Changes:

=====================================
compiler/GHC/Stg/InferTags/Types.hs
=====================================
@@ -30,11 +30,6 @@ import GHC.StgToCmm.Types
 *                                                                      *
 ********************************************************************* -}
 
-type instance BinderP      'InferTaggedBinders = (Id, TagSig)
-type instance XLet         'InferTaggedBinders = XLet         'CodeGen
-type instance XLetNoEscape 'InferTaggedBinders = XLetNoEscape 'CodeGen
-type instance XRhsClosure  'InferTaggedBinders = XRhsClosure  'CodeGen
-
 type InferStgTopBinding = GenStgTopBinding 'InferTaggedBinders
 type InferStgBinding    = GenStgBinding    'InferTaggedBinders
 type InferStgExpr       = GenStgExpr       'InferTaggedBinders


=====================================
compiler/GHC/Stg/Syntax.hs
=====================================
@@ -68,27 +68,35 @@ module GHC.Stg.Syntax (
 
 import GHC.Prelude
 
-import GHC.Core     ( AltCon )
+import GHC.Stg.InferTags.TagSig( TagSig )
+  -- To avoid having an orphan instance for BinderP InferTaggedBinders
+
 import GHC.Types.CostCentre ( CostCentreStack )
-import Data.ByteString ( ByteString )
-import Data.Data   ( Data )
-import Data.List   ( intersperse )
+
+import GHC.Core     ( AltCon )
 import GHC.Core.DataCon
+import GHC.Core.TyCon    ( PrimRep(..), TyCon )
+import GHC.Core.Type     ( Type )
+import GHC.Core.Ppr( {- instances -} )
+
 import GHC.Types.ForeignCall ( ForeignCall )
 import GHC.Types.Id
 import GHC.Types.Name        ( isDynLinkName )
 import GHC.Types.Tickish     ( StgTickish )
 import GHC.Types.Var.Set
 import GHC.Types.Literal     ( Literal, literalType )
+import GHC.Types.RepType ( typePrimRep1, typePrimRep )
+
 import GHC.Unit.Module       ( Module )
 import GHC.Utils.Outputable
+import GHC.Utils.Panic.Plain
+
 import GHC.Platform
-import GHC.Core.Ppr( {- instances -} )
 import GHC.Builtin.PrimOps ( PrimOp, PrimCall )
-import GHC.Core.TyCon    ( PrimRep(..), TyCon )
-import GHC.Core.Type     ( Type )
-import GHC.Types.RepType ( typePrimRep1, typePrimRep )
-import GHC.Utils.Panic.Plain
+
+import Data.ByteString ( ByteString )
+import Data.Data   ( Data )
+import Data.List   ( intersperse )
 
 {-
 ************************************************************************
@@ -600,25 +608,30 @@ data StgPass
   | CodeGen
 
 type family BinderP (pass :: StgPass)
-type instance BinderP 'Vanilla = Id
-type instance BinderP 'CodeGen = Id
-type instance BinderP 'InferTagged = Id
+type instance BinderP 'Vanilla            = Id
+type instance BinderP 'CodeGen            = Id
+type instance BinderP 'InferTagged        = Id
+type instance BinderP 'InferTaggedBinders = (Id, TagSig)
 
 type family XRhsClosure (pass :: StgPass)
-type instance XRhsClosure 'Vanilla = NoExtFieldSilent
-type instance XRhsClosure 'InferTagged = NoExtFieldSilent
+type instance XRhsClosure 'Vanilla            = NoExtFieldSilent
+type instance XRhsClosure 'InferTagged        = NoExtFieldSilent
+type instance XRhsClosure 'InferTaggedBinders = XRhsClosure  'CodeGen
 -- | Code gen needs to track non-global free vars
 type instance XRhsClosure 'CodeGen = DIdSet
 
+
 type family XLet (pass :: StgPass)
-type instance XLet 'Vanilla = NoExtFieldSilent
-type instance XLet 'InferTagged = NoExtFieldSilent
-type instance XLet 'CodeGen = NoExtFieldSilent
+type instance XLet 'Vanilla            = NoExtFieldSilent
+type instance XLet 'InferTagged        = NoExtFieldSilent
+type instance XLet 'InferTaggedBinders = XLet 'CodeGen
+type instance XLet 'CodeGen            = NoExtFieldSilent
 
 type family XLetNoEscape (pass :: StgPass)
-type instance XLetNoEscape 'Vanilla = NoExtFieldSilent
-type instance XLetNoEscape 'InferTagged = NoExtFieldSilent
-type instance XLetNoEscape 'CodeGen = NoExtFieldSilent
+type instance XLetNoEscape 'Vanilla            = NoExtFieldSilent
+type instance XLetNoEscape 'InferTagged        = NoExtFieldSilent
+type instance XLetNoEscape 'InferTaggedBinders = XLetNoEscape 'CodeGen
+type instance XLetNoEscape 'CodeGen            = NoExtFieldSilent
 
 {-
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a1f54d1e086001a0a2eb151ef223228958c4ecf

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a1f54d1e086001a0a2eb151ef223228958c4ecf
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230123/9a31251d/attachment-0001.html>


More information about the ghc-commits mailing list