summaryrefslogtreecommitdiff
path: root/compiler/GHC/ThToHs.hs
diff options
context:
space:
mode:
authorJohn Ericson <git@JohnEricson.me>2020-01-25 15:46:07 -0500
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-04-23 18:32:43 -0400
commitc42754d5fdd3c2db554d9541bab22d1b3def4be7 (patch)
treeeea28083a89e73b8e08a0d2387eaff19ecf05f13 /compiler/GHC/ThToHs.hs
parent5946c85abcf66555cdbcd3eed02cb8f512b6110c (diff)
downloadhaskell-c42754d5fdd3c2db554d9541bab22d1b3def4be7.tar.gz
Trees That Grow refactor for `ConPat` and `CoPat`
- `ConPat{In,Out}` -> `ConPat` - `CoPat` -> `XPat (CoPat ..)` Note that `GHC.HS.*` still uses `HsWrap`, but only when `p ~ GhcTc`. After this change, moving the type family instances out of `GHC.HS.*` is sufficient to break the cycle. Add XCollectPat class to decide how binders are collected from XXPat based on the pass. Previously we did this with IsPass, but that doesn't work for Haddock's DocNameI, and the constraint doesn't express what actual distinction is being made. Perhaps a class for collecting binders more generally is in order, but we haven't attempted this yet. Pure refactor of code around ConPat - InPat/OutPat synonyms removed - rename several identifiers - redundant constraints removed - move extension field in ConPat to be first - make ConPat use record syntax more consistently Fix T6145 (ConPatIn became ConPat) Add comments from SPJ. Add comment about haddock's use of CollectPass. Updates haddock submodule.
Diffstat (limited to 'compiler/GHC/ThToHs.hs')
-rw-r--r--compiler/GHC/ThToHs.hs33
1 files changed, 26 insertions, 7 deletions
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 7b5e4ce219..622ab13403 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -1268,12 +1268,22 @@ cvtp (UnboxedSumP p alt arity)
; return $ SumPat noExtField p' alt arity }
cvtp (ConP s ps) = do { s' <- cNameL s; ps' <- cvtPats ps
; let pps = map (parenthesizePat appPrec) ps'
- ; return $ ConPatIn s' (PrefixCon pps) }
+ ; return $ ConPat
+ { pat_con_ext = noExtField
+ , pat_con = s'
+ , pat_args = PrefixCon pps
+ }
+ }
cvtp (InfixP p1 s p2) = do { s' <- cNameL s; p1' <- cvtPat p1; p2' <- cvtPat p2
; wrapParL (ParPat noExtField) $
- ConPatIn s' $
- InfixCon (parenthesizePat opPrec p1')
- (parenthesizePat opPrec p2') }
+ ConPat
+ { pat_con_ext = NoExtField
+ , pat_con = s'
+ , pat_args = InfixCon
+ (parenthesizePat opPrec p1')
+ (parenthesizePat opPrec p2')
+ }
+ }
-- See Note [Operator association]
cvtp (UInfixP p1 s p2) = do { p1' <- cvtPat p1; cvtOpAppP p1' s p2 } -- Note [Converting UInfix]
cvtp (ParensP p) = do { p' <- cvtPat p;
@@ -1286,8 +1296,12 @@ cvtp (TH.AsP s p) = do { s' <- vNameL s; p' <- cvtPat p
; return $ AsPat noExtField s' p' }
cvtp TH.WildP = return $ WildPat noExtField
cvtp (RecP c fs) = do { c' <- cNameL c; fs' <- mapM cvtPatFld fs
- ; return $ ConPatIn c'
- $ Hs.RecCon (HsRecFields fs' Nothing) }
+ ; return $ ConPat
+ { pat_con_ext = noExtField
+ , pat_con = c'
+ , pat_args = Hs.RecCon $ HsRecFields fs' Nothing
+ }
+ }
cvtp (ListP ps) = do { ps' <- cvtPats ps
; return
$ ListPat noExtField ps'}
@@ -1317,7 +1331,12 @@ cvtOpAppP x op1 (UInfixP y op2 z)
cvtOpAppP x op y
= do { op' <- cNameL op
; y' <- cvtPat y
- ; return (ConPatIn op' (InfixCon x y')) }
+ ; return $ ConPat
+ { pat_con_ext = noExtField
+ , pat_con = op'
+ , pat_args = InfixCon x y'
+ }
+ }
-----------------------------------------------------------
-- Types and type variables