(defparameter *tstgb* '(progn (defun list (&rest x) x) (defun not (x) (if x nil 1)) (defun deriv-aux (a) (list '/ (deriv a) a)) (defun cadr (x) (car (cdr x))) (defun caddr (x) (cadr (cdr x))) (setq t 1) (defun mapcar (fun lis) (cond ((eq lis nil) nil) (1 (cons (funcall fun (car lis)) (mapcar fun (cdr lis)))))) (defun deriv (a) (cond ((not (consp a)) (if (eq a 'x) 1 0)) ((eq (car a) '*) (list '* a (cons '+ (mapcar #'(lambda (z) (deriv-aux z)) (cdr a))))) ((eq (car a) '+) (cons '+ (mapcar #'(lambda (z) (deriv z))(cdr a)))) ((eq (car a) '-) (cons '- (mapcar #'(lambda (z) (deriv z)) (cdr a)))) ((eq (car a) '/) (list '- (list '/ (deriv (cadr a)) (caddr a)) (list '/ (cadr a) (list '* (caddr a) (caddr a) (deriv (caddr a)))))) (t 'error))) (%print (caddr '(1 2 3))) (defun deriv-run () (let () (%print (deriv '(+ (* 3 x x) (* a x x) (* b x) 5))) (deriv '(+ (* 3 x x) (* a x x) (* b x) 5)) (deriv '(+ (* 3 x x) (* a x x) (* b x) 5)) (deriv '(+ (* 3 x x) (* a x x) (* b x) 5)) (deriv '(+ (* 3 x x) (* a x x) (* b x) 5)))) (deriv-run))) (defparameter *tsta1* '(let ()(defconstant a 5) (defconstant b 4) (defun f (n) (cond ((%<= n 1) 1) (1 (%+ (f (%- n 1)) (f (%- n 2)))))) (%print (f (%+ a b))))) (defparameter *tsta2* '(let () (%print (%+ 10 15)) (if (%<= (%- 7 9) 1) (%print 20) (%print -20)))) (defparameter *tsta3* '(let () (defun f (n) (%+ n n)) (defun g(n) (%+ (%+ n 17) 100)) (defun h (m) (%+ (f (f m)) (f (f (f m))))) (%print (h 19)))) (defparameter *tsta4* '(let () (defun f (n) (cond ((%<= n 1) 2) (1 (%+ 2 (f (%- n 1)))))) (%print (f 5)))) (defparameter *tsta5* '(let ((a 12) (b nil)) (%set-symbol-function 'f a) (setq b (%symbol-function 'f)) (%print (%= a b)))) (defparameter *tsta6* '(let ((a 12) (b nil)) (%print (cond ((%<= a 5) (%- 22 a)) (1 (%- 30 a)))))) (defparameter *tsta7* '(let ((a 0)) (setq a 0) (do-until ((%>= a 32)) (set-word 80 a (%+ a 7)) (setq a (%+ a 4))) (set-word 80 8 155) (setq a 0) (do-until ((%>= a 32)) (%print (get-word 80 a)) (setq a (%+ a 4))))) (defparameter *tsta8* '(let ((i 128) (a 100) (b 300)) (defun zerop (x) (%= x 0)) (defun sw (x w) (set-word x 0 w)) (defun gw (x) (get-word x 0)) (defun dec (x) (%- x 4)) (do-until ((zerop i)) (sw i (gw i)) (setq i (dec i))))) (defparameter *tsta9* '(let ((i 24) (x nil)) (do-until ((%= i 0)) (setq x (p-shiftl (p-constr i i))) (%print x) (%print (p-shiftr x)) (setq i (%- i 4))))) (defparameter *tsta10* '(let () (defun mul (a b) (let ((acc 0) (i 32)) (do-until ((%= i 0) acc) (if (%= (tag-and (addr-and b 1) 0) 1) (setq acc (%+ acc a))) (setq b (p-shiftr-1 b)) (setq a (p-shiftl-1 a)) (setq i (%- i 1))))) (%print (mul 23 58)) (%print (mul 23 -58)) (%print (mul -23 58)) (%print (mul -23 -58)))) (defparameter *tsta11* '(let () (defun mov-1 (from to n) (let ((nn n)) (set-a from) (set-b to) (do-until ((%= nn 0)) (%print (set-b-index-pp (%print (get-a-index-pp)))) (setq nn (%- nn 1))))) (defun compare-1 (from to n) (let ((i 0)) (do-until ((%= n 0)) (%print (%= (get-word from i) (get-word to i))) (setq i (%+ i 4)) (setq n (%- n 1))))) (defun set-1 (from n) (let ((i 0)) (do-until ((%= n 0)) (set-word from i (%+ n 11)) (setq i (%+ i 4)) (setq n (%- n 1))))) (set-1 80 10) (mov-1 80 160 10) (compare-1 80 160 10))) (defparameter *tsta12* '(let () (defun consx (x y) (let ((p (%reserve-space 8))) (set-word p 0 x) (set-word p 4 y) (tag-set p 1))) (%print (consx 1 (consx 2 3))))) (defparameter *tsta13* '(let () (defun null (x) (eq x nil)) (defun car (x) (get-word x 0)) (defun cdr (x) (get-word x 4)) (dolist (x '(1 2 3 4 5 a b c)) (%print x)))) (defparameter *tsta14* '(let () (do ((i 0 (%+ i 1))) ((%>= i 10) (%print (%+ i i))) (%print i)))) (defparameter *tsta15* '(progn (defun cons (x y) (let ((p (%reserve-space 8))) (set-word p 0 x) (set-word p 4 y) (setq p (tag-set p 1)) p)) (defun f (a b c) (%+ (%- a b) c)) (%print (apply f '(11 24 37))))) (defparameter *tstxa* '(let* ((a 1) (b (%+ 10 a)) (c (%* b b))) (%print a) (%print b) (%print c))) (defparameter *tstxb* '(let () (defun cc (x) (cons x x)) (defun mapcar (f l) (cond ((eq l nil) nil) (1 (cons (funcall f (car l)) (mapcar f (cdr l)))))) (let ((ccc #'(lambda (x) (cc (cc x))))) (%print (mapcar #'ccc '(1 2 3 4 5 6)))))) (defparameter *tstxc* '(let ((a 1)) (setq a a) (%print a))) (defparameter *tstxd* '(let ((a 1)(b nil)) (let ((c 3)(d 4)) (%print (%+ a c)) (%print (cons b d))))) (defparameter *tstxz* '(progn (let ((a 1) (b 2)) (defun adder (x) #'(lambda (a) (%+ x a))) (setq add3 (adder 3)) (setq add12 (adder 12)) (%print (funcall add3 7)) (%print (funcall add12 18))))) (defparameter *tstxy* '(progn (defun f (a b c) (cons (cons a b) c)) (defun lis (&rest x) x) (%print (lis 1 2 3 4 5 6)) (%print (apply f (lis 1 2 3))))) (defparameter *tstxx* '(progn (defun cons (x y) (%cons x y)) (defun eq (x y) (and (addr-eq x y) (%= (get-tag x) (get-tag y)))) (defun f (a b c) (cons (cons a b) c)) (defun lis (&rest x) x) (%print (lis 1 2 3 4 5 6)) (%print (apply f (apply f 1 '(77 88)) 3 (lis (apply f 1 '(5 6))))))) (defparameter *tst01* '(progn (defun cons (x y) (%cons x y)) (defun eq (x y) (and (addr-eq x y) (%= (get-tag x) (get-tag y)))) (defun f (n) (cond ((%<= n 1) 1) (1 (%+ (f (%- n 1)) (f (%- n 2)))))) (defun g (n) (cond ((%<= n 0) nil) (1 (cons (f n) (g (%- n 1)))))) (defun app (l x) (cond ((eq l nil) (cons x nil)) (1 (cons (car l) (app (cdr l) x))))) (defun rev (x) (cond ((eq x nil) nil) (1 (app (rev (cdr x)) (car x))))) (%print (rev '(-1 -2 "juergen" -4 -5))) (defun mapcar (f l) (cond ((eq l nil) nil) (1 (cons (funcall f (car l)) (mapcar f (cdr l)))))) (%print (mapcar #'(lambda (z) (cons "juergen" (%* z -120000))) '(1 2 3 4 5))) (%print (mapcar #'(lambda (z) (cons z z)) '(#\v #\n #\r #\g))) (%print (mapcar #'(lambda (z) (apply app z)) '(((1 2 3 4) 99) ((5 6 7 8) 33)))))) (defparameter *tst00* '(labels ((f (n) (%* n n)) (g (n) (%+ (f n) (f n)))) (%print (g 12)))) (defparameter *tst02* '(progn (setq x 10) (let ((a 1)) (labels ((f (n) (cond ((%<= n a) a) (1 (%+ (f (%- n 1)) (f (%- n 2)))))) (g (n) (cond ((%<= n 1) nil) (1 (cons (f n) (g (%- n 1))))))) (%print (g x)) (%print (g 5)))))) (defparameter *tst03* '(progn (labels ((f (n) (%* n n))) (setq ff #'(lambda (z) (f z)))) (%print (funcall ff 12)))) ;;;; (defparameter *tst00* '(let ((a 1) ;;;; (b 2) ;;;; (c 3)) ;;;; (let ((d 4)) ;;;; (%print (vector a b c d))))) (defparameter *tst04* '(progn (defun f (a &rest b) (cons a (cons b nil))) (%print (f 1 2)) (let ((a 1) (b 10) (c 100)) (%print (%* b (%- a c)))))) (defparameter *tst05* '(let ((a 1) (b 2)) (if (and (%= a b) (%= a a)) (%print a) (%print b)) (if (and (%= a a) (%= a b)) (%print a) (%print b)) (if (and (%= a a) (%= b b)) (%print a) (%print b)) (if (or (%= a b) (%= a a)) (%print a) (%print b)) (if (or (%= a a) (%= a b)) (%print a) (%print b)) (if (or (%/= a a) (%/= b b)) (%print a) (%print b)))) (defparameter *tst06* '(let ((a 1)) (%print (do-until ((%>= a 10) (%* a a)) (%print a) (setq a (%+ a 1))))))