[Git][ghc/ghc][wip/T18599] Improve location handling

[Shayne Fletcher]

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


Commits:
c4cc6282 by Shayne Fletcher at 2020-09-08T17:25:00-04:00
Improve location handling

- - - - -


2 changed files:

- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs


Changes:

=====================================
compiler/GHC/Parser.y
=====================================
@@ -3256,7 +3256,7 @@ fbind   :: { forall b. DisambECP b => PV (Fbind b) }
         | field TIGHT_INFIX_PROJ fieldToUpdate '=' texp
            {do
               $5 <- unECP $5
-              fmap Pbind $ mkHsFieldUpdaterPV ($1 : reverse $3) $5
+              fmap Pbind $ mkHsFieldUpdaterPV (comb2 $1 $5) ($1 : reverse $3) $5
            }
 
         -- See Note [Whitespace-sensitive operator parsing] in Lexer.x
@@ -3265,13 +3265,13 @@ fbind   :: { forall b. DisambECP b => PV (Fbind b) }
               let top = $1
                   fields = top : reverse $3
                   final = last fields
-                  (l, fieldName) = (getLoc final, unLoc final)
+                  l = comb2 top final
               puns <- getBit RecordPunsBit
               when (not puns) $
-                addError (comb2 top final) $
+                addError l $
                   text "For this to work, enable NamedFieldPuns."
-              var <- mkHsVarPV (L l (mkRdrUnqual . mkVarOcc . unpackFS $ fieldName))
-              fmap Pbind $ mkHsFieldUpdaterPV fields var
+              var <- mkHsVarPV (noLoc (mkRdrUnqual . mkVarOcc . unpackFS . unLoc $ final))
+              fmap Pbind $ mkHsFieldUpdaterPV l fields var
            }
 
 fieldToUpdate :: { [Located FastString] }


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -19,7 +19,7 @@
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 
 module GHC.Parser.PostProcess (
-        mkApp, mkGet, mkVar, mkFieldUpdater, mkProj, isGet, applyFieldUpdates, Fbind(..), fbindToRecField, -- RecordDot
+        mkApp, mkGet, mkVar, mkFieldUpdater, mkProj, isGet, applyFieldUpdates, Fbind(..), -- RecordDot
         mkHsOpApp,
         mkHsIntegral, mkHsFractional, mkHsIsString,
         mkHsDo, mkSpliceDecl,
@@ -1393,7 +1393,7 @@ class b ~ (Body b) GhcPs => DisambECP b where
   -- | 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)
+  mkHsFieldUpdaterPV :: SrcSpan -> [Located FastString] -> Located b -> PV (Located b -> Located b)
   -- | Disambiguate "\... -> ..." (lambda)
   mkHsLamPV :: SrcSpan -> MatchGroup GhcPs (Located b) -> PV (Located b)
   -- | Disambiguate "let ... in ..."
@@ -1521,9 +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"
+  mkHsFieldUpdaterPV l _ _ =
+    cmdFail l $
+    text "Field update syntax is not supported in commands."
   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
@@ -1587,7 +1587,7 @@ instance DisambECP (HsExpr GhcPs) where
         nest 2 (ppr c) ]
     return (L l hsHoleExpr)
   ecpFromExp' = return
-  mkHsFieldUpdaterPV fields arg = return $ mkFieldUpdater fields arg
+  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
@@ -1675,9 +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"
+  mkHsFieldUpdaterPV l _ _ =
+    addFatalError l $
+    text "Field update syntax is not supported in patterns."
   mkHsLamPV l _ = addFatalError l $
     text "Lambda-syntax in pattern." $$
     text "Pattern matching on functions is not possible."



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4cc62822e903ebbc1b2c582fa31d2abe315b7b7
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/36a2be36/attachment-0001.html>