[Git][ghc/ghc][wip/az/epa-hslet-tokens] EPA: Remove the last LHs(Uni)Token
Vladislav Zavialov (@int-index)
gitlab at gitlab.haskell.org
Sun Dec 10 19:12:59 UTC 2023
Vladislav Zavialov pushed to branch wip/az/epa-hslet-tokens at Glasgow Haskell Compiler / GHC
Commits:
ba522d6e by Vladislav Zavialov at 2023-12-10T21:47:54+03:00
EPA: Remove the last LHs(Uni)Token
- - - - -
10 changed files:
- compiler/GHC/Hs/Extension.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Unit/Module/Warnings.hs
- compiler/Language/Haskell/Syntax.hs
- − compiler/Language/Haskell/Syntax/Concrete.hs
- compiler/ghc.cabal.in
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- utils/check-exact/ExactPrint.hs
Changes:
=====================================
compiler/GHC/Hs/Extension.hs
=====================================
@@ -25,10 +25,7 @@ module GHC.Hs.Extension where
import GHC.Prelude
-import GHC.TypeLits (KnownSymbol, symbolVal)
-
import Data.Data hiding ( Fixity )
-import Language.Haskell.Syntax.Concrete
import Language.Haskell.Syntax.Extension
import GHC.Types.Name
import GHC.Types.Name.Reader
@@ -237,18 +234,10 @@ pprIfTc :: forall p. IsPass p => (p ~ 'Typechecked => SDoc) -> SDoc
pprIfTc pp = case ghcPass @p of GhcTc -> pp
_ -> empty
-type instance Anno (HsToken tok) = TokenLocation
-
-noHsTok :: GenLocated TokenLocation (HsToken tok)
-noHsTok = L NoTokenLoc HsTok
-
--- Outputable
instance Outputable NoExtField where
ppr _ = text "NoExtField"
instance Outputable DataConCantHappen where
- ppr = dataConCantHappen
-
-instance KnownSymbol tok => Outputable (HsToken tok) where
- ppr _ = text (symbolVal (Proxy :: Proxy tok))
\ No newline at end of file
+ ppr = dataConCantHappen
\ No newline at end of file
=====================================
compiler/GHC/Parser.y
=====================================
@@ -1979,7 +1979,7 @@ maybe_warning_pragma :: { Maybe (LWarningTxt GhcPs) }
| {- empty -} { Nothing }
warning_category :: { Maybe (Located InWarningCategory) }
- : 'in' STRING { Just (sLL $1 $> $ InWarningCategory (hsTok' $1) (getSTRINGs $2)
+ : 'in' STRING { Just (sLL $1 $> $ InWarningCategory (epTok $1) (getSTRINGs $2)
(sL1 $2 $ mkWarningCategory (getSTRING $2))) }
| {- empty -} { Nothing }
@@ -4491,9 +4491,6 @@ epUniTok t@(L l _) = EpUniTok (EpaSpan l) u
where
u = if isUnicode t then UnicodeSyntax else NormalSyntax
-hsTok' :: Located Token -> Located (HsToken tok)
-hsTok' (L l _) = L l HsTok
-
epExplicitBraces :: Located Token -> Located Token -> EpLayout
epExplicitBraces t1 t2 = EpExplicitBraces (epTok t1) (epTok t2)
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -111,7 +111,6 @@ import GHC.Hs.DocString
import GHC.Utils.Outputable hiding ( (<>) )
import GHC.Utils.Panic
import qualified GHC.Data.Strict as Strict
-import Language.Haskell.Syntax.Concrete (HsToken(..))
{-
Note [exact print annotations]
@@ -1400,9 +1399,6 @@ instance NoAnn AnnPragma where
instance NoAnn AnnParen where
noAnn = AnnParen AnnParens noAnn noAnn
-instance NoAnn (GenLocated TokenLocation (HsToken s)) where
- noAnn = L NoTokenLoc HsTok
-
instance NoAnn (EpToken s) where
noAnn = NoEpTok
=====================================
compiler/GHC/Unit/Module/Warnings.hs
=====================================
@@ -63,7 +63,6 @@ import GHC.Utils.Outputable
import GHC.Utils.Binary
import GHC.Unicode
-import Language.Haskell.Syntax.Concrete (HsToken (HsTok))
import Language.Haskell.Syntax.Extension
import Data.Data
@@ -120,13 +119,13 @@ the possibility of them being infinite.
data InWarningCategory
= InWarningCategory
- { iwc_in :: !(Located (HsToken "in")),
+ { iwc_in :: !(EpToken "in"),
iwc_st :: !SourceText,
iwc_wc :: (Located WarningCategory)
} deriving Data
fromWarningCategory :: WarningCategory -> InWarningCategory
-fromWarningCategory wc = InWarningCategory (noLoc HsTok) NoSourceText (noLoc wc)
+fromWarningCategory wc = InWarningCategory noAnn NoSourceText (noLoc wc)
-- See Note [Warning categories]
@@ -238,7 +237,7 @@ warningTxtSame w1 w2
deriving instance Eq InWarningCategory
-deriving instance (Eq (HsToken "in"), Eq (IdP pass)) => Eq (WarningTxt pass)
+deriving instance (Eq (IdP pass)) => Eq (WarningTxt pass)
deriving instance (Data pass, Data (IdP pass)) => Data (WarningTxt pass)
type instance Anno (WarningTxt (GhcPass pass)) = SrcSpanAnnP
=====================================
compiler/Language/Haskell/Syntax.hs
=====================================
@@ -25,7 +25,6 @@ module Language.Haskell.Syntax (
module Language.Haskell.Syntax.Module.Name,
module Language.Haskell.Syntax.Pat,
module Language.Haskell.Syntax.Type,
- module Language.Haskell.Syntax.Concrete,
module Language.Haskell.Syntax.Extension,
ModuleName(..), HsModule(..)
) where
@@ -36,7 +35,6 @@ import Language.Haskell.Syntax.Expr
import Language.Haskell.Syntax.ImpExp
import Language.Haskell.Syntax.Module.Name
import Language.Haskell.Syntax.Lit
-import Language.Haskell.Syntax.Concrete
import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Pat
import Language.Haskell.Syntax.Type
=====================================
compiler/Language/Haskell/Syntax/Concrete.hs deleted
=====================================
@@ -1,26 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-
--- | Bits of concrete syntax (tokens, layout).
-
-module Language.Haskell.Syntax.Concrete
- ( LHsToken, HsToken(HsTok),
- ) where
-
-import GHC.Prelude
-import GHC.TypeLits (Symbol, KnownSymbol)
-import Data.Data
-import Language.Haskell.Syntax.Extension
-
-type LHsToken tok p = XRec p (HsToken tok)
-
--- | A token stored in the syntax tree. For example, when parsing a
--- let-expression, we store @HsToken "let"@ and @HsToken "in"@.
--- The locations of those tokens can be used to faithfully reproduce
--- (exactprint) the original program text.
-data HsToken (tok :: Symbol) = HsTok
-
-deriving instance Eq (HsToken tok)
-deriving instance KnownSymbol tok => Data (HsToken tok)
\ No newline at end of file
=====================================
compiler/ghc.cabal.in
=====================================
@@ -940,7 +940,6 @@ Library
Language.Haskell.Syntax
Language.Haskell.Syntax.Basic
Language.Haskell.Syntax.Binds
- Language.Haskell.Syntax.Concrete
Language.Haskell.Syntax.Decls
Language.Haskell.Syntax.Expr
Language.Haskell.Syntax.Extension
=====================================
testsuite/tests/count-deps/CountDepsAst.stdout
=====================================
@@ -223,7 +223,6 @@ GHC.Utils.Word64
Language.Haskell.Syntax
Language.Haskell.Syntax.Basic
Language.Haskell.Syntax.Binds
-Language.Haskell.Syntax.Concrete
Language.Haskell.Syntax.Decls
Language.Haskell.Syntax.Expr
Language.Haskell.Syntax.Extension
=====================================
testsuite/tests/count-deps/CountDepsParser.stdout
=====================================
@@ -243,7 +243,6 @@ GHC.Utils.Word64
Language.Haskell.Syntax
Language.Haskell.Syntax.Basic
Language.Haskell.Syntax.Binds
-Language.Haskell.Syntax.Concrete
Language.Haskell.Syntax.Decls
Language.Haskell.Syntax.Expr
Language.Haskell.Syntax.Extension
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -820,15 +820,6 @@ markEpAnnLMS' (EpAnn anc a cs) l kw (Just str) = do
-- ---------------------------------------------------------------------
-markLToken :: forall m w tok . (Monad m, Monoid w, KnownSymbol tok)
- => Located (HsToken tok) -> EP w m (Located (HsToken tok))
-markLToken (L (RealSrcSpan aa mb) t) = do
- epaLoc'<- printStringAtAA (EpaSpan (RealSrcSpan aa mb)) (symbolVal (Proxy @tok))
- case epaLoc' of
- EpaSpan (RealSrcSpan aa' mb') -> return (L (RealSrcSpan aa' mb') t)
- _ -> return (L (RealSrcSpan aa mb ) t)
-markLToken (L lt t) = return (L lt t)
-
markEpToken :: forall m w tok . (Monad m, Monoid w, KnownSymbol tok)
=> EpToken tok -> EP w m (EpToken tok)
markEpToken NoEpTok = return NoEpTok
@@ -845,13 +836,6 @@ markEpUniToken (EpUniTok aa isUnicode) = do
UnicodeSyntax -> printStringAtAA aa (symbolVal (Proxy @utok))
return (EpUniTok aa' isUnicode)
-markToken :: forall m w tok . (Monad m, Monoid w, KnownSymbol tok)
- => LHsToken tok GhcPs -> EP w m (LHsToken tok GhcPs)
-markToken (L NoTokenLoc t) = return (L NoTokenLoc t)
-markToken (L (TokenLoc aa) t) = do
- aa' <- printStringAtAA aa (symbolVal (Proxy @tok))
- return (L (TokenLoc aa') t)
-
-- ---------------------------------------------------------------------
markArrow :: (Monad m, Monoid w) => HsArrow GhcPs -> EP w m (HsArrow GhcPs)
@@ -1710,7 +1694,7 @@ instance ExactPrint InWarningCategory where
setAnnotationAnchor a _ _ _ = a
exact (InWarningCategory tkIn source (L l wc)) = do
- tkIn' <- markLToken tkIn
+ tkIn' <- markEpToken tkIn
L _ (_,wc') <- markAnnotated (L l (source, wc))
return (InWarningCategory tkIn' source (L l wc'))
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ba522d6e71d1425fac178c0dbf6f6ee8d728ecb9
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ba522d6e71d1425fac178c0dbf6f6ee8d728ecb9
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/20231210/a4ad8c0e/attachment-0001.html>
More information about the ghc-commits
mailing list