[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