Commit 90771209 authored by Matthew Pickering's avatar Matthew Pickering Committed by Ben Gamari
Browse files

Use actual universal tvs in check for naughty record selectors

The naughty record selector check means to limit selectors which would
lead to existential tyvars escaping their scope. With record pattern
synonyms, there are situations where universal tyvars don't appear in
the result type, for example:

```
pattern ReadP :: Read a => a -> String
pattern ReadP{readp} <- (read -> readp)
```

This is a similar issue to #11224 where we assumed that we can decide
which variables are universal and which are existential by the syntactic
check of seeing which appear in the result type. The fix is to use
`univ_tvs` from `conLikeFullSig` rather than the previous approximation.
But we must also remember to apply `EqSpec`s so we use the free
variables from `inst_tys` which is precisely `univ_tvs` with `EqSpecs`
applied.

Reviewers: austin, bgamari

Reviewed By: bgamari

Subscribers: rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D3649
parent 3c4537ea
...@@ -846,7 +846,7 @@ mkOneRecordSelector all_cons idDetails fl ...@@ -846,7 +846,7 @@ mkOneRecordSelector all_cons idDetails fl
-- Selector type; Note [Polymorphic selectors] -- Selector type; Note [Polymorphic selectors]
field_ty = conLikeFieldType con1 lbl field_ty = conLikeFieldType con1 lbl
data_tvs = tyCoVarsOfTypeWellScoped data_ty data_tvs = tyCoVarsOfTypesWellScoped inst_tys
data_tv_set= mkVarSet data_tvs data_tv_set= mkVarSet data_tvs
is_naughty = not (tyCoVarsOfType field_ty `subVarSet` data_tv_set) is_naughty = not (tyCoVarsOfType field_ty `subVarSet` data_tv_set)
(field_tvs, field_theta, field_tau) = tcSplitSigmaTy field_ty (field_tvs, field_theta, field_tau) = tcSplitSigmaTy field_ty
......
{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Main where module Main where
...@@ -6,9 +8,14 @@ pattern Bi{a, b} = (a, b) ...@@ -6,9 +8,14 @@ pattern Bi{a, b} = (a, b)
foo = ("a","b") foo = ("a","b")
pattern ReadP :: Read a => a -> String
pattern ReadP {readp} <- (read -> readp)
main = do main = do
print foo print foo
print (a foo) print (a foo)
print (b foo) print (b foo)
print (foo {a = "c"}) print (foo {a = "c"})
print (foo {a = "fst", b = "snd"}) print (foo {a = "fst", b = "snd"})
print (readp @Int "5")
...@@ -3,3 +3,4 @@ ...@@ -3,3 +3,4 @@
"b" "b"
("c","b") ("c","b")
("fst","snd") ("fst","snd")
5
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