A small-ish generator example in common-lisp
Matthew D Swank
so I thought I would show a common-lisp example of a generator.
;;;I start out with a continuation datatype:
(defclass continuation ()
((func-object :initarg :func-object :reader func-object)))
;;((A -> Answer) -> Answer) -> (continuation-of A) -- a funcallable tag
(defun continuation (fun)
(make-instance 'continuation :func-object fun))
(defmethod unit ((type (eql 'continuation)) val)
(continuation #'(lambda (current) (funcall current val))))
(defmethod bind ((monad-val continuation) next)
(continuation #'(lambda (current)
(funcall (func-object monad-val)
(lambda (val)
(funcall (func-object (funcall next val))
current))))))
(defmethod run ((monad-val continuation))
(funcall (func-object monad-val) #'identity))
;;;((A -> continuation) -> continuation) -> continuation
(defun call/cc (entry-point)
(continuation #'(lambda (current)
(flet ((escape (val)
;;compare with unit
(continuation #'(lambda (final)
(declare (ignore final))
(funcall current val)))))
;;compare with bind
(funcall (func-object (funcall entry-point #'escape))
current)))))
;;;add a helper macro
;;;just like its says: sequential evaluation threaded with binds
(defmacro monad-progn (&body forms)
(labels ((make-bind-seq (forms)
(cond ((null forms)
nil)
((null (cdr forms))
(car forms))
(t (let ((_ (gensym)))
`(bind ,(car forms)
#'(lambda(,_)
(declare (ignore ,_))
,(make-bind-seq (cdr forms)))))))))
(make-bind-seq forms)))
;;; and define a generator facility
(defconstant gen-nil (unit 'continuation nil))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun generator-body (body)
(let ((escape (gensym)))
`(call/cc
#'(lambda (,escape)
(flet ((yield (x)
(call/cc
#'(lambda (escape1)
(funcall ,escape (cons escape1 x))))))
(monad-progn
,@body
gen-nil)))))))
(defmacro defgen (name args &body body)
`(defun ,name ,args
,(generator-body body)))
(defun next (generator &optional return-value)
(let ((gen-pair (run generator)))
(if (null gen-pair)
(values nil nil)
(destructuring-bind (gen . val) gen-pair
(values (funcall gen return-value) val)))))
;;here's an example
;;; the generator needs to written in a monadic style
;;; defgen binds the function yield in the body
(defgen leaves (tree)
(labels ((leaves (tree)
(cond ((null tree)
gen-nil)
((and (null (cadr tree)) (null (cddr tree)))
(yield (car tree)))
(t (monad-progn
(leaves (cadr tree))
(leaves (cddr tree)))))))
(leaves tree)))
;;; the consumer uses next to iterate through the generator
;;; the interface shares a lot of similarities with lazy-lists
(defun same-fringe (t1 t2 &optional (pred #'eql))
(labels ((luup (gen1 gen2)
(multiple-value-bind (gen1 val1) (next gen1)
(multiple-value-bind (gen2 val2) (next gen2)
(cond ((and (null gen1) (null gen2)) t)
((or (null gen1) (null gen2)) nil)
((funcall pred val1 val2)
(luup gen1 gen2))
(t nil))))))
(or (eq t1 t2)
(luup (leaves t1) (leaves t2)))))
#|
(same-fringe '(3 (2 (1 NIL)) 5 (4 NIL) 6 NIL)
'(3 (2 (1 NIL)) 5 (4 NIL) 6 NIL))
==> T
(same-fringe '(3 (2 (0 NIL)) 5 (4 NIL) 6 NIL)
'(3 (2 (1 NIL)) 5 (4 NIL) 6 NIL))
==> NIL
(same-fringe '(3 (2 (1 NIL)) 5 (4 NIL) 6 NIL)
'(0 (2 (1 NIL)) 5 (4 NIL) 6 NIL))
==> T
|#
Matt
--
"You do not really understand something unless you can
explain it to your grandmother." — Albert Einstein.
John Thingstad
<akopa-is-very-much-...@c.net> wrote:
Interesting
You might want to look into Curry
I think it would simplify the implementation
--
Using Opera's revolutionary e-mail client: http://www.opera.com/mail/
Matthew D Swank
> On Thu, 23 Mar 2006 23:47:46 +0100, Matthew D Swank
> <akopa-is-very-much-...@c.net> wrote:
> Interesting
> You might want to look into Curry
> I think it would simplify the implementation
Do you mean http://www.informatik.uni-kiel.de/~curry/ ?
I'm not sure how that relates to Common Lisp.
John Thingstad
<akopa-is-very-much-...@c.net> wrote:
> On Fri, 24 Mar 2006 09:34:53 +0100, John Thingstad wrote:
>
>> On Thu, 23 Mar 2006 23:47:46 +0100, Matthew D Swank
>> <akopa-is-very-much-...@c.net> wrote:
>> Interesting
>> You might want to look into Curry
>> I think it would simplify the implementation
>
> Do you mean http://www.informatik.uni-kiel.de/~curry/ ?
> I'm not sure how that relates to Common Lisp.
>
> Matt
Not exaclty. Haskell Brooks Curry is a mathematician from which
both languages Haskel and Curry are named after.
What I was refering to is a programming tequnique called currying.
http://en.wikipedia.org/wiki/Currying
It is the lightweight cusin of monads.
Matthew D Swank
> Haskell Brooks Curry is a mathematician from which
> both languages Haskel and Curry are named after.
> What I was refering to is a programming tequnique called currying.
> http://en.wikipedia.org/wiki/Currying
> It is the lightweight cusin of monads.
I am familiar with the technique. In fact, the first cps transformer I
ever wrote was curried. Your use of curry as a proper noun confused me a
little.
The example I posted was an attempt to post a usable, if
primitive generator facility in Common Lisp with as little auxiliary code
as I could manage. Of course I saw ways to simplify it almost immediately
after I posted it, but, as the say in the Perl community, "Warnock
applies". The relatively sparse response to the post didn't encourage me
to modify the code any further.
Sorry I misunderstood you.
Rob Warnock
| Of course I saw ways to simplify it almost immediately
| after I posted it, but, as the say in the Perl community,
| "Warnock applies".
Interesting. I'd never heard of this one before. (Of course,
it's named for *Bryan*, not John [no relation either] or me...) ;-}
-Rob
-----
Rob Warnock <rp...@rpw3.org>
627 26th Avenue <URL:http://rpw3.org/>
San Mateo, CA 94403 (650)572-2607
Joe Marshall
Rob Warnock wrote:
> Matthew D Swank <akopa-is-very-much-...@c.net> wrote:
> +---------------
> | Of course I saw ways to simplify it almost immediately
> | after I posted it, but, as the say in the Perl community,
> | "Warnock applies".
> +---------------
>
> Interesting. I'd never heard of this one before. (Of course,
> it's named for *Bryan*, not John [no relation either] or me...) ;-}
In this group `Warnock evals.'
John Thingstad
<akopa-is-very-much-...@c.net> wrote:
> On Mon, 27 Mar 2006 00:25:42 +0200, John Thingstad wrote:
>
>> Haskell Brooks Curry is a mathematician from which
>> both languages Haskel and Curry are named after.
>> What I was refering to is a programming tequnique called currying.
>> http://en.wikipedia.org/wiki/Currying
>> It is the lightweight cusin of monads.
>
> I am familiar with the technique. In fact, the first cps transformer I
> ever wrote was curried. Your use of curry as a proper noun confused me a
> little.
> The example I posted was an attempt to post a usable, if
> primitive generator facility in Common Lisp with as little auxiliary code
> as I could manage. Of course I saw ways to simplify it almost
> immediately
> after I posted it, but, as the say in the Perl community, "Warnock
> applies". The relatively sparse response to the post didn't encourage me
> to modify the code any further.
>
> Sorry I misunderstood you.
>
> Matt
>
I encourage you to try some more.
I thought your code looked great.
Thought it could use some improvements
don't let the slow response here slow
you down.
Philippe Lorin
> I suppose this is a little long but coroutines have come up a bit lately,
Thank you for this code. I am trying to use it, but I cannot say I
understand it fully. I probably need to spend more time with
continuations and monads. Even the most basic thing is baffling me: I'm
trying to write the equivalent of the following Scheme code:
(call/cc (lambda (k) (k 42)))
My guess is it should look like this:
(call/cc (lambda (k) (funcall (func-object k) 42)))
...but this returns a continuation. What am I doing wrong?
Matthew D Swank
> Interesting
> You might want to look into Curry
> I think it would simplify the implementation
Well the monadic formulation of continuations effectively adds the
continuation in CPS code as a curried argument:
;;CPS
(defun (add a b k)
(funcall k (+ a b)))
;;Monadic
(defun (add a b)
(lambda (k)
(funcall k (+ a b))))
As far as simplifying the implementation, not using call/cc would help.
(defclass continuation ()
((func-object :initarg :func-object :reader func-object)))
;;((A -> Answer) -> Answer) -> (continuation-of A) -- a funcallable tag
(defun continuation (fun)
(make-instance 'continuation :func-object fun))
(defmethod unit ((type (eql 'continuation)) val)
(continuation #'(lambda (current) (funcall current val))))
(defmethod bind ((monad-val continuation) next)
(continuation #'(lambda (current)
(funcall (func-object monad-val)
(lambda (val)
(funcall (func-object (funcall next val))
current))))))
(defmethod run ((monad-val continuation))
(funcall (func-object monad-val) #'identity))
;;I can define yield as a regular, top-level function:
(defun yield (val)
(continuation #'(lambda (current)
(cons current val))))
;;add a run method for cons (prolly means yields should be their own class)
(defmethod run ((monad-val cons))
monad-val)
;;redefine defgen:
(defmacro defgen (name args &body body)
`(defun ,name ,args
(monad-progn
,@body
gen-nil)))
;;and the rest of the code should work unchanged
(defmacro monad-progn (&body forms)
(cond ((null forms)
nil)
((null (cdr forms))
(car forms))
(t (let ((_ (gensym)))
`(bind ,(car forms)
#'(lambda(,_)
(declare (ignore ,_))
(monad-progn ,@(cdr forms))))))))
(defconstant gen-nil (unit 'continuation nil))
(defun next (generator &optional return-value)
==> T
|#
Matthew D Swank
Well, k is just a normal function so you don't have to use func-object.
Also, once you have a continuation object you can see what it evaluates
too by running it. So:
(run (call/cc (lambda (k) (funcall k 42))))
=> 42
If using the datatype is confusing you can also use this simpler
formulation:
;;continuation == (A -> Answer) -> Answer
(defun unit (val)
#'(lambda (current) (funcall current val)))
(defun bind (continuation next)
#'(lambda (current)
(funcall continuation
#'(lambda (val)
(funcall (funcall next val)
current)))))
(defun run (continuation)
(funcall continuation #'identity))
;;;((A -> continuation) -> continuation) -> continuation
(defun call/cc (entry-point)
#'(lambda (current)
(flet ((escape (val)
;;compare with unit
#'(lambda (final)
(declare (ignore final))
(funcall current val))))
;;compare with bind
(funcall (funcall entry-point #'escape)
current))))
Also CPS (Continuation Passing Style) is a little more traditional in
lisp, but I like the monadic form since it seems a little less clunky to
me in code I actually have to read (as opposed to using CPS as a
technique to transform code automatically). However, I am prepared to
believe that mine is a minority opinion among Common Lisp users.
Matthew D Swank
Next is a little too eager.
Delete:
> ;;add a run method for cons (prolly means yields should be their own class)
>
> (defmethod run ((monad-val cons))
> monad-val)
>
and redefine next:
(defun next (generator &optional return-value)
(let ((gen-pair (run generator)))
(if (null gen-pair)
(values nil nil)
(destructuring-bind (gen . val) gen-pair
(values (continuation #'(lambda (current)
(declare (ignore current))
(funcall gen return-value)))
val)))))
Matt
Matthew D Swank
;;forgive the schemism, but I got tired of writing labels
(defmacro luup (name bindings &body loop-body)
`(labels ((,name ,(mapcar #'car bindings)
,@loop-body))
(,name ,@(mapcar #'cadr bindings))))
(defmacro do-generator ((var generator) &body body)
(let ((rest (gensym)))
`(gen-reduce #'(lambda (,rest ,var)
(declare (ignore ,rest))
(monad-progn
,@body))
,generator
nil)))
(defun gen-unit (val)
(unit 'continuation val))
(defun gen-reduce (fun generator init)
(luup monadic-reduce ((generator generator)
(init init))
(if generator
(multiple-value-bind (gen val) (next generator)
(if gen
(bind (funcall fun init val)
#'(lambda (new-init)
(monadic-reduce gen new-init)))
(gen-unit init)))
gen-nil)))
;;I can define this little monster:
(defgen comb (items n)
(if (zerop n)
(yield nil)
(luup do-items ((items items))
(if (null items)
gen-nil
(monad-progn
(let ((gen (comb (cdr items) (1- n))))
(do-generator (cc gen)
(yield (cons (car items) cc))))
(do-items (cdr items)))))))
;;with apologies to Joe Marshall
(defvar *deck*
(mapcan (lambda (value)
(map 'list (lambda (suit)
(cons value suit))
'(:diamonds
:hearts
:clubs
:spades)))
'(:ace 2 3 4 5 6 7 8 9 10 :Jack :Queen :King)))
(defun count-hands (list n pred)
(let ((count 0))
;;prolly would be better to define a non-monadic variant of do
(run (do-generator (h (comb list n))
(if (funcall pred h)
(gen-unit (incf count))
gen-nil)))
count))
(defun pair-or-better (hand)
(destructuring-bind (a b c d e) hand
(or (eql (car a) (car b))
(eql (car a) (car c))
(eql (car a) (car d))
(eql (car a) (car e))
(eql (car b) (car c))
(eql (car b) (car d))
(eql (car b) (car e))
(eql (car c) (car d))
(eql (car c) (car e))
(eql (car d) (car e)))))
#|
(count-hands *deck* 5 (constantly 't))
=> 2598960
(count-hands *deck* 5 #'pair-or-better)
=> 1281072
(count-hands *deck* 5 (complement #'pair-or-better))
=> 1317888
|#
Rob Warnock
+---------------
| > +---------------
| >
| > Interesting. I'd never heard of this one before.
|
ROTFL! Got me... ;-} ;-}
[Though eval'ing also requires apply'ing, in general, and v-v...]
Philippe Lorin
> (defun unit (val)
> #'(lambda (current) (funcall current val)))
Could you explain what UNIT is used for?
Matthew D Swank
It's used to "inject" a value into the continuation monad. Monadic
continuations are just functions, functions that take a particular type of
a function as an argument. Confusingly this argument is also called a
(primitive) continuation.
Maybe a example is in order:
In regular CPS the primitive continuation is passed as an argument:
(defun add (a b k)
(funcall k (+ a b)))
So k takes (+ a b) and spits out an answer.
(add 2 3 #'identity)
=> 5
In monadic continuations instead of passing k to each function, each
function returns a higher order function that will take a primitive
continuation as an argument.
In our example:
(defun add (a b)
#'(lambda (k) (funcall k (+ a b))))
So UNIT encapsulates the operation of passing a value to the current
continuation:
(defun add (a b)
(unit (+ a b)))
(funcall (add 2 3) #'identity)
=> 5
Matthew D Swank
> On Thu, 23 Mar 2006 23:47:46 +0100, Matthew D Swank
> <akopa-is-very-much-...@c.net> wrote:
> Interesting
> You might want to look into Curry
> I think it would simplify the implementation
Well, here is an implementation that curries more directly:
(defclass continuation ()
((func-object :initarg :func-object :reader func-object)))
;;((A -> Answer) -> Answer) -> (continuation-of A) -- a funcallable tag
(defun continuation (fun)
(make-instance 'continuation :func-object fun))
;;A -> (continuation-of A)
(defmethod unit ((type (eql 'continuation)) val)
(continuation #'(lambda (current) (funcall current val))))
;;(continuation-of A) -> Answer
(defmethod run ((val continuation))
(funcall (func-object val) #'identity))
(defun yield (val)
(continuation #'(lambda (current)
(cons current val))))
(defconstant gen-nil (unit 'continuation nil))
;;composes two continuations; binds the result of first to var
(defmacro gen-bind (var first rest)
(let ((current (gensym)))
`(continuation
#'(lambda (,current)
(funcall (func-object ,first)
#'(lambda (,var)
(declare (ignorable ,var))
(funcall (func-object ,rest) ,current)))))))
(defmacro gen-progn (&body body)
(cond ((null body)
nil)
((null (cdr body))
(car body))
(t (let ((_ (gensym)))
`(gen-bind ,_
,(car body)
(gen-progn ,@(cdr body)))))))
(defmacro gen-let* (bindings &body body)
(cond ((null bindings)
`(gen-progn ,@body))
(t `(gen-bind ,(caar bindings)
,(cadar bindings)
(gen-let* ,(cdr bindings)
,@body)))))
(defmacro defgen (name args &body body)
`(defun ,name ,args
(monad-progn
,@body
gen-nil)))
(defun next (generator &optional return-value)
(let ((gen-pair (run generator)))
(if (null gen-pair)
(values nil nil)
(destructuring-bind (gen . val) gen-pair
(values (continuation #'(lambda (current)
(declare (ignore current))
(funcall gen return-value)))
val)))))
Matt