Fixes to use $fptools-compatible Dynamic
This commit is contained in:
parent
6045e47850
commit
ff2a96c13d
2
TODO
2
TODO
@ -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
|
||||
|
@ -10,25 +10,26 @@
|
||||
|
||||
#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
|
||||
-- (due to static vs dynamic typing issue)
|
||||
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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"]
|
||||
|
||||
|
Loading…
x
Reference in New Issue
Block a user