X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=test.lisp;h=05298238b581be1a646651bbe6f8e613bc262123;hb=303beabd731556a15a88141af6e84808c8ed425f;hp=2f4dd3543c4428396f8134a73eb5186e75f6dad5;hpb=4ad36a3415efc56d1348f9c705b6c436ed488a3f;p=jscl.git diff --git a/test.lisp b/test.lisp index 2f4dd35..0529823 100644 --- a/test.lisp +++ b/test.lisp @@ -6,14 +6,28 @@ `(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) @@ -35,77 +49,16 @@ (cons (funcall func (car list)) (mapcar func (cdr list))))) -;;; Tests - -(lambda (x y) x) - -(debug "hola") -(debug '(1 2 3 4)) -(debug (if 2 (+ 2 1) 0)) -(debug (= (+ 2 1) (- 4 1))) - -;;; Variables -(debug "---VARIABLES---") -(eval-when-compile - (%compile-defvar 'name)) -(setq name 10) -(debug name) - -;;; Functions -(debug "---FUNCTIONS---") -(eval-when-compile - (%compile-defun 'f)) -(fsetq f (lambda (x) (+ x 10))) -(debug (f 20)) - -(debug ((lambda (x) x) 9999)) - -(debug #'f) - -;;; Macros -(debug "---MACROS---") - - - -(defmacro incf (x) - (list 'setq x (list '+ 1 x))) - -(eval-when-compile - (%compile-defvar 'x)) - -(setq x 10) -(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 +(defmacro push (x place) + `(setq ,place (cons ,x ,place))) -(debug (lambda (&rest x) x)) -(debug (lambda (x y &rest z) z)) -(debug (lambda (x y &rest z) x)) +(defvar *package* (new)) +(defun intern (name) + (let ((s (get *package* name))) + (if s + s + (set *package* name (make-symbol name))))) -;; (eval-when-compile -;; (%compile-defmacro 'defun -;; (lambda (name args &rest body) -;; (list 'eval-when-compile -;; (list 'compile-defun) -;; (list 'fsetq (list 'lambda args (list 'progn body))))))) +(defun find-symbol (name) + (get *package* name))