Commit f65ff2c4 authored by Ryan Scott's avatar Ryan Scott

Disambiguate reified closed type family kinds in TH

Summary:
A continuation of #8953. This fixes an oversight in which the
left-hand sides of closed type families, when reified in Template Haskell,
would not be given kind annotations, even when they are necessary for
disambiguation purposes in the presence of `PolyKinds`.

Fixes #8953 and #12646.

Test Plan: ./validate

Reviewers: hvr, bgamari, austin, goldfire

Reviewed By: goldfire

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2795

GHC Trac Issues: #8953, #12646
parent 6da62535
......@@ -1357,11 +1357,16 @@ reifyThing thing = pprPanic "reifyThing" (pprTcTyThingCategory thing)
-------------------------------------------
reifyAxBranch :: TyCon -> CoAxBranch -> TcM TH.TySynEqn
reifyAxBranch fam_tc (CoAxBranch { cab_lhs = args, cab_rhs = rhs })
reifyAxBranch fam_tc (CoAxBranch { cab_lhs = lhs, cab_rhs = rhs })
-- remove kind patterns (#8884)
= do { args' <- mapM reifyType (filterOutInvisibleTypes fam_tc args)
= do { let lhs_types_only = filterOutInvisibleTypes fam_tc lhs
; lhs' <- reifyTypes lhs_types_only
; annot_th_lhs <- zipWith3M annotThType (mkIsPolyTvs fam_tvs)
lhs_types_only lhs'
; rhs' <- reifyType rhs
; return (TH.TySynEqn args' rhs') }
; return (TH.TySynEqn annot_th_lhs rhs') }
where
fam_tvs = filterOutInvisibleTyVars fam_tc (tyConTyVars fam_tc)
reifyTyCon :: TyCon -> TcM TH.Info
reifyTyCon tc
......
......@@ -124,6 +124,11 @@ Template Haskell
- Make quoting and reification return the same types. (:ghc-ticket:`11629`)
- More kind annotations appear in the left-hand sides of reified closed
type family equations, in order to disambiguate types that would otherwise
be ambiguous in the presence of :ghc-flag:`-XPolyKinds`.
(:ghc-ticket:`12646`)
Runtime system
~~~~~~~~~~~~~~
......
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module T12646 where
import Language.Haskell.TH
import System.IO
type family F (a :: k) :: * where
F (a :: * -> *) = Int
F (a :: k) = Char
$(do info <- reify ''F
runIO $ putStrLn $ pprint info
runIO $ hFlush stdout
return [])
type family T12646.F (a_0 :: k_1) :: * where
T12646.F (a_2 :: * -> *) = GHC.Types.Int
T12646.F (a_3 :: k_4) = GHC.Types.Char
type family T8884.Foo (a_0 :: k_1) = (r_2 :: k_1) | r_2 -> k_1 a_0 where
T8884.Foo x_3 = x_3
T8884.Foo (x_3 :: k_4) = x_3
type family T8884.Baz (a_0 :: k_1) = (r_2 :: k_1) | r_2 -> k_1 a_0
type instance T8884.Baz (x_0 :: k_1) = x_0
......@@ -440,6 +440,7 @@ test('T12478_3', omit_ways(['ghci']), compile, ['-v0'])
test('T12478_4', omit_ways(['ghci']), compile_fail, ['-v0'])
test('T12513', omit_ways(['ghci']), compile_fail, ['-v0'])
test('T12530', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T12646', normal, compile, ['-v0'])
test('T12788', extra_clean(['T12788_Lib.hi', 'T12788_Lib.o']),
multimod_compile_fail,
['T12788.hs', '-v0 ' + config.ghc_th_way_flags])
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment