[Git][ghc/ghc][wip/az/ghc-9.10-backports-1] EPA: Provide correct span for PatBind

Alan Zimmerman (@alanz) gitlab at gitlab.haskell.org
Sun Apr 21 11:39:55 UTC 2024



Alan Zimmerman pushed to branch wip/az/ghc-9.10-backports-1 at Glasgow Haskell Compiler / GHC


Commits:
7d6ae7aa by Alan Zimmerman at 2024-04-21T11:39:48+01:00
EPA: Provide correct span for PatBind

And remove unused parameter in checkPatBind

Contributes to #24669

(cherry picked from commit c90c60390aa3949b400f26ee0534273c56e19005)

- - - - -


6 changed files:

- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/ThToHs.hs
- testsuite/tests/linear/should_fail/LinearLet6.stderr
- testsuite/tests/linear/should_fail/LinearLet7.stderr


Changes:

=====================================
compiler/GHC/Hs/Binds.hs
=====================================
@@ -116,7 +116,7 @@ type instance XFunBind    (GhcPass pL) GhcTc = (HsWrapper, [CoreTickish])
 -- type         Int -> forall a'. a' -> a'
 -- Notice that the coercion captures the free a'.
 
-type instance XPatBind    GhcPs (GhcPass pR) = [AddEpAnn]
+type instance XPatBind    GhcPs (GhcPass pR) = NoExtField
 type instance XPatBind    GhcRn (GhcPass pR) = NameSet -- See Note [Bind free vars]
 type instance XPatBind    GhcTc (GhcPass pR) =
     ( Type                  -- Type of the GRHSs


=====================================
compiler/GHC/Parser.y
=====================================
@@ -2585,7 +2585,7 @@ decl_no_th :: { LHsDecl GhcPs }
                                           ; !cs <- getCommentsFor l
                                           ; return $! (sL (commentsA l cs) $ ValD noExtField r) } }
         | PREFIX_PERCENT atype infixexp     opt_sig rhs  {% runPV (unECP $3) >>= \ $3 ->
-                                       do { let { l = comb2 $3 $> }
+                                       do { let { l = comb2 $1 $> }
                                           ; r <- checkValDef l $3 (mkMultAnn (epTok $1) $2, $4) $5;
                                         -- parses bindings of the form %p x or
                                         -- %p x :: sig


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1323,7 +1323,7 @@ checkValDef loc lhs (mult, Just (sigAnn, sig)) grhss
         -- x :: ty = rhs  parses as a *pattern* binding
   = do lhs' <- runPV $ mkHsTySigPV (combineLocsA lhs sig) lhs sig [sigAnn]
                         >>= checkLPat
-       checkPatBind loc [] lhs' grhss mult
+       checkPatBind loc lhs' grhss mult
 
 checkValDef loc lhs (mult_ann, Nothing) grhss
   | HsNoMultAnn{} <- mult_ann
@@ -1334,12 +1334,12 @@ checkValDef loc lhs (mult_ann, Nothing) grhss
                            fun is_infix pats grhss
             Nothing -> do
               lhs' <- checkPattern lhs
-              checkPatBind loc [] lhs' grhss mult_ann }
+              checkPatBind loc lhs' grhss mult_ann }
 
 checkValDef loc lhs (mult_ann, Nothing) ghrss
         -- %p x = rhs  parses as a *pattern* binding
   = do lhs' <- checkPattern lhs
-       checkPatBind loc [] lhs' ghrss mult_ann
+       checkPatBind loc lhs' ghrss mult_ann
 
 checkFunBind :: SrcStrictness
              -> SrcSpan
@@ -1377,15 +1377,14 @@ makeFunBind fn ms
 
 -- See Note [FunBind vs PatBind]
 checkPatBind :: SrcSpan
-             -> [AddEpAnn]
              -> LPat GhcPs
              -> Located (GRHSs GhcPs (LHsExpr GhcPs))
              -> HsMultAnn GhcPs
              -> P (HsBind GhcPs)
-checkPatBind loc annsIn (L _ (BangPat ans (L _ (VarPat _ v))))
+checkPatBind loc (L _ (BangPat ans (L _ (VarPat _ v))))
                         (L _match_span grhss) (HsNoMultAnn _)
       = return (makeFunBind v (L (noAnnSrcSpan loc)
-                [L (noAnnSrcSpan loc) (m (ans++annsIn) v)]))
+                [L (noAnnSrcSpan loc) (m ans v)]))
   where
     m a v = Match { m_ext = a
                   , m_ctxt = FunRhs { mc_fun    = v
@@ -1394,8 +1393,8 @@ checkPatBind loc annsIn (L _ (BangPat ans (L _ (VarPat _ v))))
                   , m_pats = []
                  , m_grhss = grhss }
 
-checkPatBind _loc annsIn lhs (L _ grhss) mult = do
-  return (PatBind annsIn lhs mult grhss)
+checkPatBind _loc lhs (L _ grhss) mult = do
+  return (PatBind noExtField lhs mult grhss)
 
 
 checkValSigLhs :: LHsExpr GhcPs -> P (LocatedN RdrName)


=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -218,7 +218,7 @@ cvtDec (TH.ValD pat body ds)
         ; returnJustLA $ Hs.ValD noExtField $
           PatBind { pat_lhs = pat'
                   , pat_rhs = GRHSs emptyComments body' ds'
-                  , pat_ext = noAnn
+                  , pat_ext = noExtField
                   , pat_mult = HsNoMultAnn noExtField
                   } }
 


=====================================
testsuite/tests/linear/should_fail/LinearLet6.stderr
=====================================
@@ -13,7 +13,7 @@ LinearLet6.hs:10:3: error: [GHC-18872]
             where
                 (Just y) = x
 
-LinearLet6.hs:15:14: error: [GHC-18872]
+LinearLet6.hs:15:11: error: [GHC-18872]
     • Couldn't match type ‘Many’ with ‘One’
         arising from a non-linear pattern ‘Just y’
           (non-variable lazy pattern aren't linear)


=====================================
testsuite/tests/linear/should_fail/LinearLet7.stderr
=====================================
@@ -1,14 +1,14 @@
 
-LinearLet7.hs:6:14: error: [GHC-18872]
+LinearLet7.hs:6:11: error: [GHC-18872]
     • Couldn't match type ‘Many’ with ‘One’
-        arising from multiplicity of ‘g’
-    • In a pattern binding: g = \ y -> g y
-      In the expression: let %1 g = \ y -> ... in g x
+        arising from a non-linear pattern ‘_’
+          (non-variable pattern bindings that have been generalised aren't linear)
+    • In the expression: let %1 g = \ y -> ... in g x
       In an equation for ‘f’: f x = let %1 g = ... in g x
 
 LinearLet7.hs:6:14: error: [GHC-18872]
     • Couldn't match type ‘Many’ with ‘One’
-        arising from a non-linear pattern ‘_’
-          (non-variable pattern bindings that have been generalised aren't linear)
-    • In the expression: let %1 g = \ y -> ... in g x
+        arising from multiplicity of ‘g’
+    • In a pattern binding: g = \ y -> g y
+      In the expression: let %1 g = \ y -> ... in g x
       In an equation for ‘f’: f x = let %1 g = ... in g x



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7d6ae7aa4def7131d281040e6b0e600f84cd1bb2
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/20240421/6b392941/attachment-0001.html>


More information about the ghc-commits mailing list