This test was conducted to determine the relative efficiency and code size of handcoded Lisp, O'Caml and Qi TurboE using the benchmark challenge provided by Jon Harrop. Dr Harrop also provided the Lisp source written by Andre Thieme, Nathan Forster and Pascal Constanza.
rational n * rational m > rational(n * m)
symbol x > symbol x
0+f > f
f+0 > f
0*f > 0
f*0 > 0
1*f > f
f*1 > f
a+(b+c) > (a+b)+c
a*(b*c) > (a*b)*c
Nathan Froyd
Andre Thieme
Pascal Constanza
Dan Bensen
for providing code
Jon Harrop (for both providing code and providing motivation to develop TurboE)
Marcus Breing (for correcting my first run)
SBCL 1.0  
Qi TurboE under SBCL 1.0  
O'Caml 3.09.3 
Mark

Nathan

Andre

Pascal

Dan

Jon
 
time

3.6s

3.4s

15s

8.2s

5.1s

2.0s

loc

15

39

23

24

34

15

time vs OCaml  1.8x  1.7x  7.5x  4.1x  2.6x  1x 
(defun test (N)
(cond ((zerop N) 0)
(t (simplify *expr*) (test (1 N)))))
Author: Mark Tarver
Length: 15 lines
[Op A B] > (s Op (simplify A) (simplify B))
A > A)
+ M N > (+ M N) where (and (number? M) (number? N))
+ 0 F > F
+ F 0 > F
+ A [+ B C] > (simplify [+ [+ A B] C])
* M N > (* M N) where (and (number? M) (number? N))
* 0 F > 0
* F 0 > 0
* F 1 > F
* 1 F > F
* A [* B C] > (simplify [* [* A B] C])
Op A B > [Op A B])
(BLOCK NIL
(TAGBODY
(IF (CONSP V148)
(LET ((Cdr159 (CDR V148)))
(IF (CONSP Cdr159)
(LET ((Cdr158 (CDR Cdr159)))
(IF (CONSP Cdr158)
(IF (NULL (CDR Cdr158))
(RETURN
(s (CAR V148) (simplify (CAR Cdr159))
(simplify (CAR Cdr158))))
(GO tag154))
(GO tag154)))
(GO tag154))))
tag154
(RETURN V148))))
(DEFUN s (V149 V150 V151)
(BLOCK NIL
(TAGBODY
(IF (EQ '+ V149)
(IF (AND (NUMBERP V150) (NUMBERP V151))
(RETURN (THE NUMBER (+ V150 V151)))
(IF (EQL 0 V150) (RETURN V151)
(IF (EQL 0 V151) (RETURN V150)
(IF (CONSP V151)
(LET ((Cdr170 (CDR V151)))
(IF (EQ '+ (CAR V151))
(IF (CONSP Cdr170)
(LET ((Cdr169 (CDR Cdr170)))
(IF (CONSP Cdr169)
(IF (NULL (CDR Cdr169))
(RETURN
(simplify
(CONS '+
(CONS
(LIST '+ V150
(CAR Cdr170))
Cdr169))))
(GO tag160))
(GO tag160)))
(GO tag160))
(GO tag160)))
(GO tag160))))))
tag160
(TAGBODY
(IF (EQ '* V149)
(IF (AND (NUMBERP V150) (NUMBERP V151))
(RETURN (THE NUMBER (* V150 V151)))
(IF (EQL 0 V150) (RETURN 0)
(IF (EQL 0 V151) (RETURN 0)
(IF (EQL 1 V151) (RETURN V150)
(IF (EQL 1 V150) (RETURN V151)
(IF (CONSP V151)
(LET ((Cdr183 (CDR V151)))
(IF (EQ '* (CAR V151))
(IF (CONSP Cdr183)
(LET ((Cdr182 (CDR Cdr183)))
(IF (CONSP Cdr182)
(IF (NULL (CDR Cdr182))
(RETURN
(simplify
(CONS '*
(CONS
(LIST '* V150
(CAR
Cdr183))
Cdr182))))
(GO tag171))
(GO tag171)))
(GO tag171))
(GO tag171)))
(GO tag171))))))))
tag171
(RETURN (LIST V149 V150 V151))))))
Author: Jon Harrop
Length: 15 lines
 `Int n, `Int m > `Int (n +/ m)
 `Int (Int 0), e  e, `Int (Int 0) > e
 f, `Add(g, h) > f +: g +: h
 f, g > `Add(f, g)
 `Int n, `Int m > `Int (n */ m)
 `Int (Int 0), e  e, `Int (Int 0) > `Int (Int 0)
 `Int (Int 1), e  e, `Int (Int 1) > e
 f, `Mul(g, h) > f *: g *: h
 f, g > `Mul(f, g)
 `Int _  `Var _ as f > f
 `Add (f, g) > simplify f +: simplify g
 `Mul (f, g) > simplify f *: simplify g
Author: Andre Thieme
Length: 23 lines
(if (atom a)
a
(destructuringbind (op x y) a
(let* ((f (simplify x))
(g (simplify y))
(nf (numberp f))
(ng (numberp g))
(+? (eq '+ op))
(*? (eq '* op)))
(cond
((and +? nf ng) (+ f g))
((and +? nf (zerop f)) g)
((and +? ng (zerop g)) f)
((and (listp g) (eq op (first g)))
(destructuringbind (op2 u v) g
(simplify `(,op (,op ,f ,u) ,v))))
((and *? nf ng) (* f g))
((and *? (or (and nf (zerop f))
(and ng (zerop g)))) 0)
((and *? nf (= 1 f)) g)
((and *? ng (= 1 g)) f)
(t `(,op ,f ,g)))))))
Author: Nathan Froyd
Length: 39 lines
(if (atom xexpr)
xexpr
(let ((op (first xexpr))
(z (second xexpr))
(y (third xexpr)))
(let* ((f (simplifynoredundantchecks z))
(g (simplifynoredundantchecks y))
(nf (numberp f))
(ng (numberp g)))
(tagbody
START
(if (eq '+ op) (go OPTIMIZEPLUS) (go TESTMULTIPLY))
OPTIMIZEPLUS
(when (and nf ng) (returnfrom simplifynoredundantchecks (+ f g)))
TESTPLUSZEROS
(when (eql f 0) (returnfrom simplifynoredundantchecks g))
(when (eql g 0) (returnfrom simplifynoredundantchecks f))
(go REARRANGEEXPR)
TESTMULTIPLY
(unless (eq '* op) (go REARRANGEEXPR))
OPTIMIZEMULTIPLY
(when (and nf ng) (returnfrom simplifynoredundantchecks (* f g)))
TESTMULTIPLYZEROSANDONES
(when (or (eql f 0) (eql g 0)) (returnfrom simplifynoredundantchecks 0))
(when (eql f 1) (returnfrom simplifynoredundantchecks g))
(when (eql g 1) (returnfrom simplifynoredundantchecks f))
REARRANGEEXPR
(when (and (listp g) (eq op (first g)))
(let ((op2 (first g))
(u (second g))
(v (third g)))
(declare (ignore op2))
(returnfrom simplifynoredundantchecks
(simplifynoredundantchecks (list op (list op f u) v)))))
MAYBECONSEXPR
(if (and (eq f z) (eq g y))
(returnfrom simplifynoredundantchecks xexpr)
(returnfrom simplifynoredundantchecks (list op f g))))))))
Author: Pascal Constanza
Length: 25 lines
(defstruct mul x y)
(:method ((x number) (y number)) (+ x y))
(:method ((x (eql 0)) y) y)
(:method (x (y (eql 0))) x)
(:method (x (y add))
(simplifyadd (simplifyadd x (addx y)) (addy y)))
(:method (x y) (makeadd :x x :y y)))
(:method ((x number) (y number)) (* x y))
(:method ((x (eql 0)) y) 0)
(:method (x (y (eql 0))) 0)
(:method ((x (eql 1)) y) y)
(:method (x (y (eql 1))) x)
(:method (x (y mul))
(simplifymul (simplifymul x (mulx y)) (muly y)))
(:method (x y) (makemul :x x :y y)))
(:method (exp) exp)
(:method ((exp add))
(simplifyadd (simplify (addx exp)) (simplify (addy exp))))
(:method ((exp mul))
(simplifymul (simplify (mulx exp)) (simplify (muly exp)))))
Author: Dan Bensen
Length: 34 lines
(let ((e1 (gensym "E1"))
(e2 (gensym "E2")))
`(defun ,func (,e1 ,e2)
(declare (optimize (speed 3)))
,(delete :nocase
`(case ,e1
,zerocase
(,ident ,e2)
(t ,(delete :nocase
`(case ,e2
,zerocase
(,ident ,e1)
(t (cond
((and (rationalp ,e1)
(rationalp ,e2))
(,op ,e1 ,e2))
((atom ,e2)
(list ,e1 ,opsymbl ,e2))
(t (case
(cadr ,e2)
(,opsymbl (,func (,func ,e1 (car ,e2))
(caddr ,e2)))
(t (list ,e1 ,opsymbl ,e2))))))))))))))
(defop apply* * '* 1 ( 0 0 ))
(if (atom expr)
expr
(let ((e1 (simplify (car expr)))
(e2 (simplify (caddr expr))))
(case (cadr expr)
('+ (apply+ e1 e2))
('* (apply* e1 e2))))))