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)