Add state monad and behaviour

This commit is contained in:
Correl Roush 2014-07-09 01:28:48 -04:00
parent 4ec1a9897d
commit 1ee02b261a
3 changed files with 71 additions and 0 deletions

47
src/state-monad.lfe Normal file
View file

@ -0,0 +1,47 @@
(defmodule state-monad
(behaviour monad)
(behaviour state)
(export (return 1)
(fail 1)
(run 2)
(>>= 2)
(get 0)
(put 1)
(modify 1)
(modify-and-return 1)
(exec 2)
(eval 2)))
(defun return (x) (lambda (state) (tuple x state)))
(defun fail (x) (throw (tuple 'error x)))
(defun run (m state)
(funcall m state))
(defun >>= (m f)
(lambda (state)
(let (((tuple x s) (run m state)))
(run (funcall f x) s))))
(defun put (state)
(lambda (_) (tuple '() state)))
(defun get ()
(lambda (state)
(tuple state state)))
(defun modify (f)
(lambda (state)
(tuple '() (funcall f state))))
(defun modify-and-return (f)
(lambda (state)
(let ((newstate (funcall f state)))
(tuple newstate newstate))))
(defun eval (m state)
(let (((tuple x _s) (run m state)))
x))
(defun exec (m state)
(let (((tuple _x s) (run m state)))
s))

12
src/state.lfe Normal file
View file

@ -0,0 +1,12 @@
(defmodule state
(export (behaviour_info 1)))
(defun behaviour_info
(('callbacks) (list #(run 2)
#(get 0)
#(put 1)
#(modify 1)
#(modify-and-return 1)
#(exec 2)
#(eval 2)))
((_) 'undefined))

View file

@ -0,0 +1,12 @@
(defmodule unit-state-monad-tests
(export all)
(import
(from lfeunit-util
(check-failed-assert 2)
(check-wrong-assert-exception 2))))
(include-lib "deps/lfeunit/include/lfeunit-macros.lfe")
(include-lib "include/monads.lfe")
(include-lib "include/monad-tests.lfe")
(test-monad 'state-monad)