#10653 closed feature request (fixed)
PatternSynonyms should be imported/exported as part of the wildcard notation
Reported by: | gridaphobe | Owned by: | mpickering |
---|---|---|---|
Priority: | high | Milestone: | 8.0.1 |
Component: | Compiler | Version: | 7.11 |
Keywords: | PatternSynonyms, pattern synonyms | Cc: | cactus |
Operating System: | Unknown/Multiple | Architecture: | Unknown/Multiple |
Type of failure: | None/Unknown | Test Case: | |
Blocked By: | Blocking: | ||
Related Tickets: | Differential Rev(s): | Phab:D1258 | |
Wiki Page: |
Description (last modified by )
Suppose I have the following two modules.
{-# LANGUAGE PatternSynonyms #-} module A where data A = A2 Int Int pattern A1 a <- A2 a _ where A1 a = A2 a 0
module B where import A ( A(..) ) a = A1 0
When I try to compile B.hs
I get an error because A1
is unbound in module B
.
$ ghc --make B.hs [1 of 2] Compiling A ( A.hs, A.o ) [2 of 2] Compiling B ( B.hs, B.o ) B.hs:5:5: Not in scope: data constructor ‘A1’ Perhaps you meant ‘A2’ (imported from A)
The issue is that the import A(..)
brings all of A
s data constructors and accessors into scope, but not any associated pattern synonyms. Instead I have to enable PatternSynonyms
in module B
(or just import everything from A
).
{-# LANGUAGE PatternSynonyms #-} module B where import A ( A(..), pattern A1 ) a = A1 0
I'd like to propose that we extend the semantics of the A(..)
import/export notation to include any associated pattern synonyms. I think this is in line with the spirit of PatternSynonyms
, that the extension should allow internal refactoring without causing API breakage, and that the extension should only need to be enabled to *define* pattern synonyms.
FYI, this issue does appear in the wild, I ran into it while working on https://phabricator.haskell.org/D861 and had to modify two import lists in Cabal.
There is a specification and discussion of this feature on the wiki page PatternSynonyms/AssociatingSynonyms.
Change History (41)
comment:1 Changed 4 years ago by
comment:2 Changed 4 years ago by
I would argue that P
belongs to whatever type Tree
constructs (but not Maybe
), and that Q
belongs to pairs.
More generally, https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/syntax-extns.html#idp23521760 says that pattern synonyms have a type C => t1 -> t2 -> ... -> t
; I would argue that a pattern synonym belongs to the outermost type constructor of t
.
comment:3 follow-up: 4 Changed 4 years ago by
If Q
belongs to pairs, then is it ever imported with (..)
attached to some type? I would guess "no".
I agree that the attachment of patterns to datatypes like this is fishy, but I see gridaphobe's point that it would be nice to shield the use of synonyms from clients. What if there were a way to declare that a pattern is attached to a type? For example:
module A ( A(.., pattern A1) ) where ...
By adding A1
to the export list of the type A
, then it is imported with A
as well. We would probably want a check that A1
's result type is indeed headed by A
. This seems to make sense in re-exports as well, in case the pattern synonyms and original datatype are defined in different modules.
(The use of the pattern
keyword in there is redundant, but I like it anyway. Others may disagree.)
gridaphobe, does this address your need?
comment:4 follow-up: 5 Changed 4 years ago by
Replying to goldfire:
If
Q
belongs to pairs, then is it ever imported with(..)
attached to some type? I would guess "no".
Well I suppose it would be possible, since
import GHC.Tuple ((,)(..))
is a valid import declaration.
Here's how I imagine this working, if a module M
exports a type T
and a pattern P
whose result type is headed by T
, e.g.
module M (T(..), pattern P) where data T = T Int Int pattern P x = T x 0
then a client module that uses a wildcard import, e.g.
module B where import M ( T(..) )
should see P
as well.
This rule would avoid any sort of spooky action at a distance, where T
and P
are defined in separate modules, because the wildcard would only depend on a single interface file.
That being said, I'm perfectly happy with goldfire's suggestion too :)
What if there were a way to declare that a pattern is attached to a type? For example:
module A ( A(.., pattern A1) ) where ...By adding
A1
to the export list of the typeA
, then it is imported withA
as well. We would probably want a check thatA1
's result type is indeed headed byA
. This seems to make sense in re-exports as well, in case the pattern synonyms and original datatype are defined in different modules.
One question though, if I have a client module
module B ( A(..) ) where import A ( A(..) )
does B
now export A1
under your scheme, or does it need to explicitly add pattern A1
to the export declaration?
comment:5 follow-up: 6 Changed 4 years ago by
Replying to gridaphobe:
Replying to goldfire:
If
Q
belongs to pairs, then is it ever imported with(..)
attached to some type? I would guess "no".Well I suppose it would be possible, since
import GHC.Tuple ((,)(..))is a valid import declaration.
Yes, but no pattern synonyms are defined in GHC.Tuple
.
One question though, if I have a client module
module B ( A(..) ) where import A ( A(..) )does
B
now exportA1
under your scheme, or does it need to explicitly addpattern A1
to the export declaration?
Good point. I think it would make sense to re-export the patterns, but I see how this is perhaps problematic.
comment:6 Changed 4 years ago by
Replying to goldfire:
If
Q
belongs to pairs, then is it ever imported with(..)
attached to some type? I would guess "no".Well I suppose it would be possible, since
import GHC.Tuple ((,)(..))is a valid import declaration.
Yes, but no pattern synonyms are defined in
GHC.Tuple
.
Right, you would need a module that re-exported (,)
in addition to a pattern synonym, e.g.
module A ( (,)(..), pattern Q )
so it's very unlikely to happen in practice. But, if you are re-exporting (,)
from your module, I think it would be reasonable to attach the pattern synonyms that belong to (,)
. I see this as module A
providing its own view of pairs.
comment:7 Changed 4 years ago by
I can see the point, but I'm not enthusiastic myself
- It would mean that a programmer (and GHC) would need to do type inference even to figure out what the export
T(..)
meant. That is, lexical scoping depends on type inference. Currently Haskell never requires type inference to figure out scoping. Changing this would entail some fairly radical changes in the compiler.
- It's not clear why you might dignify smart patterns, but not smart constructors. We often use "smart constructors" and it would make the same kind of sense to export those too with
T(..)
. Perhaps any function whose result type wasT
? I just don't see a good place to stop with this line of thought.
comment:8 follow-up: 9 Changed 4 years ago by
I'm not in strong favor of any proposal of this sort, but I also haven't used pattern synonyms much, so my opinion is not well informed.
But I do think my proposal answers Simon's first point: the programmer says explicitly what should be included by any import of a datatype. This choice is checked in my proposal, but I don't imagine that would be a challenge to implement. The interface file would indicate what pattern synonyms are included with a datatype. It all doesn't seem very complicated.
As for smart constructors: I think that pattern synonyms subsume traditional "smart constructors". They should really be pattern synonyms now! With the change proposed in this ticket, clients might not even know the difference between a real constructor and a smart one.
Here might be a motivation and a design principle for this feature: a library should be able to refactor a concrete data type without affecting client code. This refactoring would require exporting pattern synonyms mimicking the old behavior. But it's conceivable a client would never know.
comment:9 Changed 4 years ago by
Replying to goldfire:
But I do think my proposal answers Simon's first point: the programmer says explicitly what should be included by any import of a datatype. This choice is checked in my proposal, but I don't imagine that would be a challenge to implement. The interface file would indicate what pattern synonyms are included with a datatype. It all doesn't seem very complicated.
As for smart constructors: I think that pattern synonyms subsume traditional "smart constructors". They should really be pattern synonyms now! With the change proposed in this ticket, clients might not even know the difference between a real constructor and a smart one.
Here might be a motivation and a design principle for this feature: a library should be able to refactor a concrete data type without affecting client code. This refactoring would require exporting pattern synonyms mimicking the old behavior. But it's conceivable a client would never know.
I agree on all accounts. We should strive to enable client code to be oblivious to library refactorings.
comment:10 follow-up: 11 Changed 4 years ago by
Well I certainly agree with the goal of being oblivious to library refactorings.
I don't yet understand Richard's proposal. Perhaps you mean this:
- Let's say that the data constructors of a type
T
are "associated withT
".
- When you say
T(..)
in an export or import list, you meanT
plus all its in-scope associated constructors.
- In the defining module of a data type (and nowhere else) you can list pattern synonyms in the export list thus
T( ..., pattern A1 )
, and that permanently associatesA1
withT
.
Is that what you intended? Well that is certainly better. It means that there is one place to go to find out the full list of what T(..)
might mean, namely the module where T
is defined.
But I dislike that you have to look (a) at the definition of T
and (b) at the exports of the module. Somehow the definition of T
should tell you everything. Something like
data T = A Int | B [Bool] with( P, Q, R ) pattern P x = B [x] ...etc...
comment:11 Changed 4 years ago by
Replying to simonpj:
- In the defining module of a data type (and nowhere else) you can list pattern synonyms in the export list thus
T( ..., pattern A1 )
, and that permanently associatesA1
withT
.
Hmm, I understood Richard's proposal to mean that any module can associate pattern synonyms with a data type in the export list. In this case the association would not be permanent, as client modules could always choose to break the association or associate different pattern synonyms, by changing their export list.
So in my interpretation you would have to to chase the import chain to figure out precisely what T(..)
means, and there would be no "maximal" meaning. I can see the argument against that.
If we go with your interpretation and say that only the defining module can associate pattern synonyms with a data type, I agree that it would be better to declare the association alongside the data type.
I guess the real question is this: do we want to allow modules to associate pattern synonyms with data types that they have imported from somewhere else?
I can see one situation where this would be handy. Suppose a package p
changes one of its core data types, but does not export pattern synonyms to provide backwards compatibility. A client could write a new package p-compat
that provides the necessary patterns and associates them with p
s data types, thus seamlessly recreating the old API.
comment:12 follow-up: 14 Changed 4 years ago by
gridaphobe's interpretation of my proposal is more accurate. I do mean to allow the reassociation of pattern synonyms in any module. This means that you have to "chase the import chain" to figure out what T(..)
means. But this is already true!
module A ( T(MkT1,MkT2) ) where data T = MkT1 | MkT2 | MkT3 module B ( T(..) ) where import A ( T(MkT1) ) module C ( T(..) ) where import B ( T(..) ) module D where import C ( T(..) )
Figuring out what is in scope in D
requires chasing a module chain. My proposal makes this no different.
Indeed, I believe (if we drop the redundant pattern
keyword in the parenthesized list after a datatype) my proposal makes it so that data constructors are no longer privileged at all. For example:
module E ( T( Pat ), pattern Mk ) where data T = Mk pattern Pat = Mk
This means that Pat
is imported with T(..)
but Mk
has to be imported separately. Is this confusing? Perhaps. But perhaps it is also sensible if done for backward compatibility.
I'm not really against putting all of this in the datatype declaration instead of in an export list. (Actually, I quite like data T = PublicMk | abstract PrivateMk
or similar.) But aiming to avoid module chasing to understand T(..)
is a red herring.
comment:13 Changed 4 years ago by
I think Richard's proposal already allows this, but I would add that there is likely some real value in allowing a module to associate a pattern synonym with a type constructor even when the module is not the one in which the type constructor is defined. It's a common organization to put a bunch of types in a single, sometimes "internal", module (to avoid import loops) and then define functions involving those types in many different modules (to avoid having one giant module of doom). Pattern synonyms can involve nontrivial functions if they use view patterns (think of Data.Seq for instance) so it would be useful to associate a pattern synonym with a data type in a top-level module that consists of re-exports.
On the subject of requiring pattern synonyms attached to type constructors to have that type constructor in outermost position in their type, what about polymorphic pattern synonyms? Doesn't it make sense to write something like
pattern Nil = (Foldable.null -> True)
where Nil
matches an expression of type Foldable t => t a
? What is the rule then?
comment:14 Changed 4 years ago by
Replying to goldfire:
But aiming to avoid module chasing to understand
T(..)
is a red herring.
Sorry Richard, I should have been clearer. I know that the precise meaning of T(..)
already depends on the full import chain. What I meant what that I can see the argument for T(..)
to have a maximal meaning.
comment:15 Changed 4 years ago by
Yes, you do have to import-chase to figure out which subset of data constructors are imported by T(..)
. But there's an upper bound: it can import no more than all the constructors.
With the new proposal, any old new pattern synonym could be brought into scope by T(..)
. That is new. Maybe it's not terrible, but it's new.
Maybe one would want to associate more things with T
? Such as a family of functions over T
, whether or not they are pattern synonyms?
Anyway I don't feel terribly strongly about all this provided it can all be resolved by the renamer (ie not involving type inference). By all means write a wiki page, seek feedback etc.
comment:17 Changed 3 years ago by
Owner: | set to mpickering |
---|---|
Priority: | normal → high |
I think this ticket is quite crucial to widespread usage of pattern synonyms. I will write up a design proposal on the wiki and post to ghc-devs for feedback.
comment:18 Changed 3 years ago by
Reid,
Your example is not a valid bidirectional synonym as the RHS contains a view pattern.
You are right that such synonyms can exist though. Here is an example.
{-# LANGUAGE PatternSynonyms, ViewPatterns #-} module Foo where class C f where build :: a -> f a destruct :: f a -> a pattern P :: () => C f => a -> f a pattern P x <- (destruct -> x) where P x = build x
comment:19 Changed 3 years ago by
I have added a section to the wiki summarising this issue. I will start to work on an implementation based on Richard's idea if this doesn't seem to be too magical.
comment:20 Changed 3 years ago by
Thanks for the wiki page. But before implementing anything, can you make it a proposed specification rather than a general idea illustrated by an example or two?
Notably:
- When, precisely, is it OK to export
T( P )
, whereP
is a pattern synonym? - What, precisely, is exported by
T(..)
?
To give you the idea, the current spec is here.
I think it's important that one can answer these questions without doing type checking. (In implementation terms, the renamer has to answer these questions, and typechecking has not happened yet.)
I think your answers will say something like this. Given
pattern P xs = C p1 p2
where C
is a data constructor, then T( P )
is a valid export item iff (a) C
is a data constructor from data type T
, and (b) P
is in scope. It does not matter whether or not C
is in scope (correct?).
But it gets more complicated if C
is itself a pattern synonym; or, worse, if it is a view pattern. Maybe it's driven off the pattern signature, if there is one?
You might find it helpful first to define the notion of "a pattern synonym P
belongs to a data type T
".
Anyway, a specification is badly needed!
Simon
comment:21 Changed 3 years ago by
Richard, could you please explain more what you mean in this paragraph? How are you imagining the implementation?
But I do think my proposal answers Simon's first point: the programmer says explicitly what should be included by any import of a datatype. This choice is checked in my proposal, but I don't imagine that would be a challenge to implement. The interface file would indicate what pattern synonyms are included with a datatype. It all doesn't seem very complicated.
comment:22 follow-up: 23 Changed 3 years ago by
I think Simon's worry is that there will be some inference of associations between pattern synonyms and datatypes. In the proposals as I see them, this is not the case. The programmer declares, in an export list, what to export with what. No type-checking needed. If we want (and I'm not sure we do), we can add validity checks after type-checking to make sure that associated pattern synonyms (or arbitrary values) have suitable types (for some yet-to-be-specified meaning of "suitable").
Does that clarify?
comment:23 Changed 3 years ago by
Replying to goldfire:
I think Simon's worry is that there will be some inference of associations between pattern synonyms and datatypes. In the proposals as I see them, this is not the case. ... Does that clarify?
Alas, no. I simply don't know what the proposal is! I'd love to see a specification. Then I'd know if I was worried or not :-).
comment:24 Changed 3 years ago by
Simon, is this a suitable specification for you? Richard, does this match with your understanding?
comment:25 Changed 3 years ago by
Yes, that's what I meant. I clarified the proposal a bit. Thanks for writing it up!
comment:26 Changed 3 years ago by
Excellent thank you! Now we have something to discuss.
There is much that I do not understand in the spec. I've added some notes with questions.
comment:28 Changed 3 years ago by
Here is a use case for this feature. A module in the Darcs codebase currently says:
import GHC.Exception ( throwIO, ErrorCall(..) )
This code doesn't compile with HEAD, because #5273 replaced the ErrorCall
data constructor by a pattern synonym.
comment:29 Changed 3 years ago by
Cc: | cactus added |
---|---|
Keywords: | PatternSynonyms added |
comment:30 follow-up: 31 Changed 3 years ago by
I just want to check that you really intend this to work
module M( Maybe(P) ) where pattern P x y = (x, True, y) module N( T(P, X, Y) ) where import M( Maybe(..) ) data T = X | Y
Pattern synonym P
has absolutely nothing to do with the Maybe
, but as I understand it module M
is legal under this proposal, and anyone going import M( Maybe(..) )
will get P
in scope.
Then module N
gets the P
from the import, and attaches it to the also-unrelated data type T
.
I think it's all well-defined, but perhaps rather surprising. Is there a consensus that this is the behaviour we all want; or has it perhaps simply not been discussed?
A possible restriction might be that you can only add P
to an export of a data type T
if P
's type has form ... -> T t1 ..tn
.
comment:31 Changed 3 years ago by
Your examples agree with my understanding of this proposal.
A possible restriction might be that you can only add
P
to an export of a data typeT
ifP
's type has form... -> T t1 ..tn
.
This has been suggested. I think it's a good idea. My guess is that it was removed because of concerns that the whole thing has to be resolved by the renamer. But I actually don't think this is problematic at all. The whole thing is resolved by the renamer. It's just that the typechecker does an extra validity check.
One reason I like this restriction is that it agrees with our guiding principle: a library should be able to refactor what was previously a concrete type into an abstract one with pattern synonyms.
Are there other opinions out there?
And has anyone gone beyond Trac to solicit support? I've come around to thinking this is a good idea, but it would be nice to know that others do, too. Apologies if the answer to this is above -- only so many things can fit in my brain at once!
comment:32 Changed 3 years ago by
Richard is right that I removed it because I thought there was some worry that the typechecker would have to get involved but if he says not then I think it's a good idea.
I'm of the opinion that without this, pattern synonyms are a bit useless but apart from the two requests from Thomas and Eric I don't think wider opinion has been solicited. I'll clean up the wiki page and post it to ghc-devs.
comment:33 Changed 3 years ago by
A possible restriction might be that you can only add P to an export of a data type T if P's type has form ... -> T t1 ..tn.
I also prefer having this restriction.
Richard is right that I removed it because I thought there was some worry that the typechecker would have to get involved but if he says not then I think it's a good idea.
As I recall, I had previously suggested that T(..)
export every pattern with a type whose result is headed by T
, which would have required running the typechecker just to determine which things T(..)
refers to. This, I believe, is what was really concerning Simon.
If on the other hand, the export list has to explicitly name patterns to associate with T
, then we can do a simple validity/sanity check during typechecking, as Richard says.
Thanks for forging ahead with this ticket Matthew!
comment:34 Changed 3 years ago by
Differential Rev(s): | → Phab:D1258 |
---|
comment:35 Changed 3 years ago by
Description: | modified (diff) |
---|
comment:36 Changed 3 years ago by
I've added a pointer to the new specification page to the ticket Description.
Personally I think we should Keep It Simple. All this talk of satisfiability makes me shiver. I suggest this: allow T( P ) in all situations except where P
's type is visibly incompatible with T
.
What does "visibly incompatible" mean? P
is visibly incompatible with T
if
P
's type is of form... -> S t1 t2
S
is a data/newtype constructor distinct fromT
Nothing harmful happens if we allow P
to be exported with a type it can't possibly be useful for, but specifying a tighter relationship is very awkward as you have discovered.
BTW, you'd better say that T( P )
is not ok if T
is a type synonym.
comment:38 Changed 3 years ago by
Resolution: | → fixed |
---|---|
Status: | new → closed |
comment:39 Changed 3 years ago by
Hey guys, could we please get an update to Note [Parents]
describing what it is meant when Parent
is PatternSynonym
? Similarly, why do we need to track if an Avail
is a pattern synonym? This is not obvious, and needs to be explained!
comment:40 Changed 3 years ago by
I have added a note now. Is that clearer? Do you think more explanation is needed?
https://github.com/ghc/ghc/commit/8868ff3eb742977c5de2609f7d748f4ff8882d6d
I don't really agree. What would you say for
would you put it in list or Maybe? What about this?
Would you export it with pairs?
Pattern synonyms inherently do not belong to one type in the way that data constructors do.