[Haskell-cafe] Newbie question: "multi-methods" in Haskell

peterv bf3 at telenet.be
Mon Aug 6 16:44:55 EDT 2007


This is very nice, but it does not really solve the original problem.

In your code, evaluating

collide (Jupiter, Asteroid)

will result in an endless loop. This is expected in your code, because no
"inheritance" relation is present between e.g Jupiter and Planet. With
multi-dispatch, it should pick the "best" matching collide function based on
inheritance, or raise an error when ambiguous types.

I could fix that be just keeping the "leafs" (Earth, Jupiter, Asteroid) as
datatypes, and adding type classes for the "super classes" (Planet, Solid),
like the code below, but I could not check Asteroid-Asteroid collision with
that, GHCi gives an error.

{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances
-fallow-overlapping-instances #-}

module Collide where

class Collide a where
    collide :: a -> String

data Asteroid = Asteroid
data Jupiter = Jupiter
data Earth = Earth

class IsSolid a
class IsSolid a => IsPlanet a

instance IsSolid Asteroid
instance IsSolid Jupiter
instance IsSolid Earth

instance IsPlanet Earth
instance IsPlanet Jupiter

instance (IsSolid a, IsSolid b) => Collide (a, b) where
    collide (x,y) = "generic collision"

instance (IsPlanet a) => Collide (Asteroid, a) where
    collide (x,y) = "an asteroid hit a planet"

instance (IsPlanet a) => Collide (a, Asteroid) where
    collide (x, y) = "an asteroid hit a planet"

instance Collide (Asteroid, Earth) where
    collide (_,_) = "the end of the dinos"

instance Collide (Earth, Asteroid) where
    collide (_,_) = "the end of the dinos"

-- This is how you get dynamic dispatch in Haskell
data Collision = forall a. Collide a => Collision a

instance Collide Collision where
    collide (Collision a) = collide a

ae = collide (Asteroid, Earth)
ea = collide (Earth, Asteroid)
ja = collide (Jupiter, Asteroid)
aj = collide (Asteroid, Jupiter)

-- However, this one gives an error?
--aa = collide (Asteroid, Asteroid)


-----Original Message-----
From: haskell-cafe-bounces at haskell.org
[mailto:haskell-cafe-bounces at haskell.org] On Behalf Of Brian Hulley
Sent: Monday, August 06, 2007 9:15 PM
To: haskell-cafe at haskell.org
Subject: Re: [Haskell-cafe] Newbie question: "multi-methods" in Haskell

Dan Weston wrote:
> Remember that type classes do not provide object-oriented 
> functionality. The dispatch is static, not dynamic. Although OOP can 
> be simulated in Haskell, it is not a natural idiom. If you need 
> dynamic dispatch (including multiple dispatch), you may want to 
> reconsider your solution.
Dynamic dispatch is easily added to Haskell code by using an existential 
to represent any collision:

{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances 
-fallow-overlapping-instances #-}

module Collide where

-- Changed to a single param to make life easier...
class Collide a where
    collide :: a -> String

data Solid = Solid
data Asteroid = Asteroid
data Planet = Planet
data Jupiter = Jupiter
data Earth = Earth

instance Collide (Asteroid, Planet) where
    collide (Asteroid, Planet) = "an asteroid hit a planet"

instance Collide (Asteroid, Earth) where
    collide (Asteroid, Earth) = "the end of the dinos"

-- Needs overlapping and undecidable instances
instance Collide (a, b) => Collide (b, a) where
    collide (a,b) = collide (b, a)

-- This is how you get dynamic dispatch in Haskell
data Collision = forall a. Collide a => Collision a

instance Collide Collision where
    collide (Collision a) = collide a

-- ghci output
*Collide> let ae = Collision (Asteroid, Earth)
*Collide> let pa = Collision (Planet, Asteroid)
*Collide> collide ae
"the end of the dinos"
*Collide> collide pa
"an asteroid hit a planet"
*Collide> map collide [ae, pa]
["the end of the dinos","an asteroid hit a planet"]


Best regards, Brian.
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe at haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe



More information about the Haskell-Cafe mailing list