Concurrency.hs

{-# LANGUAGE QuasiQuotes #-}
module Atomo.Kernel.Concurrency (load) where

import Atomo
import Atomo.Method
import Atomo.Spawn


load :: VM ()
load = do
    [$p|self|] =: do
        chan <- gets channel
        tid <- liftIO myThreadId
        return (Process chan tid)

    [$p|receive|] =: gets channel >>= liftIO . readChan

    [$p|halt|] =: gets halt >>= liftIO >> return (particle "ok")

    [$p|(p: Process) <- v|] =: do
        Process chan _ <- here "p" >>= findProcess
        v <- here "v"
        liftIO (writeChan chan v)
        here "p"

    [$p|(b: Block) spawn|] =: do
        Block s as bes <- here "b" >>= findBlock

        if length as > 0
            then throwError (BlockArity (length as) 0)
            else spawn (doBlock emptyMap s bes)

    [$p|(b: Block) spawn: (... args)|] =: do
        b@(Block _ as _) <- here "b" >>= findBlock
        vs <- getList [$e|args|]

        if length as > length vs
            then throwError (BlockArity (length as) (length vs))
            else spawn (callBlock b vs)

    [$p|(p: Process) stop|] =: do
        Process _ tid <- here "p" >>= findProcess
        liftIO (killThread tid)
        return (particle "ok")