feat(runtime): add basic support for state

src/runtime-prototype/src/StuntDouble/Actor.hs

@@ -54,7 +54,15 @@ remoteCall rr m = Free (RemoteCall rr m return)
 asyncIO :: IO IOResult -> Free ActorF (Async IOResult)
 asyncIO m = Free (AsyncIO m return)
 
+get :: Free ActorF State
+get = Free (Get return)
+
+put :: State -> Free ActorF ()
+put state' = Free (Put state' return)
 
 -- XXX:
-newtype State = State Int
-  deriving Num
+newtype State = State { getState :: Int }
+  deriving (Show, Num)
+
+initState :: State
+initState = State 0

src/runtime-prototype/src/StuntDouble/EventLoop.hs

@@ -52,6 +52,7 @@ initLoopState name transport elog =
     <*> newTVarIO []
     <*> newTBQueueIO 128
     <*> newTVarIO Map.empty
+    <*> newTVarIO Map.empty
     <*> newTVarIO []
     <*> newTVarIO Map.empty
     <*> pure transport
@@ -93,6 +94,7 @@ handleCommand (Spawn actor respVar) ls = atomically $ do
   actors <- readTVar (loopStateActors ls)
   let lref = LocalRef (Map.size actors)
   writeTVar (loopStateActors ls) (Map.insert lref actor actors)
+  modifyTVar' (loopStateActorState ls) (Map.insert lref initState)
   putTMVar respVar lref
 handleCommand Quit ls = do
   pids <- atomically (readTVar (loopStatePids ls))
@@ -176,7 +178,7 @@ runActor ls self = iterM go return
     go :: ActorF (IO a) -> IO a
     go (Call lref msg k) = do
       Just actor <- lookupActor lref (loopStateActors ls)
-      Now reply <- runActor ls self (actor msg)
+      Now reply <- runActor ls (localToRemoteRef (loopStateName ls) lref) (actor msg)
       emit ls (LogInvoke self lref msg reply)
       k reply
     go (RemoteCall rref msg k) = do
@@ -205,10 +207,14 @@ runActor ls self = iterM go return
                    -- event loop is running on.
       atomically (modifyTVar' (loopStateIOAsyncs ls) (a :))
       k a
-    go (Get k) =  do
-      undefined
+    go (Get k) = do
+     states <- readTVarIO (loopStateActorState ls)
+     let state = states Map.! remoteToLocalRef self
+     k state
     go (Put state' k) = do
-      undefined
+      atomically (modifyTVar' (loopStateActorState ls)
+                   (Map.insert (remoteToLocalRef self) state'))
+      k ()
 
 quit :: EventLoopRef -> IO ()
 quit r = atomically $

src/runtime-prototype/src/StuntDouble/EventLoop/State.hs

@@ -19,6 +19,7 @@ data LoopState = LoopState
                                      --   event loop itself.
   , loopStateQueue :: TBQueue Event
   , loopStateActors :: TVar (Map LocalRef (Message -> Actor)) -- XXX: Only changed by main loop, so no need for STM?
+  , loopStateActorState :: TVar (Map LocalRef State)
   , loopStateIOAsyncs :: TVar [Async IOResult]
   , loopStateIOContinuations :: TVar (Map (Async IOResult)
                                           (RemoteRef, CorrelationId, IOResult -> Actor))
@@ -79,6 +80,9 @@ dumpState ls = do
   putStrLn "=== LOOPSTATE DUMP ==="
   putStr "loopStateName = "
   putStrLn (getEventLoopName (loopStateName ls))
+  putStr "loopStateActorState = "
+  states <- readTVarIO (loopStateActorState ls)
+  print states
   corrId <- readTVarIO (loopStateNextCorrelationId ls)
   putStr "loopStateNextCorrelationId = "
   print corrId

src/runtime-prototype/test/StuntDouble/EventLoopTest.hs

@@ -5,7 +5,7 @@ module StuntDouble.EventLoopTest where
 import Control.Exception
 import Control.Concurrent
 import Control.Concurrent.Async
-import Test.HUnit
+import Test.HUnit hiding (State)
 
 import StuntDouble
 
@@ -112,3 +112,25 @@ unit_asyncIO = do
             reply @?= Message "Got: result")
     (\(e :: SomeException) -> dump el >> eventLog el >>= mapM_ print >> print e)
 -}
+
+statefulActor :: Message -> Actor
+statefulActor (Message intStr) = do
+  s <- get
+  let int :: Int
+      int = read intStr
+      s' :: State
+      s' = State int + s
+  put s'
+  return (Now (Message (show (getState s'))))
+
+unit_state :: Assertion
+unit_state = do
+  elog <- emptyEventLog
+  let ev = eventLoopA "state"
+  el <- makeEventLoop "/tmp" ev elog
+  lref <- spawn el statefulActor
+  reply <- invoke el lref (Message "1")
+  reply @?= Message "1"
+  reply2 <- invoke el lref (Message "2")
+  reply2 @?= Message "3"
+  quit el