[Git][ghc/ghc][wip/T18599] Switch to do notation; restablish getBit check

[Shayne Fletcher]

Shayne Fletcher pushed to branch wip/T18599 at Glasgow Haskell Compiler / GHC


Commits:
56062acf by Shayne Fletcher at 2020-09-08T12:25:10-04:00
Switch to do notation; restablish getBit check

- - - - -


2 changed files:

- compiler/GHC/Parser.y
- record-dot-syntax-tests/Test.hs


Changes:

=====================================
compiler/GHC/Parser.y
=====================================
@@ -2717,13 +2717,13 @@ aexp    :: { ECP }
         | aexp1                 { $1 }
 
 aexp1   :: { ECP }
-        : aexp1 '{' fbinds '}' {% getBit RecordDotSyntaxBit >>= \ dot ->
-                                  return (ECP $
-                                    unECP $1 >>= \ $1 ->
-                                    $3 >>= \ $3 ->
-                                    amms (mkHsRecordPV dot (comb2 $1 $>) (comb2 $2 $4) $1 (snd $3))
-                                         (moc $2:mcc $4:(fst $3))
-                                  ) }
+        : aexp1 '{' fbinds '}' { ECP $
+                                   getBit RecordDotSyntaxBit >>= \ dot ->
+                                   unECP $1 >>= \ $1 ->
+                                   $3 >>= \ $3 ->
+                                   amms (mkHsRecordPV dot (comb2 $1 $>) (comb2 $2 $4) $1 (snd $3))
+                                        (moc $2:mcc $4:(fst $3))
+                               }
         | aexp2                { $1 }
 
 aexp2   :: { ECP }
@@ -3254,18 +3254,25 @@ fbind   :: { forall b. DisambECP b => PV (Fbind b) }
 
         -- See Note [Whitespace-sensitive operator parsing] in Lexer.x
         | field TIGHT_INFIX_PROJ fieldToUpdate '=' texp
-           { unECP $5 >>= \ $5 ->
-             fmap Pbind $ mkHsFieldUpdaterPV ($1 : reverse $3) $5
+           {do
+              $5 <- unECP $5
+              fmap Pbind $ mkHsFieldUpdaterPV ($1 : reverse $3) $5
            }
 
         -- See Note [Whitespace-sensitive operator parsing] in Lexer.x
         | field TIGHT_INFIX_PROJ fieldToUpdate
-           { let { ; top = $1
-                   ; fields = top : reverse $3
-                   ; final = last fields } in
-             mkHsVarPV (noLoc (mkRdrUnqual . mkVarOcc . unpackFS . unLoc $ final)) >>= \ var ->
-             fmap Pbind (mkHsFieldUpdaterPV fields var)
-          }
+           {do
+              let top = $1
+                  fields = top : reverse $3
+                  final = last fields
+                  (l, fieldName) = (getLoc final, unLoc final)
+              puns <- getBit RecordPunsBit
+              when (not puns) $
+                addError (comb2 top final) $
+                  text "For this to work, enable NamedFieldPuns."
+              var <- mkHsVarPV (L l (mkRdrUnqual . mkVarOcc . unpackFS $ fieldName))
+              fmap Pbind $ mkHsFieldUpdaterPV fields var
+           }
 
 fieldToUpdate :: { [Located FastString] }
 fieldToUpdate


=====================================
record-dot-syntax-tests/Test.hs
=====================================
@@ -112,4 +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 now mix top-level and nested updates!
+  print $ c{f, g.foo.bar.baz.quux = 4} -- Can now mix top-level and nested updates!; 42, 4



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56062acfffa78cb9dc78e052a62b360c1dff5d82

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56062acfffa78cb9dc78e052a62b360c1dff5d82
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/20200908/a8c6b74f/attachment-0001.html>