module Control.Poly2 where
type Fractionals = Float :*: Double :*: HNil
type Nums = Int :*: Integer :*: AllOf Fractionals :*: HNil
type Ords = Bool :*: Char :*: AllOf Nums :*: HNil
type Eqs = AllOf (TypeCl OpenEqs) :*: AllOfBut Ords Fractionals :*: HNil
data OpenEqs
instance TypeCls OpenEqs () HTrue
data RusselC
instance Apply (Member Russel) x r => TypeCls RusselC x r
type Russel = AllOfBut () (TypeCl RusselC) :*: HNil
data AllOf x
data AllOfBut x y
data TypeCl x
class TypeCls l x r | l x -> r
instance TypeCast r HFalse => TypeCls l x r
data Member tl
instance Apply (Member HNil) x HFalse
instance TypeCls l x r => Apply (Member (TypeCl l)) x r
instance (TypeEq h x bf, MemApp bf t x r)
=> Apply (Member (h :*: t)) x r
instance (Apply (Member h) x bf, MemApp bf t x r)
=> Apply (Member ((AllOf h) :*: t)) x r
instance (Apply (Member exc) x bf, Apply (MemCase2 h t x) bf r)
=> Apply (Member ((AllOfBut h exc) :*: t)) x r
class MemApp bf t x r | bf t x -> r
instance MemApp HTrue t x HTrue
instance Apply (Member t) x r => MemApp HFalse t x r
data MemCase2 h t x
instance Apply (Member t) x r => Apply (MemCase2 h t x) HTrue r
instance Apply (Member ((AllOf h) :*: t)) x r
=> Apply (MemCase2 h t x) HFalse r
testm1 = apply (undefined::Member Fractionals) (1::Float)
testm2 = apply (undefined::Member Fractionals) (1::Int)
testm3 = apply (undefined::Member Fractionals) ()
class GFN n f a pred | n f a -> pred
data Otherwise
instance Apply Otherwise a HTrue
newtype GFn f = GFn f
newtype GFnA n f = GFnA f
newtype GFnTest n f flag = GFnTest f
instance (GFN Z f a pred, Apply pred a flag,
Apply (GFnTest Z f flag) a b)
=> Apply (GFn f) a b where
apply (GFn f) a = apply ((GFnTest f)::GFnTest Z f flag) a
instance Apply (GFnA n f) a b
=> Apply (GFnTest n f HTrue) a b where
apply (GFnTest f) a = apply ((GFnA f) :: GFnA n f) a
instance (GFN (S n) f a pred, Apply pred a flag,
Apply (GFnTest (S n) f flag) a b)
=> Apply (GFnTest n f HFalse) a b where
apply (GFnTest f) a = apply ((GFnTest f)::GFnTest (S n) f flag) a
data IsAnEq = IsAnEq
instance GFN Z IsAnEq a (Member Eqs)
instance Apply (GFnA Z IsAnEq) a Bool where
apply _ _ = True
instance TypeCast pred Otherwise => GFN n IsAnEq a pred
instance Apply (GFnA n IsAnEq) a Bool where
apply _ _ = False
test1 = [apply (GFn IsAnEq) (), apply (GFn IsAnEq) (1.0::Double),
apply (GFn IsAnEq) 'a']
instance GFN (S Z) IsAnEq (x,y) Otherwise
instance (Apply (GFn IsAnEq) x Bool,
Apply (GFn IsAnEq) y Bool)
=> Apply (GFnA (S Z) IsAnEq) (x,y) Bool where
apply (GFnA f) (x,y) = apply (GFn f) x && apply (GFn f) y
test2 = [apply (GFn IsAnEq) (True,'a'),
apply (GFn IsAnEq) (1.0::Double,True)]
data PairOf t
instance Apply t x r => Apply (PairOf t) (x,x) r
instance TypeCast r HFalse => Apply (PairOf t) x r
testmp1 = apply (undefined::PairOf (Member Fractionals))
((1::Float),(1::Float))
testmp2 = apply (undefined::PairOf (Member Fractionals))
((1::Integer),(1::Integer))
testmp3 = apply (undefined::PairOf (Member Nums))
((1::Integer),(1::Integer))
data ApproxEq = ApproxEq
instance GFN Z ApproxEq (x,x) (PairOf (Member Fractionals))
instance (Fractional x, Ord x) =>
Apply (GFnA Z ApproxEq) (x,x) Bool where
apply _ (x,y) = abs (x y) < 0.5
instance GFN (S Z) ApproxEq (x,x) (PairOf (Member Nums))
instance (Num x, Ord x) =>
Apply (GFnA (S Z) ApproxEq) (x,x) Bool where
apply _ (x,y) = abs (x y) < 2
instance GFN (S (S Z)) ApproxEq (x,x) (PairOf (Member Eqs))
instance (Eq x) =>
Apply (GFnA (S (S Z)) ApproxEq) (x,x) Bool where
apply _ (x,y) = x == y
instance GFN (S (S (S Z))) ApproxEq ((x,x),(x,x))
(PairOf (PairOf (Member Nums)))
instance (Apply (GFn ApproxEq) (x,x) Bool, Eq x) =>
Apply (GFnA (S (S (S Z))) ApproxEq) ((x,x),(x,x)) Bool where
apply _ ((x1,x2),(y1,y2)) = apply (GFn ApproxEq) (x1,y1) &&
x2 == y2
instance TypeCast pred Otherwise => GFN n ApproxEq a pred
instance Apply (GFnA n ApproxEq) a Bool where
apply _ _ = False
approx_eq x y = apply (GFn ApproxEq) (x,y)
test3 = [approx_eq (1.0::Double) (1.5::Double),
approx_eq (1.0::Float) (1.1::Float),
approx_eq (1::Integer) (2::Integer),
approx_eq (1::Int) True,
approx_eq (Just ()) [],
approx_eq ((2::Integer),(2::Integer)) ((1::Integer),(2::Integer)),
approx_eq ((1::Integer),(2::Integer)) ((1::Integer),(2::Integer)) ]
data ApproxEq' = ApproxEq'
instance GFN (S Z) ApproxEq' (x,x) (PairOf (Member Fractionals))
instance (Fractional x, Ord x) =>
Apply (GFnA (S Z) ApproxEq') (x,x) Bool where
apply _ (x,y) = abs (x y) < 0.5
instance GFN Z ApproxEq' (x,x) (PairOf (Member Nums))
instance (Num x, Ord x) =>
Apply (GFnA Z ApproxEq') (x,x) Bool where
apply _ (x,y) = abs (x y) < 2
instance TypeCast pred Otherwise => GFN n ApproxEq' a pred
instance Apply (GFnA n ApproxEq') a Bool where
apply _ _ = False
test4 = apply (GFn ApproxEq') ((1.0::Double),(1.5::Double))
data HNil = HNil
data a :*: b = a :*: b
infixr 5 :*:
data HTrue
data HFalse
data Z = Z
newtype S n = S n
class TypeCast a b | a -> b, b->a where typeCast :: a -> b
class TypeCast' t a b | t a -> b, t b -> a where typeCast' :: t->a->b
class TypeCast'' t a b | t a -> b, t b -> a where typeCast'' :: t->a->b
instance TypeCast' () a b => TypeCast a b where typeCast x = typeCast' () x
instance TypeCast'' t a b => TypeCast' t a b where typeCast' = typeCast''
instance TypeCast'' () a a where typeCast'' _ x = x
class TypeEq x y b | x y -> b
instance TypeEq x x HTrue
instance TypeCast HFalse b => TypeEq x y b
class Apply f a r | f a -> r where
apply :: f -> a -> r
apply = undefined
instance Apply (x -> y) x y where
apply f x = f x