[Git][ghc/ghc][wip/romes/ttg-zurich] 3 commits: AST: move Data instance definition for ModuleName to GHC.Unit.Types
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Sun Jun 9 09:55:33 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/ttg-zurich at Glasgow Haskell Compiler / GHC
Commits:
3829df8a by Fabian Kirchner at 2024-06-09T11:55:08+02:00
AST: move Data instance definition for ModuleName to GHC.Unit.Types
To remove the dependency on GHC.Utils.Misc inside
Language.Haskell.Syntax.Module.Name, the instance definition is moved
from there into GHC.Unit.Types.
- - - - -
0a10b4fc by Fabian Kirchner at 2024-06-09T11:55:15+02:00
AST: move negateOverLitVal into GHC.Hs.Lit
The function negateOverLitVal is not used within Language.Haskell and
therefore can be moved to the respective module inside GHC.Hs.
- - - - -
50a6b2f6 by Fabian Kirchner at 2024-06-09T11:55:22+02:00
AST: move conDetailsArity into GHC.Rename.Module
The function conDetailsArity is only used inside GHC.Rename.Module. We
therefore move it there from Language.Haskell.Syntax.Lit.
- - - - -
6 changed files:
- compiler/GHC/Hs/Lit.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Unit/Types.hs
- compiler/Language/Haskell/Syntax/Lit.hs
- compiler/Language/Haskell/Syntax/Module/Name.hs
- compiler/Language/Haskell/Syntax/Type.hs
Changes:
=====================================
compiler/GHC/Hs/Lit.hs
=====================================
@@ -30,6 +30,7 @@ import GHC.Core.Ppr ( {- instance OutputableBndr TyVar -} )
import GHC.Types.SourceText
import GHC.Core.Type
import GHC.Utils.Outputable
+import GHC.Utils.Panic (panic)
import GHC.Hs.Extension
import Language.Haskell.Syntax.Expr ( HsExpr )
import Language.Haskell.Syntax.Extension
@@ -248,3 +249,7 @@ pmPprHsLit (HsRat _ f _) = ppr f
pmPprHsLit (HsFloatPrim _ f) = ppr f
pmPprHsLit (HsDoublePrim _ d) = ppr d
+negateOverLitVal :: OverLitVal -> OverLitVal
+negateOverLitVal (HsIntegral i) = HsIntegral (negateIntegralLit i)
+negateOverLitVal (HsFractional f) = HsFractional (negateFractionalLit f)
+negateOverLitVal _ = panic "negateOverLitVal: argument is not a number"
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -3,6 +3,7 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
@@ -54,6 +55,7 @@ import GHC.Types.Name.Set
import GHC.Types.Name.Env
import GHC.Utils.Outputable
import GHC.Data.Bag
+import GHC.Types.Basic (Arity)
import GHC.Types.Basic ( TypeOrKind(..) )
import GHC.Data.FastString
import GHC.Types.SrcLoc as SrcLoc
@@ -2558,6 +2560,12 @@ extendPatSynEnv dup_fields_ok has_sel val_decls local_fix_env thing = do {
| otherwise
= return names
+conDetailsArity :: (rec -> Arity) -> HsConDetails tyarg arg rec -> Arity
+conDetailsArity recToArity = \case
+ PrefixCon _ args -> length args
+ RecCon rec -> recToArity rec
+ InfixCon _ _ -> 2
+
{-
*********************************************************
* *
=====================================
compiler/GHC/Unit/Types.hs
=====================================
@@ -124,6 +124,12 @@ data GenModule unit = Module
}
deriving (Eq,Ord,Data,Functor)
+instance Data ModuleName where
+ -- don't traverse?
+ toConstr _ = abstractConstr "ModuleName"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "ModuleName"
+
-- | A Module is a pair of a 'Unit' and a 'ModuleName'.
type Module = GenModule Unit
=====================================
compiler/Language/Haskell/Syntax/Lit.hs
=====================================
@@ -21,7 +21,7 @@ module Language.Haskell.Syntax.Lit where
import Language.Haskell.Syntax.Extension
import GHC.Utils.Panic (panic)
-import GHC.Types.SourceText (IntegralLit, FractionalLit, SourceText, negateIntegralLit, negateFractionalLit)
+import GHC.Types.SourceText (IntegralLit, FractionalLit, SourceText)
import GHC.Core.Type (Type)
import GHC.Data.FastString (FastString, lexicalCompareFS)
@@ -128,11 +128,6 @@ data OverLitVal
| HsIsString !SourceText !FastString -- ^ String-looking literals
deriving Data
-negateOverLitVal :: OverLitVal -> OverLitVal
-negateOverLitVal (HsIntegral i) = HsIntegral (negateIntegralLit i)
-negateOverLitVal (HsFractional f) = HsFractional (negateFractionalLit f)
-negateOverLitVal _ = panic "negateOverLitVal: argument is not a number"
-
-- Comparison operations are needed when grouping literals
-- for compiling pattern-matching (module GHC.HsToCore.Match.Literal)
instance (Eq (XXOverLit p)) => Eq (HsOverLit p) where
=====================================
compiler/Language/Haskell/Syntax/Module/Name.hs
=====================================
@@ -2,13 +2,11 @@ module Language.Haskell.Syntax.Module.Name where
import Prelude
-import Data.Data
import Data.Char (isAlphaNum)
import Control.DeepSeq
import qualified Text.ParserCombinators.ReadP as Parse
import System.FilePath
-import GHC.Utils.Misc (abstractConstr)
import GHC.Data.FastString
-- | A ModuleName is essentially a simple string, e.g. @Data.List at .
@@ -17,12 +15,6 @@ newtype ModuleName = ModuleName FastString deriving (Show, Eq)
instance Ord ModuleName where
nm1 `compare` nm2 = stableModuleNameCmp nm1 nm2
-instance Data ModuleName where
- -- don't traverse?
- toConstr _ = abstractConstr "ModuleName"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNoRepType "ModuleName"
-
instance NFData ModuleName where
rnf x = x `seq` ()
=====================================
compiler/Language/Haskell/Syntax/Type.hs
=====================================
@@ -48,7 +48,7 @@ module Language.Haskell.Syntax.Type (
ConDeclField(..), LConDeclField,
- HsConDetails(..), noTypeArgs, conDetailsArity,
+ HsConDetails(..), noTypeArgs,
FieldOcc(..), LFieldOcc,
AmbiguousFieldOcc(..), LAmbiguousFieldOcc,
@@ -66,7 +66,6 @@ import Language.Haskell.Syntax.Extension
import GHC.Types.Name.Reader ( RdrName )
import GHC.Core.DataCon( HsSrcBang(..) )
import GHC.Core.Type (Specificity)
-import GHC.Types.Basic (Arity)
import GHC.Hs.Doc (LHsDoc)
import GHC.Data.FastString (FastString)
@@ -77,7 +76,7 @@ import Data.Maybe
import Data.Eq
import Data.Bool
import Data.Char
-import Prelude (Integer, length)
+import Prelude (Integer)
import Data.Ord (Ord)
{-
@@ -1108,12 +1107,6 @@ data HsConDetails tyarg arg rec
noTypeArgs :: [Void]
noTypeArgs = []
-conDetailsArity :: (rec -> Arity) -> HsConDetails tyarg arg rec -> Arity
-conDetailsArity recToArity = \case
- PrefixCon _ args -> length args
- RecCon rec -> recToArity rec
- InfixCon _ _ -> 2
-
{-
Note [ConDeclField pass]
~~~~~~~~~~~~~~~~~~~~~~~~~
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7321591682b367cf836c07ca2d275b04ceffc60c...50a6b2f65ae69b5940fe22d817c59d6b41de884c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7321591682b367cf836c07ca2d275b04ceffc60c...50a6b2f65ae69b5940fe22d817c59d6b41de884c
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/a1294f1b/attachment-0001.html>
More information about the ghc-commits
mailing list