[Git][ghc/ghc][wip/romes/ttg-zurich] 2 commits: ttg: extract Specificity, ForAllTyFlag and helper functions from GHC.Types.Var
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Sun Jun 9 13:58:36 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/ttg-zurich at Glasgow Haskell Compiler / GHC
Commits:
1403d8aa by Fabian Kirchner at 2024-06-09T15:40:58+02:00
ttg: extract Specificity, ForAllTyFlag and helper functions from GHC.Types.Var
Progress towards #21592
Specificity, ForAllTyFlag and its' helper functions are extracted from
GHC.Types.Var and moved into a new module Language.Haskell.Syntax.Specificity.
Note: Eventually (i.e. after Language.Haskell.Syntax.Decls does not depend on
GHC.* anymore) these should be moved into Language.Haskell.Syntax.Decls.
At this point, this would cause cyclic dependencies.
- - - - -
0075a8b8 by Fabian Kirchner at 2024-06-09T15:58:20+02:00
ttg: Move some AST types into Language.Haskell.Syntax.Basic
In particular, we move:
* TopLevelFlag
* TypeOrData
* TyConFlavour
Progress towards #21592
- - - - -
8 changed files:
- compiler/GHC/Core/TyCo/Rep.hs-boot
- compiler/GHC/Types/Basic.hs
- compiler/GHC/Types/Var.hs
- compiler/GHC/Types/Var.hs-boot
- compiler/Language/Haskell/Syntax/Basic.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- + compiler/Language/Haskell/Syntax/Specificity.hs
- compiler/ghc.cabal.in
Changes:
=====================================
compiler/GHC/Core/TyCo/Rep.hs-boot
=====================================
@@ -3,8 +3,9 @@ module GHC.Core.TyCo.Rep where
import GHC.Utils.Outputable ( Outputable )
import Data.Data ( Data )
-import {-# SOURCE #-} GHC.Types.Var( Var, VarBndr, ForAllTyFlag, FunTyFlag )
+import {-# SOURCE #-} GHC.Types.Var( Var, VarBndr, FunTyFlag )
import {-# SOURCE #-} GHC.Core.TyCon ( TyCon )
+import Language.Haskell.Syntax.Specificity (ForAllTyFlag)
data Type
data Coercion
=====================================
compiler/GHC/Types/Basic.hs
=====================================
@@ -14,7 +14,9 @@ types that
\end{itemize}
-}
-{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable PromotionFlag, Binary PromotionFlag, Outputable Boxity, Binay Boxity
+{-# OPTIONS_GHC -Wno-orphans #-}
+-- Outputable PromotionFlag, Binary PromotionFlag, Outputable Boxity, Binay Boxity,
+-- Outputable ForAllTyFlag, Specificity, et friends...
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE MultiParamTypeClasses #-}
@@ -132,7 +134,8 @@ import GHC.Utils.Binary
import GHC.Types.SourceText
import qualified GHC.LanguageExtensions as LangExt
import {-# SOURCE #-} Language.Haskell.Syntax.Type (PromotionFlag(..), isPromoted)
-import Language.Haskell.Syntax.Basic (Boxity(..), isBoxed, ConTag)
+import Language.Haskell.Syntax.Basic (Boxity(..), isBoxed, ConTag, TopLevelFlag(..), isTopLevel, isNotTopLevel, TypeOrData(..), TyConFlavour(..))
+import Language.Haskell.Syntax.Specificity
import {-# SOURCE #-} Language.Haskell.Syntax.Expr (HsDoFlavour)
import Control.DeepSeq ( NFData(..) )
@@ -542,19 +545,6 @@ pprRuleName rn = doubleQuotes (ftext rn)
************************************************************************
-}
-data TopLevelFlag
- = TopLevel
- | NotTopLevel
- deriving Data
-
-isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
-
-isNotTopLevel NotTopLevel = True
-isNotTopLevel TopLevel = False
-
-isTopLevel TopLevel = True
-isTopLevel NotTopLevel = False
-
instance Outputable TopLevelFlag where
ppr TopLevel = text "<TopLevel>"
ppr NotTopLevel = text "<NotTopLevel>"
@@ -2166,22 +2156,6 @@ data TypeOrConstraint
* *
********************************************************************* -}
--- | Paints a picture of what a 'TyCon' represents, in broad strokes.
--- This is used towards more informative error messages.
-data TyConFlavour tc
- = ClassFlavour
- | TupleFlavour Boxity
- | SumFlavour
- | DataTypeFlavour
- | NewtypeFlavour
- | AbstractTypeFlavour
- | OpenFamilyFlavour TypeOrData (Maybe tc) -- Just tc <=> (tc == associated class)
- | ClosedTypeFamilyFlavour
- | TypeSynonymFlavour
- | BuiltInTypeFlavour -- ^ e.g., the @(->)@ 'TyCon'.
- | PromotedDataConFlavour
- deriving (Eq, Data, Functor)
-
instance Outputable (TyConFlavour tc) where
ppr = text . go
where
@@ -2220,17 +2194,50 @@ tyConFlavourAssoc_maybe :: TyConFlavour tc -> Maybe tc
tyConFlavourAssoc_maybe (OpenFamilyFlavour _ mb_parent) = mb_parent
tyConFlavourAssoc_maybe _ = Nothing
--- | Whether something is a type or a data declaration,
--- e.g. a type family or a data family.
-data TypeOrData
- = IAmData
- | IAmType
- deriving (Eq, Data)
-
instance Outputable TypeOrData where
ppr IAmData = text "data"
ppr IAmType = text "type"
+{- *********************************************************************
+* *
+* ForAllTyFlag
+* *
+********************************************************************* -}
+
+instance Outputable ForAllTyFlag where
+ ppr Required = text "[req]"
+ ppr Specified = text "[spec]"
+ ppr Inferred = text "[infrd]"
+
+instance Binary Specificity where
+ put_ bh SpecifiedSpec = putByte bh 0
+ put_ bh InferredSpec = putByte bh 1
+
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> return SpecifiedSpec
+ _ -> return InferredSpec
+
+instance Binary ForAllTyFlag where
+ put_ bh Required = putByte bh 0
+ put_ bh Specified = putByte bh 1
+ put_ bh Inferred = putByte bh 2
+
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> return Required
+ 1 -> return Specified
+ _ -> return Inferred
+
+instance NFData Specificity where
+ rnf SpecifiedSpec = ()
+ rnf InferredSpec = ()
+instance NFData ForAllTyFlag where
+ rnf (Invisible spec) = rnf spec
+ rnf Required = ()
+
{- *********************************************************************
* *
Defaulting options
=====================================
compiler/GHC/Types/Var.hs
=====================================
@@ -130,7 +130,7 @@ import GHC.Utils.Outputable
import GHC.Utils.Panic
import Data.Data
-import Control.DeepSeq
+import Language.Haskell.Syntax.Specificity
{-
************************************************************************
@@ -449,97 +449,6 @@ updateVarTypeM upd var
result = do { ty' <- upd (varType var)
; return (var { varType = ty' }) }
-{- *********************************************************************
-* *
-* ForAllTyFlag
-* *
-********************************************************************* -}
-
--- | ForAllTyFlag
---
--- Is something required to appear in source Haskell ('Required'),
--- permitted by request ('Specified') (visible type application), or
--- prohibited entirely from appearing in source Haskell ('Inferred')?
--- See Note [VarBndrs, ForAllTyBinders, TyConBinders, and visibility] in "GHC.Core.TyCo.Rep"
-data ForAllTyFlag = Invisible !Specificity
- | Required
- deriving (Eq, Ord, Data)
- -- (<) on ForAllTyFlag means "is less visible than"
-
--- | Whether an 'Invisible' argument may appear in source Haskell.
-data Specificity = InferredSpec
- -- ^ the argument may not appear in source Haskell, it is
- -- only inferred.
- | SpecifiedSpec
- -- ^ the argument may appear in source Haskell, but isn't
- -- required.
- deriving (Eq, Ord, Data)
-
-pattern Inferred, Specified :: ForAllTyFlag
-pattern Inferred = Invisible InferredSpec
-pattern Specified = Invisible SpecifiedSpec
-
-{-# COMPLETE Required, Specified, Inferred #-}
-
--- | Does this 'ForAllTyFlag' classify an argument that is written in Haskell?
-isVisibleForAllTyFlag :: ForAllTyFlag -> Bool
-isVisibleForAllTyFlag af = not (isInvisibleForAllTyFlag af)
-
--- | Does this 'ForAllTyFlag' classify an argument that is not written in Haskell?
-isInvisibleForAllTyFlag :: ForAllTyFlag -> Bool
-isInvisibleForAllTyFlag (Invisible {}) = True
-isInvisibleForAllTyFlag Required = False
-
-isInferredForAllTyFlag :: ForAllTyFlag -> Bool
--- More restrictive than isInvisibleForAllTyFlag
-isInferredForAllTyFlag (Invisible InferredSpec) = True
-isInferredForAllTyFlag _ = False
-
-isSpecifiedForAllTyFlag :: ForAllTyFlag -> Bool
--- More restrictive than isInvisibleForAllTyFlag
-isSpecifiedForAllTyFlag (Invisible SpecifiedSpec) = True
-isSpecifiedForAllTyFlag _ = False
-
-coreTyLamForAllTyFlag :: ForAllTyFlag
--- ^ The ForAllTyFlag on a (Lam a e) term, where `a` is a type variable.
--- If you want other ForAllTyFlag, use a cast.
--- See Note [Required foralls in Core] in GHC.Core.TyCo.Rep
-coreTyLamForAllTyFlag = Specified
-
-instance Outputable ForAllTyFlag where
- ppr Required = text "[req]"
- ppr Specified = text "[spec]"
- ppr Inferred = text "[infrd]"
-
-instance Binary Specificity where
- put_ bh SpecifiedSpec = putByte bh 0
- put_ bh InferredSpec = putByte bh 1
-
- get bh = do
- h <- getByte bh
- case h of
- 0 -> return SpecifiedSpec
- _ -> return InferredSpec
-
-instance Binary ForAllTyFlag where
- put_ bh Required = putByte bh 0
- put_ bh Specified = putByte bh 1
- put_ bh Inferred = putByte bh 2
-
- get bh = do
- h <- getByte bh
- case h of
- 0 -> return Required
- 1 -> return Specified
- _ -> return Inferred
-
-instance NFData Specificity where
- rnf SpecifiedSpec = ()
- rnf InferredSpec = ()
-instance NFData ForAllTyFlag where
- rnf (Invisible spec) = rnf spec
- rnf Required = ()
-
{- *********************************************************************
* *
* FunTyFlag
=====================================
compiler/GHC/Types/Var.hs-boot
=====================================
@@ -2,13 +2,12 @@
module GHC.Types.Var where
import {-# SOURCE #-} GHC.Types.Name
+import Language.Haskell.Syntax.Specificity (Specificity)
-data ForAllTyFlag
data FunTyFlag
data Var
instance NamedThing Var
data VarBndr var argf
-data Specificity
type TyVar = Var
type Id = Var
type TyCoVar = Id
=====================================
compiler/Language/Haskell/Syntax/Basic.hs
=====================================
@@ -2,11 +2,8 @@
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
module Language.Haskell.Syntax.Basic where
+import Prelude
import Data.Data
-import Data.Eq
-import Data.Ord
-import Data.Bool
-import Data.Int (Int)
import GHC.Data.FastString (FastString)
import Control.DeepSeq
@@ -96,3 +93,48 @@ data SrcUnpackedness = SrcUnpack -- ^ {-# UNPACK #-} specified
| SrcNoUnpack -- ^ {-# NOUNPACK #-} specified
| NoSrcUnpack -- ^ no unpack pragma
deriving (Eq, Data)
+
+
+{-
+************************************************************************
+* *
+Top-level/not-top level flag
+* *
+************************************************************************
+-}
+
+data TopLevelFlag
+ = TopLevel
+ | NotTopLevel
+ deriving Data
+
+isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
+
+isNotTopLevel NotTopLevel = True
+isNotTopLevel TopLevel = False
+
+isTopLevel TopLevel = True
+isTopLevel NotTopLevel = False
+
+-- | Whether something is a type or a data declaration,
+-- e.g. a type family or a data family.
+data TypeOrData
+ = IAmData
+ | IAmType
+ deriving (Eq, Data)
+
+-- | Paints a picture of what a 'TyCon' represents, in broad strokes.
+-- This is used towards more informative error messages.
+data TyConFlavour tc
+ = ClassFlavour
+ | TupleFlavour Boxity
+ | SumFlavour
+ | DataTypeFlavour
+ | NewtypeFlavour
+ | AbstractTypeFlavour
+ | OpenFamilyFlavour TypeOrData (Maybe tc) -- Just tc <=> (tc == associated class)
+ | ClosedTypeFamilyFlavour
+ | TypeSynonymFlavour
+ | BuiltInTypeFlavour -- ^ e.g., the @(->)@ 'TyCon'.
+ | PromotedDataConFlavour
+ deriving (Eq, Data, Functor)
=====================================
compiler/Language/Haskell/Syntax/Decls.hs
=====================================
@@ -97,14 +97,13 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Expr
import Language.Haskell.Syntax.Binds
import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Type
-import Language.Haskell.Syntax.Basic (Role)
+import Language.Haskell.Syntax.Basic (Role, TopLevelFlag, TypeOrData(..), TyConFlavour(..))
+import Language.Haskell.Syntax.Specificity (Specificity)
-import GHC.Types.Basic (TopLevelFlag, OverlapMode, RuleName, Activation
- ,TyConFlavour(..), TypeOrData(..))
+import GHC.Types.Basic (OverlapMode, RuleName, Activation)
import GHC.Types.ForeignCall (CType, CCallConv, Safety, Header, CLabelString, CCallTarget, CExportSpec)
import GHC.Types.Fixity (LexicalFixity)
-import GHC.Core.Type (Specificity)
import GHC.Unit.Module.Warnings (WarningTxt)
import GHC.Hs.Doc (LHsDoc) -- ROMES:TODO Discuss in #21592 whether this is parsed AST or base AST
=====================================
compiler/Language/Haskell/Syntax/Specificity.hs
=====================================
@@ -0,0 +1,68 @@
+{-# LANGUAGE MultiWayIf, PatternSynonyms #-}
+
+-- TODO Everthing in this module should be moved to
+-- Language.Haskell.Syntax.Decls
+
+module Language.Haskell.Syntax.Specificity (
+ -- * ForAllTyFlags
+ ForAllTyFlag(Invisible,Required,Specified,Inferred),
+ Specificity(..),
+ isVisibleForAllTyFlag, isInvisibleForAllTyFlag, isInferredForAllTyFlag,
+ isSpecifiedForAllTyFlag,
+ coreTyLamForAllTyFlag,
+ ) where
+
+import Prelude
+
+import Data.Data
+
+-- | ForAllTyFlag
+--
+-- Is something required to appear in source Haskell ('Required'),
+-- permitted by request ('Specified') (visible type application), or
+-- prohibited entirely from appearing in source Haskell ('Inferred')?
+-- See Note [VarBndrs, ForAllTyBinders, TyConBinders, and visibility] in "GHC.Core.TyCo.Rep"
+data ForAllTyFlag = Invisible !Specificity
+ | Required
+ deriving (Eq, Ord, Data)
+ -- (<) on ForAllTyFlag means "is less visible than"
+
+-- | Whether an 'Invisible' argument may appear in source Haskell.
+data Specificity = InferredSpec
+ -- ^ the argument may not appear in source Haskell, it is
+ -- only inferred.
+ | SpecifiedSpec
+ -- ^ the argument may appear in source Haskell, but isn't
+ -- required.
+ deriving (Eq, Ord, Data)
+
+pattern Inferred, Specified :: ForAllTyFlag
+pattern Inferred = Invisible InferredSpec
+pattern Specified = Invisible SpecifiedSpec
+
+{-# COMPLETE Required, Specified, Inferred #-}
+
+-- | Does this 'ForAllTyFlag' classify an argument that is written in Haskell?
+isVisibleForAllTyFlag :: ForAllTyFlag -> Bool
+isVisibleForAllTyFlag af = not (isInvisibleForAllTyFlag af)
+
+-- | Does this 'ForAllTyFlag' classify an argument that is not written in Haskell?
+isInvisibleForAllTyFlag :: ForAllTyFlag -> Bool
+isInvisibleForAllTyFlag (Invisible {}) = True
+isInvisibleForAllTyFlag Required = False
+
+isInferredForAllTyFlag :: ForAllTyFlag -> Bool
+-- More restrictive than isInvisibleForAllTyFlag
+isInferredForAllTyFlag (Invisible InferredSpec) = True
+isInferredForAllTyFlag _ = False
+
+isSpecifiedForAllTyFlag :: ForAllTyFlag -> Bool
+-- More restrictive than isInvisibleForAllTyFlag
+isSpecifiedForAllTyFlag (Invisible SpecifiedSpec) = True
+isSpecifiedForAllTyFlag _ = False
+
+coreTyLamForAllTyFlag :: ForAllTyFlag
+-- ^ The ForAllTyFlag on a (Lam a e) term, where `a` is a type variable.
+-- If you want other ForAllTyFlag, use a cast.
+-- See Note [Required foralls in Core] in GHC.Core.TyCo.Rep
+coreTyLamForAllTyFlag = Specified
=====================================
compiler/ghc.cabal.in
=====================================
@@ -976,6 +976,7 @@ Library
Language.Haskell.Syntax.Lit
Language.Haskell.Syntax.Module.Name
Language.Haskell.Syntax.Pat
+ Language.Haskell.Syntax.Specificity
Language.Haskell.Syntax.Type
autogen-modules: GHC.Platform.Constants
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d7e7821774618dda0271ac90f03eec212cac697f...0075a8b851ed08ec39456fe16387c75504fb2fdc
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d7e7821774618dda0271ac90f03eec212cac697f...0075a8b851ed08ec39456fe16387c75504fb2fdc
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/20240609/ad4975a7/attachment-0001.html>
More information about the ghc-commits
mailing list