diff options
author | romes <rodrigo.m.mesquita@gmail.com> | 2022-06-14 00:56:14 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-07-06 13:50:27 -0400 |
commit | fd379d1b8e709f4eaa20a969bf9fffd40b8a4433 (patch) | |
tree | a168d8d325b6d7cc2170676a8822e8b38152a85f /compiler/Language | |
parent | 371c5ecf6898294f4e5bf91784dc794e7e16b7cc (diff) | |
download | haskell-fd379d1b8e709f4eaa20a969bf9fffd40b8a4433.tar.gz |
Remove many GHC dependencies from L.H.S
Continue to prune the `Language.Haskell.Syntax.*` modules out of GHC
imports according to the plan in the linked issue.
Moves more GHC-specific declarations to `GHC.*` and brings more required
GHC-independent declarations to `Language.Haskell.Syntax.*` (extending
e.g. `Language.Haskell.Syntax.Basic`).
Progress towards #21592
Bump haddock submodule for !8308
-------------------------
Metric Decrease:
hard_hole_fits
-------------------------
Diffstat (limited to 'compiler/Language')
-rw-r--r-- | compiler/Language/Haskell/Syntax/Basic.hs | 57 | ||||
-rw-r--r-- | compiler/Language/Haskell/Syntax/Binds.hs | 4 | ||||
-rw-r--r-- | compiler/Language/Haskell/Syntax/Decls.hs | 80 | ||||
-rw-r--r-- | compiler/Language/Haskell/Syntax/Expr.hs | 205 | ||||
-rw-r--r-- | compiler/Language/Haskell/Syntax/Extension.hs | 25 | ||||
-rw-r--r-- | compiler/Language/Haskell/Syntax/Lit.hs | 10 | ||||
-rw-r--r-- | compiler/Language/Haskell/Syntax/Pat.hs | 20 | ||||
-rw-r--r-- | compiler/Language/Haskell/Syntax/Type.hs | 40 |
8 files changed, 130 insertions, 311 deletions
diff --git a/compiler/Language/Haskell/Syntax/Basic.hs b/compiler/Language/Haskell/Syntax/Basic.hs index ad3e0e94ba..092231b7d1 100644 --- a/compiler/Language/Haskell/Syntax/Basic.hs +++ b/compiler/Language/Haskell/Syntax/Basic.hs @@ -1,12 +1,13 @@ {-# LANGUAGE DeriveDataTypeable #-} module Language.Haskell.Syntax.Basic where -import Data.Int (Int) - +import Data.Data import Data.Eq +import Data.Ord import Data.Bool -import Data.Data +import Data.Int (Int) +import GHC.Data.FastString (FastString) {- ************************************************************************ @@ -42,4 +43,54 @@ type SumWidth = Int -- selector type ConTag = Int +{- +************************************************************************ +* * +Field Labels +* * +************************************************************************ +-} + +-- | Field labels are just represented as strings; +-- they are not necessarily unique (even within a module) +type FieldLabelString = FastString + + +{- +************************************************************************ +* * +Field Labels +* * +************************************************************************ +-} + +-- | See Note [Roles] in GHC.Core.Coercion +-- +-- Order of constructors matters: the Ord instance coincides with the *super*typing +-- relation on roles. +data Role = Nominal | Representational | Phantom + deriving (Eq, Ord, Data) + +{- +************************************************************************ +* * +Source Strictness and Unpackedness +* * +************************************************************************ +-} + +-- | Source Strictness +-- +-- What strictness annotation the user wrote +data SrcStrictness = SrcLazy -- ^ Lazy, ie '~' + | SrcStrict -- ^ Strict, ie '!' + | NoSrcStrict -- ^ no strictness annotation + deriving (Eq, Data) +-- | Source Unpackedness +-- +-- What unpackedness the user requested +data SrcUnpackedness = SrcUnpack -- ^ {-# UNPACK #-} specified + | SrcNoUnpack -- ^ {-# NOUNPACK #-} specified + | NoSrcUnpack -- ^ no unpack pragma + deriving (Eq, Data) diff --git a/compiler/Language/Haskell/Syntax/Binds.hs b/compiler/Language/Haskell/Syntax/Binds.hs index c6193af03b..7ac866cfb2 100644 --- a/compiler/Language/Haskell/Syntax/Binds.hs +++ b/compiler/Language/Haskell/Syntax/Binds.hs @@ -31,8 +31,8 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Pat import Language.Haskell.Syntax.Extension import Language.Haskell.Syntax.Type -import GHC.Types.Fixity -import GHC.Data.Bag +import GHC.Types.Fixity (Fixity) +import GHC.Data.Bag (Bag) import GHC.Types.Basic (InlinePragma) import GHC.Data.BooleanFormula (LBooleanFormula) diff --git a/compiler/Language/Haskell/Syntax/Decls.hs b/compiler/Language/Haskell/Syntax/Decls.hs index 0e013b3eea..56b32bb97f 100644 --- a/compiler/Language/Haskell/Syntax/Decls.hs +++ b/compiler/Language/Haskell/Syntax/Decls.hs @@ -30,18 +30,17 @@ module Language.Haskell.Syntax.Decls ( -- * Toplevel declarations HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep, FunDep(..), HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys, - NewOrData(..), newOrDataToFlavour, + NewOrData(..), StandaloneKindSig(..), LStandaloneKindSig, -- ** Class or type declarations - TyClDecl(..), LTyClDecl, DataDeclRn(..), + TyClDecl(..), LTyClDecl, TyClGroup(..), tyClGroupTyClDecls, tyClGroupInstDecls, tyClGroupRoleDecls, tyClGroupKindSigs, isClassDecl, isDataDecl, isSynDecl, isFamilyDecl, isTypeFamilyDecl, isDataFamilyDecl, isOpenTypeFamilyInfo, isClosedTypeFamilyInfo, - countTyClDecls, tyClDeclTyVars, FamilyDecl(..), LFamilyDecl, @@ -58,7 +57,7 @@ module Language.Haskell.Syntax.Decls ( -- ** Deriving strategies DerivStrategy(..), LDerivStrategy, -- ** @RULE@ declarations - LRuleDecls,RuleDecls(..),RuleDecl(..),LRuleDecl,HsRuleRn(..), + LRuleDecls,RuleDecls(..),RuleDecl(..),LRuleDecl, RuleBndr(..),LRuleBndr, collectRuleBndrSigTys, -- ** @default@ declarations @@ -90,8 +89,6 @@ module Language.Haskell.Syntax.Decls ( ) where -- friends: -import GHC.Prelude - import {-# SOURCE #-} Language.Haskell.Syntax.Expr ( HsExpr, HsUntypedSplice ) -- Because Expr imports Decls via HsBracket @@ -99,23 +96,28 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Expr import Language.Haskell.Syntax.Binds import Language.Haskell.Syntax.Type import Language.Haskell.Syntax.Extension +import Language.Haskell.Syntax.Basic (Role) -import GHC.Hs.Doc -- ROMES:TODO Discuss in #21592 whether this is parsed AST or base AST +import GHC.Types.Basic (TopLevelFlag, OverlapMode, RuleName, Activation) +import GHC.Types.ForeignCall (CType, CCallConv, Safety, Header, CLabelString, CCallTarget, CExportSpec) +import GHC.Types.Fixity (LexicalFixity) -import GHC.Core.TyCon -import GHC.Types.Basic -import GHC.Types.ForeignCall -import GHC.Types.Name.Set -import GHC.Types.Fixity +import GHC.Core.Type (Specificity) +import GHC.Unit.Module.Warnings (WarningTxt) --- others: -import GHC.Utils.Misc -import GHC.Types.SrcLoc -import GHC.Core.Type -import GHC.Unit.Module.Warnings +import GHC.Hs.Doc (LHsDoc) -- ROMES:TODO Discuss in #21592 whether this is parsed AST or base AST +import Control.Monad import Data.Data hiding (TyCon, Fixity, Infix) import Data.Void +import Data.Maybe +import Data.String +import Data.Function +import Data.Eq +import Data.Int +import Data.Bool +import Prelude (Show) +import qualified Data.List {- ************************************************************************ @@ -470,12 +472,6 @@ data FunDep pass type LHsFunDep pass = XRec pass (FunDep pass) -data DataDeclRn = DataDeclRn - { tcdDataCusk :: Bool -- ^ does this have a CUSK? - -- See Note [CUSKs: complete user-supplied kind signatures] - , tcdFVs :: NameSet } - deriving Data - {- Note [TyVar binders for associated decls] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ For an /associated/ data, newtype, or type-family decl, the LHsQTyVars @@ -569,21 +565,6 @@ tyClDeclTyVars :: TyClDecl pass -> LHsQTyVars pass tyClDeclTyVars (FamDecl { tcdFam = FamilyDecl { fdTyVars = tvs } }) = tvs tyClDeclTyVars d = tcdTyVars d -countTyClDecls :: [TyClDecl pass] -> (Int, Int, Int, Int, Int) - -- class, synonym decls, data, newtype, family decls -countTyClDecls decls - = (count isClassDecl decls, - count isSynDecl decls, -- excluding... - count isDataTy decls, -- ...family... - count isNewTy decls, -- ...instances - count isFamilyDecl decls) - where - isDataTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = DataType } } = True - isDataTy _ = False - - isNewTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = NewType } } = True - isNewTy _ = False - {- Note [CUSKs: complete user-supplied kind signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -715,16 +696,16 @@ data TyClGroup pass -- See Note [TyClGroups and dependency analysis] tyClGroupTyClDecls :: [TyClGroup pass] -> [LTyClDecl pass] -tyClGroupTyClDecls = concatMap group_tyclds +tyClGroupTyClDecls = Data.List.concatMap group_tyclds tyClGroupInstDecls :: [TyClGroup pass] -> [LInstDecl pass] -tyClGroupInstDecls = concatMap group_instds +tyClGroupInstDecls = Data.List.concatMap group_instds tyClGroupRoleDecls :: [TyClGroup pass] -> [LRoleAnnotDecl pass] -tyClGroupRoleDecls = concatMap group_roles +tyClGroupRoleDecls = Data.List.concatMap group_roles tyClGroupKindSigs :: [TyClGroup pass] -> [LStandaloneKindSig pass] -tyClGroupKindSigs = concatMap group_kisigs +tyClGroupKindSigs = Data.List.concatMap group_kisigs {- ********************************************************************* @@ -1005,12 +986,6 @@ data NewOrData | DataType -- ^ @data Blah ...@ deriving( Eq, Data ) -- Needed because Demand derives Eq --- | Convert a 'NewOrData' to a 'TyConFlavour' -newOrDataToFlavour :: NewOrData -> TyConFlavour -newOrDataToFlavour NewType = NewtypeFlavour -newOrDataToFlavour DataType = DataTypeFlavour - - -- | Located data Constructor Declaration type LConDecl pass = XRec pass (ConDecl pass) -- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' when @@ -1548,8 +1523,8 @@ data ForeignImport pass = -- import of a C entity -- * `Safety' is irrelevant for `CLabel' and `CWrapper' -- CImport (XCImport pass) - (Located CCallConv) -- ccall or stdcall - (Located Safety) -- interruptible, safe or unsafe + (XRec pass CCallConv) -- ccall or stdcall + (XRec pass Safety) -- interruptible, safe or unsafe (Maybe Header) -- name of C header CImportSpec -- details of the C entity | XForeignImport !(XXForeignImport pass) @@ -1565,7 +1540,7 @@ data CImportSpec = CLabel CLabelString -- import address of a C label -- specification of an externally exported entity in dependence on the calling -- convention -- -data ForeignExport pass = CExport (XCExport pass) (Located CExportSpec) -- contains the calling convention +data ForeignExport pass = CExport (XCExport pass) (XRec pass CExportSpec) -- contains the calling convention | XForeignExport !(XXForeignExport pass) @@ -1613,9 +1588,6 @@ data RuleDecl pass -- 'GHC.Parser.Annotation.AnnEqual', | XRuleDecl !(XXRuleDecl pass) -data HsRuleRn = HsRuleRn NameSet NameSet -- Free-vars from the LHS and RHS - deriving Data - -- | Located Rule Binder type LRuleBndr pass = XRec pass (RuleBndr pass) diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs index 6d57489eb5..326c9903dc 100644 --- a/compiler/Language/Haskell/Syntax/Expr.hs +++ b/compiler/Language/Haskell/Syntax/Expr.hs @@ -6,7 +6,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilyDependencies #-} {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow] -- in module Language.Haskell.Syntax.Extension @@ -23,8 +22,6 @@ -- | Abstract Haskell syntax for expressions. module Language.Haskell.Syntax.Expr where -import GHC.Prelude - import Language.Haskell.Syntax.Basic import Language.Haskell.Syntax.Decls import Language.Haskell.Syntax.Pat @@ -34,19 +31,19 @@ import Language.Haskell.Syntax.Type import Language.Haskell.Syntax.Binds -- others: -import GHC.Core.DataCon (FieldLabelString) -import GHC.Types.Name -import GHC.Types.Fixity -import GHC.Types.SourceText -import GHC.Types.SrcLoc +import GHC.Types.Name (OccName) +import GHC.Types.Fixity (LexicalFixity(Infix), Fixity) +import GHC.Types.SourceText (StringLiteral) + import GHC.Unit.Module (ModuleName) -import GHC.Utils.Outputable -import GHC.Utils.Panic -import GHC.Data.FastString +import GHC.Data.FastString (FastString) -- libraries: import Data.Data hiding (Fixity(..)) - +import Data.Bool +import Data.Either +import Data.Eq +import Data.Maybe import Data.List.NonEmpty ( NonEmpty ) {- Note [RecordDotSyntax field updates] @@ -138,26 +135,6 @@ type LFieldLabelStrings p = XRec p (FieldLabelStrings p) newtype FieldLabelStrings p = FieldLabelStrings [XRec p (DotFieldOcc p)] -instance (UnXRec p, Outputable (XRec p FieldLabelString)) => Outputable (FieldLabelStrings p) where - ppr (FieldLabelStrings flds) = - hcat (punctuate dot (map (ppr . unXRec @p) flds)) - -instance (UnXRec p, Outputable (XRec p FieldLabelString)) => OutputableBndr (FieldLabelStrings p) where - pprInfixOcc = pprFieldLabelStrings - pprPrefixOcc = pprFieldLabelStrings - -instance (UnXRec p, Outputable (XRec p FieldLabelString)) => OutputableBndr (Located (FieldLabelStrings p)) where - pprInfixOcc = pprInfixOcc . unLoc - pprPrefixOcc = pprInfixOcc . unLoc - -pprFieldLabelStrings :: forall p. (UnXRec p, Outputable (XRec p FieldLabelString)) => FieldLabelStrings p -> SDoc -pprFieldLabelStrings (FieldLabelStrings flds) = - hcat (punctuate dot (map (ppr . unXRec @p) flds)) - -instance Outputable(XRec p FieldLabelString) => Outputable (DotFieldOcc p) where - ppr (DotFieldOcc _ s) = ppr s - ppr XDotFieldOcc{} = text "XDotFieldOcc" - -- Field projection updates (e.g. @foo.bar.baz = 1@). See Note -- [RecordDotSyntax field updates]. type RecProj p arg = HsFieldBind (LFieldLabelStrings p) arg @@ -223,46 +200,6 @@ for several reasons: -- etc type family SyntaxExpr p --- | Command Syntax Table (for Arrow syntax) -type CmdSyntaxTable p = [(Name, HsExpr p)] --- See Note [CmdSyntaxTable] - -{- -Note [CmdSyntaxTable] -~~~~~~~~~~~~~~~~~~~~~ -Used only for arrow-syntax stuff (HsCmdTop), the CmdSyntaxTable keeps -track of the methods needed for a Cmd. - -* Before the renamer, this list is an empty list - -* After the renamer, it takes the form @[(std_name, HsVar actual_name)]@ - For example, for the 'arr' method - * normal case: (GHC.Control.Arrow.arr, HsVar GHC.Control.Arrow.arr) - * with rebindable syntax: (GHC.Control.Arrow.arr, arr_22) - where @arr_22@ is whatever 'arr' is in scope - -* After the type checker, it takes the form [(std_name, <expression>)] - where <expression> is the evidence for the method. This evidence is - instantiated with the class, but is still polymorphic in everything - else. For example, in the case of 'arr', the evidence has type - forall b c. (b->c) -> a b c - where 'a' is the ambient type of the arrow. This polymorphism is - important because the desugarer uses the same evidence at multiple - different types. - -This is Less Cool than what we normally do for rebindable syntax, which is to -make fully-instantiated piece of evidence at every use site. The Cmd way -is Less Cool because - * The renamer has to predict which methods are needed. - See the tedious GHC.Rename.Expr.methodNamesCmd. - - * The desugarer has to know the polymorphic type of the instantiated - method. This is checked by Inst.tcSyntaxName, but is less flexible - than the rest of rebindable syntax, where the type is less - pre-ordained. (And this flexibility is useful; for example we can - typecheck do-notation with (>>=) :: m1 a -> (a -> m2 b) -> m2 b.) --} - {- Note [Record selectors in the AST] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -648,7 +585,6 @@ data DotFieldOcc p -- | A pragma, written as {-# ... #-}, that may appear within an expression. data HsPragE p = HsPragSCC (XSCC p) - SourceText -- Note [Pragma source text] in GHC.Types.SourceText StringLiteral -- "set cost centre" SCC pragma -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen', @@ -686,10 +622,6 @@ data LamCaseVariant | LamCases -- ^ `\cases` deriving (Data, Eq) -lamCaseKeyword :: LamCaseVariant -> SDoc -lamCaseKeyword LamCase = text "\\case" -lamCaseKeyword LamCases = text "\\cases" - {- Note [Parens in HsSyn] ~~~~~~~~~~~~~~~~~~~~~~ @@ -834,11 +766,6 @@ See also #13680, which requested [] @Int to work. -} ------------------------ -pprExternalSrcLoc :: (StringLiteral,(Int,Int),(Int,Int)) -> SDoc -pprExternalSrcLoc (StringLiteral _ src _,(n1,n2),(n3,n4)) - = ppr (src,(n1,n2),(n3,n4)) - {- HsSyn records exactly where the user put parens, with HsPar. So generally speaking we print without adding any parens. @@ -981,10 +908,6 @@ data HsArrAppType | HsFirstOrderApp deriving Data -pprHsArrType :: HsArrAppType -> SDoc -pprHsArrType HsHigherOrderApp = text "higher order arrow application" -pprHsArrType HsFirstOrderApp = text "first order arrow application" - {- | Top-level command, introducing a new arrow. This may occur inside a proc (where the stack is empty) or as an argument of a command-forming operator. @@ -1716,113 +1639,3 @@ isMonadDoCompContext GhciStmtCtxt = False isMonadDoCompContext (DoExpr _) = False isMonadDoCompContext (MDoExpr _) = False -matchSeparator :: HsMatchContext p -> SDoc -matchSeparator FunRhs{} = text "=" -matchSeparator CaseAlt = text "->" -matchSeparator LamCaseAlt{} = text "->" -matchSeparator IfAlt = text "->" -matchSeparator LambdaExpr = text "->" -matchSeparator ArrowMatchCtxt{} = text "->" -matchSeparator PatBindRhs = text "=" -matchSeparator PatBindGuards = text "=" -matchSeparator StmtCtxt{} = text "<-" -matchSeparator RecUpd = text "=" -- This can be printed by the pattern - -- match checker trace -matchSeparator ThPatSplice = panic "unused" -matchSeparator ThPatQuote = panic "unused" -matchSeparator PatSyn = panic "unused" - -pprMatchContext :: (Outputable (IdP p), UnXRec p) - => HsMatchContext p -> SDoc -pprMatchContext ctxt - | want_an ctxt = text "an" <+> pprMatchContextNoun ctxt - | otherwise = text "a" <+> pprMatchContextNoun ctxt - where - want_an (FunRhs {}) = True -- Use "an" in front - want_an (ArrowMatchCtxt ProcExpr) = True - want_an (ArrowMatchCtxt KappaExpr) = True - want_an _ = False - -pprMatchContextNoun :: forall p. (Outputable (IdP p), UnXRec p) - => HsMatchContext p -> SDoc -pprMatchContextNoun (FunRhs {mc_fun=fun}) = text "equation for" - <+> quotes (ppr (unXRec @p fun)) -pprMatchContextNoun CaseAlt = text "case alternative" -pprMatchContextNoun (LamCaseAlt lc_variant) = lamCaseKeyword lc_variant - <+> text "alternative" -pprMatchContextNoun IfAlt = text "multi-way if alternative" -pprMatchContextNoun RecUpd = text "record-update construct" -pprMatchContextNoun ThPatSplice = text "Template Haskell pattern splice" -pprMatchContextNoun ThPatQuote = text "Template Haskell pattern quotation" -pprMatchContextNoun PatBindRhs = text "pattern binding" -pprMatchContextNoun PatBindGuards = text "pattern binding guards" -pprMatchContextNoun LambdaExpr = text "lambda abstraction" -pprMatchContextNoun (ArrowMatchCtxt c) = pprArrowMatchContextNoun c -pprMatchContextNoun (StmtCtxt ctxt) = text "pattern binding in" - $$ pprAStmtContext ctxt -pprMatchContextNoun PatSyn = text "pattern synonym declaration" - -pprMatchContextNouns :: forall p. (Outputable (IdP p), UnXRec p) - => HsMatchContext p -> SDoc -pprMatchContextNouns (FunRhs {mc_fun=fun}) = text "equations for" - <+> quotes (ppr (unXRec @p fun)) -pprMatchContextNouns PatBindGuards = text "pattern binding guards" -pprMatchContextNouns (ArrowMatchCtxt c) = pprArrowMatchContextNouns c -pprMatchContextNouns (StmtCtxt ctxt) = text "pattern bindings in" - $$ pprAStmtContext ctxt -pprMatchContextNouns ctxt = pprMatchContextNoun ctxt <> char 's' - -pprArrowMatchContextNoun :: HsArrowMatchContext -> SDoc -pprArrowMatchContextNoun ProcExpr = text "arrow proc pattern" -pprArrowMatchContextNoun ArrowCaseAlt = text "case alternative within arrow notation" -pprArrowMatchContextNoun (ArrowLamCaseAlt lc_variant) = lamCaseKeyword lc_variant - <+> text "alternative within arrow notation" -pprArrowMatchContextNoun KappaExpr = text "arrow kappa abstraction" - -pprArrowMatchContextNouns :: HsArrowMatchContext -> SDoc -pprArrowMatchContextNouns ArrowCaseAlt = text "case alternatives within arrow notation" -pprArrowMatchContextNouns (ArrowLamCaseAlt lc_variant) = lamCaseKeyword lc_variant - <+> text "alternatives within arrow notation" -pprArrowMatchContextNouns ctxt = pprArrowMatchContextNoun ctxt <> char 's' - ------------------ -pprAStmtContext, pprStmtContext :: (Outputable (IdP p), UnXRec p) - => HsStmtContext p -> SDoc -pprAStmtContext (HsDoStmt flavour) = pprAHsDoFlavour flavour -pprAStmtContext ctxt = text "a" <+> pprStmtContext ctxt - ------------------ -pprStmtContext (HsDoStmt flavour) = pprHsDoFlavour flavour -pprStmtContext (PatGuard ctxt) = text "pattern guard for" $$ pprMatchContext ctxt -pprStmtContext ArrowExpr = text "'do' block in an arrow command" - --- Drop the inner contexts when reporting errors, else we get --- Unexpected transform statement --- in a transformed branch of --- transformed branch of --- transformed branch of monad comprehension -pprStmtContext (ParStmtCtxt c) = - ifPprDebug (sep [text "parallel branch of", pprAStmtContext c]) - (pprStmtContext c) -pprStmtContext (TransStmtCtxt c) = - ifPprDebug (sep [text "transformed branch of", pprAStmtContext c]) - (pprStmtContext c) - -pprAHsDoFlavour, pprHsDoFlavour :: HsDoFlavour -> SDoc -pprAHsDoFlavour flavour = article <+> pprHsDoFlavour flavour - where - pp_an = text "an" - pp_a = text "a" - article = case flavour of - MDoExpr Nothing -> pp_an - GhciStmtCtxt -> pp_an - _ -> pp_a -pprHsDoFlavour (DoExpr m) = prependQualified m (text "'do' block") -pprHsDoFlavour (MDoExpr m) = prependQualified m (text "'mdo' block") -pprHsDoFlavour ListComp = text "list comprehension" -pprHsDoFlavour MonadComp = text "monad comprehension" -pprHsDoFlavour GhciStmtCtxt = text "interactive GHCi command" - -prependQualified :: Maybe ModuleName -> SDoc -> SDoc -prependQualified Nothing t = t -prependQualified (Just _) t = text "qualified" <+> t diff --git a/compiler/Language/Haskell/Syntax/Extension.hs b/compiler/Language/Haskell/Syntax/Extension.hs index 7bc4685194..4bdb3ce3cb 100644 --- a/compiler/Language/Haskell/Syntax/Extension.hs +++ b/compiler/Language/Haskell/Syntax/Extension.hs @@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -- for unXRec, etc. +{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} @@ -21,12 +22,17 @@ module Language.Haskell.Syntax.Extension where -- This module captures the type families to precisely identify the extension -- points for GHC.Hs syntax -import GHC.Prelude +import GHC.TypeLits (Symbol, KnownSymbol) + +#if MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) +import Data.Type.Equality (type (~)) +#endif -import GHC.TypeLits (Symbol, KnownSymbol, symbolVal) import Data.Data hiding ( Fixity ) import Data.Kind (Type) -import GHC.Utils.Outputable + +import Data.Eq +import Data.Ord {- Note [Trees That Grow] @@ -73,9 +79,6 @@ See also Note [IsPass] and Note [NoGhcTc] in GHC.Hs.Extension. data NoExtField = NoExtField deriving (Data,Eq,Ord) -instance Outputable NoExtField where - ppr _ = text "NoExtField" - -- | Used when constructing a term with an unused extension point. noExtField :: NoExtField noExtField = NoExtField @@ -111,9 +114,6 @@ See also [DataConCantHappen and strict fields]. data DataConCantHappen deriving (Data,Eq,Ord) -instance Outputable DataConCantHappen where - ppr = dataConCantHappen - -- | Eliminate a 'DataConCantHappen'. See Note [Constructor cannot occur]. dataConCantHappen :: DataConCantHappen -> a dataConCantHappen x = case x of {} @@ -755,10 +755,3 @@ type LHsUniToken tok utok p = XRec p (HsUniToken tok utok) data HsUniToken (tok :: Symbol) (utok :: Symbol) = HsNormalTok | HsUnicodeTok deriving instance (KnownSymbol tok, KnownSymbol utok) => Data (HsUniToken tok utok) - -instance KnownSymbol tok => Outputable (HsToken tok) where - ppr _ = text (symbolVal (Proxy :: Proxy tok)) - -instance (KnownSymbol tok, KnownSymbol utok) => Outputable (HsUniToken tok utok) where - ppr HsNormalTok = text (symbolVal (Proxy :: Proxy tok)) - ppr HsUnicodeTok = text (symbolVal (Proxy :: Proxy utok)) diff --git a/compiler/Language/Haskell/Syntax/Lit.hs b/compiler/Language/Haskell/Syntax/Lit.hs index a6f3e015b7..fcb923169d 100644 --- a/compiler/Language/Haskell/Syntax/Lit.hs +++ b/compiler/Language/Haskell/Syntax/Lit.hs @@ -20,11 +20,11 @@ module Language.Haskell.Syntax.Lit where import Language.Haskell.Syntax.Extension -import GHC.Utils.Panic -import GHC.Types.SourceText -import GHC.Core.Type +import GHC.Utils.Panic (panic) +import GHC.Types.SourceText (IntegralLit, FractionalLit, SourceText, negateIntegralLit, negateFractionalLit) +import GHC.Core.Type (Type) -import GHC.Data.FastString +import GHC.Data.FastString (FastString, lexicalCompareFS) import Data.ByteString (ByteString) import Data.Data hiding ( Fixity ) @@ -32,7 +32,7 @@ import Data.Bool import Data.Ord import Data.Eq import Data.Char -import GHC.Integer (Integer) -- ROMES:TODO where is integer +import Prelude (Integer) {- ************************************************************************ diff --git a/compiler/Language/Haskell/Syntax/Pat.hs b/compiler/Language/Haskell/Syntax/Pat.hs index 5846796de4..95abde9ce0 100644 --- a/compiler/Language/Haskell/Syntax/Pat.hs +++ b/compiler/Language/Haskell/Syntax/Pat.hs @@ -1,4 +1,5 @@ +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} @@ -8,7 +9,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow] -- in module Language.Haskell.Syntax.Extension -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE DataKinds #-} {- (c) The University of Glasgow 2006 @@ -27,7 +27,7 @@ module Language.Haskell.Syntax.Pat ( HsRecFields(..), HsFieldBind(..), LHsFieldBind, HsRecField, LHsRecField, HsRecUpdField, LHsRecUpdField, - RecFieldsDotDot, + RecFieldsDotDot(..), hsRecFields, hsRecFieldSel, hsRecFieldsArgs, ) where @@ -45,9 +45,12 @@ import Data.Functor import Data.Foldable import Data.Traversable import Data.Bool +import Data.Data +import Data.Eq +import Data.Ord import Data.Int import Data.Function -import Data.List +import qualified Data.List type LPat p = XRec p (Pat p) @@ -236,7 +239,7 @@ type HsConPatDetails p = HsConDetails (HsConPatTyArg (NoGhcTc p)) (LPat p) (HsRe hsConPatArgs :: forall p . (UnXRec p) => HsConPatDetails p -> [LPat p] hsConPatArgs (PrefixCon _ ps) = ps -hsConPatArgs (RecCon fs) = map (hfbRHS . unXRec @p) (rec_flds fs) +hsConPatArgs (RecCon fs) = Data.List.map (hfbRHS . unXRec @p) (rec_flds fs) hsConPatArgs (InfixCon p1 p2) = [p1,p2] -- | Haskell Record Fields @@ -251,8 +254,9 @@ data HsRecFields p arg -- A bunch of record fields -- AZ:The XRec for LHsRecField makes the derivings fail. -- deriving (Functor, Foldable, Traversable) --- Type synonym to be able to have a specific XRec instance for the Int in `rec_dotdot` -type RecFieldsDotDot = Int +-- | Newtype to be able to have a specific XRec instance for the Int in `rec_dotdot` +newtype RecFieldsDotDot = RecFieldsDotDot { unRecFieldsDotDot :: Int } + deriving (Data, Eq, Ord) -- Note [DotDot fields] -- ~~~~~~~~~~~~~~~~~~~~ @@ -351,10 +355,10 @@ data HsFieldBind lhs rhs = HsFieldBind { -- See also Note [Disambiguating record fields] in GHC.Tc.Gen.Head. hsRecFields :: forall p arg.UnXRec p => HsRecFields p arg -> [XCFieldOcc p] -hsRecFields rbinds = map (hsRecFieldSel . unXRec @p) (rec_flds rbinds) +hsRecFields rbinds = Data.List.map (hsRecFieldSel . unXRec @p) (rec_flds rbinds) hsRecFieldsArgs :: forall p arg. UnXRec p => HsRecFields p arg -> [arg] -hsRecFieldsArgs rbinds = map (hfbRHS . unXRec @p) (rec_flds rbinds) +hsRecFieldsArgs rbinds = Data.List.map (hfbRHS . unXRec @p) (rec_flds rbinds) hsRecFieldSel :: forall p arg. UnXRec p => HsRecField p arg -> XCFieldOcc p hsRecFieldSel = foExt . unXRec @p . hfbLHS diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs index 8d3ed8b4dc..67bb8eabd3 100644 --- a/compiler/Language/Haskell/Syntax/Type.hs +++ b/compiler/Language/Haskell/Syntax/Type.hs @@ -6,7 +6,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow] -- in module Language.Haskell.Syntax.Extension @@ -20,12 +19,12 @@ GHC.Hs.Type: Abstract syntax: user-defined types -- See Note [Language.Haskell.Syntax.* Hierarchy] for why not GHC.Hs.* module Language.Haskell.Syntax.Type ( - Mult, HsScaled(..), + HsScaled(..), hsMult, hsScaledThing, HsArrow(..), HsLinearArrowTokens(..), - HsType(..), HsCoreTy, LHsType, HsKind, LHsKind, + HsType(..), LHsType, HsKind, LHsKind, HsForAllTelescope(..), HsTyVarBndr(..), LHsTyVarBndr, LHsQTyVars(..), HsOuterTyVarBndrs(..), HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs, @@ -40,10 +39,8 @@ module Language.Haskell.Syntax.Type ( LHsTypeArg, LBangType, BangType, - HsSrcBang(..), HsImplBang(..), - SrcStrictness(..), SrcUnpackedness(..), - Boxity(..), PromotionFlag(..), - isBoxed, isPromoted, + HsSrcBang(..), + PromotionFlag(..), isPromoted, ConDeclField(..), LConDeclField, @@ -61,17 +58,14 @@ module Language.Haskell.Syntax.Type ( import {-# SOURCE #-} Language.Haskell.Syntax.Expr ( HsUntypedSplice ) import Language.Haskell.Syntax.Extension -import Language.Haskell.Syntax.Basic import GHC.Types.Name.Reader ( RdrName ) -import GHC.Core.DataCon( HsSrcBang(..), HsImplBang(..), - SrcStrictness(..), SrcUnpackedness(..) ) -import GHC.Core.Type -import GHC.Types.SrcLoc -import GHC.Parser.Annotation +import GHC.Core.DataCon( HsSrcBang(..) ) +import GHC.Core.Type (Specificity) +import GHC.Types.SrcLoc (SrcSpan) -import GHC.Hs.Doc -import GHC.Data.FastString +import GHC.Hs.Doc (LHsDoc) +import GHC.Data.FastString (FastString) import Data.Data hiding ( Fixity, Prefix, Infix ) import Data.Void @@ -79,7 +73,7 @@ import Data.Maybe import Data.Eq import Data.Bool import Data.Char -import GHC.Num (Integer) +import Prelude (Integer) {- ************************************************************************ @@ -899,14 +893,6 @@ data HsType pass | XHsType !(XXType pass) --- An escape hatch for tunnelling a Core 'Type' through 'HsType'. --- For more details on how this works, see: --- --- * @Note [Renaming HsCoreTys]@ in "GHC.Rename.HsType" --- --- * @Note [Typechecking HsCoreTys]@ in "GHC.Tc.Gen.HsType" -type HsCoreTy = Type - -- | Haskell Type Literal data HsTyLit pass @@ -1191,7 +1177,7 @@ if they correspond to a visible 'forall'. ************************************************************************ -} --- Arguments in an expression/type after splitting +-- | Arguments in an expression/type after splitting data HsArg tm ty = HsValArg tm -- Argument is an ordinary expression (f arg) | HsTypeArg SrcSpan ty -- Argument is a visible type application (f @ty) @@ -1265,8 +1251,8 @@ type LAmbiguousFieldOcc pass = XRec pass (AmbiguousFieldOcc pass) -- See Note [HsRecField and HsRecUpdField] in "GHC.Hs.Pat". -- See Note [Located RdrNames] in "GHC.Hs.Expr". data AmbiguousFieldOcc pass - = Unambiguous (XUnambiguous pass) (LocatedN RdrName) - | Ambiguous (XAmbiguous pass) (LocatedN RdrName) + = Unambiguous (XUnambiguous pass) (XRec pass RdrName) + | Ambiguous (XAmbiguous pass) (XRec pass RdrName) | XAmbiguousFieldOcc !(XXAmbiguousFieldOcc pass) |