Data commit

Task/Active-object/Haskell/active-object.hs

@@ -0,0 +1,77 @@
+module Integrator (
+  newIntegrator, input, output, stop,
+  Time, timeInterval
+) where
+import Control.Concurrent (forkIO, threadDelay)
+import Control.Concurrent.MVar (MVar, newMVar, modifyMVar_, modifyMVar, readMVar)
+import Control.Exception (evaluate)
+import Data.Time (UTCTime)
+import Data.Time.Clock (getCurrentTime, diffUTCTime)
+
+-- RC task
+main = do let f = 0.5 {- Hz -}
+          t0 <- getCurrentTime
+          i <- newIntegrator
+          input i (\t -> sin(2*pi * f * timeInterval t0 t)) -- task step 1
+          threadDelay 2000000 {- µs -}                      -- task step 2
+          input i (const 0)                                 -- task step 3
+          threadDelay 500000 {- µs -}                       -- task step 4
+          result <- output i
+          stop i
+          print result
+
+---- Implementation ------------------------------------------------------
+
+-- Utilities for working with the time type
+type Time = UTCTime
+type Func a = Time -> a
+timeInterval t0 t1 = realToFrac $ diffUTCTime t1 t0
+
+-- Type signatures of the module's interface
+newIntegrator :: Fractional a => IO (Integrator a) -- Create an integrator
+input  :: Integrator a -> Func a -> IO ()          -- Set the input function
+output :: Integrator a           -> IO a           -- Get the current value
+stop   :: Integrator a           -> IO ()          -- Stop integration, don't waste CPU
+
+-- Data structures
+data Integrator a = Integrator (MVar (IntState a)) -- MVar is a thread-safe mutable cell
+  deriving Eq
+data IntState a = IntState { func  :: Func a,      -- The current function
+                             run   :: Bool,        -- Whether to keep going
+                             value :: a,           -- The current accumulated value
+                             time  :: Time }       -- The time of the previous update
+
+newIntegrator = do
+  now <- getCurrentTime
+  state <- newMVar $ IntState { func  = const 0,
+                                run   = True,
+                                value = 0,
+                                time  = now }
+  thread <- forkIO (intThread state)  -- The state variable is shared between the thread
+  return (Integrator state)           --   and the client interface object.
+
+input  (Integrator stv) f = modifyMVar_ stv (\st -> return st { func = f })
+output (Integrator stv)   = fmap value $ readMVar stv
+stop   (Integrator stv)   = modifyMVar_ stv (\st -> return st { run = False })
+  -- modifyMVar_ takes an MVar and replaces its contents according to the provided function.
+  -- a { b = c } is record-update syntax: "the record a, except with field b changed to c"
+
+-- Integration thread
+intThread :: Fractional a => MVar (IntState a) -> IO ()
+intThread stv = whileM $ modifyMVar stv updateAndCheckRun
+  -- modifyMVar is like modifyMVar_ but the function returns a tuple of the new value
+  -- and an arbitrary extra value, which in this case ends up telling whileM whether
+  -- to keep looping.
+  where updateAndCheckRun st = do
+          now <- getCurrentTime
+          let value' = integrate (func st) (value st) (time st) now
+          evaluate value'                             -- avoid undesired laziness
+          return (st { value = value', time  = now }, -- updated state
+                  run st)                             -- whether to continue
+
+integrate :: Fractional a => Func a -> a -> Time -> Time -> a
+integrate f value t0 t1 = value + (f t0 + f t1)/2 * dt
+  where dt = timeInterval t0 t1
+
+-- Execute 'action' until it returns false.
+whileM action = do b <- action; if b then whileM action else return ()