David Sorokin david.sorokin@gmail.com, Jan 2010
A monad can be defined with help of two functions, one of which is higherorder. Direct working with them is tedious and errorprone. 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 donotation 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 clmonadmacros. It is available by the following link: http://commonlisp.net/project/clmonadmacros. 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.
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) 
do x1 < e1 
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! 
(progn! m1 m2 … mn) 
(progn! m1 (progn! m2 … mn)) 
Here #:genvar means an automatically generated unique variable name with help of GENSYM.
Macro LET! is somewhere an alternative to the arrow symbol from the donotation 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! 
(let! ((x1 e1) 
(let! ((x1 e1)) 
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)) 
do x < e 
(let ((x a)) 
do let x = a 
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 WITHMONAD that has the following application form:
(withmonad (returnfunc funcallfunc)
;; Here we can use UNIT, FUNCALL!, PROGN! and LET!
body1 … bodyN)
The first subparameter returnfunc defines a name of the return function. The second subparameter funcallfunc defines a name of the bind function. This macro is expanded to a MACROLET saving the same body.
(defmacro withmonad ((unitfunc funcallfunc)
&body body)
`(macrolet
((unit (a) (list ',unitfunc a))
(funcall! (k m) (list ',funcallfunc k m))
(progn! (&body ms) (append '(genericprogn!) '(,funcallfunc) ms))
(let! (decls m) (list 'genericlet! ',funcallfunc decls m)))
,@body))
Here the GENERICLET! macro is used to process the LET! expression in accordance with the stated above definition.
(defmacro genericlet! (funcallfunc decls m)
(reduce #'(lambda (decl m)
(destructuringbind (x e) decl
`(,funcallfunc #'(lambda (,x) ,m) ,e)))
decls
:fromend t
:initialvalue m))
The PROGN! expression is processed already by the GENERICPROGN! helper macro.
(defmacro genericprogn! (funcallfunc &body
ms)
(reduce #'(lambda (m1 m2)
(let ((x (gensym)))
`(,funcallfunc
#'(lambda (, x)
(declare (ignore ,x))
,m2)
,m1)))
ms
:fromend t))
Then the following test expression
(withmonad (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 WITHMONAD 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 WITHMONAD 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 
WITHMONAD 

WITHIDENTITYMONAD 

WITHLISTMONAD 

WITHMAYBEMONAD 

WITHREADERMONAD 

WITHSTATEMONAD 

WITHWRITERMONAD 

WITHREADERMONADTRANS 

WITHSTATEMONADTRANS 

WITHWRITERMONADTRANS 
It’s important that macros like WITHMONAD can be nested, which allows the programmer to work with different monads in the same sexpression. Each new application of the WITHMONAD 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 WITHMONAD macro, it is more convenient to create a short name for each monad in accordance with the following pattern:
(defmacro withmymonad (&body body)
`(withmonad (unitf funcallf)
,@body))
where UNITF and FUNCALLF were used as an example.
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 universalprogn! (&body ms)
(reduce #'(lambda (m1 m2)
(let ((x (gensym)))
`(funcall!
#'(lambda (,x)
(declare (ignore ,x))
,m2)
,m1)))
ms
:fromend t))
(defmacro universallet! (decls m)
(reduce #'(lambda (decl m)
(destructuringbind (x e) decl
`(funcall! #'(lambda (,x) ,m) ,e)))
decls
:fromend t
:initialvalue 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 UNIVERSALLET! 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 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 withidentitymonad (&body body)
`(withmonad (identity funcall)
,@body)
But there is a much more efficient implementation:
(defmacro withidentitymonad (&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)))
,@body))
Remembering about this monad, it is easy to memorize names FUNCALL!, PROGN! and LET!.
Our test expression
(withidentitymonad
(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)))
This section is devoted to the List monad. I’ll introduce macro WITHLISTMONAD that will implement a contract of the WITHMONAD 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 listunit (a)
`(list ,a))
(defmacro listfuncall! (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 listprogn! (&body ms)
(reduce
#'(lambda (m1 m2)
(let ((x (gensym)))
`(loop for ,x in ,m1 append ,m2)))
ms
:fromend 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 listlet! (decls m)
(reduce
#'(lambda (decl m)
(destructuringbind (x e) decl
`(loop for ,x in ,e append ,m)))
decls
:fromend t
:initialvalue 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 WITHLISTMONAD macro.
(defmacro withlistmonad (&body body)
`(macrolet
((unit (a) `(list ,a))
(funcall! (k m) `(reduce #'append (mapcar ,k ,m)))
(progn! (&body ms) (append '(listprogn!) ms))
(let! (decls m) (list 'listlet! decls m)))
,@body))
The same test example
(withlistmonad
(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:
CLUSER> (withlistmonad
(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 elsepart 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)
(withlistmonad
(if (null xs)
(unit nil)
(let! ((y xs)
(ys (perms (remove y xs :count 1))))
(unit (cons y ys))))))
Now we can test it.
CLUSER> (perms '(1 2 3))
((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
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 makemaybe (&key (just nil
justsuppliedp))
(if justsuppliedp `(cons ,just nil)))
(defmacro maybejust (a)
`(car ,a))
(defmacro maybenil ()
nil)
(defmacro maybejustp (m)
`(consp ,m))
(defmacro maybenilp (m)
`(null ,m))
The prototypes of the basic return and bind macros can be defined in the following way.
(defmacro maybeunit (a)
`(makemaybe :just ,a))
(defmacro maybefuncall! (k m)
(let ((xk (gensym))
(xm (gensym)))
`(let ((,xk ,k)
(,xm ,m))
(if (maybenilp ,xm)
(makemaybe)
(funcall ,xk (maybejust ,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 maybeprogn! (&body ms)
(reduce
#'(lambda (m1 m2)
`(if (maybenilp ,m1)
(makemaybe)
,m2))
ms
:fromend t))
The LET! macro is similar but it allows the programmer to bind variables within one computation.
(defmacro maybelet! (decls m)
(reduce
#'(lambda (decl m)
(destructuringbind (x e) decl
(let ((xe (gensym)))
`(let ((,xe ,e))
(if (maybenilp ,xe)
(makemaybe)
(let ((,x (maybejust ,xe)))
,m))))))
decls
:fromend t
:initialvalue 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 WITHMAYBEMONAD. As always, we could implement the latter with help of generic macro WITHMONAD providing the necessary return and bind functions which are trivial for this monad. But macro WITHMAYBEMONAD is much more efficient.
(defmacro withmaybemonad (&body body)
`(macrolet
((unit (a) (list 'maybeunit a))
(funcall! (k m) (list 'maybefuncall! k m))
(progn! (&body ms) (append '(maybeprogn!) ms))
(let! (decls m) (list 'maybelet! decls m)))
,@body))
Our old example
(withmaybemonad
(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
CLUSER> (withmaybemonad
(progn! (progn
(format t "Step 1.")
(makemaybe :just 'OK))
(makemaybe) ; NIL – failure
(progn
(format t "Step 2.")
(makemaybe :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 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 WITHREADERMONAD.
The UNIT macro prototype is simple enough.
(defmacro readerunit (a)
(let ((r (gensym)))
`#'(lambda (,r)
(declare (ignore ,r))
,a)))
The FUNCALL! macro prototype is crucial for understanding the monad macro.
(defmacro readerfuncall! (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 sexpression 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 readerlet! (decls m)
(reduce #'(lambda (decl m)
(destructuringbind (x e) decl
(let ((r (gensym)))
`#'(lambda (,r)
(let ((,x (funcall ,e ,r)))
(funcall ,m ,r))))))
decls
:fromend t
:initialvalue 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 sexpression 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 readerprogn! (&body ms)
(reduce #'(lambda (m1 m2)
(let ((r (gensym)))
`#'(lambda (,r)
(funcall ,m1 ,r)
(funcall ,m2 ,r))))
ms
:fromend t))
Again, if the sexpression 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 readerread! ()
(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 readerrun! (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 WITHREADERMONAD macro.
(defmacro withreadermonad (&body body)
`(macrolet
((unit (a) (list 'readerunit a))
(funcall! (k m) (list 'readerfuncall! k m))
(progn! (&body ms) (append '(readerprogn!) ms))
(let! (decls m) (list 'readerlet! decls m))
(read! () (list 'readerread!))
(run! (m r) (list 'readerrun! m r)))
,@body))
Now we can take our old test example
(withreadermonad
(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 readertest ()
(withreadermonad
(run!
(let! ((x (read!)))
(progn
(format t "x=~a~%" x)
(unit 'ok)))
10)))
and this is its output.
CLUSER> (readertest)
x=10
OK
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 WITHSTATEMONAD. 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 makestate (a st)
`(cons ,a ,st))
(defmacro statevalue (m)
`(car ,m))
(defmacro statestate (m)
`(cdr ,m))
The UNIT macro prototype is simple.
(defmacro stateunit (a)
(let ((st (gensym)))
`#'(lambda (,st)
(makestate ,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 statefuncall! (k m)
(let ((st (gensym))
(p (gensym))
(a (gensym))
(kg (gensym)))
`#'(lambda (,st)
(let ((,kg ,k))
(let ((,p (funcall ,m ,st)))
(let ((,a (statevalue ,p)))
(funcall (funcall ,kg ,a)
(statestate ,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 sexpression 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 statelet! (decls m)
(reduce #'(lambda (decl m)
(destructuringbind (x e) decl
(let ((st (gensym))
(p (gensym)))
`#'(lambda (,st)
(let ((,p (funcall ,e ,st)))
(let ((,x (statevalue ,p)))
(funcall ,m (statestate ,p))))))))
decls
:fromend t
:initialvalue m))
If we create a multilevel 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 stateprogn! (&body ms)
(reduce #'(lambda (m1 m2)
(let ((st (gensym))
(p (gensym)))
`#'(lambda (,st)
(let ((,p (funcall ,m1 ,st)))
(funcall ,m2 (statestate ,p))))))
ms
:fromend 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 staterun! (m initst)
(let ((p (gensym)))
`(let ((,p (funcall ,m ,initst)))
(list (statevalue ,p)
(statestate ,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 stateget! ()
(let ((st (gensym)))
`#'(lambda (,st)
(makestate ,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 stateput! (newst)
(let ((st (gensym)))
`#'(lambda (,st)
(declare (ignore ,st))
(makestate nil ,newst))))
Macros RUN!, GET!, PUT!, UNIT, FUNCALL!, LET! and PROGN! are implemented as a MACROLET defined by the WITHSTATEMONAD macro.
(defmacro withstatemonad (&body body)
`(macrolet
((unit (a) (list 'stateunit a))
(funcall! (k m) (list 'statefuncall! k m))
(progn! (&body ms) (append '(stateprogn!) ms))
(let! (decls m) (list 'statelet! decls m))
(get! () (list 'stateget!))
(put! (newst) (list 'stateput! newst))
(run! (m initst) (list 'staterun! m initst)))
,@body))
For our old test example
(withstatemonad
(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 CONSpair consisting of the item itself and its sequence number.
(defun statetest (tree)
(labels
((order (tree)
(withstatemonad
(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 ((newn (+ n 1)))
(progn!
(put! newn)
(unit (cons tree newn))))))))))
(destructuringbind (newtree newstate)
(withstatemonad
(run! (order tree) 0))
(format t "Item count=~a~%" newstate)
(format t "New tree=~a~%" newtree))))
Now we can launch a test.
CLUSER> (statetest '(((5 2) 7 4) 5 9))
Item count=6
New tree=((((5 . 1) (2 . 2)) (7 . 3) (4 . 4)) (5 . 5) (9 . 6))
NIL
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 makewriter (a fun)
`(cons ,a ,fun))
(defmacro writervalue (m)
`(car ,m))
(defmacro writerfun (m)
`(cdr ,m))
The next macro creates a composition of the two specified nullable functions, where NIL means the IDENTITY function.
(defmacro writercompose (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 WITHREADERMONAD and will define three additional macros WRITE!, WRITELIST! 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 writerwrite! (&body ws)
(if (= 1 (length ws))
;; An optimized case
(let ((w (nth 0 ws))
(v (gensym)))
`(makewriter nil
(let ((,v ,w))
#'(lambda (xs) (cons ,v xs)))))
;; A general case
(let ((vs (gensym)))
`(makewriter nil
(let ((,vs (list ,@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 WRITELIST! macro prototype takes the value lists and saves their values in the log. The macro returns NIL in the monad as well.
(defmacro writerwritelist! (&body wss)
(if (= 1 (length wss))
;; An optimized case
(let ((ws (nth 0 wss))
(vs (gensym)))
`(makewriter nil
(let ((,vs ,ws))
#'(lambda (xs) (append ,vs xs)))))
;; A general case
(let ((vss (gensym)))
`(makewriter nil
(let ((,vss (list ,@wss)))
#'(lambda (xs)
(reduce #'append ,vss
:fromend t
:initialvalue 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 writerrun! (m)
(let ((x (gensym))
(fun (gensym)))
`(let ((,x ,m))
(list (writervalue ,x)
(let ((,fun (writerfun ,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 WRITELIST! 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 writerunit (a)
`(makewriter ,a nil))
The FUNCALL! macro is more complicated.
(defmacro writerfuncall! (k m)
(let ((ks (gensym))
(ms (gensym))
(a (gensym))
(ka (gensym)))
`(let* ((,ks ,k) ; save it first
(,ms ,m)
(,a (writervalue ,ms))
(,ka (funcall ,ks ,a)))
(makewriter (writervalue ,ka)
(writercompose (writerfun ,ms)
(writerfun ,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 writerlet! (decls m)
(reduce
#'(lambda (decl m)
(destructuringbind (x e) decl
(let ((es (gensym))
(ms (gensym)))
`(let* ((,es ,e)
(,x (writervalue ,es))
(,ms ,m)) ; depends on x!
(makewriter (writervalue ,ms)
(writercompose (writerfun ,es)
(writerfun ,ms)))))))
decls
:fromend t
:initialvalue 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 writerprogn! (&body ms)
(reduce
#'(lambda (m1 m2)
(let ((m1s (gensym))
(m2s (gensym)))
`(let ((,m1s ,m1)
(,m2s ,m2))
(makewriter (writervalue ,m2s)
(writercompose (writerfun ,m1s)
(writerfun ,m2s))))))
ms
:fromend t))
Macros WRITE!, WRITELIST!, RUN!, UNIT, FUNCALL!, PROGN! and LET! are implemented as a MACROLET defined by macro WITHWRITERMONAD.
(defmacro withwritermonad (&body body)
`(macrolet
((unit (a) (list 'writerunit a))
(funcall! (k m) (list 'writerfuncall! k m))
(progn! (&body ms) (append '(writerprogn!) ms))
(let! (decls m) (list 'writerlet! decls m))
(write! (&body ws) (append '(writerwrite!) ws))
(writelist! (&body wss) (append '(writerwritelist!) wss))
(run! (m) (list 'writerrun! m)))
,@body))
Now we can take our old example
(withwritermonad
(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 shortliving CONSpairs 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 shortliving CONSpairs.
The next example illustrates the use of the WITHWRITERMONAD macro.
(defun writertest ()
(destructuringbind (a log)
(withwritermonad
(run!
(progn!
(write! 1)
(write! 2 3 4)
(writelist! '(5 6))
(writelist! '(7) '(8) '(9))
(unit 'ok))))
(format t "Computed value = ~a~%" a)
(format t "Written log = ~a~%" log)))
This is its output.
CLUSER> (writertest)
Computed value = OK
Written log = (1 2 3 4 5 6 7 8 9)
NIL
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 WITHREADERMONADTRANS, WITHWRITERMONADTRANS and WITHSTATEMONADTRANS. 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:
(withreadermonadtrans (withwritermonad)
;; It works within the WITHREADERMONADTRANS macro
(let! ((x (read!)))
;; It calls WRITE! within the WITHWRITERMONAD macro
(lift!
(withwritermonad
(write! x)))))
For this case we can create a separate monad macro and define the WRITE! macro on more high level using LIFT!
(defmacro withreaderwritermonad (&body body)
`(withreadermonadtrans (withwritermonad)
(macrolet
((write! (&body bs)
`(lift!
(withwritermonad
(write! ,@bs)))))
,@body)))
The monad transformer macros can be nested.
(withreadermonadtrans
(withwritermonadtrans
(withmaybemonad))
(progn!
;; It evaluates (f x) within
;; the WITHWRITERMONADTRANS macro
(lift!
(withwritermonadtrans (withmaybemonad)
(f x)))
;; It evaluates (g x) within
;; the WITHMAYBEMONAD macro
(lift!
(lift!
(withmaybemonad
(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 withsomemonadtrans
(innermonad &body body)
`(withmonadtrans
(withsomemonadtrans ,innermonad)
(macrolet
;; Definitions of UNIT, FUNCALL!, PROGN!, LET!
;; and possibly some other macros
,@body)))
Note how the definition of WITHSOMEMONADTRANS recursively refers to itself. It is important.
WITHMONADTRANS s a utility macro that allows the monad transformer implementer to use two auxiliary macros WITHINNERMONADTRANS and WITHOUTERMONADTRANS in accordance with the following scheme.
(withsomemonadtrans (withinnermonad)
;; Here the WITHSOMEMONADTRANS macro is active
(withinnermonadtrans (uniqueid)
;; Here the WITHINNERMONAD macro is active, i.e.
;; a macro specified in the parameter
(withoutermonadtrans (uniqueid)
;; Here the WITHSOMEMONADTRANS macro
;; is active again
...)))
Here the WITHINNERMONADTRANS macro must precede the WITHOUTERMONADTRANS macro. UNIQUEID 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 WITHMONADTRANS macro has the following definition.
(defmacro withmonadtrans (outermonad &body
body)
(let ((innermonad (cadr outermonad)))
`(macrolet
((withinnermonadtrans (id &body bs)
(append '(withinnermonadprototype)
(list ',outermonad)
(list ',innermonad)
(list id)
bs))
(withoutermonadtrans (id &body bs)
(append id bs)))
,@body)))
Please note that an implementation of the WITHOUTERMONADTRANS 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 WITHMONADTRANS. The WITHOUTERMONADTRANS macro is expanded to a call of the macro represented by parameter id. The last macro must be already created by WITHINNERMONADPROTOTYPE before the inner monad macro is activated  this is why an order of precedence is important.
(defmacro withinnermonadprototype
(outermonad innermonad id &body body)
`(macrolet ((,@id (&body bs) (append ',outermonad bs)))
(,@innermonad
,@body)))
The key point is that the WITHINNERMONADPROTOTYPE macro, i.e. WITHINNERMONADTRANS, creates a new macro that is expanded already to the outer monad macro, which name was passed as a parameter of WITHMONADTRANS if you remember. The name of this new generated macro is defined by the value of parameter id. But WITHOUTERMONADTRANS 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 WITHMONADTRANS 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 WITHMONADTRANS, WITHINNERMONADTRANS and WITHOUTERMONADTRANS 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.
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 INNERUNIT, INNERFUNCALL!, INNERLET! and INNERPROGN! 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 INNERUNIT macro prototype is as follows.
(defmacro genericinnerunit (a)
(let ((id (gensym)))
`(withinnermonadtrans (,id)
(unit
(withoutermonadtrans (,id)
,a)))))
Please note that expression a is evaluated within the outer monad. It will be a general rule.
The INNERFUNCALL! macro prototype is similar.
(defmacro genericinnerfuncall! (k m)
(let ((id (gensym)))
`(withinnermonadtrans (,id)
(funcall!
(withoutermonadtrans (,id) ,k)
(withoutermonadtrans (,id) ,m)))))
The INNERLET! macro prototype is analogous.
(defmacro genericinnerlet! (decls m)
(reduce
#'(lambda (decl m)
(destructuringbind (x e) decl
(let ((id (gensym)))
`(withinnermonadtrans (,id)
(let! ((,x (withoutermonadtrans (,id) ,e)))
(withoutermonadtrans (,id) ,m))))))
decls
:fromend t
:initialvalue 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 INNERPROGN! macro prototype is more optimal.
(defmacro genericinnerprogn! (&body ms)
(let ((id (gensym)))
(let ((outerms (loop for m in ms collect
`(withoutermonadtrans (,id) ,m))))
`(withinnermonadtrans (,id)
(progn! ,@outerms)))))
Macros INNERUNIT, INNERFUNCALL!, INNERLET! and INNERPROGN! are implemented as a part of the MACROLET construct defined by macro WITHMONADTRANS.
(defmacro withmonadtrans (outermonad &body
body)
(let ((innermonad (cadr outermonad)))
`(macrolet
((withinnermonadtrans (id &body bs)
(append '(withinnermonadprototype)
(list ',outermonad)
(list ',innermonad)
(list id)
bs))
(withoutermonadtrans (id &body bs)
(append id bs))
;;
(innerunit (a) (list 'genericinnerunit a))
(innerfuncall! (k m) (list 'genericinnerfuncall! k m))
(innerprogn! (&body ms) (append '(genericinnerprogn!) ms))
(innerlet! (decls m) (list 'genericinnerlet! decls m)))
,@body)))
In most cases these new macros INNERUNIT, UNNERFUNCALL!, INNERLET! and INNERPROGN! cover all the needs and make low level macros WITHINNERMONADTRANS and WITHOUTERMONADTRANS unnecessary for the practical use in your code.
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 INNERUNIT, INNERFUNCALL!, INNERLET! and INNERPROGN! introduced above.
I’ll define macro WITHREADERMONADTRANS based on the WITHMONADTRANS macro. Therefore the specified helper macros will be accessible.
The UNIT macro prototype uses INNERUNIT.
(defmacro readertransunit (a)
(let ((r (gensym)))
`#'(lambda (,r)
(declare (ignore ,r))
(innerunit ,a))))
Please note that expression a is evaluated in the context of the WITHREADERMONADTRANS 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 nonparameterized version.
(defmacro readertransfuncall! (k m)
(let ((r (gensym))
(a (gensym))
(kg (gensym)))
`#'(lambda (,r)
(let ((,kg ,k))
(innerlet! ((,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 nonparameterized 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 readertranslet! (decls m)
(reduce #'(lambda (decl m)
(destructuringbind (x e) decl
(let ((r (gensym)))
`#'(lambda (,r)
(innerlet! ((,x (funcall ,e ,r)))
(funcall ,m ,r))))))
decls
:fromend t
:initialvalue m))
We only replaced LET with INNERLET! to take a value from the inner computation.
The PROGN! macro prototype uses INNERPROGN! to bind the inner computations.
(defmacro readertransprogn! (&body ms)
(reduce #'(lambda (m1 m2)
(let ((r (gensym)))
`#'(lambda (,r)
(innerprogn!
(funcall ,m1 ,r)
(funcall ,m2 ,r)))))
ms
:fromend 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 INNERUNIT macro to wrap the environment value in the inner monad.
(defmacro readertransread! ()
(let ((r (gensym)))
`#'(lambda (,r)
(innerunit ,r))))
The RUN! macro prototype is the same, but now it returns a computation result wrapped in the inner monad.
(defmacro readertransrun! (m r)
`(funcall ,m ,r))
So far, the macros defined replicate the interface of the WITHREADERMONAD 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 readertranslift! (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 WITHREADERMONADTRANS macro, which in its turn follows a common pattern described in section Monad Transformers.
(defmacro withreadermonadtrans (innermonad
&body body)
`(withmonadtrans (withreadermonadtrans ,innermonad)
(macrolet
((unit (a) (list 'readertransunit a))
(funcall! (k m) (list 'readertransfuncall! k m))
(progn! (&body ms) (append '(readertransprogn!) ms))
(let! (decls m) (list 'readertranslet! decls m))
(read! () (list 'readertransread!))
(run! (m r) (list 'readertransrun! m r))
(lift! (m) (list 'readertranslift! m)))
,@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.
(withreadermonadtrans (withmaybemonad)
(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 readertranstest ()
(destructuringbind (a log)
(withwritermonad
(run!
(withreadermonadtrans (withwritermonad)
(run!
(let! ((x (read!)))
(progn!
(lift!
(withwritermonad
(write! x)))
(unit 'ok)))
10))))
(format t "Computed value=~a~%" a)
(format t "Written log=~a~%" log)))
This is its output.
CLUSER> (readertranstest)
Computed value=OK
Written log=(10)
NIL
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 INNERUNIT, INNERFUNCALL!, INNERLET! and INNERPROGN! provided by the WITHMONADTRANS macro.
I’ll define a new macro WITHSTATEMONADTRANS based on WITHMONADTRANS in accordance with the general pattern described in section Monad Transformers. Also the new macro will be similar to its nonparameterized counterpart WITHSTATEMONAD. The WITHSTATEMONADTRANS 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 INNERUNIT to wrap a pair in the inner monad.
(defmacro statetransunit (a)
(let ((st (gensym)))
`#'(lambda (,st)
(innerunit
(makestate ,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 INNERLET! to get a raw value from the inner monad.
(defmacro statetransfuncall! (k m)
(let ((st (gensym))
(p (gensym))
(a (gensym))
(kg (gensym)))
`#'(lambda (,st)
(let ((,kg ,k))
(innerlet! ((,p (funcall ,m ,st)))
(let ((,a (statevalue ,p)))
(funcall (funcall ,kg ,a)
(statestate ,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 sexpression 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 statetranslet! (decls m)
(reduce #'(lambda (decl m)
(destructuringbind (x e) decl
(let ((st (gensym))
(p (gensym)))
`#'(lambda (,st)
(innerlet! ((,p (funcall ,e ,st)))
(let ((,x (statevalue ,p)))
(funcall ,m (statestate ,p))))))))
decls
:fromend t
:initialvalue m))
Here expressions e and m are monad values, i.e. anonymous functions. Moreover, if we create a multilevel LET! expression then the sexpression for m is available for all cases but probably the last. This sexpression 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 statetransprogn! (&body ms)
(reduce #'(lambda (m1 m2)
(let ((st (gensym))
(p (gensym)))
`#'(lambda (,st)
(innerlet! ((,p (funcall ,m1 ,st)))
(funcall ,m2 (statestate ,p))))))
ms
:fromend 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 statetransrun! (m initst)
(let ((p (gensym)))
`(innerlet! ((,p (funcall ,m ,initst)))
(innerunit
(list (statevalue ,p)
(statestate ,p))))))
The GET! macro prototype returns the current state wrapped in the outer monad.
(defmacro statetransget! ()
(let ((st (gensym)))
`#'(lambda (,st)
(innerunit
(makestate ,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 statetransput! (newst)
(let ((st (gensym)))
`#'(lambda (,st)
(declare (ignore ,st))
(innerunit
(makestate nil ,newst)))))
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 statetranslift! (m)
(let ((st (gensym))
(a (gensym)))
`#'(lambda (,st)
(innerlet! ((,a ,m))
(innerunit
(makestate ,a ,st))))))
Macros GET!, PUT!, RUN!, LIFT!, UNIT, FUNCALL!, LET! and PROGN! are implemented as a MACROLET defined by the WITHSTATEMONADTRANS macro that follows a common pattern of the monad transformer macros.
(defmacro withstatemonadtrans (innermonad
&body body)
`(withmonadtrans (withstatemonadtrans ,innermonad)
(macrolet
((unit (a) (list 'statetransunit a))
(funcall! (k m) (list 'statetransfuncall! k m))
(progn! (&body ms) (append '(statetransprogn!) ms))
(let! (decls m) (list 'statetranslet! decls m))
(get! () (list 'statetransget!))
(put! (newst) (list 'statetransput! newst))
(run! (m initst) (list 'statetransrun! m initst))
(lift! (m) (list 'statetranslift! m)))
,@body)))
The code generation can be illustrated on the following example.
(withstatemonadtrans (withmaybemonad)
(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 CONSpair, 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 statetranstest (tree)
(labels
((order (tree)
(withstatemonadtrans (withwritermonad)
(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 ((newn (+ n 1)))
(progn!
(lift!
(withwritermonad
(write! tree)))
(put! newn)
(unit (cons tree newn))))))))))
(destructuringbind ((newtree newstate) savedlog)
(withwritermonad
(run!
(withstatemonadtrans (withwritermonad)
(run! (order tree) 0))))
(format t "Item count=~a~%" newstate)
(format t "New tree=~a~%" newtree)
(format t "Written log=~a~%" savedlog))))
Now we can launch a test.
CLUSER> (statetranstest '(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 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 WITHMONADTRANS macro that contains definitions of INNERUNIT, INNERLET!, INNERFUNCALL! and INNERPROGN! that allow us to work with the parameter monad.
So, I’ll define macro WITHWRITERMONADTRANS that will be based on the WITHMONADTRANS macro in accordance with the general pattern described in section Monad Transformers. This new macro will be similar to the WITHWRITERMONAD 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 INNERUNIT macro as we have to wrap a CONSpair created with help of MAKEWRITER.
(defmacro writertranswrite! (&body ws)
(if (= 1 (length ws))
;; An optimized case
(let ((w (nth 0 ws))
(v (gensym)))
`(innerunit
(makewriter nil
(let ((,v ,w))
#'(lambda (xs) (cons ,v xs))))))
;; A general case
(let ((vs (gensym)))
`(innerunit
(makewriter nil
(let ((,vs (list ,@ws)))
#'(lambda (xs)
(append ,vs xs))))))))
The WRITELIST! macro prototype is similar. It also returns NIL in the outer monad.
(defmacro writertranswritelist! (&body wss)
(if (= 1 (length wss))
;; An optimized case
(let ((ws (nth 0 wss))
(vs (gensym)))
`(innerunit
(makewriter nil
(let ((,vs ,ws))
#'(lambda (xs) (append ,vs xs))))))
;; A general case
(let ((vss (gensym)))
`(innerunit
(makewriter nil
(let ((,vss (list ,@wss)))
#'(lambda (xs)
(reduce #'append ,vss
:fromend t
:initialvalue 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 writertransrun! (m)
(let ((x (gensym))
(fun (gensym)))
`(innerlet! ((,x ,m))
(innerunit
(list (writervalue ,x)
(let ((,fun (writerfun ,x)))
(if (not (null ,fun))
(funcall ,fun nil))))))))
The UNIT macro prototype also uses the INNERUNIT macro to wrap a value in the inner monad.
(defmacro writertransunit (a)
`(innerunit
(makewriter ,a nil)))
Please note that expression a is expanded within the outer monad macro, i.e. within WITHWRITERMONADTRANS, for which the INNERUNIT macro is responsible.
The FUNCALL! macro prototype is also similar to its nonparameterized counterpart.
(defmacro writertransfuncall! (k m)
(let ((ks (gensym))
(ms (gensym))
(a (gensym))
(ka (gensym)))
`(let ((,ks ,k))
(innerlet! ((,ms ,m))
(let ((,a (writervalue ,ms)))
(innerlet! ((,ka (funcall ,ks ,a)))
(innerunit
(makewriter (writervalue ,ka)
(writercompose (writerfun ,ms)
(writerfun ,ka))))))))))
As usual, the LET! macro prototype is more optimal.
(defmacro writertranslet! (decls m)
(reduce
#'(lambda (decl m)
(destructuringbind (x e) decl
(let ((es (gensym))
(ms (gensym)))
`(innerlet! ((,es ,e))
(let ((,x (writervalue ,es)))
(innerlet! ((,ms ,m))
(innerunit
(makewriter (writervalue ,ms)
(writercompose (writerfun ,es)
(writerfun ,ms))))))))))
decls
:fromend t
:initialvalue m))
The PROGN! macro prototype was also slightly modified.
(defmacro writertransprogn! (&body ms)
(reduce
#'(lambda (m1 m2)
(let ((m1s (gensym))
(m2s (gensym)))
`(innerlet! ((,m1s ,m1)
(,m2s ,m2))
(innerunit
(makewriter (writervalue ,m2s)
(writercompose (writerfun ,m1s)
(writerfun ,m2s)))))))
ms
:fromend 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 writertranslift! (m)
(let ((a (gensym)))
`(innerlet! ((,a ,m))
(innerunit
(makewriter ,a nil)))))
Macros LIFT!, WRITE!, WRITELIST!, UNIT, FUNCALL!, LET! and PROGN! are implemented as a MACROLET defined by macro WITHWRITERMONADTRANS, which in its turn follows a common pattern of the monad transformer macros.
(defmacro withwritermonadtrans (innermonad
&body body)
`(withmonadtrans (withwritermonadtrans ,innermonad)
(macrolet
((unit (a) (list 'writertransunit a))
(funcall! (k m) (list 'writertransfuncall! k m))
(progn! (&body ms) (append '(writertransprogn!) ms))
(let! (decls m) (list 'writertranslet! decls m))
(write! (&body ws) (append '(writertranswrite!) ws))
(writelist! (&body wss) (append '(writertranswritelist!)
wss))
(run! (m) (list 'writertransrun! m))
(lift! (m) (list 'writertranslift! m)))
,@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
(withwritermonadtrans
(withreadermonadtrans
(withmaybemonad))
(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 writertranstest ()
(let ((m (withwritermonadtrans (withmaybemonad)
(run!
(progn!
(write! 1)
(write! 2 3)
(lift! (makemaybe)) ; FAIL
(writelist! '(4 5 6))
(unit 'ok))))))
(if (maybejustp m)
(progn
(destructuringbind (a log) (maybejust 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.
CLUSER> (writertranstest)
Computation was interrupted
NIL
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 WITHWRITERMONADTRANS (WITHREADERMONADTRANS (WITHMAYBEMONAD)).
First, we create a short name for our source macro, lifting the READ! macro from the Writer monad transformer.
(defmacro withoptproto (&body body)
`(withwritermonadtrans
(withreadermonadtrans
(withmaybemonad))
(macrolet
((read! ()
`(lift!
(withreadermonadtrans
(withmaybemonad)
(read!)))))
,@body)))
This new macro provides macros READ!, WRITE!, WRITERLIST!, RUN!, LIFT!, UNIT, FUNCALL!, LET! and PROGN!. Now we’ll create functions for them, i.e. all macros will be expanded only once.
(defun optread! ()
(withoptproto
(read!)))
(defun optwrite! (&rest ws)
(withoptproto
(if (= 1 (length ws))
(write! (nth 0 ws))
(writelist! ws))))
(defun optwritelist! (&rest wss)
(withoptproto
(if (= 1 (length wss))
(writelist! (nth 0 wss))
(reduce #'(lambda (ws m)
(progn! (writelist! ws) m))
wss
:fromend t
:initialvalue (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 WITHREADERMONADTRANS (WITHMAYBEMONAD). 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 optrun! (m r)
(withreadermonadtrans (withmaybemonad)
(run! (withoptproto
(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 MAKEMAYBE function, and the new function returns the corresponded computation wrapped in the outer monad WITHOPTPROTO.
(defun optlift! (m)
(withoptproto
(lift!
(withreadermonadtrans (withmaybemonad)
(lift! m)))))
Now we can define the return and bind functions.
(defun optunit (a)
(withoptproto
(unit a)))
(defun optfuncall! (k m)
(withoptproto
(funcall! k m)))
We have all functions to define a new monad macro with help of the WITHMONAD 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 withoptmonad (&body body)
`(withmonad (optunit optfuncall!)
(macrolet
((read! () `(optread!))
(write! (&body bs) `(optwrite! ,@ bs))
(writelist! (&body bs) `(optwritelist! ,@bs))
(run! (m r) `(optrun! ,m ,r))
(lift! (m) `(optlift! ,m)))
,@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 WITHREADERMONADTRANS (WITHMAYBEMONAD) to new macro WITHREADERMAYBEMONAD. Then we could reduce macro WITHWRITERMONADTRANS (WITHREADERMAYBEMONAD) to form WITHALTOPTMONAD, which would be equivalent to the WITHOPTMONAD 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 opttest ()
(let ((m (withoptmonad
(run!
(progn!
(write! 1)
(write! 2 3)
(writelist! '(4 5 6))
(let! ((x (read!)))
(lift! (makemaybe :just x))))
10))))
(if (maybejustp m)
(progn
(destructuringbind (a log) (maybejust m)
(format t "Computed value=~a~%" a)
(format t "Written log=~a~%" log)))
(format t "Computation was interrupted~%"))))
The test returns the following results.
CLUSER> (opttest)
Computed value=10
Written log=(1 2 3 4 5 6)
NIL
The monad macros can perfectly coexist with the standard constructions IF, COND, PROGN, LET, LET*, FLET, LABELS, MACROLET, SYMBOLMACROLET, 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.
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 WITHMONAD.
In general case we can define a prototype for the functor map function, which I’ll call FMAP.
(defmacro genericfmap (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 listfmap (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 nonoptimized 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
:fromend t
:initialvalue (unit ())))
In case of the WITHIDENTITYMONAD macro the LIST! macro can be replaced with function LIST, which corresponds to the rule of thumb.
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.