[Git][ghc/ghc][wip/az/ghc-9.10-backports-1] 2 commits: EPA: Fix comments in mkListSyntaxTy0

Alan Zimmerman (@alanz) gitlab at gitlab.haskell.org
Mon Apr 15 19:17:28 UTC 2024



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


Commits:
62235c07 by Alan Zimmerman at 2024-04-15T19:52:13+01:00
EPA: Fix comments in mkListSyntaxTy0

- - - - -
86062534 by Alan Zimmerman at 2024-04-15T20:13:45+01:00
EPA: Provide correct span for PatBind

And remove unused paramater in checkPatBind

- - - - -


7 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
- testsuite/tests/printer/AnnotationNoListTuplePuns.hs


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)
@@ -3318,12 +3317,12 @@ withCombinedComments ::
   HasLoc l2 =>
   l1 ->
   l2 ->
-  (SrcSpan -> EpAnnComments -> P a) ->
+  (SrcSpan -> P a) ->
   P (LocatedA a)
 withCombinedComments start end use = do
   cs <- getCommentsFor fullSpan
-  a <- use fullSpan cs
-  pure (L (noAnnSrcSpan fullSpan) a)
+  a <- use fullSpan
+  pure (L (EpAnn (spanAsAnchor fullSpan) noAnn cs) a)
   where
     fullSpan = combineSrcSpans (getHasLoc start) (getHasLoc end)
 
@@ -3363,15 +3362,14 @@ mkTupleSyntaxTycon boxity n =
 mkListSyntaxTy0 :: EpaLocation
                 -> EpaLocation
                 -> SrcSpan
-                -> EpAnnComments
                 -> P (HsType GhcPs)
-mkListSyntaxTy0 brkOpen brkClose span comments =
+mkListSyntaxTy0 brkOpen brkClose span =
   punsIfElse enabled disabled
   where
     enabled = HsTyVar noAnn NotPromoted rn
 
     -- attach the comments only to the RdrName since it's the innermost AST node
-    rn = L (EpAnn fullLoc rdrNameAnn comments) listTyCon_RDR
+    rn = L (EpAnn fullLoc rdrNameAnn emptyComments) listTyCon_RDR
 
     disabled =
       HsExplicitListTy annsKeyword NotPromoted []


=====================================
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


=====================================
testsuite/tests/printer/AnnotationNoListTuplePuns.hs
=====================================
@@ -1,17 +1,18 @@
 {-# language NoListTuplePuns #-}
+{-# OPTIONS -ddump-parsed-ast #-}
 module AnnotationNoListTuplePuns where
 
 type A =
-  -- comment pre
+  -- comment pre A
   [
-    -- comment inside
+    -- comment inside A
   ]
-  -- comment post
+  -- comment post A
 
 type B =
-  -- comment pre
+  -- comment pre B
   [
-    -- comment inside
+    -- comment inside B
     Bool
   ]
-  -- comment post
+  -- comment post B



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ced4814d9a5039f35c533dac02060621e43432ab...86062534289a04184bdd6768dc0c5031713873cf

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ced4814d9a5039f35c533dac02060621e43432ab...86062534289a04184bdd6768dc0c5031713873cf
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/20240415/0cdce686/attachment-0001.html>


More information about the ghc-commits mailing list