;;; ;;; Common Lisp monads based on "Comprehending Monads" ;;; paper (Philip Wadler, 1990). ;;; Kaz Kylheku ;;; 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. ;;; ;;; Example: ;;; ;;; (let ((transformer (state-xform-comp (list x y z) ;;; (x (lambda (state) ;;; (values `(:stage x ,state) (1+ state)))) ;;; (y (lambda (state) ;;; (values `(:stage y ,state) (+ 10 state)))) ;;; (z (lambda (state) ;;; (values `(:stage z ,state) nil)))))) ;;; (funcall transformer 42)) ;;; ;;; -> ((:STAGE X 42) (:STAGE Y 43) (:STAGE Z 53)) ;;; (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))))