[commit: ghc] master: TTG for IPBind had wrong extension name (5f06cf6)

git at git.haskell.org git at git.haskell.org
Fri Jun 22 19:35:31 UTC 2018


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/5f06cf6b6199c8f0e4921f4126f6eb15e2ff18ac/ghc

>---------------------------------------------------------------

commit 5f06cf6b6199c8f0e4921f4126f6eb15e2ff18ac
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date:   Fri Jun 22 21:32:19 2018 +0200

    TTG for IPBind had wrong extension name
    
    The standard[1] for extension naming is to use the XC prefix for the
    internal extension points, rather than for a new constructor.
    
    This is violated for IPBind, having
    
        data IPBind id
          = IPBind
                (XIPBind id)
                (Either (Located HsIPName) (IdP id))
                (LHsExpr id)
          | XCIPBind (XXIPBind id)
    
    Swap the usage of XIPBind and XCIPBind
    
    [1] https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow#Namingconventions
    
    Closes #15302


>---------------------------------------------------------------

5f06cf6b6199c8f0e4921f4126f6eb15e2ff18ac
 compiler/deSugar/Coverage.hs  | 2 +-
 compiler/deSugar/DsExpr.hs    | 2 +-
 compiler/hsSyn/HsBinds.hs     | 8 ++++----
 compiler/hsSyn/HsExtension.hs | 4 ++--
 compiler/rename/RnBinds.hs    | 2 +-
 compiler/typecheck/TcBinds.hs | 2 +-
 compiler/typecheck/TcHsSyn.hs | 2 +-
 7 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs
index ac02989..b5c18e5 100644
--- a/compiler/deSugar/Coverage.hs
+++ b/compiler/deSugar/Coverage.hs
@@ -810,7 +810,7 @@ addTickIPBind (IPBind x nm e) =
         liftM2 (IPBind x)
                 (return nm)
                 (addTickLHsExpr e)
-addTickIPBind (XCIPBind x) = return (XCIPBind x)
+addTickIPBind (XIPBind x) = return (XIPBind x)
 
 -- There is no location here, so we might need to use a context location??
 addTickSyntaxExpr :: SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs
index b6337e4..7767dfc 100644
--- a/compiler/deSugar/DsExpr.hs
+++ b/compiler/deSugar/DsExpr.hs
@@ -96,7 +96,7 @@ dsIPBinds (IPBinds ev_binds ip_binds) body
     ds_ip_bind (L _ (IPBind _ ~(Right n) e)) body
       = do e' <- dsLExpr e
            return (Let (NonRec n e') body)
-    ds_ip_bind (L _ (XCIPBind _)) _ = panic "dsIPBinds"
+    ds_ip_bind (L _ (XIPBind _)) _ = panic "dsIPBinds"
 dsIPBinds (XHsIPBinds _) _ = panic "dsIPBinds"
 
 -------------------------
diff --git a/compiler/hsSyn/HsBinds.hs b/compiler/hsSyn/HsBinds.hs
index e4a6906..98f503b 100644
--- a/compiler/hsSyn/HsBinds.hs
+++ b/compiler/hsSyn/HsBinds.hs
@@ -859,12 +859,12 @@ type LIPBind id = Located (IPBind id)
 -- For details on above see note [Api annotations] in ApiAnnotation
 data IPBind id
   = IPBind
-        (XIPBind id)
+        (XCIPBind id)
         (Either (Located HsIPName) (IdP id))
         (LHsExpr id)
-  | XCIPBind (XXIPBind id)
+  | XIPBind (XXIPBind id)
 
-type instance XIPBind     (GhcPass p) = NoExt
+type instance XCIPBind    (GhcPass p) = NoExt
 type instance XXIPBind    (GhcPass p) = NoExt
 
 instance (p ~ GhcPass pass, OutputableBndrId p)
@@ -878,7 +878,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (IPBind p) where
     where name = case lr of
                    Left (L _ ip) -> pprBndr LetBind ip
                    Right     id  -> pprBndr LetBind id
-  ppr (XCIPBind x) = ppr x
+  ppr (XIPBind x) = ppr x
 
 {-
 ************************************************************************
diff --git a/compiler/hsSyn/HsExtension.hs b/compiler/hsSyn/HsExtension.hs
index 52e19b9..a23b973 100644
--- a/compiler/hsSyn/HsExtension.hs
+++ b/compiler/hsSyn/HsExtension.hs
@@ -156,11 +156,11 @@ type ForallXHsIPBinds (c :: * -> Constraint) (x :: *) =
        )
 
 -- IPBind type families
-type family XIPBind  x
+type family XCIPBind x
 type family XXIPBind x
 
 type ForallXIPBind (c :: * -> Constraint) (x :: *) =
-       ( c (XIPBind  x)
+       ( c (XCIPBind x)
        , c (XXIPBind x)
        )
 
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index 79b5502..a2218e4 100644
--- a/compiler/rename/RnBinds.hs
+++ b/compiler/rename/RnBinds.hs
@@ -226,7 +226,7 @@ rnIPBind :: IPBind GhcPs -> RnM (IPBind GhcRn, FreeVars)
 rnIPBind (IPBind _ ~(Left n) expr) = do
     (expr',fvExpr) <- rnLExpr expr
     return (IPBind noExt (Left n) expr', fvExpr)
-rnIPBind (XCIPBind _) = panic "rnIPBind"
+rnIPBind (XIPBind _) = panic "rnIPBind"
 
 {-
 ************************************************************************
diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index 468950a..7060c35 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -361,7 +361,7 @@ tcLocalBinds (HsIPBinds x (IPBinds _ ip_binds)) thing_inside
             ; let d = toDict ipClass p ty `fmap` expr'
             ; return (ip_id, (IPBind noExt (Right ip_id) d)) }
     tc_ip_bind _ (IPBind _ (Right {}) _) = panic "tc_ip_bind"
-    tc_ip_bind _ (XCIPBind _) = panic "tc_ip_bind"
+    tc_ip_bind _ (XIPBind _) = panic "tc_ip_bind"
 
     -- Coerces a `t` into a dictionry for `IP "x" t`.
     -- co : t -> IP "x" t
diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs
index 8cabd0c..73fdda9 100644
--- a/compiler/typecheck/TcHsSyn.hs
+++ b/compiler/typecheck/TcHsSyn.hs
@@ -436,7 +436,7 @@ zonkLocalBinds env (HsIPBinds x (IPBinds dict_binds binds )) = do
         = do n' <- mapIPNameTc (zonkIdBndr env) n
              e' <- zonkLExpr env e
              return (IPBind x n' e')
-    zonk_ip_bind (XCIPBind _) = panic "zonkLocalBinds : XCIPBind"
+    zonk_ip_bind (XIPBind _) = panic "zonkLocalBinds : XCIPBind"
 
 zonkLocalBinds _ (HsIPBinds _ (XHsIPBinds _))
   = panic "zonkLocalBinds" -- Not in typechecker output



More information about the ghc-commits mailing list