File: compose.lisp

package info (click to toggle)
acl2 8.5dfsg-5
  • links: PTS
  • area: main
  • in suites: bookworm
  • size: 991,452 kB
  • sloc: lisp: 15,567,759; javascript: 22,820; cpp: 13,929; ansic: 12,092; perl: 7,150; java: 4,405; xml: 3,884; makefile: 3,507; sh: 3,187; ruby: 2,633; ml: 763; python: 746; yacc: 723; awk: 295; csh: 186; php: 171; lex: 154; tcl: 49; asm: 23; haskell: 17
file content (51 lines) | stat: -rw-r--r-- 1,884 bytes parent folder | download | duplicates (7)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
;; This version of COMPOSE can only handle functions which take one
;; value and return one value. There are other ways of writing
;; COMPOSE, but this is the most commonly used.

(in-package :cl-utilities)

;; This is really slow and conses a lot. Fortunately we can speed it
;; up immensely with a compiler macro.
(defun compose (&rest functions)
  "Compose FUNCTIONS right-associatively, returning a function"
  #'(lambda (x)
      (reduce #'funcall functions
	      :initial-value x
	      :from-end t)))

;; Here's some benchmarking code that compares various methods of
;; doing the same thing. If the first method, using COMPOSE, is
;; notably slower than the rest, the compiler macro probably isn't
;; being run.
#+nil
(labels ((2* (x) (* 2 x)))
  (macrolet ((repeat ((x) &body body)
	       (with-unique-names (counter)
		 `(dotimes (,counter ,x)
		   (declare (type (integer 0 ,x) ,counter)
		            (ignorable ,counter))
		   ,@body))))
    ;; Make sure the compiler macro gets run
    (declare (optimize (speed 3) (safety 0) (space 0) (debug 1)))
    (time (repeat (30000000) (funcall (compose #'1+ #'2* #'1+) 6)))
    (time (repeat (30000000) (funcall (lambda (x) (1+ (2* (1+ x)))) 6)))
    (time (repeat (30000000)
		  (funcall (lambda (x)
			     (funcall #'1+ (funcall #'2* (funcall #'1+ x))))
			   6)))))

;; Converts calls to COMPOSE to lambda forms with everything written
;; out and some things written as direct function calls.
;; Example: (compose #'1+ #'2* #'1+) => (LAMBDA (X) (1+ (2* (1+ X))))
(define-compiler-macro compose (&rest functions)
  (labels ((sharp-quoted-p (x)
	     (and (listp x)
		  (eql (first x) 'function)
		  (symbolp (second x)))))
    `(lambda (x) ,(reduce #'(lambda (fun arg)
			      (if (sharp-quoted-p fun)
				  (list (second fun) arg)
				  (list 'funcall fun arg)))
			  functions
			  :initial-value 'x
			  :from-end t))))