X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=test.lisp;h=878a18f8c6e94882c3f91bdddc4dbf17da9eba66;hb=8e2f01785d31e908194c1846d8437285aad31478;hp=507ebfb662e310d6b6b19a72cab88129d7c942c7;hpb=3e945ee1ac4ef06f5f01f90ee62e78dca634c9d3;p=jscl.git diff --git a/test.lisp b/test.lisp index 507ebfb..878a18f 100644 --- a/test.lisp +++ b/test.lisp @@ -6,6 +6,15 @@ `(eval-when-compile (%compile-defmacro ',name (lambda ,args ,@body)))))) +(defmacro defvar (name value) + `(progn + (eval-when-compile + (%compile-defvar ',name)) + (setq ,name ,value))) + +(defvar t 't) +(defvar nil 'nil) + (defmacro defun (name args &rest body) `(progn (eval-when-compile @@ -19,9 +28,18 @@ (defun / (x y) (/ x y)) (defun 1+ (x) (+ x 1)) (defun 1- (x) (- x 1)) +(defun zerop (x) (= x 0)) +(defun not (x) (if x nil t)) + +(defun truncate (x y) (floor (/ x y))) + (defun cons (x y ) (cons x y)) (defun car (x) (car x)) +(defun caar (x) (car (car x))) +(defun cadr (x) (car (cdr x))) (defun cdr (x) (cdr x)) +(defun cdar (x) (cdr (car x))) +(defun cddr (x) (cdr (cdr x))) (defun append (list1 list2) (if (null list1) @@ -43,78 +61,71 @@ (cons (funcall func (car list)) (mapcar func (cdr list))))) +(defmacro push (x place) + `(setq ,place (cons ,x ,place))) -;;; 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) +(defvar *package* (new)) -;;; Macros -(debug "---MACROS---") +(defun intern (name) + (let ((s (get *package* name))) + (if s + s + (set *package* name (make-symbol name))))) +(defun find-symbol (name) + (get *package* name)) -(defmacro incf (x) - (list 'setq x (list '+ 1 x))) +(defmacro cond (&rest clausules) + (if (null clausules) + nil + (if (eq (caar clausules) t) + `(progn ,@(cdar clausules)) + `(if ,(caar clausules) + (progn ,@(cdar clausules)) + (cond ,@(cdr clausules)))))) -(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 - -(debug (lambda (&rest x) x)) -(debug (lambda (x y &rest z) z)) -(debug (lambda (x y &rest z) x)) - - -;; (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 !reduce (func list initial) + (if (null list) + initial + (!reduce func + (cdr list) + (funcall func initial (car list))))) + + +(defun code-char (x) x) +(defun char-code (x) x) +(defvar *newline* (string (code-char 10))) + +(defun concat (&rest strs) + (!reduce (lambda (s1 s2) (concat-two s1 s2)) + strs + "")) + +;;; Concatenate a list of strings, with a separator +(defun join (list separator) + (cond + ((null list) + "") + ((null (cdr list)) + (car list)) + (t + (concat (car list) + separator + (join (cdr list) separator))))) + +(defun join-trailing (list separator) + (if (null list) + "" + (concat (car list) separator (join-trailing (cdr list) separator)))) + +(defun integer-to-string (x) + (if (zerop x) + "0" + (let ((digits nil)) + (while (not (zerop x 0)) + (push (mod x 10) digits) + (setq x (truncate x 10))) + (join (mapcar (lambda (d) (string (char "0123456789" d))) + digits) + ""))))