Context reduction with functional dependencies?
Thomas Hallgren
hallgren@cs.chalmers.se
Fri, 15 Dec 2000 20:47:55 +0100
This is a multi-part message in MIME format.
--------------000008010800080402070402
Content-Type: text/plain; charset=us-ascii; format=flowed
Content-Transfer-Encoding: 7bit
Hi,
I have been doing an experiment where I use type classes to express
static (compile-time) computations in Haskell. With multi-parameter
classes and functional dependencies, instance declarations can be used
to define function by pattern matching (on the type level). I enclose an
example where I define booleans, natural numbers, a
less-than-or-equal-to function and a maximum function.
In some simple examples (one_lte_two and two_lte_one), it works fine,
but in the last example, where I try to compute the maximum of 1 and 2
in Hugs (hugs -98, February 2000), I get the following error message:
Type checking
ERROR "FuncDeps4.hs" (line 27): Unresolved top-level overloading
*** Binding : max_one_two
*** Outstanding context : (Lte Z (S Z) b, If b (S (S Z)) (S Z) c)
Here I expected that the functional dependencies would allow b to be
instantiated to T, and hence c to be instantiated to S (S Z), which
would then be the type of max_one_two. Why doesn't this work?
Regards,
Thomas Hallgren
--------------000008010800080402070402
Content-Type: text/plain;
name="FuncDeps4.hs"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="FuncDeps4.hs"
module FuncDeps4 where
data T
data F
class If b t e r | b t e -> r
instance If T t e t
instance If F t e e
data Z
data S n
type One = S Z
type Two = S One
class Lte a b c | a b -> c where lte :: a -> b -> c
instance Lte Z b T
instance Lte (S n) Z F
instance Lte a b c => Lte (S a) (S b) c
one_lte_two = lte (u::One) (u::Two) -- :: T
two_lte_one = lte (u::Two) (u::One) -- :: F
class Max a b c | a b -> c where max' :: a -> b -> c
instance (Lte a b l,If l b a c) => Max a b c
-- This doesn't work without the type signature:
max_one_two = max' (u::One) (u::Two) -- :: Two
u=undefined -- Just a convenient abbreviation
--------------000008010800080402070402--