diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2022-01-26 06:59:51 -0500 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-01-27 02:40:47 -0500 |
| commit | f0adea14316ef476607cb7d99f74875875e52b20 (patch) | |
| tree | 2e4c288bbcc5aa9a80468b37fbc87e85664b0194 | |
| parent | 0573aeab1381680fe86a13960a7fcdb98a69aa58 (diff) | |
| download | haskell-f0adea14316ef476607cb7d99f74875875e52b20.tar.gz | |
Expand type synonyms in markNominal
`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, ['']) |