shithub: femtolisp

Download patch

ref: b0e8582c1daf6980e29e34383e3001256a11d60c
parent: b3b2bc3300fb543195a92c1e4ee3f506aca2b3f7
author: JeffBezanson <[email protected]>
date: Mon Jul 14 20:06:42 EDT 2008

adding performance test files



--- /dev/null
+++ b/femtolisp/perf.lsp
@@ -1,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))))
+
--- 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))))
--- 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,10 +58,8 @@
            (setq ,v (+ ,v 1)))))))
 
 (defmacro labl (name fn)
-  (list (list lambda (cons name nil) (list 'setq name fn)) nil))
+  `((lambda (,name) (setq ,name ,fn)) nil))
 
-;(dotimes (n 5000) (macroexpand '(dotimes (i 100) body1 body2)))
-
 (define (square x) (* x x))
 (define (evenp  x) (= x (* (/ x 2) 2)))
 (define (expt b p)
@@ -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)