[Git][ghc/ghc][wip/T18599] Add Projection syntax
Shayne Fletcher
gitlab at gitlab.haskell.org
Sun Oct 25 19:59:19 UTC 2020
Shayne Fletcher pushed to branch wip/T18599 at Glasgow Haskell Compiler / GHC
Commits:
d27f241b by Shayne Fletcher at 2020-10-25T15:57:56-04:00
Add Projection syntax
Add case `Projection` to `HsExpr` for record selectors.
- - - - -
10 changed files:
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Extension.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Types/Origin.hs
Changes:
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -457,9 +457,10 @@ data HsExpr p
-- For a type family, the arg types are of the *instance* tycon,
-- not the family tycon
- -- | Record projections
+ -- | Record field selection.
+ -- Expressions of these cases arise only when the RecordDotSyntax
+ -- langauge extensions is enabled.
- -- A get_field @fIELD arg expression.
-- e.g. z.x = GetField {
-- gf_ext=noExtField, gf_expr=z, gf_fIELD=x, gf_getField = getField @"x" z
-- }.
@@ -469,9 +470,24 @@ data HsExpr p
, gf_fIELD :: Located FastString
, gf_getField :: LHsExpr p -- Equivalent 'getField' term.
}
- -- Expressions of this case only arise when the RecordDotSyntax
+
+ -- | Record field selector.
+ -- Expressions of these cases arise only when the RecordDotSyntax
-- langauge extensions is enabled.
+ -- e.g. .x = Projection {
+ -- proj_ext=noExtField, proj_rhs=Nothing, proj_fIELD=x, proj_projection = \z -> z.x
+ -- },
+ -- .x.y = Projection {
+ -- proj_ext=noExtField, proj_rhs=Just .x, proj_fIELD=y, proj_projection = (\z -> z.y) . (\z -> z.x)
+ -- }
+ | Projection
+ { proj_ext :: XProjection p
+ , proj_rhs :: Maybe (LHsExpr p)
+ , proj_fIELD :: Located FastString
+ , proj_projection :: LHsExpr p -- Equivalent 'getField' term.
+ }
+
-- | Expression with an explicit type signature. @e :: type@
--
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon'
@@ -595,8 +611,8 @@ data RecordUpdTc = RecordUpdTc
, rupd_wrap :: HsWrapper -- See note [Record Update HsWrapper]
}
--- | Extra data fields for a 'GetField', added by the type checker
data GetFieldTc = GetFieldTc
+data ProjectionTc = ProjectionTc
-- | HsWrap appears only in typechecker output
-- Invariant: The contained Expr is *NOT* itself an HsWrap.
@@ -670,6 +686,10 @@ type instance XGetField GhcPs = NoExtField
type instance XGetField GhcRn = NoExtField
type instance XGetField GhcTc = NoExtField
+type instance XProjection GhcPs = NoExtField
+type instance XProjection GhcRn = NoExtField
+type instance XProjection GhcTc = NoExtField
+
type instance XExprWithTySig (GhcPass _) = NoExtField
type instance XArithSeq GhcPs = NoExtField
@@ -1218,6 +1238,11 @@ ppr_expr (RecordUpd { rupd_expr = L _ aexp, rupd_flds = rbinds })
ppr_expr (GetField { gf_expr = L _ fexp, gf_fIELD = field, gf_getField = _})
= ppr fexp <> dot <> ppr field
+ppr_expr (Projection { proj_rhs = maybeRhs, proj_fIELD = field, proj_projection = _})
+ = case maybeRhs of
+ Nothing -> dot <> ppr field
+ Just e -> ppr e <> dot <> ppr field
+
ppr_expr (ExprWithTySig _ expr sig)
= hang (nest 2 (ppr_lexpr expr) <+> dcolon)
4 (ppr sig)
@@ -1346,6 +1371,7 @@ hsExprNeedsParens p = go
go (NegApp{}) = p > topPrec
go (SectionL{}) = True
go (SectionR{}) = True
+ go (Projection{}) = True
go (ExplicitTuple{}) = False
go (ExplicitSum{}) = False
go (HsLam{}) = p > topPrec
=====================================
compiler/GHC/Hs/Extension.hs
=====================================
@@ -556,6 +556,7 @@ type family XExplicitList x
type family XRecordCon x
type family XRecordUpd x
type family XGetField x
+type family XProjection x
type family XExprWithTySig x
type family XArithSeq x
type family XBracket x
=====================================
compiler/GHC/Hs/Instances.hs
=====================================
@@ -346,6 +346,7 @@ deriving instance Data (ArithSeqInfo GhcTc)
deriving instance Data RecordConTc
deriving instance Data RecordUpdTc
deriving instance Data GetFieldTc
+deriving instance Data ProjectionTc
deriving instance Data CmdTopTc
deriving instance Data PendingRnSplice
deriving instance Data PendingTcSplice
=====================================
compiler/GHC/HsToCore/Expr.hs
=====================================
@@ -272,6 +272,7 @@ dsExpr (HsOverLabel{}) = panic "dsExpr: HsOverLabel"
-- I feel these should have been eliminated by their equivalent
-- getField expressions by now.
dsExpr (GetField{}) = panic "dsExpr: GetField"
+dsExpr (Projection{}) = panic "dsExpr: Projection"
dsExpr (HsLit _ lit)
= do { warnAboutOverflowedLit lit
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -1165,6 +1165,9 @@ instance HiePass p => ToHie (Located (HsExpr (GhcPass p))) where
GetField _ expr _ _ ->
[ toHie expr
]
+ Projection _ maybeExpr _ _ ->
+ [ toHie maybeExpr
+ ]
XExpr x
| GhcTc <- ghcPass @p
, WrapExpr (HsWrap w a) <- x
=====================================
compiler/GHC/Parser.y
=====================================
@@ -2807,8 +2807,10 @@ aexp2 :: { ECP }
projection :: { LHsExpr GhcPs }
projection
-- See Note [Whitespace-sensitive operator parsing] in GHC.Parsing.Lexer
- : projection TIGHT_INFIX_PROJ field { mkProj (Just $1) $3 }
- | PREFIX_PROJ field { mkProj Nothing $2 }
+ : projection TIGHT_INFIX_PROJ field
+ {% ams (mkProjection (comb3 $1 $2 $3) (Just $1) $3) [mj AnnDot $2] }
+ | PREFIX_PROJ field
+ {% ams (mkProjection (comb2 $1 $2) Nothing $2) [mj AnnDot $1] }
splice_exp :: { LHsExpr GhcPs }
: splice_untyped { mapLoc (HsSpliceE noExtField) $1 }
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -19,7 +19,7 @@
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module GHC.Parser.PostProcess (
- mkGetField, mkFieldUpdater, mkProj, isGetField, Fbind(..), -- RecordDot
+ mkGetField, mkProjection, mkFieldUpdater, mkProj, isGetField, Fbind(..), -- RecordDot
mkHsOpApp,
mkHsIntegral, mkHsFractional, mkHsIsString,
mkHsDo, mkSpliceDecl,
@@ -3006,6 +3006,15 @@ mkGetField loc arg fIELD =
, gf_getField = mkGet arg fIELD
}
+mkProjection :: SrcSpan -> Maybe (LHsExpr GhcPs) -> Located FastString -> LHsExpr GhcPs
+mkProjection loc maybeRhs fIELD =
+ L loc Projection {
+ proj_ext = noExtField
+ , proj_rhs = maybeRhs
+ , proj_fIELD = fIELD
+ , proj_projection = mkProj maybeRhs fIELD
+ }
+
-- mkSet a fIELD b calculates a set_field @fIELD expression.
-- e.g mkSet a fIELD b = set_field @"fIELD" a b (read as "set field 'fIELD' on a to b").
mkSet :: LHsExpr GhcPs -> Located FastString -> LHsExpr GhcPs -> LHsExpr GhcPs
=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -218,6 +218,16 @@ rnExpr (GetField x e f g)
; return (GetField x e' f g', fv)
}
+rnExpr (Projection x e f p)
+ = do { e' <- case e of
+ Nothing -> pure Nothing
+ Just expr -> do
+ (e', _) <- rnLExpr expr
+ pure (Just e')
+ ; (p', fv) <- rnLExpr p
+ ; return (Projection x e' f p', fv)
+ }
+
------------------------------------------
-- Template Haskell extensions
rnExpr e@(HsBracket _ br_body) = rnBracket e br_body
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -1037,6 +1037,7 @@ tcExpr (ArithSeq _ witness seq) res_ty
************************************************************************
-}
tcExpr (GetField _ _ _ (L _ g)) res_ty = tcExpr g res_ty
+tcExpr (Projection _ _ _ (L _ p)) res_ty = tcExpr p res_ty
{-
************************************************************************
=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -500,6 +500,7 @@ exprCtOrigin (OpApp _ _ op _) = lexprCtOrigin op
exprCtOrigin (NegApp _ e _) = lexprCtOrigin e
exprCtOrigin (HsPar _ e) = lexprCtOrigin e
exprCtOrigin (GetField _ e _ _) = lexprCtOrigin e
+exprCtOrigin (Projection _ _ _ _) = SectionOrigin
exprCtOrigin (SectionL _ _ _) = SectionOrigin
exprCtOrigin (SectionR _ _ _) = SectionOrigin
exprCtOrigin (ExplicitTuple {}) = Shouldn'tHappenOrigin "explicit tuple"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d27f241b3ae8df2ccc5238768be5caa3608d8496
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d27f241b3ae8df2ccc5238768be5caa3608d8496
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/20201025/f30b473f/attachment-0001.html>
More information about the ghc-commits
mailing list