Commit 31398fbc authored by Edward Z. Yang's avatar Edward Z. Yang

Test for type synonym loops on TyCon.

Previously, we tested for type synonym loops by doing
a syntactic test on the literal type synonym declarations.
However, in some cases, loops could go through hs-boot
files, leading to an infinite loop (#12042); a similar
situation can occur when signature merging.

This commit replaces the syntactic test with a test on
TyCon, simply by walking down all type synonyms until
we bottom out, or find we've looped back.  It's a lot
Signed-off-by: default avatarEdward Z. Yang <>

Test Plan: validate

Reviewers: simonpj, austin, bgamari

Subscribers: goldfire, thomie

Differential Revision:

GHC Trac Issues: #12042
parent b7695867
......@@ -619,6 +619,7 @@ countTyClDecls decls
hsDeclHasCusk :: TyClDecl Name -> Bool
hsDeclHasCusk (FamDecl { tcdFam = fam_decl }) = famDeclHasCusk Nothing fam_decl
hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
-- NB: Keep this synchronized with 'getInitialKind'
= hsTvbAllKinded tyvars && rhs_annotated rhs
rhs_annotated (L _ ty) = case ty of
......@@ -21,6 +21,7 @@ import DynFlags
import HsSyn
import RdrName
import TcRnMonad
import TcTyDecls
import InstEnv
import FamInstEnv
import Inst
......@@ -395,6 +396,9 @@ mergeSignatures lcl_iface0 = do
typecheckIfacesForMerging inner_mod ifaces type_env_var
let infos = zip ifaces detailss
-- Test for cycles
checkSynCycles (thisPackage dflags) (typeEnvTyCons type_env) []
-- NB on type_env: it contains NO dfuns. DFuns are recorded inside
-- detailss, and given a Name that doesn't correspond to anything real. See
-- also Note [Signature merging DFuns]
......@@ -1134,7 +1134,9 @@ tcMonoBinds is_rec sig_fn no_gen
-- Single function binding,
| NonRecursive <- is_rec -- ...binder isn't mentioned in RHS
, Nothing <- sig_fn name -- ...with no type signature
= -- In this very special case we infer the type of the
= -- Note [Single function non-recursive binding special-case]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- In this very special case we infer the type of the
-- right hand side first (it may have a higher-rank type)
-- and *then* make the monomorphic Id for the LHS
-- e.g. f = \(x::forall a. a->a) -> <body>
This diff is collapsed.
This diff is collapsed.
......@@ -334,6 +334,8 @@ expandTypeSynonyms :: Type -> Type
-- 'expandTypeSynonyms' only expands out type synonyms mentioned in the type,
-- not in the kinds of any TyCon or TyVar mentioned in the type.
-- Keep this synchronized with 'synonymTyConsOfType'
expandTypeSynonyms ty
= go (mkEmptyTCvSubst in_scope) ty
......@@ -87,6 +87,16 @@ Compiler
pre-processor causing the pre-processor to warn on uses of the ``#if``
directive on undefined identifiers.
- GHC will no longer automatically infer the kind of higher-rank type synonyms;
you must explicitly explicitly annotate the synonym with a kind signature.
For example, given::
data T :: (forall k. k -> Type) -> Type
to define a synonym of ``T``, you must write::
data TSyn = (T :: (forall k. k -> Type) -> Type)
......@@ -2144,10 +2144,10 @@ much more liberal about type synonyms than Haskell 98.
foo :: forall x. x -> [x]
GHC currently does kind checking before expanding synonyms (though even
that could be changed)..
that could be changed).
After expanding type synonyms, GHC does validity checking on types,
looking for the following mal-formedness which isn't detected simply by
looking for the following malformedness which isn't detected simply by
kind checking:
- Type constructor applied to a type involving for-alls (if
......@@ -85,6 +85,7 @@ extra_src_files = {
'T11827': ['A.hs', 'A.hs-boot', 'B.hs'],
'T12062': ['A.hs', 'A.hs-boot', 'C.hs'],
'T12035j': ['T12035.hs', 'T12035a.hs', 'T12035.hs-boot'],
'T12042': ['T12042.hs', 'T12042a.hs', 'T12042.hs-boot'],
'T12485': ['a.pkg', 'b.pkg', 'Main.hs'],
'T12733': ['p/', 'q/', 'Setup.hs'],
'T1372': ['p1/', 'p2/'],
......@@ -24,3 +24,4 @@ test('bkpfail25', normal, backpack_compile_fail, [''])
test('bkpfail26', normal, backpack_compile_fail, [''])
test('bkpfail27', normal, backpack_compile_fail, [''])
test('bkpfail28', normal, backpack_compile_fail, [''])
test('bkpfail29', normal, backpack_compile_fail, [''])
unit p where
signature A where
data S
type T = S
unit q where
signature A where
data T
type S = T
unit r where
dependency p[A=<A>]
dependency q[A=<A>]
module M where
import A
x :: S
x = undefined
[1 of 3] Processing p
[1 of 1] Compiling A[sig] (.hsig -> nothing)
[2 of 3] Processing q
[1 of 1] Compiling A[sig] (.hsig -> nothing)
[3 of 3] Processing r
[1 of 2] Compiling A[sig] (.hsig -> nothing)
bkpfail29.bkp:8:9: error:
Cycle in type synonym declarations:
bkpfail29.bkp:8:9-18: {A.S} from external module
bkpfail29.bkp:7:9-14: {A.T} from external module
mod27.hs:3:1: error:
Cycle in type synonym declarations:
mod27.hs:3:1-18: type T1 = (Int, T2)
mod27.hs:4:1-18: type T2 = (Int, T1)
......@@ -366,6 +366,9 @@ test('Tc267',
extra_clean(['Tc267a.hi-boot', 'Tc267a.o-boot', 'Tc267b.hi-boot', 'Tc267b.o-boot', 'Tc267a.hi', 'Tc267a.o', 'Tc267b.hi', 'Tc267b.o']),
['$MAKE -s --no-print-directory Tc267'])
test('tc268', normal, compile, [''])
test('tc269', normal, compile, [''])
test('tc270', normal, compile, [''])
test('GivenOverlapping', normal, compile, [''])
test('GivenTypeSynonym', normal, compile, [''])
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ConstraintKinds #-}
module Tc268 where
import GHC.Exts
type A = (() :: Constraint)
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeInType #-}
module Tc269 where
import GHC.Types
-- We'd like this to kind check, but it doesn't today,
-- see Note [Missed opportunity to retain higher-rank kinds]
-- TSyn is in an SCC of its own, so we can read off the
-- kind directly.
data T (p :: forall k. k -> Type) = T
type TSyn = T
-- S and SSyn are in an SCC, so we do kind inference for
-- everything. Need an explicit type signature.
data K (a :: k) = K
data S (p :: forall k. k -> Type) = S (SSyn K)
type SSyn = (S :: (forall k. k -> Type) -> Type)
This diff is collapsed.
module T12042 where
import qualified T12042a as B
type S = B.R
type R = B.U
module T12042 where
data S
type R = S
[1 of 3] Compiling T12042[boot] (.hs-boot -> .o-boot)
[2 of 3] Compiling T12042a (.hs -> .o)
[3 of 3] Compiling T12042 (.hs -> .o)
T12042.hs:3:1: error:
Cycle in type synonym declarations:
T12042.hs:3:1-12: type S = R
T12042a.hs:3:1-10: B.U from external module
T12042.hs:4:1-12: type R = B.U
module T12042a (module T12042a, module T12042) where
import {-# SOURCE #-} T12042
type U = S
......@@ -431,3 +431,4 @@ test('T12589', normal, compile_fail, [''])
test('T12529', normal, compile_fail, [''])
test('T12729', normal, compile_fail, [''])
test('T12803', normal, compile_fail, [''])
test('T12042', extra_clean(['T12042a.hi', 'T12042a.o', 'T12042.hi-boot', 'T12042.o-boot']), multimod_compile_fail, ['T12042', ''])
Markdown is supported
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment