Fixes to use $fptools-compatible Dynamic

This commit is contained in:
Don Stewart 2005-05-19 03:24:30 +00:00
parent 6045e47850
commit ff2a96c13d
6 changed files with 36 additions and 47 deletions

2
TODO
View File

@ -1,6 +1,8 @@
For 0.1
----------
+ Cascading unload/reload
+ have eval, printf return errors as arguments, not to stdout
+ nice functions for cleaning up /tmp files, given a module name

View File

@ -10,24 +10,25 @@
#include "../../../config.h"
import System.Eval.Haskell
import System.Eval
import AltData.Dynamic
-- import Data.Dynamic
pkgconf = TOP ++ "/plugins.conf.inplace"
main = do
a <- return $ toDyn (3::Int)
m_b <- unsafeEval_ "\\dyn -> fromMaybe (7 :: Int) (fromDyn dyn)"
["AltData.Dynamic","Data.Maybe"] -- imports
a <- return $ toDyn (3::Integer)
-- so, we try to compile a function that takes a dyn.
-- looks like with GHC 6.4, we need to make sure the package.confs work:
m_b <- unsafeEval_ "\\dyn -> fromDyn dyn (7 :: Integer)"
["AltData.Dynamic"]
[ "-package-conf "++pkgconf , "-package altdata" ]
[ pkgconf ]
[]
case m_b of
Left s -> mapM_ putStrLn s
Right b -> putStrLn $ show (b a :: Integer) -- now apply it
{-
-- should work, but doesn't. type check fails
@ -37,6 +38,3 @@ main = do
["Data.Dynamic","Data.Maybe"] [] []
-}
case m_b of
Left s -> mapM_ putStrLn s
Right b -> putStrLn $ show (b a :: Int)

View File

@ -1,4 +1,4 @@
{-# OPTIONS_GHC -fno-implicit-prelude #-}
{-# OPTIONS -fglasgow-exts -cpp #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Dynamic
@ -18,11 +18,10 @@
--
-----------------------------------------------------------------------------
module Data.Dynamic
(
module AltData.Dynamic (
-- Module Data.Typeable re-exported for convenience
module Data.Typeable,
module AltData.Typeable,
-- * The @Dynamic@ type
Dynamic, -- abstract, instance of: Show, Typeable
@ -39,35 +38,17 @@ module Data.Dynamic
) where
import AltData.Typeable
import Data.Maybe
#ifdef __GLASGOW_HASKELL__
import System.IO.Unsafe (unsafePerformIO)
import GHC.Base
import GHC.Show
import GHC.Err
import GHC.Num
#endif
#ifdef __HUGS__
import Hugs.Prelude
import Hugs.IO
import Hugs.IORef
import Hugs.IOExts
#endif
#ifdef __GLASGOW_HASKELL__
unsafeCoerce :: a -> b
unsafeCoerce = unsafeCoerce#
#endif
#ifdef __NHC__
import NonStdUnsafeCoerce (unsafeCoerce)
import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
#endif
#include "Typeable.h"
-------------------------------------------------------------
--
@ -85,11 +66,14 @@ import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
'Show'ing a value of type 'Dynamic' returns a pretty-printed representation
of the object\'s type; useful for debugging.
-}
#ifndef __HUGS__
data Dynamic = Dynamic TypeRep Obj
#endif
INSTANCE_TYPEABLE0(Dynamic,dynamicTc,"Dynamic")
instance Typeable Dynamic where
#if __GLASGOW_HASKELL__ >= 603
typeOf _ = mkTyConApp (mkTyCon "AltData.Dynamic") []
#else
typeOf _ = mkAppTy (mkTyCon "AltData.Dynamic") []
#endif
instance Show Dynamic where
-- the instance just prints the type representation.
@ -98,7 +82,6 @@ instance Show Dynamic where
showsPrec 0 t .
showString ">>"
#ifdef __GLASGOW_HASKELL__
type Obj = forall a . a
-- Dummy type to hold the dynamically typed value.
--
@ -109,9 +92,6 @@ type Obj = forall a . a
-- the other hand, if we use a polymorphic type, GHC will use
-- a fallback convention for evaluating it that works for all types.
-- (using a function type here would also work).
#elif !defined(__HUGS__)
data Obj = Obj
#endif
-- | Converts an arbitrary value into an object of type 'Dynamic'.
--
@ -148,7 +128,12 @@ fromDynamic
fromDynamic (Dynamic t v) =
case unsafeCoerce v of
r | t == typeOf r -> Just r
| otherwise -> Nothing
| otherwise -> unsafePerformIO (putStrLn $
"Couldn't match `" ++show(typeOf r) ++
"' against `" ++show t ++"'"++
"\n\tExpected type: " ++show(typeOf r) ++
"\n\tInferred type: " ++show t
) `seq` Nothing
-- (f::(a->b)) `dynApply` (x::a) = (f a)::b
dynApply :: Dynamic -> Dynamic -> Maybe Dynamic

View File

@ -67,6 +67,10 @@ depend: $(ALL_SRCS)
%.$(way_)o: %.hs
$(GHC) $(HC_OPTS) -c $< -o $@ -ohi $(basename $@).$(way_)hi
# Now a rule for hs-boot files.
%.$(way_)o-boot : %.hs-boot
$(GHC) $(HC_OPTS) $(PKG_OPTS) -c $< -o $@ -ohi $(basename $@).$(way_)hi-boot
# happy files
$(YOBJ): $(YSRC)
$(HAPPY) $(HAPPY_OPTS) -o $@ $(YSRC)

View File

@ -42,7 +42,7 @@ import System.Eval.Utils
import System.Plugins.Make
import System.Plugins.Load
import AltData.Dynamic
import AltData.Dynamic ( Dynamic )
import AltData.Typeable ( Typeable )
import Data.Either

View File

@ -54,7 +54,7 @@ import System.Plugins.Consts ( sysPkgSuffix, hiSuf, prefixUnderscore )
import Language.Hi.Parser
import AltData.Dynamic ( fromDyn, Dynamic )
import AltData.Dynamic ( fromDynamic, Dynamic )
import AltData.Typeable ( Typeable )
import Data.List ( isSuffixOf, nub, nubBy )
@ -161,7 +161,7 @@ dynload obj incpaths pkgconfs sym = do
s <- load obj incpaths pkgconfs sym
case s of e@(LoadFailure _) -> return e
LoadSuccess m dyn_v -> return $
case fromDyn (unsafeCoerce# dyn_v :: Dynamic) of
case fromDynamic (unsafeCoerce# dyn_v :: Dynamic) of
Just v' -> LoadSuccess m v'
Nothing -> LoadFailure ["Mismatched types in interface"]