[Haskell-cafe] Functional Dependencies Help
John Creighton
johns243a at gmail.com
Thu Apr 29 09:47:24 EDT 2010
I've been trying to apply some stuff I learned about functional
dependencies, but I run into one of two problems. I either end up with
inconsistent dependencies (OverlappingInstances doesn't seem to
apply) or I end up with infinite recursion. I want to be able to do
simple things like if a is a subset of b and b is a subset of c then a
is a subset of c. If a is a is a subset of b and b is a c then a is a
c.
Before I added the equality functions I had infinite recursion. Once I
put them them in then I have trouble with overlapping isntances.
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
data Noun = Noun deriving (Show) --10
data Verb = Verb deriving (Show) --
data Adjactive = Adjactive deriving (Show)
data Animal=Animal deriving (Show)
data Feline=Feline deriving (Show)
data Cat = Cat deriving (Show)
data Taby_Cat=Taby_Cat deriving (Show)
data T=T deriving (Show)
data F=F deriving (Show) --20
class Isa a b c | a b->c where isa::a->b->c
instance Isa Animal Noun T where isa a b = T --25
class IsSuperSet a b c | a b->c where
isSuperSet :: a->b->c
instance IsSuperSet Feline Cat T where --30
isSuperSet a b=T
instance IsSuperSet Animal Feline T where
isSuperSet a b=T
instance IsSuperSet a Animal F where
isSuperSet a b=F --35
class TypeNotEq d b c | d b->c where
typeNotEq :: a->b->c
instance (IsSuperSet d b c, --40
IsSuperSet a d c,
TypeNotEq a d T,
TypeNotEq b d T,
TypeEq c T T
)=>
IsSuperSet a b c where
isSuperSet a b=undefined::c
instance TypeNotEq a a c where
typeNotEq a b = undefined::c --50
instance TypeNotEq a b c where
typeNotEq a b = undefined::c
class TypeEq a b c | a b->c where
typeEq :: a->b->c
instance TypeEq a a c where
typeEq a b = undefined::c
instance TypeEq a b c where
typeEq a b = undefined::c
class ToBool a where
toBool :: a->Bool
instance ToBool T where
toBool a = True
instance ToBool F where
toBool a = False
myCat=Cat
bla=isSuperSet Animal Cat
More information about the Haskell-Cafe
mailing list