[Haskell-cafe] A yet another question about subtyping and heterogeneous collections

MigMit miguelimo38 at yandex.ru
Thu Oct 18 13:20:51 CEST 2012


Why do you need "ALike x", "BLike x" etc.? Why not just "Like u x"?

Отправлено с iPhone

Oct 18, 2012, в 14:36, Dmitry Vyal <akamaus at gmail.com> написал(а):

> Hello list!
> 
> I've been experimenting with emulating subtyping and heterogeneous collections in Haskell. I need this to parse a binary representation of objects of a class hierarchy in C++ program.
> 
> So far I implemented upcasting using a chain of type classes and now I'm playing with heterogeneous lists. For future purposes It would be ideal to be able to have something like these functions:
> upcast_list :: [LikeC] -> [LikeA]
> downcast_list :: [LikeA] -> [LikeC]
> 
> First one only replaces the existential wrapper leaving the actual value intact, and the second one also filters the list, passing the elements with specific enough type.
> 
> I can implement this particular functions, but what's about a more general one? Something like cast_list :: [a] -> [b], where a and b are existential types from one hierarchy. Something like LikeA and LikeC in my example.
> 
> Is my approach feasible? Is there a better one? Am I missing something obvious?
> Any relevant advices are welcome.
> 
> The example code follows:
> 
> {-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances, ExistentialQuantification, DeriveDataTypeable #-}
> 
> import Data.Typeable
> import Data.Maybe
> 
> data A = A {a_x :: Int} deriving (Show, Typeable)
> data B = B {b_x :: Int, b_a :: A} deriving (Show, Typeable)
> data C = C {c_z :: Int, c_b :: B} deriving (Show, Typeable)
> data D = D {d_w :: Int, d_c :: C, d_a :: A} deriving (Show, Typeable)
> 
> class ALike x where toA :: x -> A
> class BLike x where toB :: x -> B
> class CLike x where toC :: x -> C
> class DLike x where toD :: x -> D
> 
> instance ALike A where toA = id
> instance BLike B where toB = id
> instance CLike C where toC = id
> instance DLike D where toD = id
> 
> instance ALike B where toA = b_a
> instance BLike C where toB = c_b
> instance CLike D where toC = d_c
> 
> instance (BLike x) => (ALike x) where
>  toA = (toA :: B -> A) . toB
> instance CLike x => BLike x where
>  toB = toB . toC
> 
> a1 = A 1
> b1 = B 2 (A 2)
> c1 = C 3 b1
> d1 = D 4 c1 (A 10)
> 
> print_a :: ALike x => x -> String
> print_a v = "A = " ++ show (a_x $ toA v)
> 
> sum_a :: (ALike x, ALike y) => x -> y -> String
> sum_a v1 v2 = "A1 = " ++ show (a_x $ toA v1) ++ " A2 = " ++ show (a_x $ toA v2)
> 
> 
> data LikeA = forall a. (ALike a, Typeable a) => LikeA a
> 
> instance ALike LikeA where
>  toA (LikeA x) = toA x
> 
> get_mono :: Typeable b => [LikeA] -> [b]
> get_mono = catMaybes . map ((\(LikeA x) -> cast x))
> 
> data LikeC = forall c. (CLike c, Typeable c) => LikeC c
> 
> instance CLike LikeC where
>  toC (LikeC x) = toC x
> 
> lst_a = [LikeA a1, LikeA b1, LikeA c1, LikeA d1]
> lst_c = [LikeC c1, LikeC d1]
> 
> _______________________________________________
> 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