[Git][ghc/ghc][wip/match-datatype] Use original location info from ConPats

David (@knothed) gitlab at gitlab.haskell.org
Thu Jul 6 08:51:16 UTC 2023



David pushed to branch wip/match-datatype at Glasgow Haskell Compiler / GHC


Commits:
d51b023a by David Knothe at 2023-07-06T10:51:11+02:00
Use original location info from ConPats

- - - - -


1 changed file:

- compiler/GHC/HsToCore/Match/Constructor.hs


Changes:

=====================================
compiler/GHC/HsToCore/Match/Constructor.hs
=====================================
@@ -164,7 +164,7 @@ matchOneConLike vars ty mult (eqn1 :| eqns)   -- All eqns for a single construct
                        return ( wrapBinds (tvs `zip` tvs1)
                               . wrapBinds (ds  `zip` dicts1)
                               . mkCoreLets ds_bind
-                              , prependEqn (map (L (SrcSpanAnn EpAnnNotUsed generatedSrcSpan)) $ conArgPats val_arg_tys args) rest
+                              , prependEqn (conArgPats val_arg_tys args) rest
                               )
               shift (_, eqn) = pprPanic "matchOneCon/shift" (ppr eqn)
         ; let scaled_arg_tys = map (scaleScaled mult) val_arg_tys
@@ -256,14 +256,14 @@ conArgPats :: [Scaled Type]-- Instantiated argument types
                           -- Used only to fill in the types of WildPats, which
                           -- are probably never looked at anyway
            -> ConArgPats
-           -> [Pat GhcTc]
-conArgPats _arg_tys (PrefixCon _ ps) = map unLoc ps
-conArgPats _arg_tys (InfixCon p1 p2) = [unLoc p1, unLoc p2]
+           -> [LPat GhcTc]
+conArgPats _arg_tys (PrefixCon _ ps) = ps
+conArgPats _arg_tys (InfixCon p1 p2) = [p1, p2]
 conArgPats  arg_tys (RecCon (HsRecFields { rec_flds = rpats }))
-  | null rpats = map WildPat (map scaledThing arg_tys)
+  | null rpats = map (L (SrcSpanAnn EpAnnNotUsed generatedSrcSpan) . WildPat . scaledThing) arg_tys
         -- Important special case for C {}, which can be used for a
         -- datacon that isn't declared to have fields at all
-  | otherwise  = map (unLoc . hfbRHS . unLoc) rpats
+  | otherwise  = map (hfbRHS . unLoc) rpats
 
 {-
 Note [Record patterns]



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d51b023a7def9ff32528c3681e9646f675347633
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/20230706/70682bee/attachment-0001.html>


More information about the ghc-commits mailing list