diff --git a/include/monads.lfe b/include/monads.lfe index b6be97d..59f2c19 100644 --- a/include/monads.lfe +++ b/include/monads.lfe @@ -1,7 +1,11 @@ (defmacro monad (name) - `(list_to_atom (lists:flatten (list "calrissian-" - (atom_to_list ,name) - "-monad")))) + (case name + ;; Provide the state monad in terms of the state transformer + (''state `(transformer 'state 'identity)) + (_ + `(list_to_atom (lists:flatten (list "calrissian-" + (atom_to_list ,name) + "-monad")))))) (defmacro transformer (name inner-monad) `(tuple (list_to_atom (lists:flatten (list "calrissian-" diff --git a/src/calrissian-state-monad.lfe b/src/calrissian-state-monad.lfe deleted file mode 100644 index 7f2dd5b..0000000 --- a/src/calrissian-state-monad.lfe +++ /dev/null @@ -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)) diff --git a/test/unit/unit-calrissian-state-monad-tests.lfe b/test/unit/unit-calrissian-state-monad-tests.lfe deleted file mode 100644 index 5081012..0000000 --- a/test/unit/unit-calrissian-state-monad-tests.lfe +++ /dev/null @@ -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))