From dsorokin at common-lisp.net Wed Jan 20 05:39:11 2010 From: dsorokin at common-lisp.net (David Sorokin) Date: Wed, 20 Jan 2010 00:39:11 -0500 Subject: [Cl-monad-macros-cvs] r1 - trunk Message-ID: Author: dsorokin Date: Wed Jan 20 00:39:10 2010 New Revision: 1 Log: Initial commit Added: trunk/ trunk/cl-monad-macros.asd trunk/cl-monad-macros.lisp Added: trunk/cl-monad-macros.asd ============================================================================== --- (empty file) +++ trunk/cl-monad-macros.asd Wed Jan 20 00:39:10 2010 @@ -0,0 +1,36 @@ + +;;; Copyright (c) 2010, David Sorokin. All rights reserved. +;;; +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. +;;; +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(defpackage :cl-monad-macros-asd (:use :asdf :cl)) + +(in-package :cl-monad-macros-asd) + +(defsystem :cl-monad-macros + :version "0.1" + :author "David Sorokin " + :description "Monad Macros for Common Lisp." + :components ((:file "cl-monad-macros"))) Added: trunk/cl-monad-macros.lisp ============================================================================== --- (empty file) +++ trunk/cl-monad-macros.lisp Wed Jan 20 00:39:10 2010 @@ -0,0 +1,813 @@ + +;;; This file defines the Monad Macros. + +;;; Copyright (c) 2010, David Sorokin. All rights reserved. +;;; +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. +;;; +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(defpackage :cl-monad-macros + (:use :common-lisp) + (:export + :with-monad + :with-identity-monad + :with-list-monad + :with-maybe-monad + :with-reader-monad + :with-reader-monad-trans + :with-writer-monad + :with-writer-monad-trans + :with-state-monad + :with-state-monad-trans + :with-monad-trans + :with-inner-monad-trans + :with-outer-monad-trans + :universal-let! + :universal-progn! + :unit + :funcall! + :let! + :progn! + :lift! + :inner-unit + :inner-funcall! + :inner-let! + :inner-progn! + :make-maybe + :maybe-just + :maybe-just-p + :maybe-nil + :maybe-nil-p + :run! + :read! + :write! + :write-list! + :get! + :put!)) + +(in-package :cl-monad-macros) + +;;; +;;; General Case +;;; + +(defmacro generic-progn! (funcall-func &body ms) + (reduce #'(lambda (m1 m2) + (let ((x (gensym))) + `(,funcall-func + #'(lambda (, x) + (declare (ignore ,x)) + ,m2) + ,m1))) + ms + :from-end t)) + +(defmacro generic-let! (funcall-func decls m) + (reduce #'(lambda (decl m) + (destructuring-bind (x e) decl + `(,funcall-func #'(lambda (,x) ,m) ,e))) + decls + :from-end t + :initial-value m)) + +(defmacro with-monad ((unit-func funcall-func) &body body) + `(macrolet + ((unit (a) (list ',unit-func a)) + (funcall! (k m) (list ',funcall-func k m)) + (progn! (&body ms) (append '(generic-progn!) '(,funcall-func) ms)) + (let! (decls m) (list 'generic-let! ',funcall-func decls m))) + , at body)) + +;;; +;;; The Bind Macros +;;; + +(defmacro universal-progn! (&body ms) + (reduce #'(lambda (m1 m2) + (let ((x (gensym))) + `(funcall! + #'(lambda (, x) + (declare (ignore ,x)) + ,m2) + ,m1))) + ms + :from-end t)) + +(defmacro universal-let! (decls m) + (reduce #'(lambda (decl m) + (destructuring-bind (x e) decl + `(funcall! #'(lambda (,x) ,m) ,e))) + decls + :from-end t + :initial-value m)) + +;;; +;;; The Identity Monad +;;; + +(defmacro with-identity-monad (&body body) + `(macrolet + ((unit (a) a) + (funcall! (k m) (list 'funcall k m)) + (progn! (&body ms) (append '(progn) ms)) + (let! (decls m) (list 'let* decls m))) + , at body)) + +;;; +;;; The List Monad +;;; + +(defmacro list-progn! (&body ms) + (reduce #'(lambda (m1 m2) + (let ((x (gensym))) + `(loop for ,x in ,m1 append ,m2))) + ms + :from-end t)) + +(defmacro list-let! (decls m) + (reduce #'(lambda (decl m) + (destructuring-bind (x e) decl + `(loop for ,x in ,e append ,m))) + decls + :from-end t + :initial-value m)) + +(defmacro with-list-monad (&body body) + `(macrolet + ((unit (a) `(list ,a)) + (funcall! (k m) `(reduce #'append (mapcar ,k ,m))) + (progn! (&body ms) (append '(list-progn!) ms)) + (let! (decls m) (list 'list-let! decls m))) + , at body)) + +;;; +;;; The Maybe Monad +;;; + +(defmacro make-maybe (&key (just nil just-supplied-p)) + (if just-supplied-p `(cons ,just nil))) + +(defmacro maybe-just (a) + `(car ,a)) + +(defmacro maybe-nil () + nil) + +(defmacro maybe-just-p (m) + `(consp ,m)) + +(defmacro maybe-nil-p (m) + `(null ,m)) + +(defmacro maybe-unit (a) + `(make-maybe :just ,a)) + +(defmacro maybe-funcall! (k m) + (let ((xk (gensym)) + (xm (gensym))) + `(let ((,xk ,k) + (,xm ,m)) + (if (maybe-nil-p ,xm) + (make-maybe) + (funcall ,xk (maybe-just ,xm)))))) + +(defmacro maybe-progn! (&body ms) + (reduce #'(lambda (m1 m2) + `(if (maybe-nil-p ,m1) + (make-maybe) + ,m2)) + ms + :from-end t)) + +(defmacro maybe-let! (decls m) + (reduce #'(lambda (decl m) + (destructuring-bind (x e) decl + (let ((xe (gensym))) + `(let ((,xe ,e)) + (if (maybe-nil-p ,xe) + (make-maybe) + (let ((,x (maybe-just ,xe))) + ,m)))))) + decls + :from-end t + :initial-value m)) + +(defmacro with-maybe-monad (&body body) + `(macrolet + ((unit (a) (list 'maybe-unit a)) + (funcall! (k m) (list 'maybe-funcall! k m)) + (progn! (&body ms) (append '(maybe-progn!) ms)) + (let! (decls m) (list 'maybe-let! decls m))) + , at body)) + +;;; +;;; The Reader Monad +;;; + +(defmacro reader-unit (a) + (let ((r (gensym))) + `#'(lambda (,r) + (declare (ignore ,r)) + ,a))) + +(defmacro reader-funcall! (k m) + (let ((r (gensym)) + (a (gensym)) + (kg (gensym))) + `#'(lambda (,r) + (let ((,kg ,k) + (,a (funcall ,m ,r))) + (funcall (funcall ,kg ,a) ,r))))) + +(defmacro reader-let! (decls m) + (reduce #'(lambda (decl m) + (destructuring-bind (x e) decl + (let ((r (gensym))) + `#'(lambda (,r) + (let ((,x (funcall ,e ,r))) + (funcall ,m ,r)))))) + decls + :from-end t + :initial-value m)) + +(defmacro reader-progn! (&body ms) + (reduce #'(lambda (m1 m2) + (let ((r (gensym))) + `#'(lambda (,r) + (funcall ,m1 ,r) + (funcall ,m2 ,r)))) + ms + :from-end t)) + +(defmacro reader-read! () + (let ((r (gensym))) + `#'(lambda (,r) ,r))) + +(defmacro reader-run! (m r) + `(funcall ,m ,r)) + +(defmacro with-reader-monad (&body body) + `(macrolet + ((unit (a) (list 'reader-unit a)) + (funcall! (k m) (list 'reader-funcall! k m)) + (progn! (&body ms) (append '(reader-progn!) ms)) + (let! (decls m) (list 'reader-let! decls m)) + (read! () (list 'reader-read!)) + (run! (m r) (list 'reader-run! m r))) + , at body)) + +;;; +;;; The State Monad +;;; + +(defmacro make-state (a st) + `(cons ,a ,st)) + +(defmacro state-value (m) + `(car ,m)) + +(defmacro state-state (m) + `(cdr ,m)) + +(defmacro state-unit (a) + (let ((st (gensym))) + `#'(lambda (,st) + (make-state ,a ,st)))) + +(defmacro state-funcall! (k m) + (let ((st (gensym)) + (p (gensym)) + (a (gensym)) + (kg (gensym))) + `#'(lambda (,st) + (let ((,kg ,k)) + (let ((,p (funcall ,m ,st))) + (let ((,a (state-value ,p))) + (funcall (funcall ,kg ,a) + (state-state ,p)))))))) + +(defmacro state-let! (decls m) + (reduce #'(lambda (decl m) + (destructuring-bind (x e) decl + (let ((st (gensym)) + (p (gensym))) + `#'(lambda (,st) + (let ((,p (funcall ,e ,st))) + (let ((,x (state-value ,p))) + (funcall ,m (state-state ,p)))))))) + decls + :from-end t + :initial-value m)) + +(defmacro state-progn! (&body ms) + (reduce #'(lambda (m1 m2) + (let ((st (gensym)) + (p (gensym))) + `#'(lambda (,st) + (let ((,p (funcall ,m1 ,st))) + (funcall ,m2 (state-state ,p)))))) + ms + :from-end t)) + +(defmacro state-run! (m init-st) + (let ((p (gensym))) + `(let ((,p (funcall ,m ,init-st))) + (list (state-value ,p) + (state-state ,p))))) + +(defmacro state-get! () + (let ((st (gensym))) + `#'(lambda (,st) + (make-state ,st ,st)))) + +(defmacro state-put! (new-st) + (let ((st (gensym))) + `#'(lambda (,st) + (declare (ignore ,st)) + (make-state nil ,new-st)))) + +(defmacro with-state-monad (&body body) + `(macrolet + ((unit (a) (list 'state-unit a)) + (funcall! (k m) (list 'state-funcall! k m)) + (progn! (&body ms) (append '(state-progn!) ms)) + (let! (decls m) (list 'state-let! decls m)) + (get! () (list 'state-get!)) + (put! (new-st) (list 'state-put! new-st)) + (run! (m init-st) (list 'state-run! m init-st))) + , at body)) + +;;; +;;; The Writer Monad +;;; + +(defmacro make-writer (a fun) + `(cons ,a ,fun)) + +(defmacro writer-value (m) + `(car ,m)) + +(defmacro writer-fun (m) + `(cdr ,m)) + +(defmacro writer-compose (f g) + ;; There are high chances that g is NIL + (let ((fs (gensym)) + (gs (gensym))) + `(let ((,fs ,f) + (,gs ,g)) + (cond ((null ,gs) ,fs) ; check it first + ((null ,fs) ,gs) + (t #'(lambda (x) + (funcall ,fs + (funcall ,gs x)))))))) + +(defmacro writer-write! (&body ws) + (if (= 1 (length ws)) + ;; An optimized case + (let ((w (nth 0 ws)) + (v (gensym))) + `(make-writer nil + (let ((,v ,w)) + #'(lambda (xs) (cons ,v xs))))) + ;; A general case + (let ((vs (gensym))) + `(make-writer nil + (let ((,vs (list , at ws))) + #'(lambda (xs) + (append ,vs xs))))))) + +(defmacro writer-write-list! (&body wss) + (if (= 1 (length wss)) + ;; An optimized case + (let ((ws (nth 0 wss)) + (vs (gensym))) + `(make-writer nil + (let ((,vs ,ws)) + #'(lambda (xs) (append ,vs xs))))) + ;; A general case + (let ((vss (gensym))) + `(make-writer nil + (let ((,vss (list , at wss))) + #'(lambda (xs) + (reduce #'append ,vss + :from-end t + :initial-value xs))))))) + +(defmacro writer-run! (m) + (let ((x (gensym)) + (fun (gensym))) + `(let ((,x ,m)) + (list (writer-value ,x) + (let ((,fun (writer-fun ,x))) + (if (not (null ,fun)) + (funcall ,fun nil))))))) + +(defmacro writer-unit (a) + `(make-writer ,a nil)) + +(defmacro writer-funcall! (k m) + (let ((ks (gensym)) + (ms (gensym)) + (a (gensym)) + (ka (gensym))) + `(let* ((,ks ,k) ; save it first + (,ms ,m) + (,a (writer-value ,ms)) + (,ka (funcall ,ks ,a))) + (make-writer (writer-value ,ka) + (writer-compose (writer-fun ,ms) + (writer-fun ,ka)))))) + +(defmacro writer-let! (decls m) + (reduce + #'(lambda (decl m) + (destructuring-bind (x e) decl + (let ((es (gensym)) + (ms (gensym))) + `(let* ((,es ,e) + (,x (writer-value ,es)) + (,ms ,m)) ; depends on x! + (make-writer (writer-value ,ms) + (writer-compose (writer-fun ,es) + (writer-fun ,ms))))))) + decls + :from-end t + :initial-value m)) + + +(defmacro writer-progn! (&body ms) + (reduce + #'(lambda (m1 m2) + (let ((m1s (gensym)) + (m2s (gensym))) + `(let ((,m1s ,m1) + (,m2s ,m2)) + (make-writer (writer-value ,m2s) + (writer-compose (writer-fun ,m1s) + (writer-fun ,m2s)))))) + ms + :from-end t)) + +(defmacro with-writer-monad (&body body) + `(macrolet + ((unit (a) (list 'writer-unit a)) + (funcall! (k m) (list 'writer-funcall! k m)) + (progn! (&body ms) (append '(writer-progn!) ms)) + (let! (decls m) (list 'writer-let! decls m)) + (write! (&body ws) (append '(writer-write!) ws)) + (write-list! (&body wss) (append '(writer-write-list!) wss)) + (run! (m) (list 'writer-run! m))) + , at body)) + +;;; +;;; The Monad Transformer +;;; + +(defmacro with-monad-trans (outer-monad &body body) + (let ((inner-monad (cadr outer-monad))) + `(macrolet + ((with-inner-monad-trans (id &body bs) + (append '(with-inner-monad-prototype) + (list ',outer-monad) + (list ',inner-monad) + (list id) + bs)) + (with-outer-monad-trans (id &body bs) + (append id bs)) + ;; + (inner-unit (a) (list 'generic-inner-unit a)) + (inner-funcall! (k m) (list 'generic-inner-funcall! k m)) + (inner-progn! (&body ms) (append '(generic-inner-progn!) ms)) + (inner-let! (decls m) (list 'generic-inner-let! decls m))) + , at body))) + +(defmacro with-inner-monad-prototype + (outer-monad inner-monad id &body body) + `(macrolet ((, at id (&body bs) (append ',outer-monad bs))) + (, at inner-monad + , at body))) + +(defmacro generic-inner-unit (a) + (let ((id (gensym))) + `(with-inner-monad-trans (,id) + (unit + (with-outer-monad-trans (,id) + ,a))))) + +(defmacro generic-inner-funcall! (k m) + (let ((id (gensym))) + `(with-inner-monad-trans (,id) + (funcall! + (with-outer-monad-trans (,id) ,k) + (with-outer-monad-trans (,id) ,m))))) + +(defmacro generic-inner-let! (decls m) + (reduce + #'(lambda (decl m) + (destructuring-bind (x e) decl + (let ((id (gensym))) + `(with-inner-monad-trans (,id) + (let! ((,x (with-outer-monad-trans (,id) ,e))) + (with-outer-monad-trans (,id) ,m)))))) + decls + :from-end t + :initial-value m)) + +(defmacro generic-inner-progn! (&body ms) + (let ((id (gensym))) + (let ((outer-ms (loop for m in ms collect + `(with-outer-monad-trans (,id) ,m)))) + `(with-inner-monad-trans (,id) + (progn! , at outer-ms))))) + +;;; +;;; The Reader Monad Transformer +;;; + +(defmacro reader-trans-unit (a) + (let ((r (gensym))) + `#'(lambda (,r) + (declare (ignore ,r)) + (inner-unit ,a)))) + +(defmacro reader-trans-funcall! (k m) + (let ((r (gensym)) + (a (gensym)) + (kg (gensym))) + `#'(lambda (,r) + (let ((,kg ,k)) + (inner-let! ((,a (funcall ,m ,r))) + (funcall (funcall ,kg ,a) ,r)))))) + +(defmacro reader-trans-let! (decls m) + (reduce #'(lambda (decl m) + (destructuring-bind (x e) decl + (let ((r (gensym))) + `#'(lambda (,r) + (inner-let! ((,x (funcall ,e ,r))) + (funcall ,m ,r)))))) + decls + :from-end t + :initial-value m)) + +(defmacro reader-trans-progn! (&body ms) + (reduce #'(lambda (m1 m2) + (let ((r (gensym))) + `#'(lambda (,r) + (inner-progn! + (funcall ,m1 ,r) + (funcall ,m2 ,r))))) + ms + :from-end t)) + +(defmacro reader-trans-read! () + (let ((r (gensym))) + `#'(lambda (,r) + (inner-unit ,r)))) + +(defmacro reader-trans-run! (m r) + `(funcall ,m ,r)) + +(defmacro reader-trans-lift! (m) + (let ((r (gensym))) + `#'(lambda (,r) + (declare (ignore ,r)) + ,m))) + +(defmacro with-reader-monad-trans (inner-monad &body body) + `(with-monad-trans (with-reader-monad-trans ,inner-monad) + (macrolet + ((unit (a) (list 'reader-trans-unit a)) + (funcall! (k m) (list 'reader-trans-funcall! k m)) + (progn! (&body ms) (append '(reader-trans-progn!) ms)) + (let! (decls m) (list 'reader-trans-let! decls m)) + (read! () (list 'reader-trans-read!)) + (run! (m r) (list 'reader-trans-run! m r)) + (lift! (m) (list 'reader-trans-lift! m))) + , at body))) + +;;; +;;; The State Monad Transformer +;;; + +(defmacro state-trans-unit (a) + (let ((st (gensym))) + `#'(lambda (,st) + (inner-unit + (make-state ,a ,st))))) + +(defmacro state-trans-funcall! (k m) + (let ((st (gensym)) + (p (gensym)) + (a (gensym)) + (kg (gensym))) + `#'(lambda (,st) + (let ((,kg ,k)) + (inner-let! ((,p (funcall ,m ,st))) + (let ((,a (state-value ,p))) + (funcall (funcall ,kg ,a) + (state-state ,p)))))))) + +(defmacro state-trans-let! (decls m) + (reduce #'(lambda (decl m) + (destructuring-bind (x e) decl + (let ((st (gensym)) + (p (gensym))) + `#'(lambda (,st) + (inner-let! ((,p (funcall ,e ,st))) + (let ((,x (state-value ,p))) + (funcall ,m (state-state ,p)))))))) + decls + :from-end t + :initial-value m)) + +(defmacro state-trans-progn! (&body ms) + (reduce #'(lambda (m1 m2) + (let ((st (gensym)) + (p (gensym))) + `#'(lambda (,st) + (inner-let! ((,p (funcall ,m1 ,st))) + (funcall ,m2 (state-state ,p)))))) + ms + :from-end t)) + +(defmacro state-trans-run! (m init-st) + (let ((p (gensym))) + `(inner-let! ((,p (funcall ,m ,init-st))) + (inner-unit + (list (state-value ,p) + (state-state ,p)))))) + +(defmacro state-trans-get! () + (let ((st (gensym))) + `#'(lambda (,st) + (inner-unit + (make-state ,st ,st))))) + +(defmacro state-trans-put! (new-st) + (let ((st (gensym))) + `#'(lambda (,st) + (declare (ignore ,st)) + (inner-unit + (make-state nil ,new-st))))) + +(defmacro state-trans-lift! (m) + (let ((st (gensym)) + (a (gensym))) + `#'(lambda (,st) + (inner-let! ((,a ,m)) + (inner-unit + (make-state ,a ,st)))))) + +(defmacro with-state-monad-trans (inner-monad &body body) + `(with-monad-trans (with-state-monad-trans ,inner-monad) + (macrolet + ((unit (a) (list 'state-trans-unit a)) + (funcall! (k m) (list 'state-trans-funcall! k m)) + (progn! (&body ms) (append '(state-trans-progn!) ms)) + (let! (decls m) (list 'state-trans-let! decls m)) + (get! () (list 'state-trans-get!)) + (put! (new-st) (list 'state-trans-put! new-st)) + (run! (m init-st) (list 'state-trans-run! m init-st)) + (lift! (m) (list 'state-trans-lift! m))) + , at body))) + +;;; +;;; The Writer Monad Transformer +;;; + +(defmacro writer-trans-write! (&body ws) + (if (= 1 (length ws)) + ;; An optimized case + (let ((w (nth 0 ws)) + (v (gensym))) + `(inner-unit + (make-writer nil + (let ((,v ,w)) + #'(lambda (xs) (cons ,v xs)))))) + ;; A general case + (let ((vs (gensym))) + `(inner-unit + (make-writer nil + (let ((,vs (list , at ws))) + #'(lambda (xs) + (append ,vs xs)))))))) + +(defmacro writer-trans-write-list! (&body wss) + (if (= 1 (length wss)) + ;; An optimized case + (let ((ws (nth 0 wss)) + (vs (gensym))) + `(inner-unit + (make-writer nil + (let ((,vs ,ws)) + #'(lambda (xs) (append ,vs xs)))))) + ;; A general case + (let ((vss (gensym))) + `(inner-unit + (make-writer nil + (let ((,vss (list , at wss))) + #'(lambda (xs) + (reduce #'append ,vss + :from-end t + :initial-value xs)))))))) + +(defmacro writer-trans-run! (m) + (let ((x (gensym)) + (fun (gensym))) + `(inner-let! ((,x ,m)) + (inner-unit + (list (writer-value ,x) + (let ((,fun (writer-fun ,x))) + (if (not (null ,fun)) + (funcall ,fun nil)))))))) + +(defmacro writer-trans-unit (a) + `(inner-unit + (make-writer ,a nil))) + +(defmacro writer-trans-funcall! (k m) + (let ((ks (gensym)) + (ms (gensym)) + (a (gensym)) + (ka (gensym))) + `(let ((,ks ,k)) + (inner-let! ((,ms ,m)) + (let ((,a (writer-value ,ms))) + (inner-let! ((,ka (funcall ,ks ,a))) + (inner-unit + (make-writer (writer-value ,ka) + (writer-compose (writer-fun ,ms) + (writer-fun ,ka)))))))))) + +(defmacro writer-trans-let! (decls m) + (reduce + #'(lambda (decl m) + (destructuring-bind (x e) decl + (let ((es (gensym)) + (ms (gensym))) + `(inner-let! ((,es ,e)) + (let ((,x (writer-value ,es))) + (inner-let! ((,ms ,m)) + (inner-unit + (make-writer (writer-value ,ms) + (writer-compose (writer-fun ,es) + (writer-fun ,ms)))))))))) + decls + :from-end t + :initial-value m)) + +(defmacro writer-trans-progn! (&body ms) + (reduce + #'(lambda (m1 m2) + (let ((m1s (gensym)) + (m2s (gensym))) + `(inner-let! ((,m1s ,m1) + (,m2s ,m2)) + (inner-unit + (make-writer (writer-value ,m2s) + (writer-compose (writer-fun ,m1s) + (writer-fun ,m2s))))))) + ms + :from-end t)) + +(defmacro writer-trans-lift! (m) + (let ((a (gensym))) + `(inner-let! ((,a ,m)) + (inner-unit + (make-writer ,a nil))))) + +(defmacro with-writer-monad-trans (inner-monad &body body) + `(with-monad-trans (with-writer-monad-trans ,inner-monad) + (macrolet + ((unit (a) (list 'writer-trans-unit a)) + (funcall! (k m) (list 'writer-trans-funcall! k m)) + (progn! (&body ms) (append '(writer-trans-progn!) ms)) + (let! (decls m) (list 'writer-trans-let! decls m)) + (write! (&body ws) (append '(writer-trans-write!) ws)) + (write-list! (&body wss) (append '(writer-trans-write-list!) wss)) + (run! (m) (list 'writer-trans-run! m)) + (lift! (m) (list 'writer-trans-lift! m))) + , at body))) From dsorokin at common-lisp.net Thu Jan 21 09:50:28 2010 From: dsorokin at common-lisp.net (David Sorokin) Date: Thu, 21 Jan 2010 04:50:28 -0500 Subject: [Cl-monad-macros-cvs] r2 - trunk Message-ID: Author: dsorokin Date: Thu Jan 21 04:50:28 2010 New Revision: 2 Log: Removed unnecessary space. Modified: trunk/cl-monad-macros.lisp Modified: trunk/cl-monad-macros.lisp ============================================================================== --- trunk/cl-monad-macros.lisp (original) +++ trunk/cl-monad-macros.lisp Thu Jan 21 04:50:28 2010 @@ -107,7 +107,7 @@ (reduce #'(lambda (m1 m2) (let ((x (gensym))) `(funcall! - #'(lambda (, x) + #'(lambda (,x) (declare (ignore ,x)) ,m2) ,m1))) From dsorokin at common-lisp.net Thu Jan 21 15:16:38 2010 From: dsorokin at common-lisp.net (David Sorokin) Date: Thu, 21 Jan 2010 10:16:38 -0500 Subject: [Cl-monad-macros-cvs] r3 - trunk/doc Message-ID: Author: dsorokin Date: Thu Jan 21 10:16:37 2010 New Revision: 3 Log: Added documentation. Added: trunk/doc/ trunk/doc/monad-macros.htm Added: trunk/doc/monad-macros.htm ============================================================================== --- (empty file) +++ trunk/doc/monad-macros.htm Thu Jan 21 10:16:37 2010 @@ -0,0 +1,3980 @@ + + + + + +Monad Macros in Common Lisp + + + + + + +
+ + + +

David Sorokin david.sorokin at gmail.com, Jan 2010

+ +

Contents

+ +

Introduction. 2

+ +

General Case. 2

+ +

Bind Macros. 6

+ +

The Identity Monad. 7

+ +

The List Monad. 8

+ +

The Maybe Monad. 10

+ +

The Reader Monad. 12

+ +

The State Monad. 15

+ +

The Writer Monad. 19

+ +

Monad Transformers. 25

+ +

Inner Monad Macros. 27

+ +

The Reader Monad +Transformer. 29

+ +

The State Monad +Transformer. 32

+ +

The Writer Monad +Transformer. 37

+ +

Reducing Monad +Macros. 42

+ +

Loops. 44

+ +

Other Monad Macros. 45

+ +

Conclusion. 46

+ +

 

+ +
+ + +

 

+ +

Introduction

+ +

A monad can be defined with help of two +functions, one of which is higher-order. Direct working with them is tedious +and error-prone. In this article I?ll describe an approach that greatly +simplifies the use of monads in Common Lisp. It is possible due to macros.

+ +

I suppose that the reader is familiar with Haskell?s +definition of the Monad type class. To create a monad instance, we have to define +the mentioned two functions. The first of them is called return. The +second one is known as the bind function and it is denoted in Haskell as +operator (>>=):

+ +
+ +

class Monad m where
+????? return :: a -> m a
+????? (>>=) ?:: m a -> (a -> m b) -> m b

+ +
+ +

This definition actually allows the +programmer to use common names return and (>>=) for very different +functions. I?ll try to create similar Lisp macros that will be common for all +monads. Also Haskell provides a useful do-notation which is a syntactic sugar +for monads. The macros I will create will provide similar facilities as well.

+ +

Also I created a new project with name cl-monad-macros. +It is available by the following link: http://common-lisp.net/project/cl-monad-macros. The corresponded package contains definitions of all monad macros +described in this article.

+ +

The package and all examples were +successfully tested on the following Lisp systems:

+ +

?         +Steel Bank Common Lisp (SBCL);

+ +

?         +Clozure CL (CCL);

+ +

?         +CLISP;

+ +

?         +LispWorks;

+ +

?         +Allegro CL.

+ +

General +Case

+ +

Let?s suppose that some monad is defined +with help of two hypothetical functions UNITF and FUNCALLF:

+ +
+ +

(defun unitf (a)
+????? ;; evaluate as in Haskell: return a
+????? ?)
+
+(defun funcallf (k m)
+????? ;; evaluate as in Haskell: m >>= k
+????? ?)

+ +
+ +

The UNITF function is the return function. +Function FUNCALLF is an analog of the idiomatic bind function but only +the order of arguments is opposite. Further I call namely this new function a bind +function. Please take care.

+ +

We could limit ourselves to using only +these functions, but it would be tedious. Please take into account that the +first argument of the bind function must be a function, most probably an +anonymous function. Moreover, we can use a sequence of monad values in one +computation, which complicates the matter significantly.

+ +

Therefore I offer to use the following +macros:

+ + + + + + + + + + + + + + + + + + + + + + +
+

Common Lisp

+ 		+

Haskell

+
+

(unit a)

+ 		+

return a

+
+

(funcall! k m)

+ 		+

m >>= k

+
+

(progn! m1 m2 ? mn)

+ 		+

m1 >> m2 + >> ? >> mn

+
+

(let! ((x1 e1)
+ ?????? (x2 e2)
+ ??????? ?
+ ?????? (xn en))
+ ????? m)

+ 		+

do x1 <- e1
+ ?? x2 <- e2
+ ?? ?
+ ?? xn <- en
+ ?? m

+
+ +

 

+ +

The UNIT macro is equivalent to a call of +the return function. The FUNCALL! macro is expanded to a call of the +bind function. Macro PROGN! is equivalent to the monadic then function, +which is denoted in Haskell as (>>). It allows the programmer to create a +sequence of computations. Internally, it is based on more primitive FUNCALL! +macro.

+ + + + + + + + + + + + + + + + + + +
+

Source form

+ 		+

Reduction form

+
+

(progn! m)

+ 		+

m

+
+

(progn! m1 m2)

+ 		+

(funcall!
+ ?? #?(lambda (#:gen-var)
+ ??????? (declare (ignore #:gen_var))
+ ??????? m2)
+ ?? m1)

+
+

(progn! m1 m2 ? mn)

+ 		+

(progn! m1 (progn! m2 ? mn))

+
+ +

 

+ +

Here #:gen-var means an +automatically generated unique variable name with help of GENSYM.

+ +

Macro LET! is somewhere an alternative to +the arrow symbol from the do-notation of Haskell. It is also based on +the FUNCALL! macro. It binds computations e1, e2, ?, en +with values x1, x2, ?, xn, which can be then used in +computation m.

+ + + + + + + + + + + + + + +
+

Source form

+ 		+

Reduction form

+
+

(let! ((x e)) m)

+ 		+

(funcall!
+ ?? #?(lambda (x) m)
+ ?? e)

+
+

(let! ((x1 e1)
+ ?????? (x2 e2)
+ ??????? ?
+ ?????? (xn en))
+ ????? m)

+ 		+

(let! ((x1 e1))
+ ?? (let! ((x2 e2)
+ ?????????? ?
+ ????????? (xn en))
+ ???????? m))

+
+ +

 

+ +

Please note that the LET! macro accepts +only two arguments, the last of which is the monad value. It was made +intentionally for similarity with the LET and LET* operators in the following +sense. If we want to propagate a sequence of computations then we have to apply +the PROGN! macro in all cases:

+ + + + + + + + + + + + + + +
+

Common Lisp

+ 		+

Haskell

+
+

(let! ((x e))
+ ?? (progn! m1 m2 ? mn))

+ 		+

do x <- e
+ ?? m1
+ ?? m2
+ ?? ?
+ ?? mn

+
+

(let ((x a))
+ ?? (progn! m1 m2 ? mn))

+ 		+

do let x = a
+ ?? m1
+ ?? m2
+ ?? ?
+ ?? mn

+
+ +

 

+ +

Thus, macros UNIT, FUNCALL!, PROGN! and +LET! provide an unified common way of working with the monads. To distinguish +different monads from each other, we can implement these macros as a MACROLET defined +by global macro WITH-MONAD that has the following application form:

+ +
+ +

(with-monad (return-func funcall-func)
+????? ;; Here we can use UNIT, FUNCALL!, PROGN! and LET!
+????? body1 ? bodyN)

+ +
+ +

The first sub-parameter return-func +defines a name of the return function. The second sub-parameter funcall-func +defines a name of the bind function. This macro is expanded to a MACROLET +saving the same body.

+ +
+ +

(defmacro with-monad ((unit-func funcall-func) +&body body)
+? `(macrolet
+?????? ((unit (a) (list ',unit-func a))
+??????? (funcall! (k m) (list ',funcall-func k m))
+??????? (progn! (&body ms) (append '(generic-progn!) '(,funcall-func) ms))
+??????? (let! (decls m) (list 'generic-let! ',funcall-func decls m)))
+???? , at body))

+ +
+ +

Here the GENERIC-LET! macro is used to process +the LET! expression in accordance with the stated above definition.

+ +
+ +

(defmacro generic-let! (funcall-func decls m)
+? (reduce #'(lambda (decl m)
+??????? ??????(destructuring-bind (x e) decl
+??????????????? `(,funcall-func #'(lambda (,x) ,m) ,e)))
+?? ???????decls
+??????? ??:from-end t
+??????? ??:initial-value m))

+ +
+ +

The PROGN! expression is processed already +by the GENERIC-PROGN! helper macro.

+ +
+ +

(defmacro generic-progn! (funcall-func &body +ms)
+? (reduce #'(lambda (m1 m2)
+??????? ??????(let ((x (gensym)))
+??????????????? `(,funcall-func
+???????????????? ?#'(lambda (, x)
+??????????????? ??????(declare (ignore ,x))
+??????????????? ??????,m2)
+??????????????? ??,m1)))
+? ????????ms
+??????? ??:from-end t))

+ +
+ +

Then the following test expression

+ +
+ +

? (with-monad (unitf funcallf)
+? ??(let! ((x1 e1)
+??? ???????(x2 e2))
+????? ????(progn! m1 m2
+??????? ??????????(unit (list x1 x2)))))

+ +
+ +

is expanded ultimately to

+ +
+ +

? (FUNCALLF
+?? #'(LAMBDA (X1)
+?????? (FUNCALLF
+??????? #'(LAMBDA (X2)
+??????????? (FUNCALLF
+???????????? #'(LAMBDA (#:G983)
+???????????????? (DECLARE (IGNORE #:G983))
+???????????????? (FUNCALLF
+????????????????? #'(LAMBDA (#:G982)
+????????????????????? (DECLARE (IGNORE #:G982))
+????????????????????? (UNITF (LIST X1 X2)))
+????????????????? M2))
+???????????? M1))
+??????? E2))
+?? E1)

+ +
+ +

The expanded code is generic enough. Actually, +macro WITH-MONAD satisfies some abstract contract providing definitions for +macros UNIT, FUNCALL!, PROGN! and LET!. As we?ll see later, there are other +specialized macros that are like WITH-MONAD and that satisfy the same contract +but generate a more efficient code for their monads. Moreover, in case of the +monad transformers new macros are necessary.

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+

Monad

+ 		+

Monad Macro

+
+

General Case

+ 		+

WITH-MONAD

+
+

The Identity Monad

+ 		+

WITH-IDENTITY-MONAD

+
+

The List Monad

+ 		+

WITH-LIST-MONAD

+
+

The Maybe Monad

+ 		+

WITH-MAYBE-MONAD

+
+

The Reader Monad

+ 		+

WITH-READER-MONAD

+
+

The State Monad

+ 		+

WITH-STATE-MONAD

+
+

The Writer Monad

+ 		+

WITH-WRITER-MONAD

+
+

The Reader Monad + Transformer

+ 		+

WITH-READER-MONAD-TRANS

+
+

The State Monad + Transformer

+ 		+

WITH-STATE-MONAD-TRANS

+
+

The Writer Monad + Transformer

+ 		+

WITH-WRITER-MONAD-TRANS

+
+ +

 

+ +

It?s important that macros like WITH-MONAD +can be nested, which allows the programmer to work with different monads in the +same s-expression. Each new application of the WITH-MONAD macro shadows the +previous definition of macros UNIT, FUNCALL!, PROGN! and LET!. It means that at +any moment only one monad can be active.

+ +

Although we can always use directly the +WITH-MONAD macro, it is more convenient to create a short name for each monad +in accordance with the following pattern:

+ +
+ +

(defmacro with-my-monad (&body body)
+?? `(with-monad (unitf funcallf)
+?? ????, at body))

+ +
+ +

where UNITF and FUNCALLF were used as an +example.

+ +

Bind Macros

+ +

In the rest of the article you?ll see a lot +of definitions of the LET! and PROGN! macros. Actually, all them can be reduced +to the following two macros that will work with any monad.

+ +
+ +

(defmacro universal-progn! (&body ms)
+? (reduce #'(lambda (m1 m2)
+????????????? (let ((x (gensym)))
+??????????????? `(funcall!
+????????????????? #'(lambda (,x)
+????????????????????? (declare (ignore ,x))
+????????????????????? ,m2)
+????????????????? ,m1)))
+????????? ms
+????????? :from-end t))

+ +

(defmacro universal-let! (decls m)
+? (reduce #'(lambda (decl m)
+????????????? (destructuring-bind (x e) decl
+??????????????? `(funcall! #'(lambda (,x) ,m) ,e)))
+????????? decls
+????????? :from-end t
+????????? :initial-value m))

+ +
+ +

Nevertheless, there is one subtle +optimization issue related to the order of arguments of the FUNCALL! macro. +During the macro expansion of expression

+ +
+ +

? (let! ((x e)) m)

+ +
+ +

macro UNIVERSAL-LET! will generate +ultimately for the most of monads described in this article something like

+ +
+ +

? (let ((k #?(lambda (x) m)))??? ; save the first +argument of FUNCALL!
+??? ?
+??? (let ((a (f e)))??????????? ; use the second argument of FUNCALL!
+????? (funcall k a))
+??? ?)

+ +
+ +

But I?m not sure that any Lisp compiler is +able to optimize it to the following equivalent code that would be more +efficient

+ +
+ +

? ?
+? (let ((x (f e)))
+??? m)
+? ?

+ +
+ +

Please note that there would be no such +problem if the FUNCALL! macro had another order of parameters, i.e. an +idiomatic order as in Haskell. Then FUNCALL and LAMBDA would alternate with +each other directly in the code and the compiler most probably could reduce +them.

+ +
+ +

? ?
+? (let ((a (f e)))
+??? (funcall
+????? #?(lambda (x) m)
+????? a))
+? ?

+ +
+ +

But I think that a similarity with the +standard FUNCALL function is more important and I?m ready to provide optimized +versions of the LET! and PROGN! macros whenever it makes sense.

+ +

The +Identity Monad

+ +

The Identity monad is the simplest case. The +return function is IDENTITY. The bind function is FUNCALL. Then UNIT macro becomes +an acronym of the IDENTITY function, FUNCALL! becomes the ordinary FUNCALL, +PROGRN! is equivalent to PROGN, but LET! is transformed to LET*. This +coincidence in names can be considered as a rule of thumb. Only the LET! macro +is a small exception.

+ +
+ +

(defmacro with-identity-monad (&body body)
+?? `(with-monad (identity funcall)
+?? ???, at body)

+ +
+ +

But there is a much more efficient +implementation:

+ +
+ +

(defmacro with-identity-monad (&body body)
+? `(macrolet
+??? ???((unit (a) a)
+??????? (funcall! (k m) (list 'funcall k m))
+??????? (progn! (&body ms) (append '(progn) ms))
+??????? (let! (decls m) (list 'let* decls m)))
+???? , at body))

+ +
+ +

Remembering about this monad, it is easy to +memorize names FUNCALL!, PROGN! and LET!.

+ +

Our test expression

+ +
+ +

? (with-identity-monad
+? ??(let! ((x1 e1)
+????????? ?(x2 e2))
+????????? (progn! m1 m2
+????????????????? (unit (list x1 x2)))))

+ +
+ +

is expanded to

+ +
+ +

? (LET* ((X1 E1) (X2 E2))
+??? (PROGN M1 M2 (LIST X1 X2)))

+ +
+ +

The +List Monad

+ +

This section is devoted to the List monad. +I?ll introduce macro WITH-LIST-MONAD that will implement a contract of the +WITH-MONAD macro but that will do it in its own optimized way.

+ +

A monad value is just a list. Following the +idiomatic definition, we can write the UNIT and FUNCALL! macro prototypes:

+ +
+ +

(defmacro list-unit (a)
+?? `(list ,a))
+
+(defmacro list-funcall! (k m)
+?? `(reduce #?append (mapcar ,k ,m)))

+ +
+ +

Please note that NIL is also a value of the +list monad. We?ll use this fact further.

+ +

Here is a definition of the PROGN! macro +prototype.

+ +
+ +

(defmacro list-progn! (&body ms)
+? (reduce
+???? #'(lambda (m1 m2)
+????? ????(let ((x (gensym)))
+???????????? `(loop for ,x in ,m1 append ,m2)))
+??? ?ms
+?? ??:from-end t))

+ +
+ +

At each reduction step we introduce a loop +that appends the second argument as many times as the length of the first list. +If the first list is NIL then the result of the loop is NIL as well.

+ +

The LET! macro prototype can be implemented +similarly and also without use of the lambda.

+ +
+ +

(defmacro list-let! (decls m)
+? (reduce
+???? #'(lambda (decl m)
+??? ??????(destructuring-bind (x e) decl
+???????????? `(loop for ,x in ,e append ,m)))
+?? ??decls
+?? ??:from-end t
+?? ??:initial-value m))

+ +
+ +

Here we replace each variable binding with +the corresponded loop. It should generate an efficient enough code.

+ +

Macros UNIT, FUNCALL!, PROGN! and LET! actually +are defined in a MACROLET implemented by the WITH-LIST-MONAD macro.

+ +
+ +

(defmacro with-list-monad (&body body)
+? `(macrolet
+?????? ((unit (a) `(list ,a))
+??????? (funcall! (k m) `(reduce #'append (mapcar ,k ,m)))
+??????? (progn! (&body ms) (append '(list-progn!) ms))
+??????? (let! (decls m) (list 'list-let! decls m)))
+???? , at body))

+ +
+ +

The same test example

+ +
+ +

? (with-list-monad
+? ??(let! ((x1 e1)
+????????? ?(x2 e2))
+????????? (progn! m1 m2
+????????????????? (unit (list x1 x2)))))

+ +
+ +

is now expanded to

+ +
+ +

(LOOP FOR X1 IN E1
+?? APPEND (LOOP FOR X2 IN E2
+???? APPEND (LOOP FOR #:G1030 IN M1
+?????? APPEND (LOOP FOR #:G1029 IN M2
+???????? APPEND (LIST (LIST X1 X2))))))

+ +
+ +

We can ask for something more practical:

+ +
+ +

CL-USER> (with-list-monad
+??????????? (let ((numbers '(1 2 3 4 5 6 7 8 9 10)))
+?? ??????????????(let! ((x numbers)
+????????????????????? ??(y numbers)
+??????????????????????? (z numbers))
+?????????????????????? (if (= (+ (* x x) (* y y)) (* z z))
+?????????????????????????? (unit (list x y z))))))
+
+((3 4 5) (4 3 5) (6 8 10) (8 6 10))

+ +
+ +

Please note that here we use the fact that +NIL is a legal value of the List monad. Therefore we can omit the else-part of +the IF operator. Moreover, if numbers were an empty list then the +topmost loop would immediately return NIL.

+ +

Also we can define the following function perms +that produces a list of permutations of a given list.

+ +
+ +

(defun perms (xs)
+? (with-list-monad
+????? (if (null xs)
+???????? ?(unit nil)
+??????? ??(let! ((y xs)
+??????????????? ?(ys (perms (remove y xs :count 1))))
+??????????????? (unit (cons y ys))))))

+ +
+ +

Now we can test it.

+ +
+ +

CL-USER> (perms '(1 2 3))
+((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))

+ +
+ +

The +Maybe Monad

+ +

The next monad is the Maybe monad. It +allows efficiently stopping a complex sequence of computations right after +discovering a failure. If there is no failure then a full chain of computations +is performed.

+ +

The constructor, getters and predicates for +this data type are defined below.

+ +
+ +

(defmacro make-maybe (&key (just nil +just-supplied-p))
+? (if just-supplied-p `(cons ,just nil)))
+
+(defmacro maybe-just (a)
+? `(car ,a))
+
+(defmacro maybe-nil ()
+? nil)
+
+(defmacro maybe-just-p (m)
+? `(consp ,m))
+
+(defmacro maybe-nil-p (m)
+? `(null ,m))

+ +
+ +

The prototypes of the basic return and bind +macros can be defined in the following way.

+ +
+ +

(defmacro maybe-unit (a)
+? `(make-maybe :just ,a))
+
+(defmacro maybe-funcall! (k m)
+? (let ((xk (gensym))
+??????? (xm (gensym)))
+??? `(let ((,xk ,k)
+??????? ???(,xm ,m))
+?????? (if (maybe-nil-p ,xm)
+????????? ?(make-maybe)
+??????? ???(funcall ,xk (maybe-just ,xm))))))

+ +
+ +

The key point is the IF expression that +cuts the further computation if the result of the former one is NIL.

+ +

Based on these macros we can build their +counterpart PROGN!.

+ +
+ +

(defmacro maybe-progn! (&body ms)
+? (reduce
+???? #'(lambda (m1 m2)
+???? ?????`(if (maybe-nil-p ,m1)
+?? ????????????(make-maybe)
+?? ????????????,m2))
+? ???ms
+? ???:from-end t))

+ +
+ +

The LET! macro is similar but it allows the +programmer to bind variables within one computation.

+ +
+ +

(defmacro maybe-let! (decls m)
+? (reduce
+??? #'(lambda (decl m)
+??? ????(destructuring-bind (x e) decl
+????????? (let ((xe (gensym)))
+????????? ??`(let ((,xe ,e))
+??? ???????????(if (maybe-nil-p ,xe)
+?????????????????? (make-maybe)
+????????????????? ?(let ((,x (maybe-just ,xe)))
+???????????????????? ???,m))))))
+??? decls
+? ??:from-end t
+? ??:initial-value m))

+ +
+ +

In the three cases we see the cutting IF +expressions. They stop immediately the computation right after discovering a +failure.

+ +

Actually, these last four macros are +implemented as a MACROLET defined by macro WITH-MAYBE-MONAD. As always, we +could implement the latter with help of generic macro WITH-MONAD providing the +necessary return and bind functions which are trivial for this monad. But macro +WITH-MAYBE-MONAD is much more efficient.

+ +
+ +

(defmacro with-maybe-monad (&body body)
+? `(macrolet
+?????? ((unit (a) (list 'maybe-unit a))
+??????? (funcall! (k m) (list 'maybe-funcall! k m))
+??????? (progn! (&body ms) (append '(maybe-progn!) ms))
+??????? (let! (decls m) (list 'maybe-let! decls m)))
+???? , at body))

+ +
+ +

Our old example

+ +
+ +

? (with-maybe-monad
+? ??(let! ((x1 e1)
+????????? ?(x2 e2))
+????????? (progn! m1 m2
+????????????????? (unit (list x1 x2)))))

+ +
+ +

is expanded to

+ +
+ +

? (LET ((#:G1051 E1))
+??? (IF (NULL #:G1051) NIL
+??????? (LET ((X1 (CAR #:G1051)))
+????????? (LET ((#:G1050 E2))
+??????????? (IF (NULL #:G1050) NIL
+??????????????? (LET ((X2 (CAR #:G1050)))
+????????????????? (IF (NULL M1) NIL
+????????????????????? (IF (NULL M2) NIL (CONS (LIST X1 X2) NIL)))))))))

+ +
+ +

Now we can consider something more +illustrative

+ +
+ +

CL-USER> (with-maybe-monad
+??? ???????(progn! (progn
+??? ?????????????????(format t "Step 1.")
+?????????????? ??????(make-maybe :just 'OK))
+?????????????? ????(make-maybe)? ; NIL ? failure
+??? ???????????????(progn
+?????????????? ??????(format t "Step 2.")
+?????????????? ??????(make-maybe :just 'OK))))
+
+Step 1.
+NIL

+ +
+ +

Moreover, SBCL will warn about an unreachable +code during compilation if we?ll try to define such a function!

+ +

The +Reader Monad

+ +

The Reader monad is a rather complicated +thing. The monad value is a function that returns a result of the computation +by the given environment value. In Haskell it can be defined like this

+ +
+ +

import Control.Monad
+
+newtype Reader r a = Reader {runReader :: r -> a}
+
+instance Monad (Reader r) where
+
+??? return a = Reader (\r -> a)
+
+??? m >>= k = Reader (\r ->
+????????????????????????? let a? = runReader m r
+????????????????????????????? m' = k a
+????????????????????????? in runReader m' r)
+
+read :: Reader r r
+read = Reader (\r -> r)

+ +
+ +

In accordance with this definition I?ll +create a monad macro WITH-READER-MONAD.

+ +

The UNIT macro prototype is simple enough.

+ +
+ +

(defmacro reader-unit (a)
+? (let ((r (gensym)))
+??? `#'(lambda (,r)
+???????? (declare (ignore ,r))
+???????? ,a)))

+ +
+ +

The FUNCALL! macro prototype is crucial for +understanding the monad macro.

+ +
+ +

(defmacro reader-funcall! (k m)
+? (let ((r (gensym))
+??????? (a (gensym))
+??????? (kg (gensym)))
+??? `#'(lambda (,r)
+???????? (let ((,kg ,k)
+?????????????? (,a (funcall ,m ,r)))
+?????????? (funcall (funcall ,kg ,a) ,r)))))

+ +
+ +

There is a subtle thing. Parameter k +is evaluated inside the anonymous function returned. In other words, its +evaluation is delayed. I think that the user will expect namely such a +behavior. Moreover, it allows the Lisp compiler to optimize the code in case of +the PROGN! and LET! macros as it will be shown.

+ +

Also please note that value m, being +a monad value, is actually an anonymous function. If its s-expression will be +accessible during the macro expansion then we?ll receive something similar to

+ +
+ +

? (funcall #?(lambda (x) f) r)

+ +
+ +

which can be efficiently optimized by the +compiler to

+ +
+ +

? (let ((x r)) f)

+ +
+ +

The LET! macro prototype is more efficient +than FUNCALL! as one of the FUNCALLs becomes unnecessary.

+ +
+ +

(defmacro reader-let! (decls m)
+? (reduce #'(lambda (decl m)
+????????????? (destructuring-bind (x e) decl
+??????????????? (let ((r (gensym)))
+????????????????? `#'(lambda (,r)
+?????????????????????? (let ((,x (funcall ,e ,r)))
+???????? ????????????????(funcall ,m ,r))))))
+????????? decls
+????????? :from-end t
+????????? :initial-value m))

+ +
+ +

Here like expression e expression m +is evaluated inside FUNCALL. It?s also a monad value, i.e. an anonymous +function. If we?ll create a LET! expression with many variable bindings then +the s-expression of m will be accessible during the macro expansion for +all bindings but probably the last. It will allow the Lisp compiler to optimize +the LET! expression essentially. We?ll see an example in the end of this +section.

+ +

The PROGN! macro prototype is more simple +as we don?t bind variables.

+ +
+ +

(defmacro reader-progn! (&body ms)
+? (reduce #'(lambda (m1 m2)
+????????????? (let ((r (gensym)))
+??????????????? `#'(lambda (,r)
+???????????????????????? (funcall ,m1 ,r)
+?? ??????????????????????(funcall ,m2 ,r))))
+????????? ms
+????????? :from-end t))

+ +
+ +

Again, if the s-expression for m1 +and m2 will be accessible then the Lisp compiler will have good chances +to generate a more optimal code.

+ +

The Reader monad was created for one purpose +? to pass some value through all the computations. Let it be macro READ! that +gets this value and puts in the monad. It corresponds to the read value +defined above in Haskell. The macro prototype is as follows.

+ +
+ +

(defmacro reader-read! ()
+? (let ((r (gensym)))
+??? `#'(lambda (,r) ,r)))

+ +
+ +

A computation in the Reader monad must be +started somewhere. We take some value and pass it to the computation. This +monad computation is passed in the first parameter. The environment value is +passed in the second parameter. The corresponded macro has name RUN! and its +prototype is defined below.

+ +
+ +

(defmacro reader-run! (m r)
+? `(funcall ,m ,r))

+ +
+ +

The value returned is a result of the monad +computation.

+ +

Macros READ!, RUN!, UNIT, FUNCALL!, PROGN! +and LET! are implemented as a MACROLET defined by the WITH-READER-MONAD macro.

+ +
+ +

(defmacro with-reader-monad (&body body)
+? `(macrolet
+?????? ((unit (a) (list 'reader-unit a))
+??????? (funcall! (k m) (list 'reader-funcall! k m))
+???? ???(progn! (&body ms) (append '(reader-progn!) ms))
+??????? (let! (decls m) (list 'reader-let! decls m))
+??????? (read! () (list 'reader-read!))
+??????? (run! (m r) (list 'reader-run! m r)))
+???? , at body))

+ +
+ +

Now we can take our old test example

+ +
+ +

? (with-reader-monad
+? ??(let! ((x1 e1)
+????????? ?(x2 e2))
+????????? (progn! m1 m2
+????????????????? (unit (list x1 x2)))))

+ +
+ +

and look at the result of the macro +expansion.

+ +
+ +

? #'(LAMBDA (#:G788)
+????? (LET ((X1 (FUNCALL E1 #:G788)))
+??????? (FUNCALL
+???????? #'(LAMBDA (#:G787)
+???????????? (LET ((X2 (FUNCALL E2 #:G787)))
+?????????????? (FUNCALL
+??????????????? #'(LAMBDA (#:G790)
+??????????????????? (FUNCALL M1 #:G790)
+??????????????????? (FUNCALL
+???????????????????? #'(LAMBDA (#:G789)
+???????????????????????? (FUNCALL M2 #:G789)
+???????????????????????? (FUNCALL
+????????????????????????? #'(LAMBDA (#:G791)
+????????????????????????????? (DECLARE (IGNORE #:G791))
+????????????????????????????? (LIST X1 X2))
+????????????????????????? #:G789))
+???????????????????? #:G790))
+??????????????? #:G787)))
+???????? #:G788)))

+ +
+ +

We can see that there are many LAMBDAs and +FUNCALLs bound together. A good Lisp compiler must generate a rather efficient +code.

+ +

Here is a small test

+ +
+ +

(defun reader-test ()
+? (with-reader-monad
+??? (run!
+???? (let! ((x (read!)))
+?????????? (progn
+???????????? (format t "x=~a~%" x)
+???????????? (unit 'ok)))
+???? 10)))

+ +
+ +

and this is its output.

+ +
+ +

CL-USER> (reader-test)
+x=10
+OK

+ +
+ +

The +State Monad

+ +

The State monad allows us to manage some +state during a computation. We can put a new value or request for the current +value of the state.

+ +

I?ll use the next definition written in +Haskell.

+ +
+ +

import Control.Monad
+
+newtype State st a = State {runState :: st -> (a, st)}
+
+instance Monad (State st) where
+
+??? return a = State (\st -> (a, st))
+
+??? m >>= k = State (\st ->
+???????????????????????? let (a, st') = runState m st
+???????????????????????????? m' = k a
+????????????????????????? in runState m' st')
+
+get :: State st st
+get = State (\st -> (st, st))
+
+put :: st -> State st ()
+put st' = State (\_ -> ((), st'))

+ +
+ +

I?ll create the corresponded monad macro +WITH-STATE-MONAD. It will define macros GET!, PUT! and RUN! as a part of its +MACROLET definition. The GET! macro will correspond to the get function. +The PUT! macro will be an analog of the put function. The RUN! macro +will play a role of the runState function.

+ +

First of all, I define utility macros.

+ +
+ +

(defmacro make-state (a st)
+? `(cons ,a ,st))
+
+(defmacro state-value (m)
+? `(car ,m))
+
+(defmacro state-state (m)
+? `(cdr ,m))

+ +
+ +

The UNIT macro prototype is simple.

+ +
+ +

(defmacro state-unit (a)
+? (let ((st (gensym)))
+??? `#'(lambda (,st)
+???????? (make-state ,a ,st))))

+ +
+ +

Please note that we evaluate a +inside LAMBDA, i.e. the evaluation is delayed until the anonymous function is +called. I?ll apply this strategy to all macros for this monad. In other words, +any computation in this monad does nothing until it is explicitly started with +help of macro RUN!, which will be defined further. By the way, the same strategy +was true for the Reader monad.

+ +

The FUNCALL! macro prototype follows the +definition of the bind function.

+ +
+ +

(defmacro state-funcall! (k m)
+? (let ((st (gensym))
+??????? (p (gensym))
+??????? (a (gensym))
+??????? (kg (gensym)))
+??? `#'(lambda (,st)
+???????? (let ((,kg ,k))
+?????????? (let ((,p (funcall ,m ,st)))
+???????????? (let ((,a (state-value ,p)))
+?????????????? (funcall (funcall ,kg ,a)
+??????????????????????? (state-state ,p))))))))

+ +
+ +

All notes that I did for the FUNCALL! macro +of the Reader monad are applicable here. Being a monad value, expression m +is actually an anonymous function. If its s-expression is available at the time +of macro expansion then the corresponded FUNCALL and LAMBDA can be reduced by +the smart compiler.

+ +

The LET! macro prototype generates a more +optimal code than FUNCALL!.

+ +
+ +

(defmacro state-let! (decls m)
+? (reduce #'(lambda (decl m)
+????????????? (destructuring-bind (x e) decl
+??????????????? (let ((st (gensym))
+????????????????????? (p (gensym)))
+????????????????? `#'(lambda (,st)
+????????????? ?????????(let ((,p (funcall ,e ,st)))
+???????????????????????? (let ((,x (state-value ,p)))
+?????????????????????????? (funcall ,m (state-state ,p))))))))
+????????? decls
+????????? :from-end t
+????????? :initial-value m))

+ +
+ +

If we create a multi-level LET! expression +then m will be expanded to the LAMBDA expression in all cases but +probably the last. It will allow the Lisp compiler to optimize the expanded +code as you will see later in the example.

+ +

The PROGN! macro prototype is more simple.

+ +
+ +

(defmacro state-progn! (&body ms)
+? (reduce #'(lambda (m1 m2)
+????????????? (let ((st (gensym))
+??????????????????? (p (gensym)))
+??????????????? `#'(lambda (,st)
+???????????????????? (let ((,p (funcall ,m1 ,st)))
+?????????????????????? (funcall ,m2 (state-state ,p))))))
+????????? ms
+????????? :from-end t))

+ +
+ +

To start a computation in the State monad, +we can use the RUN! macro which accepts two arguments. The first argument +specifies the computation. The second argument is an initial state. The RUN! +macro returns a list of two values. The first value is the result of the +computation itself. The second value of this list is a final state.

+ +
+ +

(defmacro state-run! (m init-st)
+? (let ((p (gensym)))
+??? `(let ((,p (funcall ,m ,init-st)))
+?????? (list (state-value ,p)
+???????? ????(state-state ,p)))))

+ +
+ +

To manage the state during the computation, +we can use macros GET! and PUT!. The GET! macro returns the current state +wrapped in the monad.

+ +
+ +

(defmacro state-get! ()
+? (let ((st (gensym)))
+??? `#'(lambda (,st)
+???????? (make-state ,st ,st))))

+ +
+ +

The PUT! macro allows setting a new value +for the state. This value is passed as a parameter. The macro returns NIL +wrapped in the monad.

+ +
+ +

(defmacro state-put! (new-st)
+? (let ((st (gensym)))
+??? `#'(lambda (,st)
+???????? (declare (ignore ,st))
+???????? (make-state nil ,new-st))))

+ +
+ +

Macros RUN!, GET!, PUT!, UNIT, FUNCALL!, +LET! and PROGN! are implemented as a MACROLET defined by the WITH-STATE-MONAD +macro.

+ +
+ +

(defmacro with-state-monad (&body body)
+? `(macrolet
+?????? ((unit (a) (list 'state-unit a))
+??????? (funcall! (k m) (list 'state-funcall! k m))
+??????? (progn! (&body ms) (append '(state-progn!) ms))
+??????? (let! (decls m) (list 'state-let! decls m))
+??????? (get! () (list 'state-get!))
+??????? (put! (new-st) (list 'state-put! new-st))
+??????? (run! (m init-st) (list 'state-run! m init-st)))
+???? , at body))

+ +
+ +

For our old test example

+ +
+ +

? (with-state-monad
+? ??(let! ((x1 e1)
+????????? ?(x2 e2))
+????????? (progn! m1 m2
+????????????????? (unit (list x1 x2)))))

+ +
+ +

the macro expansion looks like

+ +
+ +

? #'(LAMBDA (#:G1696)
+????? (LET ((#:G1697 (FUNCALL E1 #:G1696)))
+??????? (LET ((X1 (CAR #:G1697)))
+????????? (FUNCALL
+?????????? #'(LAMBDA (#:G1694)
+?????????????? (LET ((#:G1695 (FUNCALL E2 #:G1694)))
+???????????????? (LET ((X2 (CAR #:G1695)))
+?????????????????? (FUNCALL
+??????????????????? #'(LAMBDA (#:G1700)
+??????????????????????? (LET ((#:G1701 (FUNCALL M1 #:G1700)))
+????????????????????????? (FUNCALL
+?????????????????????????? #'(LAMBDA (#:G1698)
+?????????????????????????????? (LET ((#:G1699 (FUNCALL M2 #:G1698)))
+???????????????????????????????? (FUNCALL
+????????????????????????????????? #'(LAMBDA (#:G1702)
+????????????????????????????????????? (CONS (LIST X1 X2) #:G1702))
+????????????????????????????????? (CDR #:G1699))))
+?????????????????????????? (CDR #:G1701))))
+??????????????????? (CDR #:G1695)))))
+?????????? (CDR #:G1697)))))

+ +
+ +

We can note that many LAMBDAs and FUNCALLs +can be reduced. The bigger is our source expression, the more such constructs +can the compiler reduce. The code should be rather cheap.

+ +

The next test enumerates items of the tree +and creates a new tree, where each item is replaced with the CONS-pair +consisting of the item itself and its sequence number.

+ +
+ +

(defun state-test (tree)
+? (labels
+????? ((order (tree)
+???????? (with-state-monad
+?????????? (cond ((null tree) (unit nil))
+???????????????? ((consp tree)
+????????????????? (let! ((t1 (order (car tree)))
+???????????????????????? (t2 (order (cdr tree))))
+??????????????????? (unit (cons t1 t2))))
+???????????????? (t
+????????????????? (let! ((n (get!)))
+??????????????????? (let ((new-n (+ n 1)))
+????????????????????? (progn!
+?????????????????????? (put! new-n)
+?????????????????????? (unit (cons tree new-n))))))))))
+??? (destructuring-bind (new-tree new-state)
+??????? (with-state-monad
+????????? (run! (order tree) 0))
+????? (format t "Item count=~a~%" new-state)
+????? (format t "New tree=~a~%" new-tree))))

+ +
+ +

Now we can launch a test.

+ +
+ +

CL-USER> (state-test '(((5 2) 7 4) 5 9))
+Item count=6
+New tree=((((5 . 1) (2 . 2)) (7 . 3) (4 . 4)) (5 . 5) (9 . 6))
+NIL

+ +
+ +

The Writer Monad

+ +

This section describes the Writer monad. +This monad allows writing a log during the computation. Then this log can be +requested along with the computed result.

+ +

I will use the following definition written +in Haskell.

+ +
+ +

import Control.Monad
+
+newtype Writer w a = Writer (a, [w] -> [w])
+
+runWriter :: Writer w a -> (a, [w])
+runWriter (Writer (a, f)) = (a, f [])
+
+write :: w -> Writer w ()
+write w = Writer ((), \xs -> w : xs)
+
+writeList :: [w] -> Writer w ()
+writeList ws = Writer ((), \xs -> ws ++ xs)
+
+instance Monad (Writer w) where
+
+??? return a = Writer (a, id)
+
+??? (Writer (a, f)) >>= k =
+??????? let Writer (a', f') = k a
+??????? in Writer (a', f . f')

+ +
+ +

Actually, I will use a more efficient +representation of the functions. We can note that the return function uses id, +but the bind function always creates a composition of two functions (f . f?). +This is unnecessary. In Common Lisp we can use NIL to denote the identity +function. It will be a detail of the implementation about which the user may +not know. But this approach can help the compiler to generate a more efficient +code in cases if the write and writeList functions are called +rarely, i.e. when f? is just the id function.

+ +

I?ll begin with utilities.

+ +
+ +

(defmacro make-writer (a fun)
+? `(cons ,a ,fun))
+
+(defmacro writer-value (m)
+? `(car ,m))
+
+(defmacro writer-fun (m)
+? `(cdr ,m))

+ +
+ +

The next macro creates a composition of the +two specified nullable functions, where NIL means the IDENTITY function.

+ +
+ +

(defmacro writer-compose (f g)
+? ;; There are high chances that g is NIL
+? (let ((fs (gensym))
+??????? (gs (gensym)))
+??? `(let ((,fs ,f)
+?????????? (,gs ,g))
+?????? (cond ((null ,gs) ,fs)??? ; check it first
+???????????? ((null ,fs) ,gs)
+???????????? (t #'(lambda (x)
+??????????????????? (funcall ,fs
+???????????????????????????? (funcall ,gs x))))))))

+ +
+ +

Let our monad macro will have name WITH-READER-MONAD +and will define three additional macros WRITE!, WRITE-LIST! and RUN!. The first +two will be analogs of the write and writeList functions respectively +and they will be used for writing a log. The RUN! macro will be an analog of +the runWriter function and will be used for running a computation. The +RUN! macro will return a list of two values. The first value will be a result +of the computation itself. The second value will be a log written during the +computation.

+ +

The WRITE! macro saves the specified values +in the log. It returns NIL wrapped in the monad like that how the write +function returns Writer w (). Its prototype is as follows.

+ +
+ +

(defmacro writer-write! (&body ws)
+??? (if (= 1 (length ws))
+??????? ;; An optimized case
+??????? (let ((w (nth 0 ws))
+????????????? (v (gensym)))
+????????? `(make-writer nil
+??????????????????????? (let ((,v ,w))
+????????????????????????? #'(lambda (xs) (cons ,v xs)))))
+??????? ;; A general case
+??????? (let ((vs (gensym)))
+????????? `(make-writer nil
+??????????????????????? (let ((,vs (list , at ws)))
+????????????????????????? #'(lambda (xs)
+????????????????????????????? (append ,vs xs)))))))

+ +
+ +

Please note that we don?t add new records. +We return a function that knows how to add them. This a very efficient +technique. Please compare with the shows function from Haskell.

+ +

The WRITE-LIST! macro prototype takes the +value lists and saves their values in the log. The macro returns NIL in the +monad as well.

+ +
+ +

(defmacro writer-write-list! (&body wss)
+??? (if (= 1 (length wss))
+??????? ;; An optimized case
+??????? (let ((ws (nth 0 wss))
+????????????? (vs (gensym)))
+????????? `(make-writer nil
+??????????????????????? (let ((,vs ,ws))
+????????????????????????? #'(lambda (xs) (append ,vs xs)))))
+??????? ;; A general case
+??????? (let ((vss (gensym)))
+????????? `(make-writer nil
+??????????????????????? (let ((,vss (list , at wss)))
+????????????????????????? #'(lambda (xs)
+????????????????? ????????????(reduce #'append ,vss
+????????????????????????????????????? :from-end t
+????????????????????????????????????? :initial-value xs)))))))

+ +
+ +

The RUN! macro accepts one argument, a +monad computation. It returns a list consisting of the computed value and a log +written during this computation. The prototype is defined below.

+ +
+ +

(defmacro writer-run! (m)
+? (let ((x (gensym))
+??????? (fun (gensym)))
+??? `(let ((,x ,m))
+?????? (list (writer-value ,x)
+???????????? (let ((,fun (writer-fun ,x)))
+?????????????? (if (not (null ,fun))
+?????????????????? (funcall ,fun nil)))))))

+ +
+ +

Here we take into account that the log +function can be actually represented by value NIL. In such a case we return an +empty list as a result log. If the function is defined then we ask it to create +a log based on the initial empty log. It works fast, although the log is +constructed starting from the end.

+ +

Also we can see a weakness of the method. +If macros WRITE! and WRITE-LIST! were too often called then we would have a +compound function consisting of a lot of nested functions. It might lead to the +stack overflow. Be careful!

+ +

We consider NIL as an optimized +representation of the IDENTITY function. The UNIT macro prototype uses this +fact as the log remains unmodified.

+ +
+ +

(defmacro writer-unit (a)
+? `(make-writer ,a nil))

+ +
+ +

The FUNCALL! macro is more complicated.

+ +
+ +

(defmacro writer-funcall! (k m)
+? (let ((ks (gensym))
+??????? (ms (gensym))
+??????? (a (gensym))
+??????? (ka (gensym)))
+??? `(let* ((,ks ,k)??? ; save it first
+??????????? (,ms ,m)
+??????????? (,a (writer-value ,ms))
+??????????? (,ka (funcall ,ks ,a)))
+?????? (make-writer (writer-value ,ka)
+??????????????????? (writer-compose (writer-fun ,ms)
+??????????????????????????????????? (writer-fun ,ka))))))

+ +
+ +

As usual, based on this macro we can write +a more optimal definition of the LET! macro prototype which has no FUNCALL at +all.

+ +
+ +

(defmacro writer-let! (decls m)
+? (reduce
+?? #'(lambda (decl m)
+?????? (destructuring-bind (x e) decl
+???????? (let ((es (gensym))
+?????????????? (ms (gensym)))
+?????????? `(let* ((,es ,e)
+?????????????????? (,x (writer-value ,es))
+?????????????????? (,ms ,m))??? ; depends on x!
+????????????? (make-writer (writer-value ,ms)
+?????????????????????????? (writer-compose (writer-fun ,es)
+?????????????????????????????????????????? (writer-fun ,ms)))))))
+?? decls
+?? :from-end t
+?? :initial-value m))

+ +
+ +

The PROGN! macro prototype is even more +simple as there is no variable binding. But we have to compose the log +functions, though.

+ +
+ +

(defmacro writer-progn! (&body ms)
+? (reduce
+?? #'(lambda (m1 m2)
+?????? (let ((m1s (gensym))
+???????????? (m2s (gensym)))
+???????? `(let ((,m1s ,m1)
+??????????????? (,m2s ,m2))
+??????????? (make-writer (writer-value ,m2s)
+???????????????????????? (writer-compose (writer-fun ,m1s)
+???????????????????????????????????????? (writer-fun ,m2s))))))
+?? ms
+?? :from-end t))

+ +
+ +

Macros WRITE!, WRITE-LIST!, RUN!, UNIT, +FUNCALL!, PROGN! and LET! are implemented as a MACROLET defined by macro +WITH-WRITER-MONAD.

+ +
+ +

(defmacro with-writer-monad (&body body)
+? `(macrolet
+?????? ((unit (a) (list 'writer-unit a))
+??????? (funcall! (k m) (list 'writer-funcall! k m))
+??????? (progn! (&body ms) (append '(writer-progn!) ms))
+??????? (let! (decls m) (list 'writer-let! decls m))
+??????? (write! (&body ws) (append '(writer-write!) ws))
+??????? (write-list! (&body wss) (append '(writer-write-list!) wss))
+??????? (run! (m) (list 'writer-run! m)))
+???? , at body))

+ +
+ +

Now we can take our old example

+ +
+ +

? (with-writer-monad
+? ??(let! ((x1 e1)
+????????? ?(x2 e2))
+????????? (progn! m1 m2
+????????????????? (unit (list x1 x2)))))

+ +
+ +

and look at its macro expansion.

+ +
+ +

? (LET* ((#:G1297 E1)
+???????? (X1 (CAR #:G1297))
+???????? (#:G1298
+????????? (LET* ((#:G1295 E2)
+???????????????? (X2 (CAR #:G1295))
+???????????????? (#:G1296
+????????????????? (LET ((#:G1301 M1)
+??????????????????????? (#:G1302
+???????????????????????? (LET ((#:G1299 M2) (#:G1300 (CONS (LIST X1 X2) NIL)))
+?????????? ????????????????(CONS (CAR #:G1300)
+???????????????????????????????? (LET ((#:G1303 (CDR #:G1299))
+?????????????????????????????????????? (#:G1304 (CDR #:G1300)))
+?????????????????????????????????? (IF (NULL #:G1304) (PROGN #:G1303)
+?????????????????????? ????????????????(IF (NULL #:G1303) (PROGN #:G1304)
+?????????????????????????????????????????? (THE T
+???????????????????????????????????????????? (PROGN
+?????????????????????????????????????????????? #'(LAMBDA (X)
+????????????????????????????????????????? ?????????(FUNCALL #:G1303
+??????????????????????????????????????????????????????????? (FUNCALL #:G1304
+???????????????????????????????????????????????????????????????????? +X))))))))))))
+??????????????????? (CONS (CAR #:G1302)
+????????????????????????? (LET ((#:G1305 (CDR #:G1301)) (#:G1306 (CDR +#:G1302)))
+??????????????????????????? (IF (NULL #:G1306) (PROGN #:G1305)
+??????????????????????????????? (IF (NULL #:G1305) (PROGN #:G1306)
+??????????????????????????????????? (THE T
+??????????????????????????????? ??????(PROGN
+??????????????????????????????????????? #'(LAMBDA (X)
+??????????????????????????????????????????? (FUNCALL #:G1305
+???????????????????????????????????????????????????? (FUNCALL #:G1306
+????????????????????????????????????????????????????????? ????X))))))))))))
+??????????? (CONS (CAR #:G1296)
+????????????????? (LET ((#:G1307 (CDR #:G1295)) (#:G1308 (CDR #:G1296)))
+??????????????????? (IF (NULL #:G1308) (PROGN #:G1307)
+??????????????????????? (IF (NULL #:G1307) (PROGN #:G1308)
+?????????????????? ?????????(THE T
+????????????????????????????? (PROGN
+??????????????????????????????? #'(LAMBDA (X)
+??????????????????????????????????? (FUNCALL #:G1307
+???????????????????????????????????????????? (FUNCALL #:G1308 X))))))))))))
+??? (CONS (CAR #:G1298)
+??? ??????(LET ((#:G1309 (CDR #:G1297)) (#:G1310 (CDR #:G1298)))
+??????????? (IF (NULL #:G1310) (PROGN #:G1309)
+??????????????? (IF (NULL #:G1309) (PROGN #:G1310)
+??????????????????? (THE T
+????????????????????? (PROGN
+??????????????????????? #'(LAMBDA (X)
+?? ?????????????????????????(FUNCALL #:G1309 (FUNCALL #:G1310 X))))))))))

+ +
+ +

Although the expanded code looks long, it?s +straightforward enough. It mainly consists of the IF conditions and creations +of the short-living CONS-pairs at each step. The anonymous functions are +created only in case of need. The compiled code should be rather cheap. +Moreover, it can be efficient if the compiler can optimize the short-living +CONS-pairs.

+ +

The next example illustrates the use of the +WITH-WRITER-MONAD macro.

+ +
+ +

(defun writer-test ()
+? (destructuring-bind (a log)
+????? (with-writer-monad
+??????? (run!
+???????? (progn!
+????????? (write! 1)
+????????? (write! 2 3 4)
+????????? (write-list! '(5 6))
+????????? (write-list! '(7) '(8) '(9))
+????????? (unit 'ok))))
+??? (format t "Computed value = ~a~%" a)
+??? (format t "Written log = ~a~%" log)))

+ +
+ +

This is its output.

+ +
+ +

CL-USER> (writer-test)
+Computed value = OK
+Written log = (1 2 3 4 5 6 7 8 9)
+NIL

+ +
+ +

Monad +Transformers

+ +

It?s possible to create a macro analog of +the monad transformer in Common Lisp. Such a macro must be parameterized and it +must define macro LIFT! that has the same meaning as the lift function +in Haskell.

+ +
+ +

class MonadTrans where
+??? lift :: (Monad m) => m a -> t m a

+ +
+ +

In the next sections are defined macros WITH-READER-MONAD-TRANS, +WITH-WRITER-MONAD-TRANS and WITH-STATE-MONAD-TRANS. They are examples of the +monad transformer macros. Each of them accepts the first parameter which must +be a name of some monad macro in parentheses.

+ +

For example, we can write:

+ +
+ +

(with-reader-monad-trans (with-writer-monad)
+?
+? ;; It works within the WITH-READER-MONAD-TRANS macro
+
+? (let! ((x (read!)))
+
+??????? ;; It calls WRITE! within the WITH-WRITER-MONAD macro
+
+??????? (lift!
+???????? (with-writer-monad
+?????????? (write! x)))))

+ +
+ +

For this case we can create a separate +monad macro and define the WRITE! macro on more high level using LIFT!

+ +
+ +

(defmacro with-reader-writer-monad (&body body)
+? `(with-reader-monad-trans (with-writer-monad)
+???? (macrolet
+???????? ((write! (&body bs)
+???? ???????`(lift!
+????????????? (with-writer-monad
+??????????????? (write! , at bs)))))
+?????? , at body)))

+ +
+ +

The monad transformer macros can be nested.

+ +
+ +

(with-reader-monad-trans
+??? (with-writer-monad-trans
+??????? (with-maybe-monad))
+
+? (progn!
+
+?? ;; It evaluates (f x) within
+?? ;; the WITH-WRITER-MONAD-TRANS macro
+
+?? (lift!
+??? (with-writer-monad-trans (with-maybe-monad)
+????? (f x)))
+
+?? ;; It evaluates (g x) within
+?? ;; the WITH-MAYBE-MONAD macro
+
+?? (lift!
+??? (lift!
+???? (with-maybe-monad
+?????? (g x))))))

+ +
+ +

The LIFT! macro must know a name of the +inner monad macro to call the corresponded inner return and bind functions. +This is a crucial point. It is applied to macros UNIT, FUNCALL!, PROGN! and +LET! as well.

+ +

In the next sections you will see how the +monad transformer macros can be implemented. All examples follow a common +pattern.

+ +
+ +

(defmacro with-some-monad-trans
+??? (inner-monad &body body)
+
+? `(with-monad-trans
+?????? (with-some-monad-trans ,inner-monad)
+
+???? (macrolet
+???????? ;; Definitions of UNIT, FUNCALL!, PROGN!, LET!
+???????? ;; and possibly some other macros
+
+???????? , at body)))

+ +
+ +

Note how the definition of +WITH-SOME-MONAD-TRANS recursively refers to itself. It is important.

+ +

WITH-MONAD-TRANS s a utility macro that allows +the monad transformer implementer to use two auxiliary macros +WITH-INNER-MONAD-TRANS and WITH-OUTER-MONAD-TRANS in accordance with the +following scheme.

+ +
+ +

(with-some-monad-trans (with-inner-monad)
+
+? ;; Here the WITH-SOME-MONAD-TRANS macro is active
+
+??(with-inner-monad-trans (unique-id)
+
+??? ;; Here the WITH-INNER-MONAD macro is active, i.e.
+??? ;; a macro specified in the parameter
+
+??? (with-outer-monad-trans (unique-id)
+
+????? ;; Here the WITH-SOME-MONAD-TRANS macro
+????? ;; is active again
+?
+??? ??...)))

+ +
+ +

Here the WITH-INNER-MONAD-TRANS macro must +precede the WITH-OUTER-MONAD-TRANS macro. UNIQUE-ID is some unique identifier +which must be different for each occurrence. Usually, it is a generated value +with help of function GENSYM.

+ +

This scheme allows the implementer to +switch between the outer and inner monad macros.

+ +

The WITH-MONAD-TRANS macro has the +following definition.

+ +
+ +

(defmacro with-monad-trans (outer-monad &body +body)
+? (let ((inner-monad (cadr outer-monad)))
+??? `(macrolet
+???????? ((with-inner-monad-trans (id &body bs)
+??????????? (append '(with-inner-monad-prototype)
+??????????????????? (list ',outer-monad)
+??????????????????? (list ',inner-monad)
+??????????????????? (list id)
+??????????????????? bs))
+????????? (with-outer-monad-trans (id &body bs)
+??????????? (append id bs)))
+?????? , at body)))

+ +
+ +

Please note that an implementation of the WITH-OUTER-MONAD-TRANS +macro is common and doesn?t depend on additional parameters, which allows us to +switch to the outer monad even if case of the deep nested calls of +WITH-MONAD-TRANS. The WITH-OUTER-MONAD-TRANS macro is expanded to a call of the +macro represented by parameter id. The last macro must be already +created by WITH-INNER-MONAD-PROTOTYPE before the inner monad macro is activated +- this is why an order of precedence is important.

+ +
+ +

(defmacro with-inner-monad-prototype
+??? (outer-monad inner-monad id &body body)
+? `(macrolet ((, at id (&body bs) (append ',outer-monad bs)))
+???? (, at inner-monad
+????? , at body)))

+ +
+ +

The key point is that the +WITH-INNER-MONAD-PROTOTYPE macro, i.e. WITH-INNER-MONAD-TRANS, creates a new +macro that is expanded already to the outer monad macro, which name was passed +as a parameter of WITH-MONAD-TRANS if you remember. The name of this new generated +macro is defined by the value of parameter id. But +WITH-OUTER-MONAD-TRANS macro has a common implementation and it is always +expanded namely to that new macro, which is expanded in its turn to the outer +monad macro regardless of that how deeply the WITH-MONAD-TRANS macros are +nested, for the value of the id parameter is supposed to be unique.

+ +

It?s worthy to note that if the monad +macros consist of MACROLETs then macros WITH-MONAD-TRANS, +WITH-INNER-MONAD-TRANS and WITH-OUTER-MONAD-TRANS add nothing but MACROLETs to +the expanded code. Such a code should be rather efficient. All monad macros +described in this article consist of MACROLETs only. It should be a general +rule.

+ +

Nevertheless, in practice the Lisp +compilers cannot process complex expressions, where the nested monad +transformer macros are directly applied, although the simplest expressions are still +compilable. There is a simple workaround for this problem. The approach is +described in section Reducing Monad Macros.

+ +

Inner Monad Macros

+ +

In absence of the type classes in the +language we have to distinguish somehow the operations performed in the inner +and outer monads if we speak about the monad transformers. Now I will introduce +prototypes for macros INNER-UNIT, INNER-FUNCALL!, INNER-LET! and INNER-PROGN! +that will be counterparts to macros UNIT, FUNCALL!, LET! and PROGN!. Only the +first macros call the corresponded operations in the inner monad with one important +exception. Their parameters are always evaluated lexically within the outer +monad. It allows us to safely call these macros within the outer monad macro.

+ +

So, the INNER-UNIT macro prototype is as +follows.

+ +
+ +

(defmacro generic-inner-unit (a)
+? (let ((id (gensym)))
+??? `(with-inner-monad-trans (,id)
+?????? (unit
+??????? (with-outer-monad-trans (,id)
+????????? ,a)))))

+ +
+ +

Please note that expression a is +evaluated within the outer monad. It will be a general rule.

+ +

The INNER-FUNCALL! macro prototype is +similar.

+ +
+ +

(defmacro generic-inner-funcall! (k m)
+? (let ((id (gensym)))
+??? `(with-inner-monad-trans (,id)
+?????? (funcall!
+??????? (with-outer-monad-trans (,id) ,k)
+??????? (with-outer-monad-trans (,id) ,m)))))

+ +
+ +

The INNER-LET! macro prototype is +analogous.

+ +
+ +

(defmacro generic-inner-let! (decls m)
+? (reduce
+?? #'(lambda (decl m)
+?????? (destructuring-bind (x e) decl
+???????? (let ((id (gensym)))
+?????????? `(with-inner-monad-trans (,id)
+????????????? (let! ((,x (with-outer-monad-trans (,id) ,e)))
+??????????????????? (with-outer-monad-trans (,id) ,m))))))
+?? decls
+?? :from-end t
+?? :initial-value m))

+ +
+ +

Please note how carefully we restore the +outer monad lexical context. It?s very important. As we already discussed, it +has no performance penalty for the generated code, although it creates a high +load for the compiler because of numerous MACROLETs that are generated during +the macro expansion.

+ +

The INNER-PROGN! macro prototype is more +optimal.

+ +
+ +

(defmacro generic-inner-progn! (&body ms)
+? (let ((id (gensym)))
+??? (let ((outer-ms (loop for m in ms collect
+???????????????????????? `(with-outer-monad-trans (,id) ,m))))
+????? `(with-inner-monad-trans (,id)
+???????? (progn! , at outer-ms)))))

+ +
+ +

Macros INNER-UNIT, INNER-FUNCALL!, +INNER-LET! and INNER-PROGN! are implemented as a part of the MACROLET construct +defined by macro WITH-MONAD-TRANS.

+ +
+ +

(defmacro with-monad-trans (outer-monad &body +body)
+? (let ((inner-monad (cadr outer-monad)))
+??? `(macrolet
+???????? ((with-inner-monad-trans (id &body bs)
+??????????? (append '(with-inner-monad-prototype)
+??????????????????? (list ',outer-monad)
+??????????????????? (list ',inner-monad)
+??????????????????? (list id)
+??????????????????? bs))
+????????? (with-outer-monad-trans (id &body bs)
+??????????? (append id bs))
+????????? ;;
+????????? (inner-unit (a) (list 'generic-inner-unit a))
+????????? (inner-funcall! (k m) (list 'generic-inner-funcall! k m))
+????????? (inner-progn! (&body ms) (append '(generic-inner-progn!) ms))
+????????? (inner-let! (decls m) (list 'generic-inner-let! decls m)))
+?????? , at body)))

+ +
+ +

In most cases these new macros INNER-UNIT, +UNNER-FUNCALL!, INNER-LET! and INNER-PROGN! cover all the needs and make low +level macros WITH-INNER-MONAD-TRANS and WITH-OUTER-MONAD-TRANS unnecessary for +the practical use in your code.

+ +

The +Reader Monad Transformer

+ +

The Reader monad transformer is a parameterized +version of the Reader monad but which can also act as the monad specified in +the parameter. This is a very powerful abstraction. For example, we can combine +the Reader monad transformer with the Writer monad. Then we can write a log and +read an external value passed to the computation at the same time.

+ +

In Haskell the Reader monad transformer can +be defined in the following way.

+ +
+ +

import Control.Monad
+import Control.Monad.Trans
+
+newtype ReaderTrans r m a =
+??? ReaderTrans {runReader :: r -> m a}
+
+instance (Monad m) => Monad (ReaderTrans r m) where
+
+??? return a =
+??????? ReaderTrans (\r -> return a)
+
+??? m >>= k =
+??????? ReaderTrans (\r ->
+???????????????????????? do a <- runReader m r
+??????????????????????????? let m' = k a
+??????????????????????? ????runReader m' r)
+
+instance MonadTrans (ReaderTrans r) where
+??? lift m = ReaderTrans (\r -> m)
+
+read :: (Monad m) => ReaderTrans r m r
+read = ReaderTrans (\r -> return r)

+ +
+ +

Please note that the return and bind +functions are mixed. Some of them are related to the ReaderTrans monad itself. +Others are related already to the parameter monad m. It says that we +need helper macros INNER-UNIT, INNER-FUNCALL!, INNER-LET! and INNER-PROGN! +introduced above.

+ +

I?ll define macro WITH-READER-MONAD-TRANS +based on the WITH-MONAD-TRANS macro. Therefore the specified helper macros will +be accessible.

+ +

The UNIT macro prototype uses INNER-UNIT.

+ +
+ +

(defmacro reader-trans-unit (a)
+? (let ((r (gensym)))
+??? `#'(lambda (,r)
+???????? (declare (ignore ,r))
+???????? (inner-unit ,a))))

+ +
+ +

Please note that expression a is +evaluated in the context of the WITH-READER-MONAD-TRANS macro, not in the +context of the inner monad. It will be true for all next definitions as well.

+ +

The FUNCALL! macro prototype is also +similar to its non-parameterized version.

+ +
+ +

(defmacro reader-trans-funcall! (k m)
+? (let ((r (gensym))
+??????? (a (gensym))
+??????? (kg (gensym)))
+??? `#'(lambda (,r)
+???????? (let ((,kg ,k))
+?????????? (inner-let! ((,a (funcall ,m ,r)))
+?????????????????????? (funcall (funcall ,kg ,a) ,r))))))

+ +
+ +

It corresponds to the definition written in +Haskell. Only the order of parameters is different. Also all notes that I did +for the non-parameterized version remain true. The generated code can be +optimized by the compiler under some circumstances.

+ +

As before, the LET! macro prototype is more +efficient.

+ +
+ +

(defmacro reader-trans-let! (decls m)
+? (reduce #'(lambda (decl m)
+????????????? (destructuring-bind (x e) decl
+??????????????? (let ((r (gensym)))
+????????????????? `#'(lambda (,r)
+?????????????????????? (inner-let! ((,x (funcall ,e ,r)))
+???????????????????????? (funcall ,m ,r))))))
+????????? decls
+????????? :from-end t
+????????? :initial-value m))

+ +
+ +

We only replaced LET with INNER-LET! to +take a value from the inner computation.

+ +

The PROGN! macro prototype uses +INNER-PROGN! to bind the inner computations.

+ +
+ +

(defmacro reader-trans-progn! (&body ms)
+? (reduce #'(lambda (m1 m2)
+????????????? (let ((r (gensym)))
+??? ????????????`#'(lambda (,r)
+???????????????????? (inner-progn!
+????????????????????? (funcall ,m1 ,r)
+????????????????????? (funcall ,m2 ,r)))))
+????????? ms
+????????? :from-end t))

+ +
+ +

Being applied in complex nested +expressions, all macros are expanded to a code that can be efficiently +optimized by the compiler because of LAMBDAs and FUNCALLs that alternate with +each other.

+ +

The READ! macro prototype uses already the +INNER-UNIT macro to wrap the environment value in the inner monad.

+ +
+ +

(defmacro reader-trans-read! ()
+? (let ((r (gensym)))
+??? `#'(lambda (,r)
+???????? (inner-unit ,r))))

+ +
+ +

The RUN! macro prototype is the same, but +now it returns a computation result wrapped in the inner monad.

+ +
+ +

(defmacro reader-trans-run! (m r)
+? `(funcall ,m ,r))

+ +
+ +

So far, the macros defined replicate the +interface of the WITH-READER-MONAD macro. Now I?ll define the LIFT! macro that +will allow us to perform any computation in the inner monad. This is namely +that thing that allows the parameterized monad transformer to act as a monad +specified in its parameter.

+ +
+ +

(defmacro reader-trans-lift! (m)
+? (let ((r (gensym)))
+??? `#'(lambda (,r)
+???????? (declare (ignore ,r))
+? ???????,m)))

+ +
+ +

Macros LIFT!, READ!, UNIT, FUNCALL!, LET! +and PROGN! are implemented as a MACROLET defined by the WITH-READER-MONAD-TRANS +macro, which in its turn follows a common pattern described in section Monad Transformers.

+ +
+ +

(defmacro with-reader-monad-trans (inner-monad +&body body)
+? `(with-monad-trans (with-reader-monad-trans ,inner-monad)
+???? (macrolet
+???????? ((unit (a) (list 'reader-trans-unit a))
+????????? (funcall! (k m) (list 'reader-trans-funcall! k m))
+????????? (progn! (&body ms) (append '(reader-trans-progn!) ms))
+????????? (let! (decls m) (list 'reader-trans-let! decls m))
+????????? (read! () (list 'reader-trans-read!))
+????????? (run! (m r) (list 'reader-trans-run! m r))
+????????? (lift! (m) (list 'reader-trans-lift! m)))
+?????? , at body)))

+ +
+ +

Now the monad macro generates much code. +Even after removing the MACROLETs that mean nothing for the execution time but +that may slow down the compilation process, the macro expansion may be still +long depending on the specified inner monad. Therefore I will use a simpler +example to illustrate the code generation.

+ +
+ +

(with-reader-monad-trans (with-maybe-monad)
+? (let! ((x e)) m))

+ +
+ +

After removing all the MACROLETs (with help +of CLISP), the code expansion looks like

+ +
+ +

#'(LAMBDA (#:G4207)
+????????? (LET ((#:G4209 (FUNCALL E #:G4207))) (IF (NULL #:G4209) NIL (LET ((X +(CAR #:G4209))) (FUNCALL M #:G4207)))))

+ +
+ +

Here is a test of the monad macro.

+ +
+ +

(defun reader-trans-test ()
+? (destructuring-bind (a log)
+
+????? (with-writer-monad
+???? ???(run!
+
+???????? (with-reader-monad-trans (with-writer-monad)
+?????????? (run!
+
+??????????? (let! ((x (read!)))
+????????????????? (progn!
+
+?????????????????? (lift!
+??????????????????? (with-writer-monad
+????????????????????? (write! x)))
+
+?????????????????? (unit 'ok)))
+??????????? 10))))
+
+??? (format t "Computed value=~a~%" a)
+??? (format t "Written log=~a~%" log)))
+
+

+ +
+ +

This is its output.

+ +
+ +

CL-USER> (reader-trans-test)
+Computed value=OK
+Written log=(10)
+NIL

+ +
+ +

The +State Monad Transformer

+ +

The State monad transformer is a +parameterized version of the State monad but which can also behave like a monad +specified in the parameter. For example, we can create a version of the State +monad transformer parameterized by the Writer monad. Then we can manage the +state and write a log during the computation simultaneously.

+ +

I?ll use the following definition of the +State monad transformer written in Haskell.

+ +
+ +

import Control.Monad
+import Control.Monad.Trans
+
+newtype StateTrans st m a = StateTrans {runState :: st -> m (a, st)}
+
+instance (Monad m) => Monad (StateTrans st m) where
+
+??? return a = StateTrans (\st -> return (a, st))
+
+??? m >>= k = StateTrans (\st ->
+????????????????????????????? do (a, st') <- runState m st
+???????????????????????????????? let m' = k a
+???????????????????????????????? runState m' st')
+
+instance MonadTrans (StateTrans st) where
+??? lift m = StateTrans (\st -> do a <- m; return (a, st))
+
+get :: (Monad m) => StateTrans st m st
+get = StateTrans (\st -> return (st, st))
+
+put :: (Monad m) => st -> StateTrans st m ()
+put st' = StateTrans (\_ -> return ((), st'))

+ +
+ +

We see that the return and bind functions +are mixed as it was in case of the Reader monad transformer. Some functions +correspond to the StateTrans monad. Others correspond to the inner monad m. +Hence we need macros INNER-UNIT, INNER-FUNCALL!, INNER-LET! and INNER-PROGN! +provided by the WITH-MONAD-TRANS macro.

+ +

I?ll define a new macro +WITH-STATE-MONAD-TRANS based on WITH-MONAD-TRANS in accordance with the general +pattern described in section Monad Transformers. Also the new macro +will be similar to its non-parameterized counterpart WITH-STATE-MONAD. The +WITH-STATE-MONAD-TRANS macro will define macros GET!, PUT! and RUN!. Only the +latter will return a value wrapped in the inner monad.

+ +

The UNIT macro prototype is similar but it +uses INNER-UNIT to wrap a pair in the inner monad.

+ +
+ +

(defmacro state-trans-unit (a)
+? (let ((st (gensym)))
+??? `#'(lambda (,st)
+???????? (inner-unit
+????????? (make-state ,a ,st)))))

+ +
+ +

As before, expression a is evaluated +inside LAMBDA, i.e. the evaluation is delayed. This strategy will be applied to +all other macros defined further.

+ +

The FUNCALL! macro prototype is similar +too, but now it uses INNER-LET! to get a raw value from the inner monad.

+ +
+ +

(defmacro state-trans-funcall! (k m)
+? (let ((st (gensym))
+??????? (p (gensym))
+??????? (a (gensym))
+??????? (kg (gensym)))
+??? `#'(lambda (,st)
+???????? (let ((,kg ,k))
+?????????? (inner-let! ((,p (funcall ,m ,st)))
+???????????? (let ((,a (state-value ,p)))
+?????????????? (funcall (funcall ,kg ,a)
+??????????????????????? (state-state ,p))))))))

+ +
+ +

The notes that I did earlier for the State +monad are applicable now as well. Expression m is used as the first +argument of the FUNCALL function. This expression is a monad value, i.e. an +anonymous function. If the s-expression for m is available then m +will be expanded to the LAMBDA expression. These LAMBDA and FUNCALL can be +reduced by the smart compiler.

+ +

As usual, the LET! macro prototype +generates a more efficient code than FUNCALL!.

+ +
+ +

(defmacro state-trans-let! (decls m)
+? (reduce #'(lambda (decl m)
+????????????? (destructuring-bind (x e) decl
+??????????????? (let ((st (gensym))
+????????????????????? (p (gensym)))
+????????????????? `#'(lambda (,st)
+?????????????????????? (inner-let! ((,p (funcall ,e ,st)))
+???????????????????????? (let ((,x (state-value ,p)))
+?????????????????????????? (funcall ,m (state-state ,p))))))))
+????????? decls
+????????? :from-end t
+????????? :initial-value m))

+ +
+ +

Here expressions e and m are +monad values, i.e. anonymous functions. Moreover, if we create a multi-level +LET! expression then the s-expression for m is available for all cases +but probably the last. This s-expression is started with LAMBDA. Therefore +LAMBDAs and FUNCALLs can be reduced by the compiler too.

+ +

The PROGN! macro prototype doesn?t bind +variables but it passes the state through the computation like the previous +macros.

+ +
+ +

(defmacro state-trans-progn! (&body ms)
+? (reduce #'(lambda (m1 m2)
+????????????? (let ((st (gensym))
+??????????????????? (p (gensym)))
+??????????????? `#'(lambda (,st)
+???????????????????? (inner-let! ((,p (funcall ,m1 ,st)))
+?????????????????????? (funcall ,m2 (state-state ,p))))))
+????????? ms
+????????? :from-end t))

+ +
+ +

The RUN! macro launches a computation +specified in the first parameter. The second parameter defines an initial +state. The macro returns a list wrapped in the inner monad. The first value of +the list is a result of the computation itself. The second value is a final state.

+ +
+ +

(defmacro state-trans-run! (m init-st)
+? (let ((p (gensym)))
+??? `(inner-let! ((,p (funcall ,m ,init-st)))
+?????? (inner-unit
+??????? (list (state-value ,p)
+????????????? (state-state ,p))))))

+ +
+ +

The GET! macro prototype returns the +current state wrapped in the outer monad.

+ +
+ +

(defmacro state-trans-get! ()
+? (let ((st (gensym)))
+??? `#'(lambda (,st)
+???????? (inner-unit
+????????? (make-state ,st ,st)))))

+ +
+ +

The PUT! macro prototype has one parameter +that specifies a new value for the state. It allows us to modify the state. The +new value will be then passed to the rest part of the computation. The macro +returns NIL wrapped in the outer monad.

+ +
+ +

(defmacro state-trans-put! (new-st)
+? (let ((st (gensym)))
+??? `#'(lambda (,st)
+???????? (declare (ignore ,st))
+???????? (inner-unit
+????????? (make-state nil ,new-st)))))

+ +
+ +

The LIFT! macro endows the parameterized monad +transformer with an ability to act as a monad specified in the parameter. The +macro accepts any computation in the inner monad. This inner computation becomes +a part of the outer computation.

+ +
+ +

(defmacro state-trans-lift! (m)
+? (let ((st (gensym))
+??????? (a (gensym)))
+??? `#'(lambda (,st)
+???????? (inner-let! ((,a ,m))
+?????????? (inner-unit
+??????????? (make-state ,a ,st))))))

+ +
+ +

Macros GET!, PUT!, RUN!, LIFT!, UNIT, +FUNCALL!, LET! and PROGN! are implemented as a MACROLET defined by the +WITH-STATE-MONAD-TRANS macro that follows a common pattern of the monad +transformer macros.

+ +
+ +

(defmacro with-state-monad-trans (inner-monad +&body body)
+? `(with-monad-trans (with-state-monad-trans ,inner-monad)
+???? (macrolet
+???????? ((unit (a) (list 'state-trans-unit a))
+????????? (funcall! (k m) (list 'state-trans-funcall! k m))
+????????? (progn! (&body ms) (append '(state-trans-progn!) ms))
+????????? (let! (decls m) (list 'state-trans-let! decls m))
+????????? (get! () (list 'state-trans-get!))
+????????? (put! (new-st) (list 'state-trans-put! new-st))
+????????? (run! (m init-st) (list 'state-trans-run! m init-st))
+????????? (lift! (m) (list 'state-trans-lift! m)))
+?????? , at body)))

+ +
+ +

The code generation can be illustrated on +the following example.

+ +
+ +

(with-state-monad-trans (with-maybe-monad)
+? (let! ((x e)) m))

+ +
+ +

After removing all MACROLETs (with help of +CLISP), the code is expanded to

+ +
+ +

#'(LAMBDA (#:G4372)
+??? (LET ((#:G4375 (FUNCALL E #:G4372)))
+????? (IF (NULL #:G4375) NIL (LET ((#:G4373 (CAR #:G4375))) (LET ((X (CAR +#:G4373))) (FUNCALL M (CDR #:G4373)))))))

+ +
+ +

The next test enumerates all items of the +tree. It creates a new tree, where each item is replaced with a CONS-pair, +consisting of the item itself and its sequence number. Also the test function +saves all enumerated items in the list and shows it as a log.

+ +
+ +

(defun state-trans-test (tree)
+? (labels
+????? ((order (tree)
+???????? (with-state-monad-trans (with-writer-monad)
+?????????? (cond ((null tree) (unit nil))
+???????????????? ((consp tree)
+????????????????? (let! ((t1 (order (car tree)))
+???????????????????????? (t2 (order (cdr tree))))
+??????????????????? (unit (cons t1 t2))))
+???????????????? (t
+????????????????? (let! ((n (get!)))
+??????????????????? (let ((new-n (+ n 1)))
+????????????????????? (progn!
+
+?????????????????????? (lift!
+??????????????????????? (with-writer-monad
+????????????????????????? (write! tree)))
+
+?????????????????????? (put! new-n)
+?????????????????????? (unit (cons tree new-n))))))))))
+
+??? (destructuring-bind ((new-tree new-state) saved-log)
+??????? (with-writer-monad
+????????? (run!
+?????????? (with-state-monad-trans (with-writer-monad)
+??? ?????????(run! (order tree) 0))))
+
+????? (format t "Item count=~a~%" new-state)
+????? (format t "New tree=~a~%" new-tree)
+????? (format t "Written log=~a~%" saved-log))))

+ +
+ +

Now we can launch a test.

+ +
+ +

CL-USER> (state-trans-test '(5 4 (1 2 (3))))
+Item count=5
+New tree=((5 . 1) (4 . 2) ((1 . 3) (2 . 4) ((3 . 5))))
+Written log=(5 4 1 2 3)
+NIL

+ +
+ +

The Writer Monad Transformer

+ +

The Writer monad transformer is a +parameterized version of the Writer monad but which can also act as a monad +specified in the parameter. For example, we can parameterize this transformer +by the Maybe monad. As a result, we?ll receive a new monad that will allow us +to write a log and cut all computations immediately in case of need.

+ +

I will use the next definition written in +Haskell.

+ +
+ +

import Control.Monad
+import Control.Monad.Trans
+
+newtype WriterTrans w m a = WriterTrans (m (a, [w] -> [w]))
+
+runWriter :: (Monad m) => WriterTrans w m a -> m (a, [w])
+runWriter (WriterTrans m) = do (a, f) <- m
+?????????????????????????????? return (a, f [])
+
+write :: (Monad m) => w -> WriterTrans w m ()
+write w = WriterTrans (return ((), \xs -> w : xs))
+
+writeList :: (Monad m) => [w] -> WriterTrans w m ()
+writeList ws = WriterTrans (return ((), \xs -> ws ++ xs))
+
+instance (Monad m) => Monad (WriterTrans w m) where
+
+?? ?return a = WriterTrans (return (a, id))
+
+??? (WriterTrans m) >>= k =
+??????? WriterTrans (do (a, f) <- m
+??????????????????????? let WriterTrans m' = k a
+??????????????????????? (a', f') <- m'
+??????????????????????? return (a', f . f'))
+
+instance MonadTrans (WriterTrans w) where
+??? lift m = WriterTrans (do a <- m; return (a, id))

+ +
+ +

As in case of the Reader monad transformer +we can see a lot of the mixed functions return and bind. Some of them are +related to WriterTrans. Others are related to monad m. Therefore +we need again the WITH-MONAD-TRANS macro that contains definitions of +INNER-UNIT, INNER-LET!, INNER-FUNCALL! and INNER-PROGN! that allow us to work +with the parameter monad.

+ +

So, I?ll define macro +WITH-WRITER-MONAD-TRANS that will be based on the WITH-MONAD-TRANS macro in +accordance with the general pattern described in section Monad Transformers. This new macro will be similar to the WITH-WRITER-MONAD macro. It +will be only parameterized and it will also contain macro LIFT!, an analog of +the lift function from Haskell.

+ +

The WRITE! macro uses now the INNER-UNIT +macro as we have to wrap a CONS-pair created with help of MAKE-WRITER.

+ +
+ +

(defmacro writer-trans-write! (&body ws)
+??? (if (= 1 (length ws))
+??????? ;; An optimized case
+??????? (let ((w (nth 0 ws))
+????????????? (v (gensym)))
+????????? `(inner-unit
+??????????? (make-writer nil
+???????????????????????? (let ((,v ,w))
+?????????????????????????? #'(lambda (xs) (cons ,v xs))))))
+??????? ;; A general case
+??????? (let ((vs (gensym)))
+????????? `(inner-unit
+??????????? (make-writer nil
+???????????????????????? (let ((,vs (list , at ws)))
+?????????????????????????? #'(lambda (xs)
+?????????????????????????????? (append ,vs xs))))))))

+ +
+ +

The WRITE-LIST! macro prototype is similar. +It also returns NIL in the outer monad.

+ +
+ +

(defmacro writer-trans-write-list! (&body wss)
+??? (if (= 1 (length wss))
+??????? ;; An optimized case
+??????? (let ((ws (nth 0 wss))
+????????????? (vs (gensym)))
+????????? `(inner-unit
+?????? ?????(make-writer nil
+???????????????????????? (let ((,vs ,ws))
+?????????????????????????? #'(lambda (xs) (append ,vs xs))))))
+??????? ;; A general case
+??????? (let ((vss (gensym)))
+????????? `(inner-unit
+??????????? (make-writer nil
+???????????????????? ????(let ((,vss (list , at wss)))
+?????????????????????????? #'(lambda (xs)
+?????????????????????????????? (reduce #'append ,vss
+?????????????????????????????????????? :from-end t
+?????????????????????????????????????? :initial-value xs))))))))

+ +
+ +

Please note that in the both macros we +evaluate the values ws and wss first and then return new +functions. The real writing operation will be delayed.

+ +

Now the RUN! macro returns a list of two +values, where the list is wrapped in the inner monad. The first value of the +list is a result of the computation. The second value is a log written during +this computation.

+ +
+ +

(defmacro writer-trans-run! (m)
+? (let ((x (gensym))
+?????? ?(fun (gensym)))
+??? `(inner-let! ((,x ,m))
+???????????????? (inner-unit
+????????????????? (list (writer-value ,x)
+??????????????????????? (let ((,fun (writer-fun ,x)))
+????????????????????????? (if (not (null ,fun))
+????????????????????????????? (funcall ,fun nil))))))))

+ +
+ +

The UNIT macro prototype also uses the +INNER-UNIT macro to wrap a value in the inner monad.

+ +
+ +

(defmacro writer-trans-unit (a)
+? `(inner-unit
+??? (make-writer ,a nil)))

+ +
+ +

Please note that expression a is +expanded within the outer monad macro, i.e. within WITH-WRITER-MONAD-TRANS, for +which the INNER-UNIT macro is responsible.

+ +

The FUNCALL! macro prototype is also +similar to its non-parameterized counterpart.

+ +
+ +

(defmacro writer-trans-funcall! (k m)
+? (let ((ks (gensym))
+??????? (ms (gensym))
+??????? (a (gensym))
+??????? (ka (gensym)))
+??? `(let ((,ks ,k))
+?????? (inner-let! ((,ms ,m))
+???????? (let ((,a (writer-value ,ms)))
+?????????? (inner-let! ((,ka (funcall ,ks ,a)))
+???????????? (inner-unit?
+???????????? ?(make-writer (writer-value ,ka)
+?????????????????????????? (writer-compose (writer-fun ,ms)
+?????????????????????????????????????????? (writer-fun ,ka))))))))))

+ +
+ +

As usual, the LET! macro prototype is more +optimal.

+ +
+ +

(defmacro writer-trans-let! (decls m)
+? (reduce
+?? #'(lambda (decl m)
+?????? (destructuring-bind (x e) decl
+???????? (let ((es (gensym))
+?????????????? (ms (gensym)))
+?????????? `(inner-let! ((,es ,e))
+????????????? (let ((,x (writer-value ,es)))
+??????????????? (inner-let! ((,ms ,m))
+?????? ???????????(inner-unit
+?????????????????? (make-writer (writer-value ,ms)
+??????????????????????????????? (writer-compose (writer-fun ,es)
+??????????????????????????????????????????????? (writer-fun ,ms))))))))))
+?? decls
+?? :from-end t
+?? :initial-value m))

+ +
+ +

The PROGN! macro prototype was also +slightly modified.

+ +
+ +

(defmacro writer-trans-progn! (&body ms)
+? (reduce
+?? #'(lambda (m1 m2)
+?????? (let ((m1s (gensym))
+???????????? (m2s (gensym)))
+???????? `(inner-let! ((,m1s ,m1)
+?????????????????????? (,m2s ,m2))
+??????????? (inner-unit
+???????????? (make-writer (writer-value ,m2s)
+????????????????????????? (writer-compose (writer-fun ,m1s)
+????????????????????????????????????????? (writer-fun ,m2s)))))))
+?? ms
+?? :from-end t))

+ +
+ +

As in case of the Reader monad transformer +macro we can define the LIFT! macro that will allow us to perform any +computation in the inner monad. This is that thing that allows the parameterized +monad transformer to act as a monad specified in its parameter.

+ +
+ +

(defmacro writer-trans-lift! (m)
+? (let ((a (gensym)))
+??? `(inner-let! ((,a ,m))
+?????? (inner-unit
+??????? (make-writer ,a nil)))))

+ +
+ +

Macros LIFT!, WRITE!, WRITE-LIST!, UNIT, +FUNCALL!, LET! and PROGN! are implemented as a MACROLET defined by macro +WITH-WRITER-MONAD-TRANS, which in its turn follows a common pattern of the +monad transformer macros.

+ +
+ +

(defmacro with-writer-monad-trans (inner-monad +&body body)
+? `(with-monad-trans (with-writer-monad-trans ,inner-monad)
+???? (macrolet
+???????? ((unit (a) (list 'writer-trans-unit a))
+????????? (funcall! (k m) (list 'writer-trans-funcall! k m))
+????????? (progn! (&body ms) (append '(writer-trans-progn!) ms))
+????????? (let! (decls m) (list 'writer-trans-let! decls m))
+????????? (write! (&body ws) (append '(writer-trans-write!) ws))
+????????? (write-list! (&body wss) (append '(writer-trans-write-list!) +wss))
+????????? (run! (m) (list 'writer-trans-run! m))
+????????? (lift! (m) (list 'writer-trans-lift! m)))
+?????? , at body)))

+ +
+ +

This monad macro generates a lot of +MACROLETs. They don?t impact the performance of the executed code, although the +compilation becomes a more difficult task for the Lisp system.

+ +

Let?s take the following sample

+ +
+ +

(with-writer-monad-trans
+??? (with-reader-monad-trans
+??????? (with-maybe-monad))
+
+? (let! ((x e)) m))

+ +
+ +

After removing the MACROLETs (with help of +CLISP) the macro expansion looks like this

+ +
+ +

#'(LAMBDA (#:G4325)
+??? (LET ((#:G4327 (FUNCALL E #:G4325)))
+????? (IF (NULL #:G4327) NIL
+????????? (LET ((#:G4322 (CAR #:G4327)))
+??????????? (FUNCALL
+???????????? (LET ((X (CAR #:G4322)))
+?????????????? #'(LAMBDA (#:G4329)
+?????????????????? (LET ((#:G4331 (FUNCALL M #:G4329)))
+???????????????????? (IF (NULL #:G4331) NIL
+???????????????????????? (LET ((#:G4323 (CAR #:G4331)))
+?????????????????????????? (FUNCALL
+?????????????????????????? ?#'(LAMBDA (#:G4333)
+??????????????????????????????? (DECLARE (IGNORE #:G4333))
+??????????????????????????????? (CONS
+???????????????????????????????? (CONS (CAR #:G4323)
+?????????????????????????????????????? (LET ((#:G4335 (CDR #:G4322)) (#:G4336 +(CDR #:G4323)))
+???????????????????????????????????????? (COND ((NULL #:G4336) #:G4335) ((NULL +#:G4335) #:G4336)
+?????????????????????????????????????????????? (T
+??????????????????????????????????????????????? #'(LAMBDA (X)
+????????????????????????????????????? ??????????????(FUNCALL #:G4335 (FUNCALL +#:G4336 X)))))))
+???????????????????????????????? NIL))
+??????????????????????????? #:G4329))))))
+???????????? #:G4325)))))

+ +
+ +

Here is a test.

+ +
+ +

(defun writer-trans-test ()
+? (let ((m (with-writer-monad-trans (with-maybe-monad)
+????????????
+???????????? (run!
+????????????? (progn!
+?????????????? (write! 1)
+?????????????? (write! 2 3)
+?????????????? (lift! (make-maybe))??? ; FAIL
+?????????????? (write-list! '(4 5 6))
+?????????????? (unit 'ok))))))
+
+??? (if (maybe-just-p m)
+
+??????? (progn
+????????? (destructuring-bind (a log) (maybe-just m)
+??????????? (format t "Computed value=~a~%" a)
+??????????? (format t "Written log=~a~%" log)))
+
+??????? (format t "Computation was interrupted~%"))))

+ +
+ +

If you?ll try to compile it with help of +SBCL, then the compiler will warn about an unreachable code!

+ +

This is an output of the test.

+ +
+ +

CL-USER> (writer-trans-test)
+Computation was interrupted
+NIL

+ +
+ +

Reducing Monad Macros

+ +

The ordinary monad macros are expanded to a +construct that contains a single MACROLET. Therefore the expressions that use +these monad macros are compiled fast. The monad macros built on the monad +transformers are not that case. They are expanded already to a construct that +may contain a lot of nested MACROLETs. It becomes a real problem for the Lisp +compiler. Not any expression consisting of the nested monad transformer macros +can be even compiled!

+ +

Below is described an approach that allows the +Lisp system to compile monad transformer macros of any complexity and to do it relatively +fast. The main idea is to replace the macros with functions. The drawback of +this method is that an executable code becomes a little bit slower than it +could be in case of the pure macro expansion.

+ +

I?ll illustrate the method on the +parameterized twice macro WITH-WRITER-MONAD-TRANS (WITH-READER-MONAD-TRANS +(WITH-MAYBE-MONAD)).

+ +

First, we create a short name for our +source macro, lifting the READ! macro from the Writer monad transformer.

+ +
+ +

(defmacro with-opt-proto (&body body)
+? `(with-writer-monad-trans
+?????? (with-reader-monad-trans
+?????????? (with-maybe-monad))
+???? (macrolet
+???????? ((read! ()
+??????????? `(lift!
+????????????? (with-reader-monad-trans
+????????????????? (with-maybe-monad)
+??????????????? (read!)))))
+?????? , at body)))

+ +
+ +

This new macro provides macros READ!, +WRITE!, WRITER-LIST!, RUN!, LIFT!, UNIT, FUNCALL!, LET! and PROGN!. Now we?ll +create functions for them, i.e. all macros will be expanded only once.

+ +
+ +

(defun opt-read! ()
+? (with-opt-proto
+??? (read!)))

+ +

(defun opt-write! (&rest ws)
+? (with-opt-proto
+??? (if (= 1 (length ws))
+??????? (write! (nth 0 ws))
+??????? (write-list! ws))))
+
+(defun opt-write-list! (&rest wss)
+? (with-opt-proto
+??? (if (= 1 (length wss))
+??????? (write-list! (nth 0 wss))
+??????? (reduce #'(lambda (ws m)
+?????? ?????????????(progn! (write-list! ws) m))
+??????????????? wss
+??????????????? :from-end t
+??????????????? :initial-value (unit nil)))))

+ +
+ +

In the last function we create a sequence +of the computations and always return NIL wrapped in the monad.

+ +

The top level RUN! macro returns a list +wrapped in the inner monad WITH-READER-MONAD-TRANS (WITH-MAYBE-MONAD). This +list contains two values. The first is a result of the computation. The second +value is a log written during this computation. The inner RUN! macro returns +already a value in the Maybe monad. Therefore we can unite two RUN! macros and +return the list of two values in the Maybe monad.

+ +
+ +

(defun opt-run! (m r)
+? (with-reader-monad-trans (with-maybe-monad)
+??? (run! (with-opt-proto
+??????????? (run! m))
+???????? ?r)))

+ +
+ +

We also have two LIFT! macros. We can unite +them too. We pass some computation in the Maybe monad, for example, a value +created with help of the MAKE-MAYBE function, and the new function returns the +corresponded computation wrapped in the outer monad WITH-OPT-PROTO.

+ +
+ +

(defun opt-lift! (m)
+? (with-opt-proto
+??? (lift!
+????? (with-reader-monad-trans (with-maybe-monad)
+??????? (lift! m)))))

+ +
+ +

Now we can define the return and bind +functions.

+ +
+ +

(defun opt-unit (a)
+? (with-opt-proto
+??? (unit a)))
+
+(defun opt-funcall! (k m)
+? (with-opt-proto
+????? (funcall! k m)))

+ +
+ +

We have all functions to define a new monad +macro with help of the WITH-MONAD macro. I?ll call this new monad macro a reduction +form of the source macro. It contains only two nested MACROLETs, which makes +the code with the new macro easily compilable regardless of that how complex +are the expressions built with help of macros UNIT, FUNCALL!, LET! and PROGN!.

+ +
+ +

(defmacro with-opt-monad (&body body)
+? `(with-monad (opt-unit opt-funcall!)
+???? (macrolet
+???? ????((read! () `(opt-read!))
+????????? (write! (&body bs) `(opt-write! ,@ bs))
+????????? (write-list! (&body bs) `(opt-write-list! , at bs))
+????????? (run! (m r) `(opt-run! ,m ,r))
+????????? (lift! (m) `(opt-lift! ,m)))
+?????? , at body)))

+ +
+ +

In difficult cases the reduction can be +applied many times. For example, to receive a monad macro with the same +behavior, we could first reduce macro WITH-READER-MONAD-TRANS +(WITH-MAYBE-MONAD) to new macro WITH-READER-MAYBE-MONAD. Then we could reduce +macro WITH-WRITER-MONAD-TRANS (WITH-READER-MAYBE-MONAD) to form WITH-ALTOPT-MONAD, +which would be equivalent to the WITH-OPT-MONAD macro. Only the more reduction +steps we apply the less efficient code is generated by the compiler. But +sometimes the reduction is a single possible way to make the code compilable.

+ +

This is a small test with the new monad.

+ +
+ +

(defun opt-test ()
+? (let ((m (with-opt-monad
+???????????? (run!
+????????????? (progn!
+
+?????????????? (write! 1)
+?????????????? (write! 2 3)
+?????????????? (write-list! '(4 5 6))
+
+?????????????? (let! ((x (read!)))
+???????????????? (lift! (make-maybe :just x))))
+
+????????????? 10))))
+
+??? (if (maybe-just-p m)
+
+??????? (progn
+????????? (destructuring-bind (a log) (maybe-just m)
+??????????? (format t "Computed value=~a~%" a)
+??????? ????(format t "Written log=~a~%" log)))
+
+??????? (format t "Computation was interrupted~%"))))

+ +
+ +

The test returns the following results.

+ +
+ +

CL-USER> (opt-test)
+Computed value=10
+Written log=(1 2 3 4 5 6)
+NIL

+ +
+ +

Loops

+ +

The monad macros can perfectly coexist with +the standard constructions IF, COND, PROGN, LET, LET*, FLET, LABELS, MACROLET, +SYMBOL-MACROLET, LAMBDA, FUNCALL, DESTRUCTURING -BIND and some others in one +expression. On the contrary, the standard loop macros DO, DOLIST, DOTIMES and +LOOP are not so simple. If we perform monad computations in some loop then, +generally speaking, we have to connect all the intermediate monad computations +into one with help of something like the PROGN! macro. This is a key point.

+ +

I won?t dwell on this subject, but I want +to say that some monad macros could be implemented as a MACROLET defining +macros DO!, DOLIST! and DOTIMES! that would be monadic counterparts to the +standard loop macros. Here we would probably have to add some monad representation +of an empty loop, i.e. an empty monad computation. It could be a macro named +ZERO!, for example. Also I think that the LOOP macro is more difficult case and +I?m not sure that a monadic counterpart can be created for it.

+ +

Other Monad Macros

+ +

In Haskell we can define a small set of +polymorphic functions that will work with any monad. Here in Common Lisp we can +partially implement the same idea but in another way. Taking into account that +the number of such common functions is relatively small and they are usually +simple, we can try to implement them with help of a MACROLET that would be +supplied together with the monad macro like WITH-MONAD.

+ +

In general case we can define a prototype +for the functor map function, which I?ll call FMAP.

+ +
+ +

? (defmacro generic-fmap (f m)
+???? ;; an analog of the fmap function from Haskell
+???? (let ((fun (gensym))
+?????????? (x (gensym)))
+???????? `(let ((,fun ,f))
+?????????????? (let! ((,x ,m))
+???????????????????? (unit (funcall ,fun ,x))))))

+ +
+ +

It?s obvious that in case of the List monad +the following definition will be much more efficient:

+ +
+ +

? (defmacro list-fmap (f m)
+???? ;; fmap for the List monad
+???? `(mapcar ,f ,m))

+ +
+ +

It?s easy to provide each monad macro with +its own optimized version of the FMAP macro. Moreover, such a technique has no +almost performance overhead.

+ +

The approach can be generalized for other monad +functions. But the task of their creation deserves a separate article. Now I +will only provide a naïve non-optimized version of another useful macro +LIST!, which is an expanded version of the sequence function from +Haskell

+ +
+ +

? (defmacro list! (&body ms)
+???? (reduce
+??????? #?(lambda (x xs)
+???????????? (let ((y (gensym))
+?????????????????? (ys (gensym)))
+???????????????? `(let! ((,y ,x)
+???????????????????????? (,ys ,xs))
+??????????????????????? (unit (cons ,y ,ys)))))
+??????? ms
+??????? :from-end t
+??????? :initial-value (unit ())))

+ +
+ +

In case of the WITH-IDENTITY-MONAD macro +the LIST! macro can be replaced with function LIST, which corresponds to the +rule of thumb.

+ +

Conclusion

+ +

I tried to introduce the monads in the Lisp +Way. I know that there were other attempts. They are mainly based on using +generic functions that allow the programmer to write a polymorphic code but at +the cost of some lost of the performance. My approach, on the contrary, allows +the Lisp compiler to generate an efficient code but it lacks some flexibility.

+ +

Also I think that my approach is somewhere +similar to the F# workflows. Only the monad macros play a role of the +workflow builders.

+ +
+ + + + From dsorokin at common-lisp.net Thu Jan 21 15:42:10 2010 From: dsorokin at common-lisp.net (David Sorokin) Date: Thu, 21 Jan 2010 10:42:10 -0500 Subject: [Cl-monad-macros-cvs] r4 - tags Message-ID: Author: dsorokin Date: Thu Jan 21 10:42:09 2010 New Revision: 4 Log: Added a directory for releases. Added: tags/ From dsorokin at common-lisp.net Thu Jan 21 15:43:57 2010 From: dsorokin at common-lisp.net (David Sorokin) Date: Thu, 21 Jan 2010 10:43:57 -0500 Subject: [Cl-monad-macros-cvs] r5 - tags/cl-monad-macros-0_1 Message-ID: Author: dsorokin Date: Thu Jan 21 10:43:57 2010 New Revision: 5 Log: Released the first version 0.1. Added: tags/cl-monad-macros-0_1/ - copied from r4, /trunk/ From dsorokin at common-lisp.net Wed Jan 27 17:57:56 2010 From: dsorokin at common-lisp.net (David Sorokin) Date: Wed, 27 Jan 2010 12:57:56 -0500 Subject: [Cl-monad-macros-cvs] r6 - trunk Message-ID: Author: dsorokin Date: Wed Jan 27 12:57:53 2010 New Revision: 6 Log: Replaced some internal macros with functions. Modified: trunk/cl-monad-macros.asd trunk/cl-monad-macros.lisp Modified: trunk/cl-monad-macros.asd ============================================================================== --- trunk/cl-monad-macros.asd (original) +++ trunk/cl-monad-macros.asd Wed Jan 27 12:57:53 2010 @@ -30,7 +30,7 @@ (in-package :cl-monad-macros-asd) (defsystem :cl-monad-macros - :version "0.1" + :version "0.2" :author "David Sorokin " :description "Monad Macros for Common Lisp." :components ((:file "cl-monad-macros"))) Modified: trunk/cl-monad-macros.lisp ============================================================================== --- trunk/cl-monad-macros.lisp (original) +++ trunk/cl-monad-macros.lisp Wed Jan 27 12:57:53 2010 @@ -72,7 +72,7 @@ ;;; General Case ;;; -(defmacro generic-progn! (funcall-func &body ms) +(defun generic-progn! (funcall-func ms) (reduce #'(lambda (m1 m2) (let ((x (gensym))) `(,funcall-func @@ -83,7 +83,7 @@ ms :from-end t)) -(defmacro generic-let! (funcall-func decls m) +(defun generic-let! (funcall-func decls m) (reduce #'(lambda (decl m) (destructuring-bind (x e) decl `(,funcall-func #'(lambda (,x) ,m) ,e))) @@ -95,8 +95,8 @@ `(macrolet ((unit (a) (list ',unit-func a)) (funcall! (k m) (list ',funcall-func k m)) - (progn! (&body ms) (append '(generic-progn!) '(,funcall-func) ms)) - (let! (decls m) (list 'generic-let! ',funcall-func decls m))) + (progn! (&body ms) (generic-progn! ',funcall-func ms)) + (let! (decls m) (generic-let! ',funcall-func decls m))) , at body)) ;;; @@ -138,14 +138,14 @@ ;;; The List Monad ;;; -(defmacro list-progn! (&body ms) +(defun list-progn! (ms) (reduce #'(lambda (m1 m2) (let ((x (gensym))) `(loop for ,x in ,m1 append ,m2))) ms :from-end t)) -(defmacro list-let! (decls m) +(defun list-let! (decls m) (reduce #'(lambda (decl m) (destructuring-bind (x e) decl `(loop for ,x in ,e append ,m))) @@ -157,8 +157,8 @@ `(macrolet ((unit (a) `(list ,a)) (funcall! (k m) `(reduce #'append (mapcar ,k ,m))) - (progn! (&body ms) (append '(list-progn!) ms)) - (let! (decls m) (list 'list-let! decls m))) + (progn! (&body ms) (list-progn! ms)) + (let! (decls m) (list-let! decls m))) , at body)) ;;; @@ -180,10 +180,10 @@ (defmacro maybe-nil-p (m) `(null ,m)) -(defmacro maybe-unit (a) +(defun maybe-unit (a) `(make-maybe :just ,a)) -(defmacro maybe-funcall! (k m) +(defun maybe-funcall! (k m) (let ((xk (gensym)) (xm (gensym))) `(let ((,xk ,k) @@ -192,7 +192,7 @@ (make-maybe) (funcall ,xk (maybe-just ,xm)))))) -(defmacro maybe-progn! (&body ms) +(defun maybe-progn! (ms) (reduce #'(lambda (m1 m2) `(if (maybe-nil-p ,m1) (make-maybe) @@ -200,7 +200,7 @@ ms :from-end t)) -(defmacro maybe-let! (decls m) +(defun maybe-let! (decls m) (reduce #'(lambda (decl m) (destructuring-bind (x e) decl (let ((xe (gensym))) @@ -215,23 +215,23 @@ (defmacro with-maybe-monad (&body body) `(macrolet - ((unit (a) (list 'maybe-unit a)) - (funcall! (k m) (list 'maybe-funcall! k m)) - (progn! (&body ms) (append '(maybe-progn!) ms)) - (let! (decls m) (list 'maybe-let! decls m))) + ((unit (a) (maybe-unit a)) + (funcall! (k m) (maybe-funcall! k m)) + (progn! (&body ms) (maybe-progn! ms)) + (let! (decls m) (maybe-let! decls m))) , at body)) ;;; ;;; The Reader Monad ;;; -(defmacro reader-unit (a) +(defun reader-unit (a) (let ((r (gensym))) `#'(lambda (,r) (declare (ignore ,r)) ,a))) -(defmacro reader-funcall! (k m) +(defun reader-funcall! (k m) (let ((r (gensym)) (a (gensym)) (kg (gensym))) @@ -240,7 +240,7 @@ (,a (funcall ,m ,r))) (funcall (funcall ,kg ,a) ,r))))) -(defmacro reader-let! (decls m) +(defun reader-let! (decls m) (reduce #'(lambda (decl m) (destructuring-bind (x e) decl (let ((r (gensym))) @@ -251,7 +251,7 @@ :from-end t :initial-value m)) -(defmacro reader-progn! (&body ms) +(defun reader-progn! (ms) (reduce #'(lambda (m1 m2) (let ((r (gensym))) `#'(lambda (,r) @@ -260,21 +260,21 @@ ms :from-end t)) -(defmacro reader-read! () +(defun reader-read! () (let ((r (gensym))) `#'(lambda (,r) ,r))) -(defmacro reader-run! (m r) +(defun reader-run! (m r) `(funcall ,m ,r)) (defmacro with-reader-monad (&body body) `(macrolet - ((unit (a) (list 'reader-unit a)) - (funcall! (k m) (list 'reader-funcall! k m)) - (progn! (&body ms) (append '(reader-progn!) ms)) - (let! (decls m) (list 'reader-let! decls m)) - (read! () (list 'reader-read!)) - (run! (m r) (list 'reader-run! m r))) + ((unit (a) (reader-unit a)) + (funcall! (k m) (reader-funcall! k m)) + (progn! (&body ms) (reader-progn! ms)) + (let! (decls m) (reader-let! decls m)) + (read! () (reader-read!)) + (run! (m r) (reader-run! m r))) , at body)) ;;; @@ -290,12 +290,12 @@ (defmacro state-state (m) `(cdr ,m)) -(defmacro state-unit (a) +(defun state-unit (a) (let ((st (gensym))) `#'(lambda (,st) (make-state ,a ,st)))) -(defmacro state-funcall! (k m) +(defun state-funcall! (k m) (let ((st (gensym)) (p (gensym)) (a (gensym)) @@ -307,7 +307,7 @@ (funcall (funcall ,kg ,a) (state-state ,p)))))))) -(defmacro state-let! (decls m) +(defun state-let! (decls m) (reduce #'(lambda (decl m) (destructuring-bind (x e) decl (let ((st (gensym)) @@ -320,7 +320,7 @@ :from-end t :initial-value m)) -(defmacro state-progn! (&body ms) +(defun state-progn! (ms) (reduce #'(lambda (m1 m2) (let ((st (gensym)) (p (gensym))) @@ -330,18 +330,18 @@ ms :from-end t)) -(defmacro state-run! (m init-st) +(defun state-run! (m init-st) (let ((p (gensym))) `(let ((,p (funcall ,m ,init-st))) (list (state-value ,p) (state-state ,p))))) -(defmacro state-get! () +(defun state-get! () (let ((st (gensym))) `#'(lambda (,st) (make-state ,st ,st)))) -(defmacro state-put! (new-st) +(defun state-put! (new-st) (let ((st (gensym))) `#'(lambda (,st) (declare (ignore ,st)) @@ -349,13 +349,13 @@ (defmacro with-state-monad (&body body) `(macrolet - ((unit (a) (list 'state-unit a)) - (funcall! (k m) (list 'state-funcall! k m)) - (progn! (&body ms) (append '(state-progn!) ms)) - (let! (decls m) (list 'state-let! decls m)) - (get! () (list 'state-get!)) - (put! (new-st) (list 'state-put! new-st)) - (run! (m init-st) (list 'state-run! m init-st))) + ((unit (a) (state-unit a)) + (funcall! (k m) (state-funcall! k m)) + (progn! (&body ms) (state-progn! ms)) + (let! (decls m) (state-let! decls m)) + (get! () (state-get!)) + (put! (new-st) (state-put! new-st)) + (run! (m init-st) (state-run! m init-st))) , at body)) ;;; @@ -383,7 +383,7 @@ (funcall ,fs (funcall ,gs x)))))))) -(defmacro writer-write! (&body ws) +(defun writer-write! (ws) (if (= 1 (length ws)) ;; An optimized case (let ((w (nth 0 ws)) @@ -398,7 +398,7 @@ #'(lambda (xs) (append ,vs xs))))))) -(defmacro writer-write-list! (&body wss) +(defun writer-write-list! (wss) (if (= 1 (length wss)) ;; An optimized case (let ((ws (nth 0 wss)) @@ -415,7 +415,7 @@ :from-end t :initial-value xs))))))) -(defmacro writer-run! (m) +(defun writer-run! (m) (let ((x (gensym)) (fun (gensym))) `(let ((,x ,m)) @@ -424,10 +424,10 @@ (if (not (null ,fun)) (funcall ,fun nil))))))) -(defmacro writer-unit (a) +(defun writer-unit (a) `(make-writer ,a nil)) -(defmacro writer-funcall! (k m) +(defun writer-funcall! (k m) (let ((ks (gensym)) (ms (gensym)) (a (gensym)) @@ -440,7 +440,7 @@ (writer-compose (writer-fun ,ms) (writer-fun ,ka)))))) -(defmacro writer-let! (decls m) +(defun writer-let! (decls m) (reduce #'(lambda (decl m) (destructuring-bind (x e) decl @@ -457,7 +457,7 @@ :initial-value m)) -(defmacro writer-progn! (&body ms) +(defun writer-progn! (ms) (reduce #'(lambda (m1 m2) (let ((m1s (gensym)) @@ -472,13 +472,13 @@ (defmacro with-writer-monad (&body body) `(macrolet - ((unit (a) (list 'writer-unit a)) - (funcall! (k m) (list 'writer-funcall! k m)) - (progn! (&body ms) (append '(writer-progn!) ms)) - (let! (decls m) (list 'writer-let! decls m)) - (write! (&body ws) (append '(writer-write!) ws)) - (write-list! (&body wss) (append '(writer-write-list!) wss)) - (run! (m) (list 'writer-run! m))) + ((unit (a) (writer-unit a)) + (funcall! (k m) (writer-funcall! k m)) + (progn! (&body ms) (writer-progn! ms)) + (let! (decls m) (writer-let! decls m)) + (write! (&body ws) (writer-write! ws)) + (write-list! (&body wss) (writer-write-list! wss)) + (run! (m) (writer-run! m))) , at body)) ;;; @@ -489,41 +489,40 @@ (let ((inner-monad (cadr outer-monad))) `(macrolet ((with-inner-monad-trans (id &body bs) - (append '(with-inner-monad-prototype) - (list ',outer-monad) - (list ',inner-monad) - (list id) + (with-inner-monad-prototype + ',outer-monad + ',inner-monad + id bs)) (with-outer-monad-trans (id &body bs) (append id bs)) ;; - (inner-unit (a) (list 'generic-inner-unit a)) - (inner-funcall! (k m) (list 'generic-inner-funcall! k m)) - (inner-progn! (&body ms) (append '(generic-inner-progn!) ms)) - (inner-let! (decls m) (list 'generic-inner-let! decls m))) + (inner-unit (a) (generic-inner-unit a)) + (inner-funcall! (k m) (generic-inner-funcall! k m)) + (inner-progn! (&body ms) (generic-inner-progn! ms)) + (inner-let! (decls m) (generic-inner-let! decls m))) , at body))) -(defmacro with-inner-monad-prototype - (outer-monad inner-monad id &body body) +(defun with-inner-monad-prototype (outer-monad inner-monad id body) `(macrolet ((, at id (&body bs) (append ',outer-monad bs))) (, at inner-monad , at body))) -(defmacro generic-inner-unit (a) +(defun generic-inner-unit (a) (let ((id (gensym))) `(with-inner-monad-trans (,id) (unit (with-outer-monad-trans (,id) ,a))))) -(defmacro generic-inner-funcall! (k m) +(defun generic-inner-funcall! (k m) (let ((id (gensym))) `(with-inner-monad-trans (,id) (funcall! (with-outer-monad-trans (,id) ,k) (with-outer-monad-trans (,id) ,m))))) -(defmacro generic-inner-let! (decls m) +(defun generic-inner-let! (decls m) (reduce #'(lambda (decl m) (destructuring-bind (x e) decl @@ -535,7 +534,7 @@ :from-end t :initial-value m)) -(defmacro generic-inner-progn! (&body ms) +(defun generic-inner-progn! (ms) (let ((id (gensym))) (let ((outer-ms (loop for m in ms collect `(with-outer-monad-trans (,id) ,m)))) @@ -546,13 +545,13 @@ ;;; The Reader Monad Transformer ;;; -(defmacro reader-trans-unit (a) +(defun reader-trans-unit (a) (let ((r (gensym))) `#'(lambda (,r) (declare (ignore ,r)) (inner-unit ,a)))) -(defmacro reader-trans-funcall! (k m) +(defun reader-trans-funcall! (k m) (let ((r (gensym)) (a (gensym)) (kg (gensym))) @@ -561,7 +560,7 @@ (inner-let! ((,a (funcall ,m ,r))) (funcall (funcall ,kg ,a) ,r)))))) -(defmacro reader-trans-let! (decls m) +(defun reader-trans-let! (decls m) (reduce #'(lambda (decl m) (destructuring-bind (x e) decl (let ((r (gensym))) @@ -572,7 +571,7 @@ :from-end t :initial-value m)) -(defmacro reader-trans-progn! (&body ms) +(defun reader-trans-progn! (ms) (reduce #'(lambda (m1 m2) (let ((r (gensym))) `#'(lambda (,r) @@ -582,15 +581,15 @@ ms :from-end t)) -(defmacro reader-trans-read! () +(defun reader-trans-read! () (let ((r (gensym))) `#'(lambda (,r) (inner-unit ,r)))) -(defmacro reader-trans-run! (m r) +(defun reader-trans-run! (m r) `(funcall ,m ,r)) -(defmacro reader-trans-lift! (m) +(defun reader-trans-lift! (m) (let ((r (gensym))) `#'(lambda (,r) (declare (ignore ,r)) @@ -599,26 +598,26 @@ (defmacro with-reader-monad-trans (inner-monad &body body) `(with-monad-trans (with-reader-monad-trans ,inner-monad) (macrolet - ((unit (a) (list 'reader-trans-unit a)) - (funcall! (k m) (list 'reader-trans-funcall! k m)) - (progn! (&body ms) (append '(reader-trans-progn!) ms)) - (let! (decls m) (list 'reader-trans-let! decls m)) - (read! () (list 'reader-trans-read!)) - (run! (m r) (list 'reader-trans-run! m r)) - (lift! (m) (list 'reader-trans-lift! m))) + ((unit (a) (reader-trans-unit a)) + (funcall! (k m) (reader-trans-funcall! k m)) + (progn! (&body ms) (reader-trans-progn! ms)) + (let! (decls m) (reader-trans-let! decls m)) + (read! () (reader-trans-read!)) + (run! (m r) (reader-trans-run! m r)) + (lift! (m) (reader-trans-lift! m))) , at body))) ;;; ;;; The State Monad Transformer ;;; -(defmacro state-trans-unit (a) +(defun state-trans-unit (a) (let ((st (gensym))) `#'(lambda (,st) (inner-unit (make-state ,a ,st))))) -(defmacro state-trans-funcall! (k m) +(defun state-trans-funcall! (k m) (let ((st (gensym)) (p (gensym)) (a (gensym)) @@ -630,7 +629,7 @@ (funcall (funcall ,kg ,a) (state-state ,p)))))))) -(defmacro state-trans-let! (decls m) +(defun state-trans-let! (decls m) (reduce #'(lambda (decl m) (destructuring-bind (x e) decl (let ((st (gensym)) @@ -643,7 +642,7 @@ :from-end t :initial-value m)) -(defmacro state-trans-progn! (&body ms) +(defun state-trans-progn! (ms) (reduce #'(lambda (m1 m2) (let ((st (gensym)) (p (gensym))) @@ -653,27 +652,27 @@ ms :from-end t)) -(defmacro state-trans-run! (m init-st) +(defun state-trans-run! (m init-st) (let ((p (gensym))) `(inner-let! ((,p (funcall ,m ,init-st))) (inner-unit (list (state-value ,p) (state-state ,p)))))) -(defmacro state-trans-get! () +(defun state-trans-get! () (let ((st (gensym))) `#'(lambda (,st) (inner-unit (make-state ,st ,st))))) -(defmacro state-trans-put! (new-st) +(defun state-trans-put! (new-st) (let ((st (gensym))) `#'(lambda (,st) (declare (ignore ,st)) (inner-unit (make-state nil ,new-st))))) -(defmacro state-trans-lift! (m) +(defun state-trans-lift! (m) (let ((st (gensym)) (a (gensym))) `#'(lambda (,st) @@ -684,21 +683,21 @@ (defmacro with-state-monad-trans (inner-monad &body body) `(with-monad-trans (with-state-monad-trans ,inner-monad) (macrolet - ((unit (a) (list 'state-trans-unit a)) - (funcall! (k m) (list 'state-trans-funcall! k m)) - (progn! (&body ms) (append '(state-trans-progn!) ms)) - (let! (decls m) (list 'state-trans-let! decls m)) - (get! () (list 'state-trans-get!)) - (put! (new-st) (list 'state-trans-put! new-st)) - (run! (m init-st) (list 'state-trans-run! m init-st)) - (lift! (m) (list 'state-trans-lift! m))) + ((unit (a) (state-trans-unit a)) + (funcall! (k m) (state-trans-funcall! k m)) + (progn! (&body ms) (state-trans-progn! ms)) + (let! (decls m) (state-trans-let! decls m)) + (get! () (state-trans-get!)) + (put! (new-st) (state-trans-put! new-st)) + (run! (m init-st) (state-trans-run! m init-st)) + (lift! (m) (state-trans-lift! m))) , at body))) ;;; ;;; The Writer Monad Transformer ;;; -(defmacro writer-trans-write! (&body ws) +(defun writer-trans-write! (ws) (if (= 1 (length ws)) ;; An optimized case (let ((w (nth 0 ws)) @@ -715,7 +714,7 @@ #'(lambda (xs) (append ,vs xs)))))))) -(defmacro writer-trans-write-list! (&body wss) +(defun writer-trans-write-list! (wss) (if (= 1 (length wss)) ;; An optimized case (let ((ws (nth 0 wss)) @@ -734,7 +733,7 @@ :from-end t :initial-value xs)))))))) -(defmacro writer-trans-run! (m) +(defun writer-trans-run! (m) (let ((x (gensym)) (fun (gensym))) `(inner-let! ((,x ,m)) @@ -744,11 +743,11 @@ (if (not (null ,fun)) (funcall ,fun nil)))))))) -(defmacro writer-trans-unit (a) +(defun writer-trans-unit (a) `(inner-unit (make-writer ,a nil))) -(defmacro writer-trans-funcall! (k m) +(defun writer-trans-funcall! (k m) (let ((ks (gensym)) (ms (gensym)) (a (gensym)) @@ -762,7 +761,7 @@ (writer-compose (writer-fun ,ms) (writer-fun ,ka)))))))))) -(defmacro writer-trans-let! (decls m) +(defun writer-trans-let! (decls m) (reduce #'(lambda (decl m) (destructuring-bind (x e) decl @@ -779,7 +778,7 @@ :from-end t :initial-value m)) -(defmacro writer-trans-progn! (&body ms) +(defun writer-trans-progn! (ms) (reduce #'(lambda (m1 m2) (let ((m1s (gensym)) @@ -793,7 +792,7 @@ ms :from-end t)) -(defmacro writer-trans-lift! (m) +(defun writer-trans-lift! (m) (let ((a (gensym))) `(inner-let! ((,a ,m)) (inner-unit @@ -802,12 +801,12 @@ (defmacro with-writer-monad-trans (inner-monad &body body) `(with-monad-trans (with-writer-monad-trans ,inner-monad) (macrolet - ((unit (a) (list 'writer-trans-unit a)) - (funcall! (k m) (list 'writer-trans-funcall! k m)) - (progn! (&body ms) (append '(writer-trans-progn!) ms)) - (let! (decls m) (list 'writer-trans-let! decls m)) - (write! (&body ws) (append '(writer-trans-write!) ws)) - (write-list! (&body wss) (append '(writer-trans-write-list!) wss)) - (run! (m) (list 'writer-trans-run! m)) - (lift! (m) (list 'writer-trans-lift! m))) + ((unit (a) (writer-trans-unit a)) + (funcall! (k m) (writer-trans-funcall! k m)) + (progn! (&body ms) (writer-trans-progn! ms)) + (let! (decls m) (writer-trans-let! decls m)) + (write! (&body ws) (writer-trans-write! ws)) + (write-list! (&body wss) (writer-trans-write-list! wss)) + (run! (m) (writer-trans-run! m)) + (lift! (m) (writer-trans-lift! m))) , at body))) From dsorokin at common-lisp.net Wed Jan 27 17:59:49 2010 From: dsorokin at common-lisp.net (David Sorokin) Date: Wed, 27 Jan 2010 12:59:49 -0500 Subject: [Cl-monad-macros-cvs] r7 - trunk Message-ID: Author: dsorokin Date: Wed Jan 27 12:59:48 2010 New Revision: 7 Log: Removed macros UNIVERSAL-LET! and UNIVERSAL-PROGN!. Modified: trunk/cl-monad-macros.lisp Modified: trunk/cl-monad-macros.lisp ============================================================================== --- trunk/cl-monad-macros.lisp (original) +++ trunk/cl-monad-macros.lisp Wed Jan 27 12:59:48 2010 @@ -43,8 +43,6 @@ :with-monad-trans :with-inner-monad-trans :with-outer-monad-trans - :universal-let! - :universal-progn! :unit :funcall! :let! @@ -100,29 +98,6 @@ , at body)) ;;; -;;; The Bind Macros -;;; - -(defmacro universal-progn! (&body ms) - (reduce #'(lambda (m1 m2) - (let ((x (gensym))) - `(funcall! - #'(lambda (,x) - (declare (ignore ,x)) - ,m2) - ,m1))) - ms - :from-end t)) - -(defmacro universal-let! (decls m) - (reduce #'(lambda (decl m) - (destructuring-bind (x e) decl - `(funcall! #'(lambda (,x) ,m) ,e))) - decls - :from-end t - :initial-value m)) - -;;; ;;; The Identity Monad ;;;