/[cl-utilities]/cl-utilities/compose.lisp
ViewVC logotype

Contents of /cl-utilities/compose.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations)
Thu May 26 19:11:51 2005 UTC (8 years, 11 months ago) by pscott
Branch: MAIN
CVS Tags: HEAD
Changes since 1.3: +4 -0 lines
Added some commentary on single and multiple values.
1 ;; This version of COMPOSE can only handle functions which take one
2 ;; value and return one value. There are other ways of writing
3 ;; COMPOSE, but this is the most commonly used.
4
5 (in-package :cl-utilities)
6
7 ;; This is really slow and conses a lot. Fortunately we can speed it
8 ;; up immensely with a compiler macro.
9 (defun compose (&rest functions)
10 "Compose FUNCTIONS right-associatively, returning a function"
11 #'(lambda (x)
12 (reduce #'funcall functions
13 :initial-value x
14 :from-end t)))
15
16 ;; Here's some benchmarking code that compares various methods of
17 ;; doing the same thing. If the first method, using COMPOSE, is
18 ;; notably slower than the rest, the compiler macro probably isn't
19 ;; being run.
20 #+nil
21 (labels ((2* (x) (* 2 x)))
22 (macrolet ((repeat ((x) &body body)
23 (with-unique-names (counter)
24 `(dotimes (,counter ,x)
25 (declare (type (integer 0 ,x) ,counter)
26 (ignorable ,counter))
27 ,@body))))
28 ;; Make sure the compiler macro gets run
29 (declare (optimize (speed 3) (safety 0) (space 0) (debug 1)))
30 (time (repeat (30000000) (funcall (compose #'1+ #'2* #'1+) 6)))
31 (time (repeat (30000000) (funcall (lambda (x) (1+ (2* (1+ x)))) 6)))
32 (time (repeat (30000000)
33 (funcall (lambda (x)
34 (funcall #'1+ (funcall #'2* (funcall #'1+ x))))
35 6)))))
36
37 ;; Converts calls to COMPOSE to lambda forms with everything written
38 ;; out and some things written as direct function calls.
39 ;; Example: (compose #'1+ #'2* #'1+) => (LAMBDA (X) (1+ (2* (1+ X))))
40 (define-compiler-macro compose (&rest functions)
41 (labels ((sharp-quoted-p (x)
42 (and (listp x)
43 (eql (first x) 'function)
44 (symbolp (second x)))))
45 `(lambda (x) ,(reduce #'(lambda (fun arg)
46 (if (sharp-quoted-p fun)
47 (list (second fun) arg)
48 (list 'funcall fun arg)))
49 functions
50 :initial-value 'x
51 :from-end t))))

  ViewVC Help
Powered by ViewVC 1.1.5