2014-04-25 05:11:04 +00:00
|
|
|
(defmacro do-m args
|
2014-04-24 19:33:28 +00:00
|
|
|
(let ((monad (car args))
|
|
|
|
(statements (cdr args)))
|
|
|
|
(monad:do-transform monad statements)))
|
|
|
|
|
|
|
|
(defmacro >>= (monad m f)
|
2014-05-11 21:25:17 +00:00
|
|
|
(if (: lfe-utils atom? monad)
|
|
|
|
`(call ',monad '>>= ,m ,f)
|
|
|
|
`(call ,monad '>>= ,m ,f)))
|
2014-04-24 19:33:28 +00:00
|
|
|
|
|
|
|
(defmacro >> (monad m1 m2)
|
2014-05-11 21:25:17 +00:00
|
|
|
(let ((f `(lambda (_) ,m2)))
|
|
|
|
(if (: lfe-utils atom? monad)
|
|
|
|
`(call ',monad '>>= ,m1 ,f)
|
|
|
|
`(call ,monad '>>= ,m1 ,f))))
|
2014-04-24 19:33:28 +00:00
|
|
|
|
|
|
|
(defmacro return (monad expr)
|
2014-05-11 21:25:17 +00:00
|
|
|
(if (: lfe-utils atom? monad)
|
|
|
|
`(call ',monad 'return ,expr)
|
|
|
|
`(call ,monad 'return ,expr)))
|
2014-04-25 05:06:19 +00:00
|
|
|
|
2014-04-25 05:27:13 +00:00
|
|
|
(defmacro fail (monad expr)
|
2014-05-11 21:25:17 +00:00
|
|
|
(if (: lfe-utils atom? monad)
|
|
|
|
`(call ',monad 'fail ,expr)
|
|
|
|
`(call ,monad 'fail ,expr)))
|
2014-04-25 05:27:13 +00:00
|
|
|
|
2014-04-25 05:06:19 +00:00
|
|
|
(defmacro sequence (monad list)
|
|
|
|
`(: lists foldr
|
|
|
|
(lambda (m acc) (mcons ,monad m acc))
|
|
|
|
(return ,monad [])
|
|
|
|
,list))
|
|
|
|
|
|
|
|
(defmacro mcons (monad m mlist)
|
2014-04-25 05:11:04 +00:00
|
|
|
`(do-m ,monad
|
|
|
|
(x <- ,m)
|
|
|
|
(rest <- ,mlist)
|
|
|
|
(return ,monad (cons x rest))))
|