[Git][ghc/ghc][wip/aidylns/ttg-remove-hsunboundvar-via-hshole] Simplify XHole instantiation
Adriaan Leijnse (@aidylns)
gitlab at gitlab.haskell.org
Wed Jan 22 00:15:59 UTC 2025
Adriaan Leijnse pushed to branch wip/aidylns/ttg-remove-hsunboundvar-via-hshole at Glasgow Haskell Compiler / GHC
Commits:
06add9db by Adriaan Leijnse at 2025-01-22T00:14:59+00:00
Simplify XHole instantiation
- - - - -
3 changed files:
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Rename/Expr.hs
- utils/check-exact/ExactPrint.hs
Changes:
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -404,45 +404,26 @@ type instance XEmbTy GhcTc = DataConCantHappen
-- be enough. But then deriving a Data instance becomes impossible. Much,
-- much easier just to define HoleExprRef with a Data instance and store
-- the whole structure.
-type instance XHole (GhcPass p) =
- (HoleKind (XHoleVar (GhcPass p)) (XHoleParseError (GhcPass p)), XHoleShared (GhcPass p))
+type instance XHole GhcPs = (HoleKind (Maybe EpAnnHole) NoExtField, NoExtField)
+type instance XHole GhcRn = (HoleKind RdrName DataConCantHappen, NoExtField)
+type instance XHole GhcTc = (HoleKind RdrName DataConCantHappen, HoleExprRef)
data HoleKind unboundVarInfo parseErrorInfo
= HoleVar unboundVarInfo
| HoleParseError parseErrorInfo
deriving Data
--- | HsHole extensions for (named) holes and unbound variables.
-type family XHoleVar x
-type instance XHoleVar GhcPs = Maybe EpAnnHole
-type instance XHoleVar GhcRn = RdrName
-type instance XHoleVar GhcTc = RdrName
-
--- | HsHole extension for parse errors. Unused for now except to encode that
--- these cannot occur after the renamer.
-type family XHoleParseError p
-type instance XHoleParseError GhcPs = NoExtField
-type instance XHoleParseError GhcRn = DataConCantHappen
-type instance XHoleParseError GhcTc = DataConCantHappen
-
--- | HsHole extension shared between all types of holes.
-type family XHoleShared p
-type instance XHoleShared GhcPs = NoExtField
-type instance XHoleShared GhcRn = NoExtField
-type instance XHoleShared GhcTc = HoleExprRef
-
--- | The RdrName for an unnamed hole ("_").
-unnamedHoleRdrName :: RdrName
-unnamedHoleRdrName = mkUnqual varName (fsLit "_")
-
--- | The RdrName for an unnamed ("_") hole or named hole/unbound variable
--- ("_hole").
-holeVarRdrName :: forall p. IsPass p => XHoleVar (GhcPass p) -> RdrName
-holeVarRdrName hv = case (ghcPass @p, hv) of
- (GhcPs, _) -> unnamedHoleRdrName
- (GhcRn, r) -> r
- (GhcTc, r) -> r
-
+-- | The 'RdrName' for a hole. In the case of a 'HoleVar' denoting an unnamed
+-- hole ("_"), named hole ("_hole"), or an unbound variable this returns a
+-- 'RdrName' matching the syntactical representation. For a 'ParseError'
+-- 'HoleKind' the "_" literal is returned.
+holeRdrName :: forall p. IsPass p => XHole (GhcPass p) -> RdrName
+holeRdrName h = case (ghcPass @p, h) of
+ (GhcPs, _) -> mkUnqual varName (fsLit "_")
+ (GhcRn, (HoleVar r, _)) -> r
+ (GhcRn, (HoleParseError x, _)) -> dataConCantHappen x
+ (GhcTc, (HoleVar r, _)) -> r
+ (GhcTc, (HoleParseError x, _)) -> dataConCantHappen x
type instance XForAll GhcPs = NoExtField
type instance XForAll GhcRn = NoExtField
@@ -748,11 +729,7 @@ ppr_lexpr e = ppr_expr (unLoc e)
ppr_expr :: forall p. (OutputableBndrId p)
=> HsExpr (GhcPass p) -> SDoc
ppr_expr (HsVar _ (L _ v)) = pprPrefixOcc v
-ppr_expr (HsHole (HoleVar v, _)) = pprPrefixOcc (holeVarRdrName @p v)
-ppr_expr (HsHole (HoleParseError x, _)) = case ghcPass @p of
- GhcPs -> pprPrefixOcc unnamedHoleRdrName
- GhcRn -> dataConCantHappen x
- GhcTc -> dataConCantHappen x
+ppr_expr (HsHole h) = pprPrefixOcc (holeRdrName @p h)
ppr_expr (HsIPVar _ v) = ppr v
ppr_expr (HsOverLabel s l) = case ghcPass @p of
GhcPs -> helper s
@@ -1010,11 +987,7 @@ instance Outputable XXExprGhcTc where
ppr_infix_expr :: forall p. (OutputableBndrId p) => HsExpr (GhcPass p) -> Maybe SDoc
ppr_infix_expr (HsVar _ (L _ v)) = Just (pprInfixOcc v)
-ppr_infix_expr (HsHole (HoleVar hv, _)) = Just (pprInfixOcc (holeVarRdrName @p hv))
-ppr_infix_expr (HsHole (HoleParseError x, _)) = case ghcPass @p of
- GhcPs -> Just (pprInfixOcc unnamedHoleRdrName) -- TODO: Why not print the actual source text in case of a parse error?
- GhcRn -> dataConCantHappen x
- GhcTc -> dataConCantHappen x
+ppr_infix_expr (HsHole h) = Just (pprInfixOcc (holeRdrName @p h))
ppr_infix_expr (XExpr x) = case ghcPass @p of
GhcRn -> ppr_infix_expr_rn x
GhcTc -> ppr_infix_expr_tc x
=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -8,6 +8,7 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE DataKinds #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
@@ -353,8 +354,9 @@ rnExpr (HsVar _ (L l v))
rnExpr (HsIPVar x v)
= return (HsIPVar x v, emptyFVs)
-rnExpr (HsHole (HoleVar _, NoExtField))
- = return (HsHole (HoleVar unnamedHoleRdrName, NoExtField), emptyFVs)
+rnExpr (HsHole xh@(HoleVar _, NoExtField))
+ -- Using holeRdrName avoids repeating the "_" literal for unnamed holes:
+ = return (HsHole (HoleVar (holeRdrName @'Parsed xh), NoExtField), emptyFVs)
rnExpr (HsHole (HoleParseError NoExtField, NoExtField))
= panic "rnExpr tried to rename a HoleParseError"
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -2882,7 +2882,7 @@ instance ExactPrint (HsExpr GhcPs) where
exact (HsHole (HoleVar an, NoExtField)) = do
case an of
Just (EpAnnHole (ob,cb) l) -> do
- ob' <- markEpToken ob
+ ob' <- markEpToken ob
l' <- markEpToken l
cb' <- markEpToken cb
return (HsHole (HoleVar (Just (EpAnnHole (ob',cb') l')), NoExtField))
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/06add9dbe979249856f7963c1986eb88c364003a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/06add9dbe979249856f7963c1986eb88c364003a
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/20250121/2e92f2da/attachment-0001.html>
More information about the ghc-commits
mailing list