X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=test.lisp;h=a85dabaf9dae68350c902eb54fbc953e1099daca;hb=cde0e46ceeba0bf1eafcf43b13cd95a7eb14e6f7;hp=4b87743c8b59f87e49af000222b630266ea1038e;hpb=34dd089e729a3980a23f26f1f601fd58069f6e27;p=jscl.git diff --git a/test.lisp b/test.lisp index 4b87743..a85daba 100644 --- a/test.lisp +++ b/test.lisp @@ -1,5 +1,58 @@ -(lambda (x y) - x) +;;; Library + +(eval-when-compile + (%compile-defmacro 'defmacro + (lambda (name args &rest body) + `(eval-when-compile + (%compile-defmacro ',name (lambda ,args ,@body)))))) + +(defmacro defvar (name value) + `(progn + (eval-when-compile + (%compile-defvar ',name)) + (setq ,name ,value))) + +(defmacro defun (name args &rest body) + `(progn + (eval-when-compile + (%compile-defun ',name)) + (fsetq ,name (lambda ,args ,@body)))) + +(defun = (x y) (= x y)) +(defun + (x y) (+ x y)) +(defun - (x y) (- x y)) +(defun * (x y) (* x y)) +(defun / (x y) (/ x y)) +(defun 1+ (x) (+ x 1)) +(defun 1- (x) (- x 1)) +(defun cons (x y ) (cons x y)) +(defun car (x) (car x)) +(defun cdr (x) (cdr x)) + +(defun append (list1 list2) + (if (null list1) + list2 + (cons (car list1) + (append (cdr list1) list2)))) + +(defun reverse-aux (list acc) + (if (null list) + acc + (reverse-aux (cdr list) (cons (car list) acc)))) + +(defun reverse (list) + (reverse-aux list '())) + +(defun mapcar (func list) + (if (null list) + '() + (cons (funcall func (car list)) + (mapcar func (cdr list))))) + + +;;; Tests + +(lambda (x y) x) (debug "hola") (debug '(1 2 3 4)) @@ -20,15 +73,14 @@ (fsetq f (lambda (x) (+ x 10))) (debug (f 20)) +(debug ((lambda (x) x) 9999)) + +(debug #'f) + ;;; Macros (debug "---MACROS---") -(eval-when-compile - (%compile-defmacro 'defmacro - (lambda (name args &rest body) - (list 'eval-when-compile - (list '%compile-defmacro (list 'quote name) - (list* 'lambda args body)))))) + (defmacro incf (x) (list 'setq x (list '+ 1 x))) @@ -40,6 +92,24 @@ (incf x) (debug x) +;;; Conses +(debug (cons 1 2)) +(debug (car (cons 1 2))) +(debug (cdr (cons 1 2))) + +(setq x '(1 . 2)) +(debug x) +(debug (eq x x)) +(debug (eq '(1 . 2) '(1 . 2))) + +;;; Symbols +(debug (symbol-name 'foo)) +(debug (symbol-name 'foo-bar)) + +(debug (progn 1 2 3 123)) + +(debug (let ((x 99999)) + (incf x))) ;;; &rest lambda-list @@ -47,11 +117,6 @@ (debug (lambda (x y &rest z) z)) (debug (lambda (x y &rest z) x)) -;;; Conses -(debug (cons 1 2)) -(debug (car (cons 1 2))) -(debug (cdr (cons 1 2))) - ;; (eval-when-compile ;; (%compile-defmacro 'defun