Browse Source

Add self.

tags/0.1.0.0
Thomas Kerber 1 year ago
parent
commit
95c08ddbf4
Signed by: tk <tk@drwx.org> GPG Key ID: 8489B911F9ED617B
2 changed files with 7 additions and 3 deletions
  1. +5
    -1
      src/Yggdrasil/ExecutionModel.hs
  2. +2
    -2
      src/Yggdrasil/SimpleState.hs

+ 5
- 1
src/Yggdrasil/ExecutionModel.hs View File

@@ -2,7 +2,7 @@

module Yggdrasil.ExecutionModel (
GlobalState(..), StrongGlobalState(..), Action, Funct(..), LegalFunct, run,
abort, sample, send, create
abort, self, doSample, send, create
) where

import Control.Monad
@@ -33,6 +33,7 @@ type LegalFunct gs s a b = (GlobalState gs, Typeable s, Typeable a, Typeable b)

data Action gs b where
Abort :: Action gs b
Self :: Action gs (WeakRef gs)
Sample :: Distribution b -> Action gs b
Send :: LegalFunct gs s a b => Ref gs s a b -> a -> Action gs b
Create :: LegalFunct gs s a b => Funct gs s a b -> Action gs (Ref gs s a b)
@@ -41,6 +42,8 @@ data Action gs b where
-- Export visible constructors as functions.
abort :: Action gs b
abort = Abort
self :: Action gs (WeakRef gs)
self = Self
doSample :: Distribution b -> Action gs b
doSample = Sample
send :: LegalFunct gs s a b => Ref gs s a b -> a -> Action gs b
@@ -54,6 +57,7 @@ run g a = let (r, g') = run' g empty external a in (fmap snd r, g')
run' :: (RandomGen g, GlobalState gs) =>
g -> gs -> WeakRef gs -> Action gs b -> (Maybe (gs, b), g)
run' g _ _ Abort = (Nothing, g)
run' g gs self' Self = (Just (gs, self'), g)
run' g gs _ (Sample d) = let (y, g') = sample g d in (Just (gs, y), g')
run' g gs from (Send ref m) = case update gs from ref m of
Just (gs', a) -> run' g gs' (weaken ref) a


+ 2
- 2
src/Yggdrasil/SimpleState.hs View File

@@ -11,14 +11,14 @@ newtype SimpleState = SimpleState [Dynamic]
get :: LegalFunct SimpleState s a b =>
SimpleState ->
Ref SimpleState s a b ->
Maybe (Funct SimpleState s a b)
Maybe (SSFunct s a b)
get (SimpleState []) _ = Nothing
get (SimpleState (x:_)) (SSRef 0) = fromDynamic x
get (SimpleState (_:xs)) ref = get (SimpleState xs) (refdec ref)
set :: LegalFunct SimpleState s a b =>
SimpleState ->
Ref SimpleState s a b ->
Funct SimpleState s a b ->
SSFunct s a b ->
Maybe SimpleState
set (SimpleState []) _ _ = Nothing
set (SimpleState (_:xs)) (SSRef 0) f = Just $ SimpleState $ toDyn f : xs


Loading…
Cancel
Save