[Cl-monad-macros-cvs] r6 - trunk
David Sorokin
dsorokin at common-lisp.net
Wed Jan 27 17:57:56 UTC 2010
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 <david.sorokin at gmail.com>"
: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)))
More information about the cl-monad-macros-cvs
mailing list