[Git][ghc/ghc][wip/T18599-split-construct] Merge pbinds into fbinds
Shayne Fletcher
gitlab at gitlab.haskell.org
Mon Sep 7 22:04:46 UTC 2020
Shayne Fletcher pushed to branch wip/T18599-split-construct at Glasgow Haskell Compiler / GHC
Commits:
dde48b77 by Shayne Fletcher at 2020-09-07T18:03:59-04:00
Merge pbinds into fbinds
- - - - -
3 changed files:
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- record-dot-syntax-tests/Test.hs
Changes:
=====================================
compiler/GHC/Parser.y
=====================================
@@ -2723,7 +2723,6 @@ aexp1 :: { ECP }
$3 >>= \ $3 ->
amms (mkHsRecordPV dot (comb2 $1 $>) (comb2 $2 $4) $1 (snd $3))
(moc $2:mcc $4:(fst $3)) }
- | aexp1 '{' pbinds '}' {% runPV (unECP $1) >>= \ $1 -> fmap ecpFromExp $ applyFieldUpdates $1 $3 }
| aexp2 { $1 }
aexp2 :: { ECP }
@@ -3231,7 +3230,7 @@ fbinds1 :: { forall b. DisambECP b => PV ([AddAnn],([Fbind b], Maybe SrcSpan)) }
: fbind ',' fbinds1
{ $1 >>= \ $1 ->
$3 >>= \ $3 ->
- addAnnotation (gl (fbindToRecField $1)) AnnComma (gl $2) >>
+ -- addAnnotation (gl (fbindToRecField $1)) AnnComma (gl $2) >>
return (case $3 of (ma,(flds, dd)) -> (ma,($1 : flds, dd))) }
| fbind { $1 >>= \ $1 ->
return ([],([$1], Nothing)) }
@@ -3253,42 +3252,30 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) }
-- In the punning case, use a place-holder
-- The renamer fills in the final value
------------------------------------------------------------------------------
--- Nested updates (strictly expressions; patterns do not participate in updates).
-
-pbinds :: { [LHsExpr GhcPs -> LHsExpr GhcPs] }
- : pbinds1 { $1 }
-
-pbinds1 :: { [LHsExpr GhcPs -> LHsExpr GhcPs] }
- : pbind ',' pbinds1 { $1 : $3 }
- | pbind { [$1] }
-
-pbind :: { LHsExpr GhcPs -> LHsExpr GhcPs }
-- See Note [Whitespace-sensitive operator parsing] in Lexer.x
- : field TIGHT_INFIX_PROJ fieldToUpdate '=' texp
- {%do { ; let { top = $1 -- foo
- ; fields = top : reverse $3 -- [foo, bar, baz, quux]
- }
- ; arg <- runPV (unECP $5)
- ; return $ mkFieldUpdater fields arg
- }}
+ | field TIGHT_INFIX_PROJ fieldToUpdate '=' texp
+ { unECP $5 >>= \ $5 ->
+ mkHsFieldUpdaterPV ($1 : reverse $3) $5 >>= \ up ->
+ return $ Pbind up
+ }
+
-- See Note [Whitespace-sensitive operator parsing] in Lexer.x
- | field TIGHT_INFIX_PROJ fieldToUpdate
- {%do { ; recordPuns <- getBit RecordPunsBit
- ; if not recordPuns
- then do {
- ; addFatalError noSrcSpan $
- text "For this to work, enable NamedFieldPuns."
- }
- else do {
- ; let { ; top = $1 -- foo
- ; fields = top : reverse $3 -- [foo, bar, baz, quux]
- ; final = last fields -- quux
- ; arg = mkVar $ unpackFS (unLoc final)
- }
- ; return $ mkFieldUpdater fields arg
- }
- }}
+ | field TIGHT_INFIX_PROJ fieldToUpdate
+ { let { ; top = $1
+ ; fields = top : reverse $3
+ ; final = last fields }
+ in
+ getBit RecordPunsBit >>= \ puns ->
+ if puns
+ then
+ let arg = mkRdrUnqual . mkVarOcc . unpackFS . unLoc $ final in
+ mkHsVarPV (noLoc arg) >>= \ var ->
+ mkHsFieldUpdaterPV fields var >>= \ up ->
+ return $ Pbind up
+ else
+ addFatalError noSrcSpan $
+ text "For this to work, enable NamedFieldPuns."
+ }
fieldToUpdate :: { [Located FastString] }
fieldToUpdate
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -153,7 +153,7 @@ import Data.Kind ( Type )
#include "HsVersions.h"
data Fbind b =
- Fbind (LHsRecField GhcPs (Located b)) | Pbind (LHsExpr GhcPs -> LHsExpr GhcPs)
+ Fbind (LHsRecField GhcPs (Located b)) | Pbind (Located b -> Located b)
fbindToRecField :: Fbind b -> LHsRecField GhcPs (Located b)
fbindToRecField (Fbind f) = f
@@ -1392,6 +1392,8 @@ class b ~ (Body b) GhcPs => DisambECP b where
ecpFromCmd' :: LHsCmd GhcPs -> PV (Located b)
-- | Return an expression without ambiguity, or fail in a non-expression context.
ecpFromExp' :: LHsExpr GhcPs -> PV (Located b)
+ -- | This can only be satified by expressions.
+ mkHsFieldUpdaterPV :: [Located FastString] -> Located b -> PV (Located b -> Located b)
-- | Disambiguate "\... -> ..." (lambda)
mkHsLamPV :: SrcSpan -> MatchGroup GhcPs (Located b) -> PV (Located b)
-- | Disambiguate "let ... in ..."
@@ -1519,6 +1521,9 @@ instance DisambECP (HsCmd GhcPs) where
type Body (HsCmd GhcPs) = HsCmd
ecpFromCmd' = return
ecpFromExp' (L l e) = cmdFail l (ppr e)
+ mkHsFieldUpdaterPV _ _ =
+ cmdFail (noSrcSpan) $
+ text "Trying to make a field update in a command context"
mkHsLamPV l mg = return $ L l (HsCmdLam noExtField mg)
mkHsLetPV l bs e = return $ L l (HsCmdLet noExtField bs e)
type InfixOp (HsCmd GhcPs) = HsExpr GhcPs
@@ -1582,6 +1587,7 @@ instance DisambECP (HsExpr GhcPs) where
nest 2 (ppr c) ]
return (L l hsHoleExpr)
ecpFromExp' = return
+ mkHsFieldUpdaterPV fields arg = return $ mkFieldUpdater fields arg
mkHsLamPV l mg = return $ L l (HsLam noExtField mg)
mkHsLetPV l bs c = return $ L l (HsLet noExtField bs c)
type InfixOp (HsExpr GhcPs) = HsExpr GhcPs
@@ -1669,6 +1675,9 @@ instance DisambECP (PatBuilder GhcPs) where
ecpFromExp' (L l e) =
addFatalError l $
text "Expression syntax in pattern:" <+> ppr e
+ mkHsFieldUpdaterPV _ _ =
+ addFatalError noSrcSpan $
+ text "Trying to make a field update in a pattern context"
mkHsLamPV l _ = addFatalError l $
text "Lambda-syntax in pattern." $$
text "Pattern matching on functions is not possible."
=====================================
record-dot-syntax-tests/Test.hs
=====================================
@@ -112,5 +112,4 @@ main = do
g <- pure a
print $ c{f} -- 42, 1
print $ c{f, g} -- 42, 42
- -- print $ c{f, g.foo.bar.baz.quux = 4} -- Can't mix top-level and nested updates (limitation of this prototype).
- print $ c{f}{g.foo.bar.baz.quux = 4} -- Workaround; 42, 4
+ print $ c{f, g.foo.bar.baz.quux = 4} -- Can now mix top-level and nested updates!
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dde48b77356c548c6d625344946725f02e8518a6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dde48b77356c548c6d625344946725f02e8518a6
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/20200907/5d43b1cb/attachment-0001.html>
More information about the ghc-commits
mailing list