Hey everyone,
I was just reading Philip Wadler's paper "Comprehending Monads", which
approaches Monads as a generalization of list comprehensions.
Then I did some preliminary Lisp hacking, resulting in this.
Let's define the list monad, whose comprehension macro will be
called LIST-COMP.
(define-monad list-monad
:comprehension list-comp
:map ((function) (lambda (list) (mapcar function list)))
:join ((list-of-lists) (reduce #'append list-of-lists))
:unit ((element) (list element)))
Now:
(list-comp 1) -> (1)
(list-comp x (x '(1 2 3))) -> (1 2 3)
(list-comp (cons x y)
(x '(1 2))
(y '(a b)))
-> ((1 . A) (1 . B) (2 . A) (2 . B))
Using generic COMPREHEND macro:
(comprehend 'list-monad 1) -> (1)
Ho hum.
Code here:
;;;
;;; Common Lisp monads based on "Comprehending Monads"
;;; paper (Philip Wadler, 1990).
;;; Kaz Kylheku <········@gmail.com>
;;; November 2008
;;;
;;;
;;; A monad is represented by a representative instance of its CLOS class.
;;; There basic generic functions must be specialized for the class:
;;; MONADIC-MAP, MONADIC-JOIN, and MONADIC-UNIT.
;;;
;;; The programmer should also implement a method called MONADIC-INSTANCE
;;; which is specialized on the class name (via EQL method specialization).
;;; This should instantiate and return a representative instance.
;;;
;;;
;;; MONADIC-MAP
;;;
;;; Takes a function and returns a function. The input
;;; function is of the form:
;;;
;;; (lambda (input-element) ...) -> output-element
;;;
;;; MONADIC-MAP takes this function, and returns
;;; a new function based on it, which is of this form:
;;;
;;; (lambda (input-monadic-container) ...) -> output-monadic-container
;;;
;;; Conceptually, the monadic container is some containing type based
;;; on the elements, and the functionn returned by MONADIC-MAP
;;; cracks open the container, works with the elements, and then re-packages
;;; the results as a container. In the case of LIST monads (provided below),
;;; the monadic container type is literally a list of elements, and the
;;; function that is returned by MONADIC-MAP performs a Lisp MAPCAR on one
;;; container to produce a new container, using FUNCTION.
;;;
;;; Example:
;;;
;;; (funcall (monadic-map 'list-monad (lambda (x) (* 10 x))) '(1 2 3))
;;;
;;; -> (10 20 30)
;;;
(defgeneric monadic-map (monad-class function))
;;;
;;; MONADIC-JOIN
;;;
;;; Conceptually, takes a monadic container-of-containers-of-elements, and
;;; flattens it to a container of elements. The LIST specialization
;;; does this:
;;;
;;; (monadic-join 'list-monad '((1 2 3) (4 5 6))) -> (1 2 3 4 5 6)
;;;
(defgeneric monadic-join (monad-class container-of-containers))
;;;
;;; MONADIC-UNIT
;;;
;;; Takes a single element and produces a monadic container of that element.
;;;
;;; For lists, it makes a one-element list
;;;
;;; (monadic-unit 'list-monad 1) -> (1)
;;;
(defgeneric monadic-unit (monad-class element))
;;;
;;; MONADIC-INSTANCE
;;;
;;; Should be specialized to symbol, and return an instance of that
;;; class, preferrably the same instance every time, e.g. using
;;; LOAD-TIME-VALUE.
;;;
;;; ;; Fetch representative instance of foo-monad
;;;
;;; (defmethod monadic-instance ((monad-class-name (eql 'foo-monad)))
;;; (load-time-value (make-instance 'foo-monad)))
;;;
(defgeneric monadic-instance (monad-class-name))
;;;
;;; COMPREHEND
;;;
;;; Monadic comprehension, reducing to list comprehension for LIST monads.
;;; Examples:
;;;
;;; (comprehend 'list-monad 1) -> (1)
;;;
;;; ;; collect X, for X in '(1 2 3)
;;; (comprehend 'list-monad x (x '(1 2 3))) -> (1 2 3)
;;;
;;; ;; collect (CONS X Y) for X in '(1 2 3) and Y in '(A B C).
;;; (comprehend 'list-monad (cons x y) (x '(1 2 3)) (y '(A B C)))
;;; -> ((1 . A) (1 . B) (1 . C)
;;; (2 . A) (2 . B) (2 . C)
;;; (3 . A) (3 . B) (3 . C))
;;;
;;; NOTE: the LIST-MONAD defines a convenience macro called LIST-COMP,
;;; allowing (list-comp 1) -> (1) et cetera.
;;;
(defmacro comprehend (monad-instance expr &rest clauses)
(let ((monad-var (gensym "CLASS-")))
(cond
((null clauses) `(monadic-unit ,monad-instance ,expr))
((rest clauses) `(let ((,monad-var ,monad-instance))
(monadic-join ,monad-var
(comprehend ,monad-var
(comprehend ,monad-var ,expr ,@(rest clauses))
,(first clauses)))))
(t (destructuring-bind (var container-expr) (first clauses)
(cond
((and var (symbolp var))
`(funcall (monadic-map ,monad-instance (lambda (,var) ,expr))
,container-expr))
(t (error "COMPREHEND: bad variable specification: ~s" vars))))))))
;;;
;;; DEFINE-MONAD
;;;
;;; Monad-defining convenience macro. Defines a CLOS class for the monad,
;;; with all three required methods specialized for that class, using
;;; destructured keyword arguments.
;;;
;;; Base classes and slots for the class can be specified, as well
;;; as a list of arguments for the MAKE-INSTANCE call.
;;;
;;; A method called MONADIC-INSTANCE is generated which is specialized
;;; to the class name via an EQL specializer. It returns a representative
;;; instance of the monad class which is used for the monad dispatch.
;;;
(defmacro define-monad (class-name
&key comprehension
monad-param-sym
bases slots initargs
((:map ((function-param) &body map-body)))
((:join ((c-of-c-param) &body join-body)))
((:unit ((element-param) &body unit-body))))
(let ((monad-param (or monad-param-sym (gensym "MONAD-"))))
`(progn
(defclass ,class-name ,bases ,slots)
(defmethod monadic-instance ((monad (eql ',class-name)))
(load-time-value (make-instance ',class-name ,@initargs)))
(defmethod monadic-map ((,monad-param ,class-name) ,function-param)
(declare (ignorable ,monad-param))
,@map-body)
(defmethod monadic-join ((,monad-param ,class-name) ,c-of-c-param)
(declare (ignorable ,monad-param))
,@join-body)
(defmethod monadic-unit ((,monad-param ,class-name) ,element-param)
(declare (ignorable ,monad-param))
,@unit-body)
,@(if comprehension
`((defmacro ,comprehension (expr &rest clauses)
`(comprehend (monadic-instance ',',class-name)
,expr ,@clauses)))))))
;;;
;;; Monad methods that handle symbolically named monads
;;; by redirecting to the representative instance, similarly to how
;;; (make-instance 'sym ...) redirects to (make-instance (find-class 'sym) ...)
;;; We don't resolve the monad symbol to its class, but rather
;;; to the representative instance.
;;;
(defmethod monadic-map ((monad symbol) function)
(monadic-map (monadic-instance monad) function))
(defmethod monadic-join ((monad symbol) container-of-containers)
(monadic-join (monadic-instance monad) container-of-containers))
(defmethod monadic-unit ((monad symbol) element)
(monadic-unit (monadic-instance monad) element))
;;;
;;; Define the LIST-MONAD, succinctly
;;;
(define-monad list-monad
:comprehension list-comp
:map ((function) (lambda (container) (mapcar function container)))
:join ((list-of-lists) (reduce #'append list-of-lists))
:unit ((element) (list element)))
On 2008-11-27, Kaz Kylheku <········@gmail.com> wrote:
> ;;;
> ;;; Define the LIST-MONAD, succinctly
> ;;;
> (define-monad list-monad
> :comprehension list-comp
> :map ((function) (lambda (container) (mapcar function container)))
> :join ((list-of-lists) (reduce #'append list-of-lists))
> :unit ((element) (list element)))
Oh man, look at this. Ugly! But the comprehension macro could be
augmented to support multiple values, and then this could be
rewritten more succinctly using comprehensions over the identity
monad (which would basically hide the multiple-value-bind
telescoping):
;;; State transformer monad.
(define-monad state-xform-monad
:comprehension state-xform-comp
:monad-param-sym monad
:map ((f)
(lambda (xformer)
(lambda (s)
(multiple-value-bind (x new-state) (funcall xformer s)
(values (funcall f x) new-state)))))
:join ((nested-xformer)
(lambda (s)
(multiple-value-bind (embedded-xformer intermediate-state)
(funcall nested-xformer s)
(multiple-value-bind (x new-state)
(funcall embedded-xformer
intermediate-state)
(values x new-state)))))
:unit ((x) (lambda (s) (values x s))))
;; example, start with state 42, and go through two state
;; transformations, gathering their output values into a list.
;; Two values are returned: the list of two state transition
;; values, and the final state.
(let ((transformer (state-xform-comp (list x y)
(x (lambda (state)
(values 'foo (1+ state))))
(y (lambda (state)
(values 'bar (+ 10 state)))))))
(funcall transformer 42))
-> (FOO BAR) ; 53
Perfect!
Who says we can't do useless academic shit in Lisp?
On 2008-11-28, Kaz Kylheku <········@gmail.com> wrote:
> On 2008-11-27, Kaz Kylheku <········@gmail.com> wrote:
>> ;;;
>> ;;; Define the LIST-MONAD, succinctly
>> ;;;
>> (define-monad list-monad
>> :comprehension list-comp
>> :map ((function) (lambda (container) (mapcar function container)))
>> :join ((list-of-lists) (reduce #'append list-of-lists))
>> :unit ((element) (list element)))
>
> Oh man, look at this. Ugly! But the comprehension macro could be
> augmented to support multiple values, and then this could be
> rewritten more succinctly using comprehensions over the identity
> monad (which would basically hide the multiple-value-bind
> telescoping):
Done:
http://paste.lisp.org/display/71196
State transformer using identity monad comprehensions that
work properly with multiple value binding.