From b0e8582c1daf6980e29e34383e3001256a11d60c Mon Sep 17 00:00:00 2001
From: JeffBezanson <jeff.bezanson@gmail.com>
Date: Tue, 15 Jul 2008 00:06:42 +0000
Subject: [PATCH] adding performance test files

---
 femtolisp/perf.lsp   | 17 +++++++++++++++++
 femtolisp/tcolor.lsp |  5 ++++-
 femtolisp/test.lsp   | 20 ++++++++++----------
 3 files changed, 31 insertions(+), 11 deletions(-)
 create mode 100644 femtolisp/perf.lsp

diff --git a/femtolisp/perf.lsp b/femtolisp/perf.lsp
new file mode 100644
index 0000000..f1ae87f
--- /dev/null
+++ b/femtolisp/perf.lsp
@@ -0,0 +1,17 @@
+(load "test.lsp")
+
+(princ "colorgraph: ")
+(load "tcolor.lsp")
+
+(princ "fib(34): ")
+(assert (equal (time (fib 34)) 5702887))
+(princ "yfib(32): ")
+(assert (equal (time (yfib 32)) 2178309))
+
+(princ "sort: ")
+(setq r (map-int (lambda (x) (mod (+ (* x 9421) 12345) 1024)) 1000))
+(time (sort r))
+
+(princ "mexpand: ")
+(time (dotimes (n 5000) (macroexpand '(dotimes (i 100) body1 body2))))
+
diff --git a/femtolisp/tcolor.lsp b/femtolisp/tcolor.lsp
index 0bb7b85..ba35fc9 100644
--- a/femtolisp/tcolor.lsp
+++ b/femtolisp/tcolor.lsp
@@ -8,4 +8,7 @@
   (setq C (color-pairs Q '(a b c d e)))
   (dotimes (n 99) (color-pairs Q '(a b c d e))))
 (time (ct))
-(print C)
+(assert (equal C '((23 . a) (9 . a) (22 . b) (17 . d) (14 . d) (8 . b) (21 . e)
+                   (19 . b) (16 . c) (13 . c) (11 . b) (7 . e) (24 . c) (20 . d)
+                   (18 . e) (15 . a) (12 . a) (10 . e) (6 . d) (5 . c) (4 . e)
+                   (3 . d) (2 . c) (0 . b) (1 . a))))
diff --git a/femtolisp/test.lsp b/femtolisp/test.lsp
index 5875954..61d98c5 100644
--- a/femtolisp/test.lsp
+++ b/femtolisp/test.lsp
@@ -48,9 +48,6 @@
              (list piv)
              (sort (filter (lambda (x) (>  x piv)) (cdr l)))))))
 
-;(setq r (map-int (lambda (x) (mod (+ (* x 9421) 12345) 1024)) 1000))
-;(sort r)
-
 (defmacro dotimes (var . body)
   (let ((v   (car var))
         (cnt (cadr var)))
@@ -61,9 +58,7 @@
            (setq ,v (+ ,v 1)))))))
 
 (defmacro labl (name fn)
-  (list (list lambda (cons name nil) (list 'setq name fn)) nil))
-
-;(dotimes (n 5000) (macroexpand '(dotimes (i 100) body1 body2)))
+  `((lambda (,name) (setq ,name ,fn)) nil))
 
 (define (square x) (* x x))
 (define (evenp  x) (= x (* (/ x 2) 2)))
@@ -178,6 +173,11 @@
      (lambda (h)
        (f (lambda (x) ((h h) x)))))))
 
+(define yfib
+  (Y (lambda (fib)
+       (lambda (n)
+         (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))))))
+
 (defmacro debug ()
   (let ((g (gensym)))
     `(progn (princ "Debug REPL:\n")
@@ -188,7 +188,7 @@
                                      identity))
                   (setq ,g (read))))))))
 
-(defun tt () (time (dotimes (i 500000) (* 0x1fffffff 1) )))
-(tt)
-(tt)
-(tt)
+;(defun tt () (time (dotimes (i 500000) (* 0x1fffffff 1) )))
+;(tt)
+;(tt)
+;(tt)