diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2022-01-26 06:59:51 -0500 |
|---|---|---|
| committer | Ryan Scott <ryan.gl.scott@gmail.com> | 2022-01-26 06:59:53 -0500 |
| commit | 0af31d8ed4157f06c0f836c333897e89f1b2890a (patch) | |
| tree | bcd99d9ecd4fc50313e636e62b0df5314c4247f5 | |
| parent | aa50e118b201ae4ac2714afb998d430c9a4a9caa (diff) | |
| download | haskell-wip/T20999.tar.gz | |
Expand type synonyms in markNominalwip/T20999
`markNominal` is repsonsible for setting the roles of type variables
that appear underneath an `AppTy` to be nominal. However, `markNominal`
previously did not expand type synonyms, so in a data type like this:
```hs
data M f a = MkM (f (T a))
type T a = Int
```
The `a` in `M f a` would be marked nominal, even though `T a` would simply
expand to `Int`. The fix is simple: call `coreView` as appropriate in
`markNominal`. This is much like the fix for #14101, but in a different spot.
Fixes #20999.
| -rw-r--r-- | compiler/GHC/Tc/TyCl/Utils.hs | 2 | ||||
| -rw-r--r-- | testsuite/tests/roles/should_compile/T20999.hs | 10 | ||||
| -rw-r--r-- | testsuite/tests/roles/should_compile/all.T | 1 |
3 files changed, 13 insertions, 0 deletions
diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs index 347a7e57ff..7abde66296 100644 --- a/compiler/GHC/Tc/TyCl/Utils.hs +++ b/compiler/GHC/Tc/TyCl/Utils.hs @@ -651,6 +651,8 @@ markNominal lcls ty = let nvars = fvVarList (FV.delFVs lcls $ get_ty_vars ty) in -- recurring into coercions. Recall: coercions are totally ignored during -- role inference. See [Coercions in role inference] get_ty_vars :: Type -> FV + get_ty_vars t | Just t' <- coreView t -- #20999 + = get_ty_vars t' get_ty_vars (TyVarTy tv) = unitFV tv get_ty_vars (AppTy t1 t2) = get_ty_vars t1 `unionFV` get_ty_vars t2 get_ty_vars (FunTy _ w t1 t2) = get_ty_vars w `unionFV` get_ty_vars t1 `unionFV` get_ty_vars t2 diff --git a/testsuite/tests/roles/should_compile/T20999.hs b/testsuite/tests/roles/should_compile/T20999.hs new file mode 100644 index 0000000000..a698bb1ae2 --- /dev/null +++ b/testsuite/tests/roles/should_compile/T20999.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE RoleAnnotations #-} +module T20999 where + +type T a = Int + +type role M nominal phantom +data M f a = MkM (f (T a)) + +type role N nominal phantom +data N f a = MkN (f Int) diff --git a/testsuite/tests/roles/should_compile/all.T b/testsuite/tests/roles/should_compile/all.T index b74f704f23..25849ccb86 100644 --- a/testsuite/tests/roles/should_compile/all.T +++ b/testsuite/tests/roles/should_compile/all.T @@ -11,3 +11,4 @@ test('T10263', normal, compile, ['']) test('T9204b', [], multimod_compile, ['T9204b', '-v0']) test('T14101', normal, compile, ['']) test('T16718', req_th, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T20999', normal, compile, ['']) |