diff --git a/compiler/GHC/Hs/Doc.hs-boot b/compiler/GHC/Hs/Doc.hs-boot new file mode 100644 index 0000000000000000000000000000000000000000..160908e84efa392c4d291f0812a7e9814952a770 --- /dev/null +++ b/compiler/GHC/Hs/Doc.hs-boot @@ -0,0 +1,19 @@ +{-# LANGUAGE RoleAnnotations #-} +module GHC.Hs.Doc where + +-- See #21592 for progress on removing this boot file. + +import GHC.Types.SrcLoc +import GHC.Hs.DocString +import Data.Kind + +type role WithHsDocIdentifiers representational nominal +type WithHsDocIdentifiers :: Type -> Type -> Type +data WithHsDocIdentifiers a pass + +type HsDoc :: Type -> Type +type HsDoc = WithHsDocIdentifiers HsDocString + +type LHsDoc :: Type -> Type +type LHsDoc pass = Located (HsDoc pass) + diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs index 02036046ab9079e893b7a1186c05bd877e58a939..b470790c2c2121884415fa5b0c0c3c15e6e0721b 100644 --- a/compiler/GHC/Unit/Types.hs +++ b/compiler/GHC/Unit/Types.hs @@ -110,7 +110,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS.Char8 import Language.Haskell.Syntax.Module.Name -import {-# SOURCE #-} Language.Haskell.Syntax.ImpExp (IsBootInterface(..)) +import Language.Haskell.Syntax.ImpExp (IsBootInterface(..)) --------------------------------------------------------------------- -- MODULES diff --git a/compiler/Language/Haskell/Syntax/ImpExp.hs b/compiler/Language/Haskell/Syntax/ImpExp.hs index 47f8be01678f91e3f6cc57f6a24dd65cb5752806..b1fd879f0670647636904c87c5e5ef0f16a2fbce 100644 --- a/compiler/Language/Haskell/Syntax/ImpExp.hs +++ b/compiler/Language/Haskell/Syntax/ImpExp.hs @@ -16,7 +16,7 @@ import Data.Int (Int) import Control.DeepSeq -import GHC.Hs.Doc -- ROMES:TODO Discuss in #21592 whether this is parsed AST or base AST +import {-# SOURCE #-} GHC.Hs.Doc (LHsDoc) -- ROMES:TODO Discuss in #21592 whether this is parsed AST or base AST {- ************************************************************************ diff --git a/compiler/Language/Haskell/Syntax/ImpExp.hs-boot b/compiler/Language/Haskell/Syntax/ImpExp.hs-boot deleted file mode 100644 index 68bd7fdc53538faf1ed8d929c9764254833afd02..0000000000000000000000000000000000000000 --- a/compiler/Language/Haskell/Syntax/ImpExp.hs-boot +++ /dev/null @@ -1,16 +0,0 @@ -module Language.Haskell.Syntax.ImpExp where - -import Data.Eq -import Data.Ord -import Text.Show -import Data.Data - --- This boot file should be short lived: As soon as the dependency on --- `GHC.Hs.Doc` is gone we'll no longer have cycles and can get rid this file. - -data IsBootInterface = NotBoot | IsBoot - -instance Eq IsBootInterface -instance Ord IsBootInterface -instance Show IsBootInterface -instance Data IsBootInterface