mirror of
https://github.com/correl/calrissian.git
synced 2024-12-18 03:00:22 +00:00
Remove unnecessary state monad implementation
(monad 'state) is synonymous with (transformer 'state 'identity). The monad macro has been updated to reflect that.
This commit is contained in:
parent
99be83ee71
commit
22fb903209
3 changed files with 7 additions and 62 deletions
|
@ -1,7 +1,11 @@
|
||||||
(defmacro monad (name)
|
(defmacro monad (name)
|
||||||
|
(case name
|
||||||
|
;; Provide the state monad in terms of the state transformer
|
||||||
|
(''state `(transformer 'state 'identity))
|
||||||
|
(_
|
||||||
`(list_to_atom (lists:flatten (list "calrissian-"
|
`(list_to_atom (lists:flatten (list "calrissian-"
|
||||||
(atom_to_list ,name)
|
(atom_to_list ,name)
|
||||||
"-monad"))))
|
"-monad"))))))
|
||||||
|
|
||||||
(defmacro transformer (name inner-monad)
|
(defmacro transformer (name inner-monad)
|
||||||
`(tuple (list_to_atom (lists:flatten (list "calrissian-"
|
`(tuple (list_to_atom (lists:flatten (list "calrissian-"
|
||||||
|
|
|
@ -1,47 +0,0 @@
|
||||||
(defmodule calrissian-state-monad
|
|
||||||
(behaviour calrissian-monad)
|
|
||||||
(behaviour calrissian-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))
|
|
|
@ -1,12 +0,0 @@
|
||||||
(defmodule unit-calrissian-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 (monad 'state))
|
|
Loading…
Reference in a new issue