Dear all,
I'm trying to create active nodes that have a common base part and a
user definable custom part, run in their own thread and can
communicate/send message to each other. For some reason the compiler
complains about an ambiguous type, while I feel, though the type may be
partially ambiguous, I'm not using that particular part in related
function calls. So in some ways I think there is nothing to complain. Is
there a way to resolve this? Are there better/easier solutions to this
problem?
My solution so far is as follows (see code is below):
The active nodes have different types that have a common base state and
a changing top state. The base state will be responsible for connection
nodes to each other, the top state is user defined.
1. I 'piggy-bag' two State transformers (and IO) onto each other, one
with the base state and one with the custom state
2. In their own thread, the top state transformer processes the contents
of a list (in which each element is an action) that comes from a channel.
3. The channel is basically the active object and can receive message.
4. Since 'active objects' need to be stored in a list in the base state
they are wrapped in a general node data structure (GN) that hides the
type of the active object.
In this way, actions can be fed to the channel and are executed in the
thread and context of the state monad. One can define a changing
topstate and add basic functionality to it. This works reasonably well,
except that when I store a node into another node (using the base
functionality) and later on retrieve it and then want to apply some
other suitably typed functions functions using only the base
functionality, the compiler complains that the type is ambiguous.
However I feel it shouldn't complain, since the functions doesn't use
the ambiguous part. Of course the problem is resolved as soon as a
function establishes the type. However, in many cases I don't know (and
don't want to know the type). Can this be resolved?
The code below is unfortunately rather long. Of course it doesn't
compile, unless the last comment is removed. If removed it works fine.
Any comments and pointers appreciated. Thanks. (I'm quite new to
haskell, so I may be missing some obvious things.)
Maarten
P.S. (Sorry for the long code sample below, but I don't know how to
condens is into something smaller, while retaining the relevant properties).
{-# OPTIONS -fglasgow-exts -cpp -fallow-undecidable-instances #-}
module Main where
import Data.Generics
import Control.Monad.State
import Data.Unique
import Control.Concurrent (forkIO, forkOS)
import Control.Concurrent.Chan
import Control.Concurrent.MVar
instance Show Unique where
show a = show (hashUnique a)
-- default node state; same for all states; nodes are active objects
(see below)
data DefNodeState = DefNodeState { id::Unique, nodes::ActiveObjects }
deriving Show
-- make this default state a base state transformer
type BaseStateT m = StateT DefNodeState m
type BaseStateTIO = BaseStateT IO
-- TopStateT with parameterizable state
type TopStateT ts a = StateT ts BaseStateTIO a
instance Show (TopStateT b ()) where
show a = "TopStateT Monad"
tsTc = mkTyCon "TopStateT"
instance forall ts. (Show ts, Typeable ts) => Typeable1 (StateT ts
BaseStateTIO) where
typeOf1 _ = mkTyConApp tsTc []
-- hide top state type so we can put them in a list; typeable so it can
be cast back
data GN = forall o. (Show o,Typeable o) => GN o
instance Show (GN) where
show (GN o) = "GN " ++ show o
gnTc = mkTyCon "GN"
instance Typeable GN where
typeOf _ = mkTyConApp gnTc []
-- convenience type
type ActiveObjects = [GN]
-- active objects
-- make topstate an active object by putting it in a chan
data ActiveObject a = ActiveObject (Chan (TopStateT a ()))
-- make active object instance of show
instance Show (ActiveObject o) where
show o = "ActiveObject Chan StateT"
-- make active object typeable
activeObjectTc = mkTyCon "ActiveObject"
instance Typeable1 ActiveObject where
typeOf1 _ = mkTyConApp activeObjectTc []
-- make new active object over some state
newActiveObject action state t = do
chan <- newChan
contents <- getChanContents chan
forkIO (start (action contents) state)
return (ActiveObject chan)
-- send an action if we are not interested in the result
send :: forall a . (Typeable a, Show a) => ActiveObject a -> TopStateT a
() -> IO ()
send (ActiveObject chan) act = do
writeChan chan act
-- sync an action if we are interested in the result
sync :: forall a b. (Typeable a, Show a) => ActiveObject a -> TopStateT
a b -> IO b
sync ao f = do
mv <- newEmptyMVar
send ao (f' mv)
a <- takeMVar mv
return a
where
f' mv = do
a <- f
lift $ lift $ putMVar mv a
class SendSync t where
sendM :: forall a. (Typeable a, Show a) =>
t a -> TopStateT a () -> IO ()
syncM :: forall a b. (Typeable a, Show a) =>
t a -> TopStateT a b -> IO b
instance SendSync (ActiveObject) where
sendM ao m = send ao m
syncM ao m = sync ao m
{- unforunately doesn't work
instance SendSync (GN) where
sendM (GN ao) m = sendM ao m
syncM (GN ao) m = syncM ao m
-}
castGN :: forall a. (Show a,Typeable a) => GN -> ActiveObject a
castGN (GN o) = mcast o
where
mcast o = case (cast o) of
Nothing -> error "No cast possible"
Just a -> a
-- some test states for toplevel
data TestState = TestState { val::Int }
deriving (Show,Typeable)
data TestState2 = TestState2 { val2::Int }
deriving (Show,Typeable)
uid :: forall b. TopStateT b Unique
uid = lift $ gets Main.id
changeUid :: forall b. Unique -> TopStateT b ()
changeUid n = do
lift $ modify (\s -> s { Main.id = n })
newUid :: forall b. TopStateT b ()
newUid = do
n <- lift $ lift $ newUnique
lift $ modify (\s -> s { Main.id = n })
-- add a node to list in basestate
addNode :: forall o a. (Typeable a, Show o,Typeable o) => ActiveObject o
-> TopStateT a ()
addNode n = do
ns <- lift $ gets nodes
lift $ modify (\s -> s { nodes = (GN n):ns })
-- get a node from list in basestate
getNode :: forall a o. (Show o,Typeable o) => Integer -> (TopStateT a
(ActiveObject o))
getNode i = do
ns <- lift $ gets nodes
let ao = ns !! (fromInteger i)
return (castGN ao)
-- action that executes messages send to it
action [] = return ()
action (e:es) = do
-- just for testing
i <- uid
s <- get
ns <- lift get
lift $ lift $ putStrLn $ "event (" ++ show i ++ "):" ++ " state:" ++
show s ++ " nstate:" ++ show ns
--
e
action es
-- create a new node state with a unique id
newNodeState = do
u <- newUnique
return (DefNodeState u [])
-- start evaluation
start action state = do
ns <- newNodeState
execStateT (execStateT action state) ns
return ()
main = do
ao <- newActiveObject action (TestState 5) TestState
ao2 <- newActiveObject action (TestState2 5) TestState2
-- simple test
u1 <- syncM ao (gets val)
putStrLn $ "u1:" ++ show u1
-- show complete state
r <- syncM ao (get)
putStrLn $ show r
-- connect ao to ao2
sendM ao (addNode ao2)
-- get node back
ao2' <- syncM ao (getNode 0)
-- get unique id
u <- syncM ao2' (uid)
putStrLn $ "u:" ++ show (hashUnique u)
-- set a new id
sendM ao2' (newUid)
-- show it
u' <- syncM ao2' (uid)
putStrLn $ "u':" ++ show (hashUnique u')
-- u2 <- syncM ao2' (gets val2)
getChar
return ()
_______________________________________________
Haskell mailing list
Haskell@haskell.org
http://www.haskell.org/mailman/listinfo/haskell
