collecting requirements for FDs

The favourite customer for FDs has been the monad transformer library. (There are at least two versions, but they have the same requirements.) In this library, all the dependencies are full, i.e. involve all (both) the arguments of the class, e.g. class (Monoid w, Monad m) => MonadWriter w m | m -> w Instances of these classes are of two kinds: 1) Base cases: the range argument is a variable that occurs in the domain argument, e.g. instance (Monoid w, Monad m) => MonadWriter w (WriterT w m) 2) Inductive definitions: the range argument is a variable that is determined by variables in the domain argument via an FD (on the same class) in the context of the instance, e.g. instance (Error e, MonadWriter w m) => MonadWriter w (ErrorT e m) What other libraries should Haskell' support, and what are their requirements?

On 4/10/06, Ross Paterson
What other libraries should Haskell' support, and what are their requirements?
http://hackage.haskell.org/trac/ghc/wiki/CollectionClassFramework There are two "range arguments" here, IIUC. Jim

Hello,
I just moved the documentation (still accessible from the below wiki
page) to here:
http://users.skynet.be/jyp/html/collections/Data.Collections.html
the source being:
http://darcs.haskell.org/packages/collections/Data/Collections.hs
And, since you asked for it, there is something I think would be nice to have.
As you may have found out by reading the above documentation, I've
been trying to put Sets and Maps into the same class-framework. (Or,
to put differently, unify collections and associative collections).
The result of this, as Jim said, is I get two range parameters:
class Map m k a | m -> k a where ...
The value type for sets being ().
instance Map IntSet Int () where ...
This is all very well, except that it complexifies some type contexts,
and is also a bit restrictive in some respects: intersectionWith must
have type (a -> a -> a) -> m -> m -> m, instead of (a -> b -> c) -> m
a -> m b -> m c, if Map was (partially) a constructor class.
One way to reconcile both approaches would be to have both classes:
class Map m k a | m -> k a where ...
class Map_ m k | m -> k where ...
In order to avoid redundancy though, I'd wish to relate the classes like this:
class Map (m a) k a => Map_ m k | m -> k where ...
This is rejected by GHC, and I suspect every current haskell
implementation. Before you ask, I haven't worked out the implications
in terms of confluence. But I thought I might just as well express my
wish. :)
Cheers,
JP.
On 4/11/06, Jim Apple
On 4/10/06, Ross Paterson
wrote: What other libraries should Haskell' support, and what are their requirements?
http://hackage.haskell.org/trac/ghc/wiki/CollectionClassFramework
There are two "range arguments" here, IIUC.
Jim _______________________________________________ Haskell-prime mailing list Haskell-prime@haskell.org http://haskell.org/mailman/listinfo/haskell-prime

Hello Ross, Tuesday, April 11, 2006, 3:43:18 AM, you wrote:
The favourite customer for FDs has been the monad transformer library.
What other libraries should Haskell' support, and what are their requirements?
why you think that FD are required only for libs? :) i think it's better to ask in main Haskell list where FDs really used my own library (http://freearc.narod.ru/Streams.tar.gz) use FDs widely for monad-involving classes. one typical example is: class Stream m h | h->m where each Stream type `h` is working (i.e. can be read/written) in some monad `m`. Another class defines monad-independent operations on references: class Ref m r | r->m, m->r where newRef::... readRef::... writeRef:... This class used in definitions of monad-independent Stream Transformers, i.e. transformers that can be applied to streams working in any monad (references used to hold internal transformer's state). instances of stream classes sometimes are very complex: instance (ByteStream m h, Ref m r) => BinaryStream m (BitAligned h r) instance (TextStream m h, ByteStream m h, BinaryStream m (BitAligned h r)) => TextStream m (BitAligned h r) where i'm not sure that G' should support my library but at least it provides feature-extended replacement for Handles, binary I/O and serializaition facilities. i think that extending Streams to work in any monads is what the hskellers would like to see -- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com

Dear all, Ross Peterson wrote:
The favourite customer for FDs has been the monad transformer library. ... What other libraries should Haskell' support, and what are their requirements?
Here are some classes from Yampa/earlier versions of FRP. I shouldn't think they're particularly demanding. Also, I'm not saying these classes could not be defined differently/better. They are just examples of what seems to me reasonable uses of FDs. --------------------------------------------------------- -- Minimal instance: zeroVector, (*^), (^+^), dot class Floating a => VectorSpace v a | v -> a where zeroVector :: v (*^) :: a -> v -> v (^/) :: v -> a -> v negateVector :: v -> v (^+^) :: v -> v -> v (^-^) :: v -> v -> v dot :: v -> v -> a norm :: v -> a normalize :: v -> v ---------------------------------------------------------- -- Minimal instance: origin, .+^, .^. class (Floating a, VectorSpace v a) => AffineSpace p v a | p -> v, v -> a where origin :: p (.+^) :: p -> v -> p (.-^) :: p -> v -> p (.-.) :: p -> p -> v distance :: p -> p -> a ---------------------------------------------------------- From an old version of FRP: FRPCore.lhs:> class MixSwitchable s a b | s a -> b where FRPCore.lhs:> class Switchable s i | s -> i where FRPCore.lhs: class RunningIn a b i | a -> i where FRPCore.lhs:> class ImpAs a b | a -> b where FRPTask.lhs: class RunningInTask a t i | a t -> i where FRPTask.lhs:> class Monad m => StateMonad s m | m -> s where FRPTask.lhs:> class Monad m => EnvMonad env m | m -> env where FRPTask.lhs:> class GTask t => MsgTask t m | t -> m where FRPTask.lhs:> class MsgTaskMap mt m nt n | mt -> m, nt -> n where /Henrik -- Henrik Nilsson School of Computer Science and Information Technology The University of Nottingham nhn@cs.nott.ac.uk This message has been checked for viruses but the contents of an attachment may still contain software viruses, which could damage your computer system: you are advised to perform your own checks. Email communications with the University of Nottingham may be monitored as permitted by UK legislation.

On Wed, Apr 12, 2006 at 03:57:31PM +0100, Henrik Nilsson wrote:
Here are some classes from Yampa/earlier versions of FRP.
The instances are probably more important, especially instances that violate the following restriction (from the original description of FDs, christened the "coverage condition" in the FD-CHR paper): any type variable occurring in a range argument must also occur in a domain argument. The following (from mtl) satisfies this condition (and is therefore boring): class (Monoid w, Monad m) => MonadWriter w m | m -> w instance (Monoid w, Monad m) => MonadWriter w (WriterT w m) (because w occurs in WriterT w m) but this (also from mtl) does not: instance (Error e, MonadWriter w m) => MonadWriter w (ErrorT e m) Here w is determined by ErrorT e m, via the FD on the context. GHC and Hugs use this laxer notion of dependency, but it has emerged that this system is not well-behaved, so it has been proposed that we use some intermediate conditions on instances. One possibility is: Instances must either satisfy the coverage condition, or 1) the functional dependency must be full, i.e. involve all arguments of the class, and 2) the range arguments of an instance must be distinct type variables determined by domain variables, but not occurring elsewhere in the instance head. That's pretty clunky, but it handles the mtl instances. Does it permit enough of the uses people want?
class (Floating a, VectorSpace v a) => AffineSpace p v a | p -> v, v -> a where origin :: p (.+^) :: p -> v -> p (.-^) :: p -> v -> p (.-.) :: p -> p -> v distance :: p -> p -> a
The dependencies here are not full, so this is likely to be problematic. Presumably you can't split the class because you want the default definition of distance to use (.-.) and norm.
FRPCore.lhs: class RunningIn a b i | a -> i where FRPTask.lhs:> class MsgTaskMap mt m nt n | mt -> m, nt -> n where
Ditto

What other libraries should Haskell' support, and what are their requirements?
useful initiative! will your collection be available anywhere? may I suggest that you (a) ask on the main Haskell and library lists for better coverage (I would have thought that the alternative Num prelude suggestions might have some use cases), and (b) collect non-use cases as well (eg, where current implementations are buggy/incomplete/do different things, or where other reasons have prevented Haskellers from using FDs so far)? I think trying to clean up the latter will be more effective than wading through dozens of variations of the same working examples - you're looking for counter-examples to the current design, aren't you? and just in case you haven't got these on your list already, here are some examples from earlier discussions on this mailing list: - ticket #92 has module Data.Records attached to it. http://hackage.haskell.org/trac/haskell-prime/ticket/92 I'd like to be able to use that in Haskell'. the library is useful in itself (I've used its record selection and concatenation parts when encoding attribute grammars), and I also suggested it as a good testcase for Haskell' providing a sufficient (but cleaned-up) subset of currently available features. but it is also an example of code that - works with GHC, but not with Hugs; one of those problems I reported on hugs-bugs: http://www.haskell.org//pipermail/hugs-bugs/2006-February/001560.html and went through a few of the Hugs/GHC differences here on this mailing list: http://www.haskell.org//pipermail/haskell-prime/2006-February/000577.html and used the Select example to motivate the need for relaxed coverage in termination checking: http://www.haskell.org//pipermail/haskell-prime/2006-February/000825.html I have since come to doubt that GHC really solves the issue, it just happens that its strategy of delaying problems until they may no longer matter works for this example; but one can construct other examples that expose the problem in spite of this delayed complaining trick. see my own attempts to show FD problems here: http://www.haskell.org//pipermail/haskell-prime/2006-February/000781.html or Oleg's recent example on haskell-cafe: http://www.haskell.org//pipermail/haskell-cafe/2006-April/015372.html while I didn't quite agree with his interpretation (see my answer to his message), he did manage to construct an example in which GHC accepts a type/program in violation of an FD. - requires complex workarounds, thanks to current restrictions, where the same could be expressed simply and directly without; (compare the code for Remove in Data.Record.hs: the one in comments vs the one I had to use to make GHC happy) - things like a simple type equality predicate at the type class level run into problems with both GHC and Hugs. reported to both GHC and Hugs bugs lists as: http://www.haskell.org//pipermail/hugs-bugs/2006-February/001564.html - the FD-visibility limitations strike not only at the instance level. here is a simplified example of a problem I ran into when trying to encode ATS in FDs (a variable in a superclass constraint that doesn't occur in the class head, but is determined by an FD on the superclass constraint): http://hackage.haskell.org/trac/ghc/ticket/714 - the HList library and associated paper also use and investigate the peculiarities of FDs, and variations on the TypeEq theme (it has both unpractical/portable and practical versions that make essential use of some limitations in GHC's type class implementation to work around other of its limitations; it demonstrates wonderfully why the current story needs to be cleaned up!): http://homepages.cwi.nl/~ralf/HList/ hope that's the kind of thing you are looking for?-) cheers, claus
participants (6)
-
Bulat Ziganshin
-
Claus Reinke
-
Henrik Nilsson
-
Jean-Philippe Bernardy
-
Jim Apple
-
Ross Paterson