Simulating OO programming with type classes; writing a factory fu nction

I've been experimenting with simulating OO programming in Haskell (why, you might ask? Because I'm trying to port a non-trivial piece of software, and I want to respect the original design, at least to begin with). I've been trying the technique illustrated by Ralf Laemmel: http://homepages.cwi.nl/~ralf/OOHaskell/src/interpreter/extensible.hs There's a small problem: how to write a factory function that returns values of various subtypes. The makeSubType function below won't compile, obviously because the returns types are different (they're not the same 'm'). I realise that I'm looking for something that Haskell doesn't natively do, so my question is: is there some kind of workaround that'll give me the ability to write factory functions? (No doubt there's some obvious trick that I've missed :-) I'm aware of http://homepages.cwi.nl/~ralf/OOHaskell/ , which will be my technique of last resort. I was fond of Ralf's extensible interpreter example because it's quite lightweight, but if there's no way around the factory problem, so be it. Alistair. ------------------------------------------- -- Toy OO example with subtyping module Main where main = print "boo" -- class to represent OO base class class BaseClass c -- each subtype of BaseClass is a separate datatype data SubBase1 = SubBase1 Int data BaseClass c => SubBase2 c = SubBase2 c instance BaseClass SubBase1 instance BaseClass (SubBase2 c) -- methods of BaseClass defined with new class class BaseClass c => Method c where -- illegal: can't return values of type c; can only consume them method1 :: c -> Int -> c method2 :: c -> Int -- install each subtype (datatype) as instance of Method instance Method SubBase1 where method1 _ i = SubBase1 i method2 (SubBase1 i) = i instance Method c => Method (SubBase2 c) where -- This one fails, because must return polymorphic value, not concrete --method1 _ i = SubBase2 (SubBase1 5) method1 x i = x method2 x = 2 -- Also, cannot make factory function: --makeSubType :: (Method m) => String -> m makeSubType s = if s == "SubBase1" then SubBase1 3 else SubBase2 (SubBase1 4) ----------------------------------------- ***************************************************************** Confidentiality Note: The information contained in this message, and any attachments, may contain confidential and/or privileged material. It is intended solely for the person(s) or entity to which it is addressed. Any review, retransmission, dissemination, or taking of any action in reliance upon this information by persons or entities other than the intended recipient(s) is prohibited. If you received this in error, please contact the sender and delete the material from any computer. *****************************************************************

Hi Alistair! Just a "quick" reply (I didn't had time to look at Ralf's technique). Looking at your code, it seems to me that you are missing the notion of a supertype (perhaps, that's the intended thing with BaseClass?). I would use an existencial type to "capture" this notion: =========== data Base = forall c . Method c => Base c instance BaseClass Base instance Method Base where method1 (Base x) i = Base (method1 x i) method2 (Base x) = method2 x the modifications on the code would be: class BaseClass c => Method c where -- method1 returns a supertype Base method1 :: c -> Int -> Base method2 :: c -> Int instance Method c => Method (SubBase2 c) where -- method1 does not fail any more method1 x i = Base (SubBase2 (SubBase1 5)) method2 x = 2 makeSubType s = if s == "SubBase1" then Base (SubBase1 3) else Base (SubBase2 (SubBase1 4)) ============ Perhaps a better name for Base would be SuperMethod (since it is really trying to capture the fact that is the super type for Method). Hope it helps Cheers, Bruno

Alistair Bayley wrote:
There's a small problem: how to write a factory function that returns values of various subtypes. The makeSubType function below won't compile, obviously because the returns types are different (they're not the same 'm').
Indeed, expressions in both branches of an `if' statement
if s == "SubBase1" then SubBase1 3 else SubBase2 (SubBase1 4)
must be of the same type. If we had intersection types (I'm not complaining!), the compiler would have derived the intersection by itself. As things are now, we have to make the intersection manually: we have to abstract away irrelevant pieces. Expressions `SubBase1 3' and `SubBase2 (SubBase1 4)' have in common the fact that both have types that are instances of a Method class. So, we have to write that common piece of information explicitly. There are two ways of doing this, which can be called direct style and CPS style. In direct style, we do
data WM = forall m. Method m => WM m makeSubType1 :: String -> WM makeSubType1 s = if s == "SubBase1" then WM $ SubBase1 3 else WM $ SubBase2 (SubBase1 4)
test1 = let foo x = case x of WM y -> method2 y in map (foo . makeSubType1) ["SubBase1", "SubBase2"]
The CPS style is just the inverse:
-- Higher-ranked type: signature is required! makeSubType2:: (forall m. Method m => m -> w) -> String -> w makeSubType2 consumer s = if s == "SubBase1" then consumer $ SubBase1 3 else consumer $ SubBase2 (SubBase1 4)
test2 = let foo x = method2 x in map (makeSubType2 foo) ["SubBase1", "SubBase2"]
The CPS style involves less tagging (no need to add and remove the tag WM). Also, the CPS style is more general:
makeSubType1' s = makeSubType2 WM s
test3 = let foo x = case x of WM y -> method2 y in map (foo . makeSubType1') ["SubBase1", "SubBase2"]
participants (3)
-
Bayley, Alistair
-
Bruno Oliveira
-
oleg@pobox.com