From ff2a96c13d24e230bde6f3f9f272995936a60da5 Mon Sep 17 00:00:00 2001 From: Don Stewart Date: Thu, 19 May 2005 03:24:30 +0000 Subject: [PATCH] Fixes to use $fptools-compatible Dynamic --- TODO | 2 ++ examples/eval/eval3/Main.hs | 22 ++++++-------- src/altdata/AltData/Dynamic.hs | 49 +++++++++++------------------- src/build.mk | 4 +++ src/plugins/System/Eval/Haskell.hs | 2 +- src/plugins/System/Plugins/Load.hs | 4 +-- 6 files changed, 36 insertions(+), 47 deletions(-) diff --git a/TODO b/TODO index 0c1997f..9e5f28a 100644 --- a/TODO +++ b/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 diff --git a/examples/eval/eval3/Main.hs b/examples/eval/eval3/Main.hs index 1082a84..47af6e3 100644 --- a/examples/eval/eval3/Main.hs +++ b/examples/eval/eval3/Main.hs @@ -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) diff --git a/src/altdata/AltData/Dynamic.hs b/src/altdata/AltData/Dynamic.hs index 5f6d63b..346dc9c 100644 --- a/src/altdata/AltData/Dynamic.hs +++ b/src/altdata/AltData/Dynamic.hs @@ -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 diff --git a/src/build.mk b/src/build.mk index 15e4e43..985b532 100644 --- a/src/build.mk +++ b/src/build.mk @@ -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) diff --git a/src/plugins/System/Eval/Haskell.hs b/src/plugins/System/Eval/Haskell.hs index a9cfa20..4b3d5d8 100644 --- a/src/plugins/System/Eval/Haskell.hs +++ b/src/plugins/System/Eval/Haskell.hs @@ -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 diff --git a/src/plugins/System/Plugins/Load.hs b/src/plugins/System/Plugins/Load.hs index c40b3e5..9f9361c 100644 --- a/src/plugins/System/Plugins/Load.hs +++ b/src/plugins/System/Plugins/Load.hs @@ -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"]