[Git][ghc/ghc][master] EPA: Remove unnecessary XRec in CompleteMatchSig

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Wed Apr 10 09:42:20 UTC 2024



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
1b1a92bd by Alan Zimmerman at 2024-04-10T05:41:05-04:00
EPA: Remove unnecessary XRec in CompleteMatchSig

The XRec for [LIdP pass] is not needed for exact printing, remove it.

- - - - -


8 changed files:

- compiler/GHC/Hs/Binds.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Parser.y
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/ThToHs.hs
- compiler/Language/Haskell/Syntax/Binds.hs


Changes:

=====================================
compiler/GHC/Hs/Binds.hs
=====================================
@@ -853,7 +853,7 @@ ppr_sig (SCCFunSig (_, src) fn mlabel)
           GhcTc -> ppr fn
 ppr_sig (CompleteMatchSig (_, src) cs mty)
   = pragSrcBrackets src "{-# COMPLETE"
-      ((hsep (punctuate comma (map ppr_n (unLoc cs))))
+      ((hsep (punctuate comma (map ppr_n cs)))
         <+> opt_sig)
   where
     opt_sig = maybe empty ((\t -> dcolon <+> ppr t) . unLoc) mty
@@ -946,14 +946,6 @@ type instance Anno (HsBindLR (GhcPass idL) (GhcPass idR)) = SrcSpanAnnA
 type instance Anno (IPBind (GhcPass p)) = SrcSpanAnnA
 type instance Anno (Sig (GhcPass p)) = SrcSpanAnnA
 
--- For CompleteMatchSig
-type instance Anno [LocatedN RdrName] = SrcSpan
-type instance Anno [LocatedN Name]    = SrcSpan
-type instance Anno [LocatedN Id]      = SrcSpan
-
 type instance Anno (FixitySig (GhcPass p)) = SrcSpanAnnA
 
 type instance Anno StringLiteral = EpAnnCO
-type instance Anno (LocatedN RdrName) = SrcSpan
-type instance Anno (LocatedN Name) = SrcSpan
-type instance Anno (LocatedN Id) = SrcSpan


=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -1159,11 +1159,11 @@ repPhases (ActiveAfter _ i)  = do { MkC arg <- coreIntLit i
                                   ; dataCon' fromPhaseDataConName [arg] }
 repPhases _                  = dataCon allPhasesDataConName
 
-rep_complete_sig :: Located [LocatedN Name]
+rep_complete_sig :: [LocatedN Name]
                  -> Maybe (LocatedN Name)
                  -> SrcSpan
                  -> MetaM [(SrcSpan, Core (M TH.Dec))]
-rep_complete_sig (L _ cls) mty loc
+rep_complete_sig cls mty loc
   = do { mty' <- repMaybe nameTyConName lookupLOcc mty
        ; cls' <- repList nameTyConName lookupLOcc cls
        ; sig <- repPragComplete cls' mty'


=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -1812,9 +1812,8 @@ instance HiePass p => ToHie (SigContext (LocatedA (Sig (GhcPass p)))) where
           [ toHie $ (C Use) name
           , maybe (pure []) (locOnly . getLocA) mtxt
           ]
-        CompleteMatchSig _ (L ispan names) typ ->
-          [ locOnly ispan
-          , toHie $ map (C Use) names
+        CompleteMatchSig _ names typ ->
+          [ toHie $ map (C Use) names
           , toHie $ fmap (C Use) typ
           ]
         XSig _ -> []


=====================================
compiler/GHC/Parser.y
=====================================
@@ -3630,10 +3630,10 @@ con_list :: { Located (NonEmpty (LocatedN RdrName)) }
 con_list : con                  { sL1 $1 (pure $1) }
          | con ',' con_list     {% sLL $1 $> . (:| toList (unLoc $3)) <\$> addTrailingCommaN $1 (gl $2) }
 
-qcon_list :: { Located [LocatedN RdrName] }
-qcon_list : qcon                  { sL1 $1 [$1] }
+qcon_list :: { [LocatedN RdrName] }
+qcon_list : qcon                  { [$1] }
           | qcon ',' qcon_list    {% do { h <- addTrailingCommaN $1 (gl $2)
-                                        ; return (sLL $1 $> (h : unLoc $3)) }}
+                                        ; return (h : $3) }}
 
 -- See Note [ExplicitTuple] in GHC.Hs.Expr
 sysdcon_nolist :: { LocatedN DataCon }  -- Wired in data constructors


=====================================
compiler/GHC/Rename/Bind.hs
=====================================
@@ -1138,7 +1138,7 @@ renameSig ctxt sig@(SCCFunSig (_, st) v s)
 
 -- COMPLETE Sigs can refer to imported IDs which is why we use
 -- lookupLocatedOccRn rather than lookupSigOccRn
-renameSig _ctxt sig@(CompleteMatchSig (_, s) (L l bf) mty)
+renameSig _ctxt sig@(CompleteMatchSig (_, s) bf mty)
   = do new_bf <- traverse lookupLocatedOccRn bf
        new_mty  <- traverse lookupLocatedOccRn mty
 
@@ -1147,7 +1147,7 @@ renameSig _ctxt sig@(CompleteMatchSig (_, s) (L l bf) mty)
          -- Why 'any'? See Note [Orphan COMPLETE pragmas]
          addErrCtxt (text "In" <+> ppr sig) $ failWithTc TcRnOrphanCompletePragma
 
-       return (CompleteMatchSig (noAnn, s) (L l new_bf) new_mty, emptyFVs)
+       return (CompleteMatchSig (noAnn, s) new_bf new_mty, emptyFVs)
 
 
 {-


=====================================
compiler/GHC/Tc/Gen/Bind.hs
=====================================
@@ -227,7 +227,7 @@ tcCompleteSigs sigs =
       -- combinations are invalid it will be found so at match sites.
       -- There it is also where we consider if the type of the pattern match is
       -- compatible with the result type constructor 'mb_tc'.
-      doOne (L loc c@(CompleteMatchSig (_ext, _src_txt) (L _ ns) mb_tc_nm))
+      doOne (L loc c@(CompleteMatchSig (_ext, _src_txt) ns mb_tc_nm))
         = fmap Just $ setSrcSpanA loc $ addErrCtxt (text "In" <+> ppr c) $ do
             cls   <- mkUniqDSet <$> mapM (addLocM tcLookupConLike) ns
             mb_tc <- traverse @Maybe tcLookupLocatedTyCon mb_tc_nm


=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -952,7 +952,7 @@ cvtPragmaD (LineP line file)
        ; return Nothing
        }
 cvtPragmaD (CompleteP cls mty)
-  = do { cls'  <- wrapL $ mapM cNameN cls
+  = do { cls'  <- mapM cNameN cls
        ; mty'  <- traverse tconNameN mty
        ; returnJustLA $ Hs.SigD noExtField
                    $ CompleteMatchSig (noAnn, NoSourceText) cls' mty' }


=====================================
compiler/Language/Haskell/Syntax/Binds.hs
=====================================
@@ -487,7 +487,7 @@ data Sig pass
        -- complete matchings which, for example, arise from pattern
        -- synonym definitions.
   | CompleteMatchSig (XCompleteMatchSig pass)
-                     (XRec pass [LIdP pass])
+                     [LIdP pass]
                      (Maybe (LIdP pass))
   | XSig !(XXSig pass)
 



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1b1a92bd25c3f7249cf922c5dbf4415d2de44a36
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/20240410/4a7036ff/attachment-0001.html>


More information about the ghc-commits mailing list