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
|
For 0.1
|
||||||
----------
|
----------
|
||||||
|
|
||||||
|
+ Cascading unload/reload
|
||||||
|
|
||||||
+ have eval, printf return errors as arguments, not to stdout
|
+ have eval, printf return errors as arguments, not to stdout
|
||||||
|
|
||||||
+ nice functions for cleaning up /tmp files, given a module name
|
+ nice functions for cleaning up /tmp files, given a module name
|
||||||
|
@ -10,25 +10,26 @@
|
|||||||
|
|
||||||
#include "../../../config.h"
|
#include "../../../config.h"
|
||||||
|
|
||||||
import System.Eval.Haskell
|
import System.Eval
|
||||||
import AltData.Dynamic
|
import AltData.Dynamic
|
||||||
|
|
||||||
-- import Data.Dynamic
|
|
||||||
|
|
||||||
pkgconf = TOP ++ "/plugins.conf.inplace"
|
pkgconf = TOP ++ "/plugins.conf.inplace"
|
||||||
|
|
||||||
main = do
|
main = do
|
||||||
a <- return $ toDyn (3::Int)
|
a <- return $ toDyn (3::Integer)
|
||||||
|
|
||||||
m_b <- unsafeEval_ "\\dyn -> fromMaybe (7 :: Int) (fromDyn dyn)"
|
|
||||||
["AltData.Dynamic","Data.Maybe"] -- imports
|
|
||||||
|
|
||||||
|
-- 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" ]
|
[ "-package-conf "++pkgconf , "-package altdata" ]
|
||||||
|
|
||||||
[ pkgconf ]
|
[ 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
|
-- should work, but doesn't. type check fails
|
||||||
-- (due to static vs dynamic typing issue)
|
-- (due to static vs dynamic typing issue)
|
||||||
@ -37,6 +38,3 @@ main = do
|
|||||||
["Data.Dynamic","Data.Maybe"] [] []
|
["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
|
-- Module : Data.Dynamic
|
||||||
@ -18,11 +18,10 @@
|
|||||||
--
|
--
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
|
|
||||||
module Data.Dynamic
|
module AltData.Dynamic (
|
||||||
(
|
|
||||||
|
|
||||||
-- Module Data.Typeable re-exported for convenience
|
-- Module Data.Typeable re-exported for convenience
|
||||||
module Data.Typeable,
|
module AltData.Typeable,
|
||||||
|
|
||||||
-- * The @Dynamic@ type
|
-- * The @Dynamic@ type
|
||||||
Dynamic, -- abstract, instance of: Show, Typeable
|
Dynamic, -- abstract, instance of: Show, Typeable
|
||||||
@ -39,35 +38,17 @@ module Data.Dynamic
|
|||||||
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
|
||||||
import AltData.Typeable
|
import AltData.Typeable
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
|
||||||
#ifdef __GLASGOW_HASKELL__
|
import System.IO.Unsafe (unsafePerformIO)
|
||||||
|
|
||||||
import GHC.Base
|
import GHC.Base
|
||||||
import GHC.Show
|
import GHC.Show
|
||||||
import GHC.Err
|
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 :: a -> b
|
||||||
unsafeCoerce = unsafeCoerce#
|
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
|
'Show'ing a value of type 'Dynamic' returns a pretty-printed representation
|
||||||
of the object\'s type; useful for debugging.
|
of the object\'s type; useful for debugging.
|
||||||
-}
|
-}
|
||||||
#ifndef __HUGS__
|
|
||||||
data Dynamic = Dynamic TypeRep Obj
|
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
|
instance Show Dynamic where
|
||||||
-- the instance just prints the type representation.
|
-- the instance just prints the type representation.
|
||||||
@ -98,7 +82,6 @@ instance Show Dynamic where
|
|||||||
showsPrec 0 t .
|
showsPrec 0 t .
|
||||||
showString ">>"
|
showString ">>"
|
||||||
|
|
||||||
#ifdef __GLASGOW_HASKELL__
|
|
||||||
type Obj = forall a . a
|
type Obj = forall a . a
|
||||||
-- Dummy type to hold the dynamically typed value.
|
-- 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
|
-- the other hand, if we use a polymorphic type, GHC will use
|
||||||
-- a fallback convention for evaluating it that works for all types.
|
-- a fallback convention for evaluating it that works for all types.
|
||||||
-- (using a function type here would also work).
|
-- (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'.
|
-- | Converts an arbitrary value into an object of type 'Dynamic'.
|
||||||
--
|
--
|
||||||
@ -148,7 +128,12 @@ fromDynamic
|
|||||||
fromDynamic (Dynamic t v) =
|
fromDynamic (Dynamic t v) =
|
||||||
case unsafeCoerce v of
|
case unsafeCoerce v of
|
||||||
r | t == typeOf r -> Just r
|
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
|
-- (f::(a->b)) `dynApply` (x::a) = (f a)::b
|
||||||
dynApply :: Dynamic -> Dynamic -> Maybe Dynamic
|
dynApply :: Dynamic -> Dynamic -> Maybe Dynamic
|
||||||
|
@ -67,6 +67,10 @@ depend: $(ALL_SRCS)
|
|||||||
%.$(way_)o: %.hs
|
%.$(way_)o: %.hs
|
||||||
$(GHC) $(HC_OPTS) -c $< -o $@ -ohi $(basename $@).$(way_)hi
|
$(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
|
# happy files
|
||||||
$(YOBJ): $(YSRC)
|
$(YOBJ): $(YSRC)
|
||||||
$(HAPPY) $(HAPPY_OPTS) -o $@ $(YSRC)
|
$(HAPPY) $(HAPPY_OPTS) -o $@ $(YSRC)
|
||||||
|
@ -42,7 +42,7 @@ import System.Eval.Utils
|
|||||||
import System.Plugins.Make
|
import System.Plugins.Make
|
||||||
import System.Plugins.Load
|
import System.Plugins.Load
|
||||||
|
|
||||||
import AltData.Dynamic
|
import AltData.Dynamic ( Dynamic )
|
||||||
import AltData.Typeable ( Typeable )
|
import AltData.Typeable ( Typeable )
|
||||||
|
|
||||||
import Data.Either
|
import Data.Either
|
||||||
|
@ -54,7 +54,7 @@ import System.Plugins.Consts ( sysPkgSuffix, hiSuf, prefixUnderscore )
|
|||||||
|
|
||||||
import Language.Hi.Parser
|
import Language.Hi.Parser
|
||||||
|
|
||||||
import AltData.Dynamic ( fromDyn, Dynamic )
|
import AltData.Dynamic ( fromDynamic, Dynamic )
|
||||||
import AltData.Typeable ( Typeable )
|
import AltData.Typeable ( Typeable )
|
||||||
|
|
||||||
import Data.List ( isSuffixOf, nub, nubBy )
|
import Data.List ( isSuffixOf, nub, nubBy )
|
||||||
@ -161,7 +161,7 @@ dynload obj incpaths pkgconfs sym = do
|
|||||||
s <- load obj incpaths pkgconfs sym
|
s <- load obj incpaths pkgconfs sym
|
||||||
case s of e@(LoadFailure _) -> return e
|
case s of e@(LoadFailure _) -> return e
|
||||||
LoadSuccess m dyn_v -> return $
|
LoadSuccess m dyn_v -> return $
|
||||||
case fromDyn (unsafeCoerce# dyn_v :: Dynamic) of
|
case fromDynamic (unsafeCoerce# dyn_v :: Dynamic) of
|
||||||
Just v' -> LoadSuccess m v'
|
Just v' -> LoadSuccess m v'
|
||||||
Nothing -> LoadFailure ["Mismatched types in interface"]
|
Nothing -> LoadFailure ["Mismatched types in interface"]
|
||||||
|
|
||||||
|
Loading…
x
Reference in New Issue
Block a user