[Git][ghc/ghc][wip/andreask/ppr_prelude] 5 commits: Replace use of Prelude with Prelude.Basic
Andreas Klebinger (@AndreasK)
gitlab at gitlab.haskell.org
Tue Nov 1 16:01:29 UTC 2022
Andreas Klebinger pushed to branch wip/andreask/ppr_prelude at Glasgow Haskell Compiler / GHC
Commits:
9e87adc6 by Andreas Klebinger at 2022-11-01T16:17:45+01:00
Replace use of Prelude with Prelude.Basic
- - - - -
18891ee1 by Andreas Klebinger at 2022-11-01T16:37:50+01:00
Make GHC.Utils.Ppr prelude importable
- - - - -
7c59fd38 by Andreas Klebinger at 2022-11-01T16:50:22+01:00
Make outputable prelude importable
- - - - -
20a20eb0 by Andreas Klebinger at 2022-11-01T16:55:44+01:00
Remove Ppr.Doc
- - - - -
95cd19f5 by Andreas Klebinger at 2022-11-01T16:59:03+01:00
wip
- - - - -
25 changed files:
- compiler/GHC/Data/Bool.hs
- compiler/GHC/Data/FastMutInt.hs
- compiler/GHC/Data/FastString.hs
- compiler/GHC/Data/FastString/Type.hs
- compiler/GHC/Driver/Config/StgToCmm.hs
- compiler/GHC/Prelude.hs
- + compiler/GHC/Prelude/Basic.hs
- compiler/GHC/Utils/BufHandle.hs
- compiler/GHC/Utils/Constants.hs
- compiler/GHC/Utils/Exception.hs
- compiler/GHC/Utils/Fingerprint.hs
- compiler/GHC/Utils/GlobalVars.hs
- compiler/GHC/Utils/IO/Unsafe.hs
- compiler/GHC/Utils/Misc.hs
- compiler/GHC/Utils/Outputable.hs
- − compiler/GHC/Utils/Outputable/SDoc.hs
- compiler/GHC/Utils/Panic/Plain.hs
- compiler/GHC/Utils/Ppr.hs
- compiler/GHC/Utils/Ppr/Colour.hs
- − compiler/GHC/Utils/Ppr/Doc.hs
- compiler/GHC/Utils/Trace.hs
- compiler/GHC/Utils/Trace.hs-boot
- compiler/Setup.hs
- compiler/ghc.cabal.in
- hadrian/src/Rules/Generate.hs
Changes:
=====================================
compiler/GHC/Data/Bool.hs
=====================================
@@ -4,7 +4,7 @@ module GHC.Data.Bool
)
where
-import Prelude
+import GHC.Prelude.Basic
data OverridingBool
= Auto
=====================================
compiler/GHC/Data/FastMutInt.hs
=====================================
@@ -13,7 +13,7 @@ module GHC.Data.FastMutInt(
atomicFetchAddFastMut
) where
-import GHC.Prelude
+import GHC.Prelude.Basic
import GHC.Base
=====================================
compiler/GHC/Data/FastString.hs
=====================================
@@ -109,7 +109,7 @@ module GHC.Data.FastString
lengthPS
) where
-import GHC.Prelude
+import GHC.Prelude.Basic
import GHC.Data.FastString.Type
=====================================
compiler/GHC/Data/FastString/Type.hs
=====================================
@@ -52,7 +52,7 @@ module GHC.Data.FastString.Type
) where
-import Prelude
+import GHC.Prelude.Basic
import Control.DeepSeq
import Data.ByteString (ByteString)
=====================================
compiler/GHC/Driver/Config/StgToCmm.hs
=====================================
@@ -2,6 +2,8 @@ module GHC.Driver.Config.StgToCmm
( initStgToCmmConfig
) where
+import GHC.Prelude.Basic
+
import GHC.StgToCmm.Config
import GHC.Driver.Backend
@@ -12,9 +14,6 @@ import GHC.Utils.Error
import GHC.Unit.Module
import GHC.Utils.Outputable
-import Data.Maybe
-import Prelude
-
initStgToCmmConfig :: DynFlags -> Module -> StgToCmmConfig
initStgToCmmConfig dflags mod = StgToCmmConfig
-- settings
=====================================
compiler/GHC/Prelude.hs
=====================================
@@ -13,11 +13,8 @@
-- * Explicitly imports GHC.Prelude
module GHC.Prelude
- (module X
- ,Applicative (..)
- ,module Bits
+ (module GHC.Prelude
,module GHC.Utils.Trace
- ,shiftL, shiftR
) where
@@ -49,9 +46,7 @@ NoImplicitPrelude. There are two motivations for this:
extensions.
-}
-import Prelude as X hiding ((<>), Applicative(..))
-import Control.Applicative (Applicative(..))
-import Data.Foldable as X (foldl')
+import GHC.Prelude.Basic as GHC.Prelude
import {-# SOURCE #-} GHC.Utils.Trace
( pprTrace
@@ -64,52 +59,3 @@ import {-# SOURCE #-} GHC.Utils.Trace
, warnPprTrace
, pprTraceUserWarning
)
-
-#if MIN_VERSION_base(4,16,0)
-import GHC.Bits as Bits hiding (shiftL, shiftR)
-# if defined(DEBUG)
-import qualified GHC.Bits as Bits (shiftL, shiftR)
-# endif
-
-#else
---base <4.15
-import Data.Bits as Bits hiding (shiftL, shiftR)
-# if defined(DEBUG)
-import qualified Data.Bits as Bits (shiftL, shiftR)
-# endif
-#endif
-
-{- Note [Default to unsafe shifts inside GHC]
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The safe shifts can introduce branches which come
-at the cost of performance. We still want the additional
-debugability for debug builds. So we define it as one or the
-other depending on the DEBUG setting.
-
-Why do we then continue on to re-export the rest of Data.Bits?
-If we would not what is likely to happen is:
-* Someone imports Data.Bits, uses xor. Things are fine.
-* They add a shift and get an ambiguous definition error.
-* The are puzzled for a bit.
-* They either:
- + Remove the import of Data.Bits and get an error because xor is not in scope.
- + Add the hiding clause to the Data.Bits import for the shifts.
-
-Either is quite annoying. Simply re-exporting all of Data.Bits avoids this
-making for a smoother developer experience. At the cost of having a few more
-names in scope at all time. But that seems like a fair tradeoff.
-
-See also #19618
--}
-
--- We always want the Data.Bits method to show up for rules etc.
-{-# INLINE shiftL #-}
-{-# INLINE shiftR #-}
-shiftL, shiftR :: Bits.Bits a => a -> Int -> a
-#if defined(DEBUG)
-shiftL = Bits.shiftL
-shiftR = Bits.shiftR
-#else
-shiftL = Bits.unsafeShiftL
-shiftR = Bits.unsafeShiftR
-#endif
=====================================
compiler/GHC/Prelude/Basic.hs
=====================================
@@ -0,0 +1,104 @@
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_HADDOCK not-home #-}
+{-# OPTIONS_GHC -O2 #-} -- See Note [-O2 Prelude]
+
+-- | Custom minimal GHC "Prelude"
+--
+-- This module serves as a replacement for the "Prelude" module
+-- and abstracts over differences between the bootstrapping
+-- GHC version, and may also provide a common default vocabulary.
+
+-- Every module in GHC
+-- * Is compiled with -XNoImplicitPrelude
+-- * Explicitly imports GHC.BasicPrelude or GHC.Prelude
+-- * The later provides some functionality with within ghc itself
+-- like pprTrace.
+
+module GHC.Prelude.Basic
+ (module X
+ ,Applicative (..)
+ ,module Bits
+ ,shiftL, shiftR
+ ) where
+
+
+{- Note [-O2 Prelude]
+~~~~~~~~~~~~~~~~~~~~~
+There is some code in GHC that is *always* compiled with -O[2] because
+of it's impact on compile time performance. Some of this code might depend
+on the definitions like shiftL being defined here being performant.
+
+So we always compile this module with -O2. It's (currently) tiny so I
+have little reason to suspect this impacts overall GHC compile times
+negatively.
+
+-}
+-- We export the 'Semigroup' class but w/o the (<>) operator to avoid
+-- clashing with the (Outputable.<>) operator which is heavily used
+-- through GHC's code-base.
+
+{-
+Note [Why do we import Prelude here?]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The files ghc-boot-th.cabal, ghc-boot.cabal, ghci.cabal and
+ghc-heap.cabal contain the directive default-extensions:
+NoImplicitPrelude. There are two motivations for this:
+ - Consistency with the compiler directory, which enables
+ NoImplicitPrelude;
+ - Allows loading the above dependent packages with ghc-in-ghci,
+ giving a smoother development experience when adding new
+ extensions.
+-}
+
+import Prelude as X hiding ((<>), Applicative(..))
+import Control.Applicative (Applicative(..))
+import Data.Foldable as X (foldl')
+
+#if MIN_VERSION_base(4,16,0)
+import GHC.Bits as Bits hiding (shiftL, shiftR)
+# if defined(DEBUG)
+import qualified GHC.Bits as Bits (shiftL, shiftR)
+# endif
+
+#else
+--base <4.15
+import Data.Bits as Bits hiding (shiftL, shiftR)
+# if defined(DEBUG)
+import qualified Data.Bits as Bits (shiftL, shiftR)
+# endif
+#endif
+
+{- Note [Default to unsafe shifts inside GHC]
+ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The safe shifts can introduce branches which come
+at the cost of performance. We still want the additional
+debugability for debug builds. So we define it as one or the
+other depending on the DEBUG setting.
+
+Why do we then continue on to re-export the rest of Data.Bits?
+If we would not what is likely to happen is:
+* Someone imports Data.Bits, uses xor. Things are fine.
+* They add a shift and get an ambiguous definition error.
+* The are puzzled for a bit.
+* They either:
+ + Remove the import of Data.Bits and get an error because xor is not in scope.
+ + Add the hiding clause to the Data.Bits import for the shifts.
+
+Either is quite annoying. Simply re-exporting all of Data.Bits avoids this
+making for a smoother developer experience. At the cost of having a few more
+names in scope at all time. But that seems like a fair tradeoff.
+
+See also #19618
+-}
+
+-- We always want the Data.Bits method to show up for rules etc.
+{-# INLINE shiftL #-}
+{-# INLINE shiftR #-}
+shiftL, shiftR :: Bits.Bits a => a -> Int -> a
+#if defined(DEBUG)
+shiftL = Bits.shiftL
+shiftR = Bits.shiftR
+#else
+shiftL = Bits.unsafeShiftL
+shiftR = Bits.unsafeShiftR
+#endif
=====================================
compiler/GHC/Utils/BufHandle.hs
=====================================
@@ -24,7 +24,7 @@ module GHC.Utils.BufHandle (
bFlush,
) where
-import GHC.Prelude
+import GHC.Prelude.Basic
import GHC.Data.FastString
import GHC.Data.FastMutInt
=====================================
compiler/GHC/Utils/Constants.hs
=====================================
@@ -8,7 +8,7 @@ module GHC.Utils.Constants
)
where
-import GHC.Prelude
+import GHC.Prelude.Basic
{-
=====================================
compiler/GHC/Utils/Exception.hs
=====================================
@@ -8,7 +8,7 @@ module GHC.Utils.Exception
)
where
-import Prelude
+import GHC.Prelude.Basic
import GHC.IO (catchException)
import Control.Exception as CE hiding (assert)
=====================================
compiler/GHC/Utils/Fingerprint.hs
=====================================
@@ -22,7 +22,7 @@ module GHC.Utils.Fingerprint (
getFileHash
) where
-import GHC.Prelude
+import GHC.Prelude.Basic
import Foreign
import GHC.IO
=====================================
compiler/GHC/Utils/GlobalVars.hs
=====================================
@@ -22,7 +22,7 @@ module GHC.Utils.GlobalVars
)
where
-import GHC.Prelude
+import GHC.Prelude.Basic
import GHC.Conc.Sync ( sharedCAF )
=====================================
compiler/GHC/Utils/IO/Unsafe.hs
=====================================
@@ -9,7 +9,7 @@ module GHC.Utils.IO.Unsafe
)
where
-import GHC.Prelude ()
+import GHC.Prelude.Basic ()
import GHC.Exts
import GHC.IO (IO(..))
=====================================
compiler/GHC/Utils/Misc.hs
=====================================
@@ -124,7 +124,7 @@ module GHC.Utils.Misc (
HasDebugCallStack,
) where
-import GHC.Prelude hiding ( head, init, last, tail )
+import GHC.Prelude.Basic hiding ( head, init, last, tail )
import GHC.Utils.Exception
import GHC.Utils.Panic.Plain
=====================================
compiler/GHC/Utils/Outputable.hs
=====================================
@@ -6,11 +6,6 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
--- The SDoc IsString instance requires the text function from this module.
--- Given the choice between an orphan instance and using a boot module I chose
--- the orphan instance. Mostly for performance reasons.
-{-# OPTIONS_GHC -Wno-orphans #-}
-
{-
(c) The University of Glasgow 2006-2012
(c) The GRASP Project, Glasgow University, 1992-1998
@@ -111,13 +106,12 @@ module GHC.Utils.Outputable (
) where
-import GHC.Prelude
-
-import GHC.Utils.Outputable.SDoc
import Language.Haskell.Syntax.Module.Name ( ModuleName(..) )
-import {-# SOURCE #-} GHC.Unit.Types ( moduleName )
--- import {-# SOURCE #-} GHC.Types.Name.Occurrence( OccName )
+import GHC.Prelude.Basic
+
+import {-# SOURCE #-} GHC.Unit.Types ( Unit, Module, moduleName )
+import {-# SOURCE #-} GHC.Types.Name.Occurrence( OccName )
import GHC.Utils.BufHandle (BufHandle)
import GHC.Data.FastString
@@ -154,8 +148,77 @@ import Data.Time.Format.ISO8601
import GHC.Fingerprint
import GHC.Show ( showMultiLineString )
import GHC.Utils.Exception
--- import GHC.Exts (oneShot)
+import GHC.Exts (oneShot)
+
+{-
+************************************************************************
+* *
+\subsection{The @PprStyle@ data type}
+* *
+************************************************************************
+-}
+
+data PprStyle
+ = PprUser PrintUnqualified Depth Coloured
+ -- Pretty-print in a way that will make sense to the
+ -- ordinary user; must be very close to Haskell
+ -- syntax, etc.
+ -- Assumes printing tidied code: non-system names are
+ -- printed without uniques.
+
+ | PprDump PrintUnqualified
+ -- For -ddump-foo; less verbose than in ppr-debug mode, but more than PprUser
+ -- Does not assume tidied code: non-external names
+ -- are printed with uniques.
+
+ | PprCode -- ^ Print code; either C or assembler
+
+data Depth
+ = AllTheWay
+ | PartWay Int -- ^ 0 => stop
+ | DefaultDepth -- ^ Use 'sdocDefaultDepth' field as depth
+
+data Coloured
+ = Uncoloured
+ | Coloured
+
+-- -----------------------------------------------------------------------------
+-- Printing original names
+-- | When printing code that contains original names, we need to map the
+-- original names back to something the user understands. This is the
+-- purpose of the triple of functions that gets passed around
+-- when rendering 'SDoc'.
+data PrintUnqualified = QueryQualify {
+ queryQualifyName :: QueryQualifyName,
+ queryQualifyModule :: QueryQualifyModule,
+ queryQualifyPackage :: QueryQualifyPackage
+}
+
+-- | Given a `Name`'s `Module` and `OccName`, decide whether and how to qualify
+-- it.
+type QueryQualifyName = Module -> OccName -> QualifyName
+
+-- | For a given module, we need to know whether to print it with
+-- a package name to disambiguate it.
+type QueryQualifyModule = Module -> Bool
+
+-- | For a given package, we need to know whether to print it with
+-- the component id to disambiguate it.
+type QueryQualifyPackage = Unit -> Bool
+
+-- See Note [Printing original names] in GHC.Types.Name.Ppr
+data QualifyName -- Given P:M.T
+ = NameUnqual -- It's in scope unqualified as "T"
+ -- OR nothing called "T" is in scope
+
+ | NameQual ModuleName -- It's in scope qualified as "X.T"
+
+ | NameNotInScope1 -- It's not in scope at all, but M.T is not bound
+ -- in the current scope, so we can refer to it as "M.T"
+
+ | NameNotInScope2 -- It's not in scope at all, and M.T is already bound in
+ -- the current scope, so we must refer to it as "P:M.T"
instance Outputable QualifyName where
ppr NameUnqual = text "NameUnqual"
@@ -253,8 +316,85 @@ shown.
The following test decides whether or not we are actually generating
code (either C or assembly), or generating interface files.
+************************************************************************
+* *
+\subsection{The @SDoc@ data type}
+* *
+************************************************************************
-}
+-- | Represents a pretty-printable document.
+--
+-- To display an 'SDoc', use 'printSDoc', 'printSDocLn', 'bufLeftRenderSDoc',
+-- or 'renderWithContext'. Avoid calling 'runSDoc' directly as it breaks the
+-- abstraction layer.
+newtype SDoc = SDoc' (SDocContext -> Doc)
+
+-- See Note [The one-shot state monad trick] in GHC.Utils.Monad
+{-# COMPLETE SDoc #-}
+pattern SDoc :: (SDocContext -> Doc) -> SDoc
+pattern SDoc m <- SDoc' m
+ where
+ SDoc m = SDoc' (oneShot m)
+
+runSDoc :: SDoc -> (SDocContext -> Doc)
+runSDoc (SDoc m) = m
+
+data SDocContext = SDC
+ { sdocStyle :: !PprStyle
+ , sdocColScheme :: !Col.Scheme
+ , sdocLastColour :: !Col.PprColour
+ -- ^ The most recently used colour.
+ -- This allows nesting colours.
+ , sdocShouldUseColor :: !Bool
+ , sdocDefaultDepth :: !Int
+ , sdocLineLength :: !Int
+ , sdocCanUseUnicode :: !Bool
+ -- ^ True if Unicode encoding is supported
+ -- and not disabled by GHC_NO_UNICODE environment variable
+ , sdocHexWordLiterals :: !Bool
+ , sdocPprDebug :: !Bool
+ , sdocPrintUnicodeSyntax :: !Bool
+ , sdocPrintCaseAsLet :: !Bool
+ , sdocPrintTypecheckerElaboration :: !Bool
+ , sdocPrintAxiomIncomps :: !Bool
+ , sdocPrintExplicitKinds :: !Bool
+ , sdocPrintExplicitCoercions :: !Bool
+ , sdocPrintExplicitRuntimeReps :: !Bool
+ , sdocPrintExplicitForalls :: !Bool
+ , sdocPrintPotentialInstances :: !Bool
+ , sdocPrintEqualityRelations :: !Bool
+ , sdocSuppressTicks :: !Bool
+ , sdocSuppressTypeSignatures :: !Bool
+ , sdocSuppressTypeApplications :: !Bool
+ , sdocSuppressIdInfo :: !Bool
+ , sdocSuppressCoercions :: !Bool
+ , sdocSuppressCoercionTypes :: !Bool
+ , sdocSuppressUnfoldings :: !Bool
+ , sdocSuppressVarKinds :: !Bool
+ , sdocSuppressUniques :: !Bool
+ , sdocSuppressModulePrefixes :: !Bool
+ , sdocSuppressStgExts :: !Bool
+ , sdocErrorSpans :: !Bool
+ , sdocStarIsType :: !Bool
+ , sdocLinearTypes :: !Bool
+ , sdocListTuplePuns :: !Bool
+ , sdocPrintTypeAbbreviations :: !Bool
+ , sdocUnitIdForUser :: !(FastString -> SDoc)
+ -- ^ Used to map UnitIds to more friendly "package-version:component"
+ -- strings while pretty-printing.
+ --
+ -- Use `GHC.Unit.State.pprWithUnitState` to set it. Users should never
+ -- have to set it to pretty-print SDocs emitted by GHC, otherwise it's a
+ -- bug. It's an internal field used to thread the UnitState so that the
+ -- Outputable instance of UnitId can use it.
+ --
+ -- See Note [Pretty-printing UnitId] in "GHC.Unit" for more details.
+ --
+ -- Note that we use `FastString` instead of `UnitId` to avoid boring
+ -- module inter-dependency issues.
+ }
+
instance IsString SDoc where
fromString = text
=====================================
compiler/GHC/Utils/Outputable/SDoc.hs deleted
=====================================
@@ -1,171 +0,0 @@
-{-# LANGUAGE PatternSynonyms #-}
-
--- Having the SDoc type in it's own module allows us to export
--- trace functions from our prelude.
--- See Note [Exporting pprTrace from GHC.Prelude]
-module GHC.Utils.Outputable.SDoc where
-
-import Prelude
-
-import GHC.Utils.Ppr.Doc
-import Language.Haskell.Syntax.Module.Name.Type ( ModuleName(..) )
-import qualified GHC.Utils.Ppr.Colour as Col
-
-import {-# SOURCE #-} GHC.Unit.Types ( Unit, Module )
-import {-# SOURCE #-} GHC.Types.Name.Occurrence( OccName )
-
-import GHC.Data.FastString.Type ( FastString )
-import GHC.Exts (oneShot)
-
-{-
-************************************************************************
-* *
-\subsection{The @SDoc@ data type}
-* *
-************************************************************************
--}
-
--- | Represents a pretty-printable document.
---
--- To display an 'SDoc', use 'printSDoc', 'printSDocLn', 'bufLeftRenderSDoc',
--- or 'renderWithContext'. Avoid calling 'runSDoc' directly as it breaks the
--- abstraction layer.
-newtype SDoc = SDoc' (SDocContext -> Doc)
-
--- See Note [The one-shot state monad trick] in GHC.Utils.Monad
-{-# COMPLETE SDoc #-}
-pattern SDoc :: (SDocContext -> Doc) -> SDoc
-pattern SDoc m <- SDoc' m
- where
- SDoc m = SDoc' (oneShot m)
-
-runSDoc :: SDoc -> (SDocContext -> Doc)
-runSDoc (SDoc m) = m
-
-data SDocContext = SDC
- { sdocStyle :: !PprStyle
- , sdocColScheme :: !Col.Scheme
- , sdocLastColour :: !Col.PprColour
- -- ^ The most recently used colour.
- -- This allows nesting colours.
- , sdocShouldUseColor :: !Bool
- , sdocDefaultDepth :: !Int
- , sdocLineLength :: !Int
- , sdocCanUseUnicode :: !Bool
- -- ^ True if Unicode encoding is supported
- -- and not disabled by GHC_NO_UNICODE environment variable
- , sdocHexWordLiterals :: !Bool
- , sdocPprDebug :: !Bool
- , sdocPrintUnicodeSyntax :: !Bool
- , sdocPrintCaseAsLet :: !Bool
- , sdocPrintTypecheckerElaboration :: !Bool
- , sdocPrintAxiomIncomps :: !Bool
- , sdocPrintExplicitKinds :: !Bool
- , sdocPrintExplicitCoercions :: !Bool
- , sdocPrintExplicitRuntimeReps :: !Bool
- , sdocPrintExplicitForalls :: !Bool
- , sdocPrintPotentialInstances :: !Bool
- , sdocPrintEqualityRelations :: !Bool
- , sdocSuppressTicks :: !Bool
- , sdocSuppressTypeSignatures :: !Bool
- , sdocSuppressTypeApplications :: !Bool
- , sdocSuppressIdInfo :: !Bool
- , sdocSuppressCoercions :: !Bool
- , sdocSuppressCoercionTypes :: !Bool
- , sdocSuppressUnfoldings :: !Bool
- , sdocSuppressVarKinds :: !Bool
- , sdocSuppressUniques :: !Bool
- , sdocSuppressModulePrefixes :: !Bool
- , sdocSuppressStgExts :: !Bool
- , sdocErrorSpans :: !Bool
- , sdocStarIsType :: !Bool
- , sdocLinearTypes :: !Bool
- , sdocListTuplePuns :: !Bool
- , sdocPrintTypeAbbreviations :: !Bool
- , sdocUnitIdForUser :: !(FastString -> SDoc)
- -- ^ Used to map UnitIds to more friendly "package-version:component"
- -- strings while pretty-printing.
- --
- -- Use `GHC.Unit.State.pprWithUnitState` to set it. Users should never
- -- have to set it to pretty-print SDocs emitted by GHC, otherwise it's a
- -- bug. It's an internal field used to thread the UnitState so that the
- -- Outputable instance of UnitId can use it.
- --
- -- See Note [Pretty-printing UnitId] in "GHC.Unit" for more details.
- --
- -- Note that we use `FastString` instead of `UnitId` to avoid boring
- -- module inter-dependency issues.
- }
-
-
-{-
-************************************************************************
-* *
-\subsection{The @PprStyle@ data type}
-* *
-************************************************************************
--}
-
-data PprStyle
- = PprUser PrintUnqualified Depth Coloured
- -- Pretty-print in a way that will make sense to the
- -- ordinary user; must be very close to Haskell
- -- syntax, etc.
- -- Assumes printing tidied code: non-system names are
- -- printed without uniques.
-
- | PprDump PrintUnqualified
- -- For -ddump-foo; less verbose than in ppr-debug mode, but more than PprUser
- -- Does not assume tidied code: non-external names
- -- are printed with uniques.
-
- | PprCode -- ^ Print code; either C or assembler
-
-data Depth
- = AllTheWay
- | PartWay Int -- ^ 0 => stop
- | DefaultDepth -- ^ Use 'sdocDefaultDepth' field as depth
-
-data Coloured
- = Uncoloured
- | Coloured
-
--- -----------------------------------------------------------------------------
--- Printing original names
-
--- | When printing code that contains original names, we need to map the
--- original names back to something the user understands. This is the
--- purpose of the triple of functions that gets passed around
--- when rendering 'SDoc'.
-data PrintUnqualified = QueryQualify {
- queryQualifyName :: QueryQualifyName,
- queryQualifyModule :: QueryQualifyModule,
- queryQualifyPackage :: QueryQualifyPackage
-}
-
-
-
--- | Given a `Name`'s `Module` and `OccName`, decide whether and how to qualify
--- it.
-type QueryQualifyName = Module -> OccName -> QualifyName
-
--- | For a given module, we need to know whether to print it with
--- a package name to disambiguate it.
-type QueryQualifyModule = Module -> Bool
-
--- | For a given package, we need to know whether to print it with
--- the component id to disambiguate it.
-type QueryQualifyPackage = Unit -> Bool
-
--- See Note [Printing original names] in GHC.Types.Name.Ppr
-data QualifyName -- Given P:M.T
- = NameUnqual -- It's in scope unqualified as "T"
- -- OR nothing called "T" is in scope
-
- | NameQual ModuleName -- It's in scope qualified as "X.T"
-
- | NameNotInScope1 -- It's not in scope at all, but M.T is not bound
- -- in the current scope, so we can refer to it as "M.T"
-
- | NameNotInScope2 -- It's not in scope at all, and M.T is already bound in
- -- the current scope, so we must refer to it as "P:M.T"
\ No newline at end of file
=====================================
compiler/GHC/Utils/Panic/Plain.hs
=====================================
@@ -28,7 +28,7 @@ import GHC.Settings.Config
import GHC.Utils.Constants
import GHC.Utils.Exception as Exception
import GHC.Stack
-import GHC.Prelude
+import GHC.Prelude.Basic
import System.IO.Unsafe
-- | This type is very similar to 'GHC.Utils.Panic.GhcException', but it omits
=====================================
compiler/GHC/Utils/Ppr.hs
=====================================
@@ -1,10 +1,6 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
--- The Doc Show instance requires the fullRender function from this module.
--- Given the choice between an orphan instance and using a boot module I chose
--- the orphan instance. Mostly for performance reasons.
-{-# OPTIONS_GHC -Wno-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Utils.Ppr
@@ -115,7 +111,7 @@ module GHC.Utils.Ppr (
) where
-import GHC.Prelude hiding (error)
+import GHC.Prelude.Basic hiding (error)
import GHC.Utils.BufHandle
import GHC.Data.FastString
@@ -127,7 +123,6 @@ import Numeric (showHex)
import GHC.Base ( unpackCString#, unpackNBytes#, Int(..) )
import GHC.Ptr ( Ptr(..) )
-import GHC.Utils.Ppr.Doc
-- ---------------------------------------------------------------------------
-- The Doc calculus
@@ -211,6 +206,72 @@ infixl 6 <+>
infixl 5 $$, $+$
+-- ---------------------------------------------------------------------------
+-- The Doc data type
+
+-- | The abstract type of documents.
+-- A Doc represents a *set* of layouts. A Doc with
+-- no occurrences of Union or NoDoc represents just one layout.
+data Doc
+ = Empty -- empty
+ | NilAbove Doc -- text "" $$ x
+ | TextBeside !TextDetails {-# UNPACK #-} !Int Doc -- text s <> x
+ | Nest {-# UNPACK #-} !Int Doc -- nest k x
+ | Union Doc Doc -- ul `union` ur
+ | NoDoc -- The empty set of documents
+ | Beside Doc Bool Doc -- True <=> space between
+ | Above Doc Bool Doc -- True <=> never overlap
+
+{-
+Here are the invariants:
+
+1) The argument of NilAbove is never Empty. Therefore
+ a NilAbove occupies at least two lines.
+
+2) The argument of @TextBeside@ is never @Nest at .
+
+3) The layouts of the two arguments of @Union@ both flatten to the same
+ string.
+
+4) The arguments of @Union@ are either @TextBeside@, or @NilAbove at .
+
+5) A @NoDoc@ may only appear on the first line of the left argument of an
+ union. Therefore, the right argument of an union can never be equivalent
+ to the empty set (@NoDoc@).
+
+6) An empty document is always represented by @Empty at . It can't be
+ hidden inside a @Nest@, or a @Union@ of two @Empty at s.
+
+7) The first line of every layout in the left argument of @Union@ is
+ longer than the first line of any layout in the right argument.
+ (1) ensures that the left argument has a first line. In view of
+ (3), this invariant means that the right argument must have at
+ least two lines.
+
+Notice the difference between
+ * NoDoc (no documents)
+ * Empty (one empty document; no height and no width)
+ * text "" (a document containing the empty string;
+ one line high, but has no width)
+-}
+
+
+-- | RDoc is a "reduced GDoc", guaranteed not to have a top-level Above or Beside.
+type RDoc = Doc
+
+-- | The TextDetails data type
+--
+-- A TextDetails represents a fragment of text that will be
+-- output at some point.
+data TextDetails = Chr {-# UNPACK #-} !Char -- ^ A single Char fragment
+ | Str String -- ^ A whole String fragment
+ | PStr FastString -- a hashed string
+ | ZStr FastZString -- a z-encoded string
+ | LStr {-# UNPACK #-} !PtrString
+ -- a '\0'-terminated array of bytes
+ | RStr {-# UNPACK #-} !Int {-# UNPACK #-} !Char
+ -- a repeated character (e.g., ' ')
+
instance Show Doc where
showsPrec _ doc cont = fullRender (mode style) (lineLength style)
(ribbonsPerLine style)
=====================================
compiler/GHC/Utils/Ppr/Colour.hs
=====================================
@@ -1,5 +1,5 @@
module GHC.Utils.Ppr.Colour where
-import Prelude
+import GHC.Prelude.Basic
import Data.Maybe (fromMaybe)
import GHC.Data.Bool
=====================================
compiler/GHC/Utils/Ppr/Doc.hs deleted
=====================================
@@ -1,76 +0,0 @@
--- | This module contains some ppr internals which need to live in their own
--- module to avoid module loops.
--- Avoid importing it directly and instead import GHC.Utils.Ppr instead if
--- possible.
--- See Note [Exporting pprTrace from GHC.Prelude]
-
-module GHC.Utils.Ppr.Doc where
-
-import Prelude
-
-import GHC.Data.FastString.Type ( FastString, FastZString, PtrString )
--- ---------------------------------------------------------------------------
--- The Doc data type
-
--- | The abstract type of documents.
--- A Doc represents a *set* of layouts. A Doc with
--- no occurrences of Union or NoDoc represents just one layout.
-data Doc
- = Empty -- empty
- | NilAbove Doc -- text "" $$ x
- | TextBeside !TextDetails {-# UNPACK #-} !Int Doc -- text s <> x
- | Nest {-# UNPACK #-} !Int Doc -- nest k x
- | Union Doc Doc -- ul `union` ur
- | NoDoc -- The empty set of documents
- | Beside Doc Bool Doc -- True <=> space between
- | Above Doc Bool Doc -- True <=> never overlap
-
-{-
-Here are the invariants:
-
-1) The argument of NilAbove is never Empty. Therefore
- a NilAbove occupies at least two lines.
-
-2) The argument of @TextBeside@ is never @Nest at .
-
-3) The layouts of the two arguments of @Union@ both flatten to the same
- string.
-
-4) The arguments of @Union@ are either @TextBeside@, or @NilAbove at .
-
-5) A @NoDoc@ may only appear on the first line of the left argument of an
- union. Therefore, the right argument of an union can never be equivalent
- to the empty set (@NoDoc@).
-
-6) An empty document is always represented by @Empty at . It can't be
- hidden inside a @Nest@, or a @Union@ of two @Empty at s.
-
-7) The first line of every layout in the left argument of @Union@ is
- longer than the first line of any layout in the right argument.
- (1) ensures that the left argument has a first line. In view of
- (3), this invariant means that the right argument must have at
- least two lines.
-
-Notice the difference between
- * NoDoc (no documents)
- * Empty (one empty document; no height and no width)
- * text "" (a document containing the empty string;
- one line high, but has no width)
--}
-
-
--- | RDoc is a "reduced GDoc", guaranteed not to have a top-level Above or Beside.
-type RDoc = Doc
-
--- | The TextDetails data type
---
--- A TextDetails represents a fragment of text that will be
--- output at some point.
-data TextDetails = Chr {-# UNPACK #-} !Char -- ^ A single Char fragment
- | Str String -- ^ A whole String fragment
- | PStr FastString -- a hashed string
- | ZStr FastZString -- a z-encoded string
- | LStr {-# UNPACK #-} !PtrString
- -- a '\0'-terminated array of bytes
- | RStr {-# UNPACK #-} !Int {-# UNPACK #-} !Char
- -- a repeated character (e.g., ' ')
=====================================
compiler/GHC/Utils/Trace.hs
=====================================
@@ -43,7 +43,7 @@ So we don't provide a boot-export for this function to avoid people using it
accidentally.
-}
-import Prelude
+import GHC.Prelude.Basic
import GHC.Utils.Outputable
import GHC.Utils.Exception
import GHC.Utils.Panic
=====================================
compiler/GHC/Utils/Trace.hs-boot
=====================================
@@ -15,9 +15,10 @@ module GHC.Utils.Trace
)
where
-import Prelude
-import GHC.Utils.Outputable.SDoc
-import GHC.Utils.Exception
+import GHC.Prelude.Basic
+
+import GHC.Utils.Outputable ( SDoc )
+import GHC.Utils.Exception ( ExceptionMonad )
import GHC.Stack
import Debug.Trace (trace)
=====================================
compiler/Setup.hs
=====================================
@@ -116,7 +116,7 @@ generateConfigHs settings = either error id $ do
, " , cStage"
, " ) where"
, ""
- , "import GHC.Prelude"
+ , "import GHC.Prelude.Basic"
, ""
, "import GHC.Version"
, ""
=====================================
compiler/ghc.cabal.in
=====================================
@@ -561,6 +561,7 @@ Library
GHC.Platform.X86_64
GHC.Plugins
GHC.Prelude
+ GHC.Prelude.Basic
GHC.Rename.Bind
GHC.Rename.Doc
GHC.Rename.Env
@@ -802,12 +803,10 @@ Library
GHC.Utils.Monad
GHC.Utils.Monad.State.Strict
GHC.Utils.Outputable
- GHC.Utils.Outputable.SDoc
GHC.Utils.Panic
GHC.Utils.Panic.Plain
GHC.Utils.Ppr
GHC.Utils.Ppr.Colour
- GHC.Utils.Ppr.Doc
GHC.Utils.TmpFs
GHC.Utils.Trace
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -384,7 +384,7 @@ generateConfigHs = do
, " , cStage"
, " ) where"
, ""
- , "import GHC.Prelude"
+ , "import GHC.Prelude.Basic"
, ""
, "import GHC.Version"
, ""
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2f3727c4167263a5548f7ee3fd103cfc0cd35d33...95cd19f5c8332f2de3ca1057aac33971caaaafa6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2f3727c4167263a5548f7ee3fd103cfc0cd35d33...95cd19f5c8332f2de3ca1057aac33971caaaafa6
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/20221101/0db87861/attachment-0001.html>
More information about the ghc-commits
mailing list