On 10/26/05, Tomasz Zielonka <[EMAIL PROTECTED]> wrote:
> See code in the attachment.
I forgot to attach it :-)
Best regards
Tomasz
{-# OPTIONS -fglasgow-exts #-}
module Type where
import Control.Monad
data Type t where
Bool :: Type Bool
Int :: Type Int
Char :: Type Char
Unit :: Type ()
List :: Type a -> Type [a]
Pair :: Type a -> Type b -> Type (a, b)
Fun :: Type a -> Type b -> Type (a -> b)
instance Show (Type t) where
show Bool = "Bool"
show Int = "Int"
show Char = "Char"
show Unit = "()"
show (List a) = "[" ++ show a ++ "]"
show (Pair a b) = "(" ++ show a ++ ", " ++ show b ++ ")"
show (Fun a b) = "(" ++ show a ++ " -> " ++ show b ++ ")"
class Typed t where
typeOf :: t -> Type t
instance Typed Bool where typeOf _ = Bool
instance Typed Int where typeOf _ = Int
instance Typed Char where typeOf _ = Char
instance Typed () where typeOf _ = Unit
instance Typed a => Typed [a] where typeOf x = List (typeOf (head x))
instance (Typed a, Typed b) => Typed (a, b) where
typeOf ~(a,b) = Pair (typeOf a) (typeOf b)
instance (Typed a, Typed b) => Typed (a->b) where
typeOf _ = Fun (typeOf (undefined :: a)) (typeOf (undefined :: b))
cast :: (Typed a, Typed b) => a -> Maybe b
cast a = cast0 (typeOf a) (typeOf (undefined :: b)) a
newtype Wrapper1 f tc a = Wrapper1 (f (tc a))
newtype Wrapper21 f tc a b = Wrapper21 (f (tc a b))
newtype Wrapper22 f tc b a = Wrapper22 (f (tc a b))
cast1 :: MonadPlus m => (Type a) -> (Type b) -> f a -> m (f b)
cast1 Bool Bool x = return x
cast1 Int Int x = return x
cast1 Char Char x = return x
cast1 Unit Unit x = return x
cast1 (List a) (List b) x = do
Wrapper1 y <- cast1 a b (Wrapper1 x)
return y
cast1 (Pair a1 b1) (Pair a2 b2) x = cast1TC2 a1 b1 a2 b2 x
cast1 (Fun a1 b1) (Fun a2 b2) x = cast1TC2 a1 b1 a2 b2 x
cast1 _ _ _ = mzero
cast1TC2 :: MonadPlus m =>
Type a -> Type b1 -> Type b2 -> Type b -> f (tc a b1) -> m (f (tc b2 b))
cast1TC2 a1 b1 a2 b2 x = do
Wrapper21 x' <- cast1 b1 b2 (Wrapper21 x)
Wrapper22 x'' <- cast1 a1 a2 (Wrapper22 x')
return x''
newtype Id a = Id { unId :: a }
cast0 :: MonadPlus m => (Type a) -> (Type b) -> a -> m b
cast0 ta tb x = liftM unId (cast1 ta tb (Id x))
data Dyn = forall a. Typed a => Dyn a
fromDyn :: Typed a => Dyn -> Maybe a
fromDyn (Dyn d) = cast d
toDyn :: Typed a => a -> Dyn
toDyn a = Dyn a
withDyn :: Dyn -> (forall a. Typed a => a -> b) -> b
withDyn (Dyn d) f = f d
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
