| Paste number 71196: | Lisp Monads |
| Pasted by: | kaz |
| When: | 7 months, 4 days ago |
| Share: | Tweet this! | http://paste.lisp.org/+1IXO |
| Channel: | None |
| Paste contents: |
;;;
;;; Common Lisp monads based on "Comprehending Monads"
;;; paper (Philip Wadler, 1990).
;;; Kaz Kylheku <kkylheku@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)
;;;
;;; The purpose of the &REST parameters is to support the notion of elements
;;; that are multiple values. See comment for MONADIC-UNIT below.
;;;
(defgeneric monadic-join (monad-class container-of-containers &rest additional))
;;;
;;; 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)
;;;
;;; The purpose of the &REST parameters is to support elements which
;;; are multiple values. This is of particular importance in the identity
;;; monad. The identity monad's unit function is variadic and returns all
;;; of the parameters as multiple values. This works in conjunction with
;;; the comprehension macro, allowing multiple value bindings, e.g:
;;;
;;; (identity-comp (values x y) ((x y) (values 1 2)))
;;;
;;; Here (x y) get bound as if by (multiple-value-bind (x y) (values 1 2)).
;;; Because the expression is (values x y), the comprehension as a whole
;;; returns 1 2 as a pair of values.
;;;
;;; Multiple value support is required in the identity monad, because
;;; Wadler's paper expresses identity monads that bind multiple values.
;;; Wadler's state transformer monad is based on a domain of state
;;; transformer functions which return multiple values, and he uses
;;; identity comprehensions to express the bodies of the operations,
;;; where pairs of values coming from calls state transformers are
;;; captured by two variables. I didn't want to represent that
;;; as (for instance) conses, but proper Lisp multiple values.
;;;
(defgeneric monadic-unit (monad-class element &rest additional))
;;;
;;; 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) `(multiple-value-call #'monadic-unit
,monad-instance ,expr))
((rest clauses) `(let ((,monad-var ,monad-instance))
(multiple-value-call #'monadic-join ,monad-var
(comprehend ,monad-var
(comprehend ,monad-var ,expr ,@(rest clauses))
,(first clauses)))))
(t (destructuring-bind (var &rest container-exprs) (first clauses)
(cond
((and var (symbolp var))
`(funcall (monadic-map ,monad-instance (lambda (,var) ,expr))
,(first container-exprs)))
((and (consp var) (every #'symbolp var))
`(multiple-value-call (monadic-map ,monad-instance
(lambda (,@var) ,expr))
,@container-exprs))
(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 (gensym "MONAD-"))
bases slots initargs
((:map ((map-param)
&body map-body)))
((:join ((join-param
&optional
(j-rest-kw '&rest)
(j-rest (gensym "JOIN-REST-")))
&body join-body)))
((:unit ((unit-param
&optional
(u-rest-kw '&rest)
(u-rest (gensym "UNIT-REST-")))
&body unit-body))))
`(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) map-param)
(declare (ignorable ,monad-param))
,@map-body)
(defmethod monadic-join ((,monad-param ,class-name)
,join-param &rest ,j-rest)
(declare (ignorable ,monad-param ,j-rest))
,@join-body)
(defmethod monadic-unit ((,monad-param ,class-name)
,unit-param &rest ,u-rest)
(declare (ignorable ,monad-param ,u-rest))
,@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 &rest rest)
(apply #'monadic-join (monadic-instance monad) container-of-containers rest))
(defmethod monadic-unit ((monad symbol) element &rest rest)
(appy #'monadic-unit (monadic-instance monad) element rest))
;;;
;;; 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)))
;;;
;;; Define the IDENTITY-MONAD.
;;;
(define-monad identity-monad
:comprehension identity-comp
:map ((f) f)
:join ((x &rest rest) (apply #'values x rest))
:unit ((x &rest rest) (apply #'values x rest)))
;;;
;;; State transformer monad, with operations expressed using comprehensions
;;; over the identity monad, featuring multiple-value binding.
;;;
(define-monad state-xform-monad
:comprehension state-xform-comp
:map ((f)
(lambda (xformer)
(lambda (s)
(identity-comp (values (funcall f x) new-state)
((x new-state) (funcall xformer s))))))
:join ((nested-xformer)
(lambda (s)
(identity-comp (values x new-state)
((embedded-xformer intermediate-state)
(funcall nested-xformer s))
((x new-state)
(funcall embedded-xformer intermediate-state)))))
:unit ((x) (lambda (s) (values x s))))
Annotations for this paste:
| Annotation number 1: | bugfixes |
| Pasted by: | kaz |
| When: | 7 months, 1 day ago |
| Share: | Tweet this! | http://paste.lisp.org/+1IXO#1 |
| Paste contents: |
;;;
;;; Common Lisp monads based on "Comprehending Monads"
;;; paper (Philip Wadler, 1990).
;;; Kaz Kylheku <kkylheku@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)
;;;
;;; The purpose of the &REST parameters is to support the notion of elements
;;; that are multiple values. See comment for MONADIC-UNIT below.
;;;
(defgeneric monadic-join (monad-class container-of-containers &rest additional))
;;;
;;; 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)
;;;
;;; The purpose of the &REST parameters is to support elements which
;;; are multiple values. This is of particular importance in the identity
;;; monad. The identity monad's unit function is variadic and returns all
;;; of the parameters as multiple values. This works in conjunction with
;;; the comprehension macro, allowing multiple value bindings, e.g:
;;;
;;; (identity-comp (values x y) ((x y) (values 1 2)))
;;;
;;; Here (x y) get bound as if by (multiple-value-bind (x y) (values 1 2)).
;;; Because the expression is (values x y), the comprehension as a whole
;;; returns 1 2 as a pair of values.
;;;
;;; Multiple value support is required in the identity monad, because
;;; Wadler's paper expresses identity monads that bind multiple values.
;;; Wadler's state transformer monad is based on a domain of state
;;; transformer functions which return multiple values, and he uses
;;; identity comprehensions to express the bodies of the operations,
;;; where pairs of values coming from calls state transformers are
;;; captured by two variables. I didn't want to represent that
;;; as (for instance) conses, but proper Lisp multiple values.
;;;
(defgeneric monadic-unit (monad-class element &rest additional))
;;;
;;; 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) `(multiple-value-call #'monadic-unit
,monad-instance ,expr))
((rest clauses) `(let ((,monad-var ,monad-instance))
(multiple-value-call #'monadic-join ,monad-var
(comprehend ,monad-var
(comprehend ,monad-var ,expr ,@(rest clauses))
,(first clauses)))))
(t (destructuring-bind (var &rest container-exprs) (first clauses)
(cond
((and var (symbolp var))
`(funcall (monadic-map ,monad-instance (lambda (,var) ,expr))
,(first container-exprs)))
((and (consp var) (every #'symbolp var))
`(multiple-value-call (monadic-map ,monad-instance
(lambda (,@var) ,expr))
,@container-exprs))
(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 (gensym "MONAD-"))
bases slots initargs
((:map ((map-param)
&body map-body)))
((:join ((join-param
&optional
(j-rest-kw '&rest)
(j-rest (gensym "JOIN-REST-")))
&body join-body)))
((:unit ((unit-param
&optional
(u-rest-kw '&rest)
(u-rest (gensym "UNIT-REST-")))
&body unit-body))))
`(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) ,map-param)
(declare (ignorable ,monad-param))
,@map-body)
(defmethod monadic-join ((,monad-param ,class-name)
,join-param &rest ,j-rest)
(declare (ignorable ,monad-param ,j-rest))
,@join-body)
(defmethod monadic-unit ((,monad-param ,class-name)
,unit-param &rest ,u-rest)
(declare (ignorable ,monad-param ,u-rest))
,@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 &rest rest)
(apply #'monadic-join (monadic-instance monad) container-of-containers rest))
(defmethod monadic-unit ((monad symbol) element &rest rest)
(apply #'monadic-unit (monadic-instance monad) element rest))
;;;
;;; 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)))
;;;
;;; Define the IDENTITY-MONAD.
;;;
(define-monad identity-monad
:comprehension identity-comp
:map ((f) f)
:join ((x &rest rest) (apply #'values x rest))
:unit ((x &rest rest) (apply #'values x rest)))
;;;
;;; State transformer monad, with operations expressed using comprehensions
;;; over the identity monad, featuring multiple-value binding.
;;;
(define-monad state-xform-monad
:comprehension state-xform-comp
:map ((f)
(lambda (xformer)
(lambda (s)
(identity-comp (values (funcall f x) new-state)
((x new-state) (funcall xformer s))))))
:join ((nested-xformer)
(lambda (s)
(identity-comp (values x new-state)
((embedded-xformer intermediate-state)
(funcall nested-xformer s))
((x new-state)
(funcall embedded-xformer intermediate-state)))))
:unit ((x) (lambda (s) (values x s))))