github/calrissian
1
0
Fork 0
mirror of https://github.com/correl/calrissian.git synced 2024-11-23 19:19:57 +00:00
Code Issues Projects Releases Packages Wiki Activity

Rename 'do' to 'do-m'

Browse source 
'do' is a built-in lisp macro
This commit is contained in:
Correl Roush 2014-04-25 01:11:04 -04:00
parent f923b68374
commit 888effbf13
3 changed files with 25 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
include/monad-tests.lfe
View file

@ -12,14 +12,14 @@
(return ,monad 1)))) (return ,monad 1))))
(deftest monad-do (deftest monad-do
(is-equal (return ,monad 'ok) (is-equal (return ,monad 'ok)
(do ,monad (do-m ,monad
(return ,monad 'ignored) (return ,monad 'ignored)
(return ,monad 'ok)))) (return ,monad 'ok))))
(deftest monad-do-binding (deftest monad-do-binding
(is-equal (return ,monad 9) (is-equal (return ,monad 9)
(do ,monad (do-m ,monad
(a <- (return ,monad 3)) (a <- (return ,monad 3))
(return ,monad (* a a))))) (return ,monad (* a a)))))
(deftest monad-sequence (deftest monad-sequence
(is-equal (return ,monad (list 1 2 3)) (is-equal (return ,monad (list 1 2 3))
(sequence ,monad (list (return ,monad 1) (sequence ,monad (list (return ,monad 1)
@ -50,26 +50,26 @@
(deftest monad-do-left-identity (deftest monad-do-left-identity
(let ((a 3) (let ((a 3)
(f (lambda (n) (return ,monad (* 3 n))))) (f (lambda (n) (return ,monad (* 3 n)))))
(is-equal (do ,monad (a' <- (return ,monad a)) (is-equal (do-m ,monad (a' <- (return ,monad a))
(funcall f a')) (funcall f a'))
(do ,monad (funcall f a))))) (do-m ,monad (funcall f a)))))
(deftest monad-do-right-identity (deftest monad-do-right-identity
(let ((m (return ,monad 3))) (let ((m (return ,monad 3)))
(is-equal (do ,monad (x <- m) (is-equal (do-m ,monad (x <- m)
(return ,monad x)) (return ,monad x))
(do ,monad m)))) (do-m ,monad m))))
(deftest monad-do-associativity (deftest monad-do-associativity
(let ((m (return ,monad 3)) (let ((m (return ,monad 3))
(f (lambda (n) (return ,monad (* 3 n)))) (f (lambda (n) (return ,monad (* 3 n))))
(g (lambda (n) (return ,monad (+ 5 n))))) (g (lambda (n) (return ,monad (+ 5 n)))))
(is-equal (do ,monad (y <- (do ,monad (x <- m) (is-equal (do-m ,monad (y <- (do-m ,monad (x <- m)
(funcall f x))) (funcall f x)))
(funcall g y)) (funcall g y))
(do ,monad (x <- m) (do-m ,monad (x <- m)
(do ,monad (y <- (funcall f x)) (do-m ,monad (y <- (funcall f x))
(funcall g y)))))) (funcall g y))))))
)) ))
(defmacro test-monad (monad) (defmacro test-monad (monad)

10
include/monads.lfe
View file

@ -1,4 +1,4 @@
(defmacro do args (defmacro do-m args
(let ((monad (car args)) (let ((monad (car args))
(statements (cdr args))) (statements (cdr args)))
(monad:do-transform monad statements))) (monad:do-transform monad statements)))
@ -19,7 +19,7 @@
,list)) ,list))
(defmacro mcons (monad m mlist) (defmacro mcons (monad m mlist)
`(do ,monad `(do-m ,monad
(x <- ,m) (x <- ,m)
(rest <- ,mlist) (rest <- ,mlist)
(return ,monad (cons x rest)))) (return ,monad (cons x rest))))

4
test/unit/unit-maybe-monad-tests.lfe
View file

@ -38,13 +38,13 @@
(deftest do-bindings (deftest do-bindings
(is-equal #(just 3) (is-equal #(just 3)
(do maybe-monad (do-m maybe-monad
(a <- #(just 1)) (a <- #(just 1))
(b <- #(just 2)) (b <- #(just 2))
(return maybe-monad (+ a b))))) (return maybe-monad (+ a b)))))
(deftest do-nobindings (deftest do-nobindings
(is-equal #(just 3) (is-equal #(just 3)
(do maybe-monad (do-m maybe-monad
#(just 5) #(just 5)
#(just 3)))) #(just 3))))