Sorry, I made a small typo:

(defun flatten/fold-rigth (list)
š (fold-rigth #'(lambda (e rest)
ššššššššššššššššš (typecase e
ššššššššššššššššššš (atom (cons e rest))
ššššššššššššššššššš - (list (append (flatten e) rest))
ššššššššššššššššššš + (list (append (flatten/fold-rigth e) rest))))
ššššššššššššš list nil))

But this, of course, does not affect the benchmark
.

2010/8/8 Heka Treep <zena.treep@gmail.com>
Hi.

I was found that there is no effective fold operators on lists or trees in CL. I know that `reduce' can do this (as an article in Wikipedia sayz) but `reduce' is not very effective. As stated in the Graham Hutton's article ``fold is a standard operator that encapsulates a simple pattern of recursion for processing lists'', also catamorphism at some ADT plays the same role. So I thought that if we introduce an effective fold operators, it becomes possible to express many functions through its shortly and effectively (in fact, almost any function on that ADT).

Take for example the `flatten' function that is defined in Alexandria as follows:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ok, TCO recursion:
;;
(defun flatten (tree)
š (let (list)
ššš (labels ((traverse (subtree)
šššššššššššššš (when subtree
šššššššššššššššš (if (consp subtree)
šššššššššššššššššššš (progn
šššššššššššššššššššššš (traverse (car subtree))
šššššššššššššššššššššš (traverse (cdr subtree)))
šššššššššššššššššššš (push subtree list)))))
ššššš (traverse tree))
ššš (nreverse list)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

We need an ADT for the trees, but in the first approximation we can use nested lists.

When expressed in terms of reduce:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun flatten/reduce (list)
š (reduce #'(lambda (e rest)
ššššššššššššššššš (typecase e
ššššššššššššššššššš (atom (cons e rest))
ššššššššššššššššššš (list (append (flatten/reduce e) rest))))
ššššššššš list
ššššššššš :initial-value nil
ššššššššš :from-end t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Now if we translate pure functional operator (here is `reduce') to the instructions for tagbody/go "state machine":

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; fold-left f '(a b c) i
;;;
;;;šššššš f
;;;ššššš /\
;;;šššš fš c
;;;ššš /\
;;;šš fš b
;;;š /\
;;; iš a
;;;
;;; foldl f z []šššš = z
;;; foldl f z (x:xs) = foldl f (f z x) xs

(defun fold-left (function list &optional initial-value)
š (let ((result initial-value))
ššš (tagbody
šššš :start
šššš (unless (endp list)
šššššš (setq result (funcall function result (car list)))
šššššš (setq list (cdr list))
šššššš (go :start)))
ššš result))

;;; fold-rigth f '(a b c) i
;;;
;;;šš f
;;;š /\
;;; aš f
;;;ššš /\
;;;šš bš f
;;;ššššš /\
;;;šššš cš i
;;;
;;; foldr f z []šššš = z
;;; foldr f z (x:xs) = f x (foldr f z xs)

(defun fold-rigth (function list &optional initial-value)
š (let ((result initial-value)
ššššššš (list (nreverse list)))
ššš (tagbody
šššš :start
šššš (unless (endp list)
šššššš (setq result (funcall function (car list) result))
šššššš (setq list (cdr list))
šššššš (go :start)))
ššš result))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Then `flatten' can be written as:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun flatten/fold-rigth (list)
š (fold-rigth #'(lambda (e rest)
ššššššššššššššššš (typecase e
ššššššššššššššššššš (atom (cons e rest))
ššššššššššššššššššš (list (append (flatten e) rest))))
ššššššššššššš list nil))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

I try to benchmarc (this three functions) and has the following results:

flatten/fold-rigth

X time
Y memory

alexandria:flatten

10 * X time
23 * Y memory

flatten/reduce

42 * X time
83 * Y memory

So, its look resonable to use folders there.



((sorry for my english - I just using google.translate :))