
Hi,
Not everyone in the community is keen on replacing functional
dependencies with type families. My advice would be to use whichever
language construct seems more suitable to your problem and disregard
the occasional posts by people claiming that functional dependencies
are obsolete or deprecated.
-Iavor
On Tue, Dec 22, 2009 at 9:18 AM, Eduard Sergeev
Hi Stephen,
Stephen Tetley-2 wrote:
Currently this seems a more like a rumour than a fact - from [1] Type Families and Fun Deps are equivalently expressive which seems a worthwhile point to restate.
I've got the same impresion initially and was keen to use TF in favor to FD. And I'm probably missing something here... but here is wiki example which, I think, gives an example of the 'difference' I was refering to: http://www.haskell.org/haskellwiki/GHC/AdvancedOverlap (see '2 Notes and variations', last part).
As an additional example I can point to Oleg Kiselyov's TypeCast implementation (http://okmij.org/ftp/Haskell/deepest-functor.lhs), here is its slightly modified version:
{-# OPTIONS -fglasgow-exts #-} {-# OPTIONS -fallow-undecidable-instances #-} {-# OPTIONS -fallow-overlapping-instances #-}
module FMAP where
data Atom
-- Check if a type is a collection type. This is the only typeclass that -- needs overlapping instances class IsCollection t coll | t -> coll instance IsCollection (m a) (m ()) instance Atom ~ coll => IsCollection t coll
-- The desired deep functor. Needs no overlapping instances class Funct a b c1 c2 | c1 -> a, c1 b -> c2 where f_map :: (a -> b) -> c1 -> c2
instance (IsCollection c1 coll, Funct' coll a b c1 c2) => Funct a b c1 c2 where f_map = f_map' (undefined::coll)
class Funct' coll a b c1 c2 | coll c1 -> a, coll c1 b -> c2 where f_map' :: coll -> (a -> b) -> c1 -> c2
instance Funct' Atom a b a b where f_map' _ = id
instance (Functor m, Funct a b c d) => Funct' (m ()) a b (m c) (m d) where f_map' _ = fmap . f_map
test1 = f_map (+1) [[[1::Int,2,3]]] test2 = f_map not [[True], [False]] test3 = f_map not (Just [Just True, Nothing]) test4 = f_map not (print "here" >> return (Just (Just [Just [True], Nothing]))) >>= print
Still I am not sure how to rewrite this example using Type Families..
-- View this message in context: http://old.nabble.com/Are-functional-dependencies-around-to-stay--tp26873777... Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe