Data/Dynamic.hs (original) (raw)

#ifdef GLASGOW_HASKELL

#endif

module Data.Dynamic (

    module Data.Typeable,

    
    Dynamic,        

    
    toDyn,          
    fromDyn,        
    fromDynamic,    
    
    
    dynApply,
    dynApp,
    dynTypeRep

) where

import Data.Typeable import Data.Maybe import Unsafe.Coerce

#ifdef GLASGOW_HASKELL import GHC.Base import GHC.Show import GHC.Exception #endif

#ifdef HUGS import Hugs.Prelude import Hugs.IO import Hugs.IORef import Hugs.IOExts #endif

#ifdef NHC import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO) #endif

#include "Typeable.h"

#ifndef HUGS data Dynamic = Dynamic TypeRep Obj #endif

INSTANCE_TYPEABLE0(Dynamic,dynamicTc,"Dynamic")

instance Show Dynamic where

showsPrec _ (Dynamic t _) = showString "<<" . showsPrec 0 t . showString ">>"

#ifdef GLASGOW_HASKELL

instance Exception Dynamic #endif

#ifdef GLASGOW_HASKELL type Obj = Any

#elif !defined(HUGS) data Obj = Obj #endif

toDyn :: Typeable a => a -> Dynamic toDyn v = Dynamic (typeOf v) (unsafeCoerce v)

fromDyn :: Typeable a => Dynamic
-> a
-> a

fromDyn (Dynamic t v) def | typeOf def == t = unsafeCoerce v | otherwise = def

fromDynamic :: Typeable a => Dynamic
-> Maybe a

fromDynamic (Dynamic t v) = case unsafeCoerce v of r | t == typeOf r -> Just r | otherwise -> Nothing

dynApply :: Dynamic -> Dynamic -> Maybe Dynamic dynApply (Dynamic t1 f) (Dynamic t2 x) = case funResultTy t1 t2 of Just t3 -> Just (Dynamic t3 ((unsafeCoerce f) x)) Nothing -> Nothing

dynApp :: Dynamic -> Dynamic -> Dynamic dynApp f x = case dynApply f x of Just r -> r Nothing -> error ("Type error in dynamic application.\n" ++ "Can't apply function " ++ show f ++ " to argument " ++ show x)

dynTypeRep :: Dynamic -> TypeRep dynTypeRep (Dynamic tr _) = tr