fix typo and add benchmark code
This commit is contained in:
		
							parent
							
								
									96290cf128
								
							
						
					
					
						commit
						548d7596f4
					
				|  | @ -0,0 +1,86 @@ | |||
| (defun tak (x y z) | ||||
|   (if (not (< y x)) | ||||
|       z | ||||
|     (tak | ||||
|      (tak (1- x) y z) | ||||
|      (tak (1- y) z x) | ||||
|      (tak (1- z) x y)))) | ||||
| 
 | ||||
| (defun benchmark-tak () | ||||
|   (tak 18 12 6)) | ||||
| 
 | ||||
| (defun fib (n) | ||||
|   (if (< n 3) 1 | ||||
|     (+ (fib (- n 1)) (fib (- n 2))))) | ||||
| 
 | ||||
| (defun benchmark-fib () | ||||
|   (fib 23)) | ||||
| 
 | ||||
| (defun q (n) | ||||
|   (if (<= n 2) 1 | ||||
|     (+ | ||||
|      (q (- n (q (- n 1)))) | ||||
|      (q (- n (q (- n 2))))))) | ||||
| 
 | ||||
| (defun benchmark-q () | ||||
|   (q 21)) | ||||
| 
 | ||||
| (defun q2 (x y) | ||||
|   (if (or (< x 1) (< y 1)) 1 | ||||
|     (+ (q2 (- x (q2 (1- x) y)) y) | ||||
|        (q2 x (- y (q2 x (1- y))))))) | ||||
| 
 | ||||
| (defun benchmark-q2 () | ||||
|   (q2 7 8)) | ||||
| 
 | ||||
| (defun factor (n) | ||||
|   (cond | ||||
|    ((zerop (mod n 2)) 2) | ||||
|    ((zerop (mod n 3)) 3) | ||||
|    (t (let ((d 5) (i 2)) | ||||
|         (loop | ||||
|          (when (> (* d d) n) (return n)) | ||||
|          (when (zerop (mod n d)) (return d)) | ||||
|          (incf d i) (setq i (- 6 i))))))) | ||||
| 
 | ||||
| (defvar *factor-prime* 2142142141) | ||||
| (defun benchmark-factor () | ||||
|   (factor *factor-prime*)) | ||||
| 
 | ||||
| (defun sieve (size) | ||||
|   (let ((a (make-array size :element-type 'bit)) | ||||
|         max) | ||||
|     (setf (aref a 0) 1 (aref a 1) 1) | ||||
|     (dotimes (i size max) | ||||
|       (when (zerop (aref a i)) | ||||
|         (setq max i) | ||||
|         (do ((j (* 2 i) (+ j i))) ((>= j size)) (setf (aref a j) 1)))))) | ||||
| 
 | ||||
| (defun benchmark-sieve () | ||||
|   (sieve 100000)) | ||||
| 
 | ||||
| (defun benchmark-check (fun expected) | ||||
|   (let ((answer (fun))) | ||||
|     (unless (eq answer expected) | ||||
|       (error "benchmark failed: have ~a, expected ~a~%" | ||||
| 	     answer | ||||
| 	     expected) | ||||
|       t))) | ||||
| 
 | ||||
| (defun benchmark-time-it (fun expected) | ||||
|   (time (benchmark-check fun expected))) | ||||
| 
 | ||||
| (defun benchmark () | ||||
|   (print '(tak 18 12 6)) | ||||
|   (benchmark-time-it benchmark-tak 7) | ||||
|   (print '(fib 23)) | ||||
|   (benchmark-time-it benchmark-fib 28657) | ||||
|   (print '(q 21)) | ||||
|   (benchmark-time-it benchmark-q 12) | ||||
|   (print '(q2 7 8)) | ||||
|   (benchmark-time-it benchmark-q2 31) | ||||
|   (print '(factor 2142142141)) | ||||
|   (benchmark-time-it benchmark-factor *factor-prime*) | ||||
|   (print '(sieve 100000)) | ||||
|   (benchmark-time-it benchmark-sieve 99991)) | ||||
| 
 | ||||
|  | @ -2287,7 +2287,7 @@ checkkeyword(object *obj) | |||
| 
 | ||||
| 	builtin_t kname = builtin(obj->name); | ||||
| 	uint8_t context = getminmax(kname); | ||||
| 	if (context != 0 && context !e Context) { | ||||
| 	if (context != 0 && context != Context) { | ||||
| 		error(invalidkey, obj); | ||||
| 	} | ||||
| 
 | ||||
|  |  | |||
		Loading…
	
		Reference in New Issue