X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=test.lisp;h=c99c8929bb163017366bc957a3077f598cdbd8d3;hb=bde4a4bf8433a91cfe6f0996af8b53bc1b778903;hp=560a2550b3437d7e5418eaf0f8db4e0422f0806c;hpb=42f5cdc28edf163d5b838b925395d0adce6b3979;p=jscl.git diff --git a/test.lisp b/test.lisp index 560a255..c99c892 100644 --- a/test.lisp +++ b/test.lisp @@ -21,6 +21,12 @@ (%compile-defun ',name)) (fsetq ,name (lambda ,args ,@body)))) +(defmacro when (condition &rest body) + `(if ,condition (progn ,@body))) + +(defmacro unless (condition &rest body) + `(if ,condition nil (progn ,@body))) + (defun = (x y) (= x y)) (defun + (x y) (+ x y)) (defun - (x y) (- x y)) @@ -209,3 +215,37 @@ (or (null ch) (whitespacep ch) (char= #\) ch) (char= #\( ch))) +(defun read-until (stream func) + (let ((string "") + (ch)) + (setq ch (%peek-char stream)) + (while (not (funcall func ch)) + (setq string (concat string (string ch))) + (%read-char stream) + (setq ch (%peek-char stream))) + string)) + +(defun skip-whitespaces-and-comments (stream) + (let (ch) + (skip-whitespaces stream) + (setq ch (%peek-char stream)) + (while (and ch (char= ch #\;)) + (read-until stream (lambda (x) (char= x #\newline))) + (skip-whitespaces stream) + (setq ch (%peek-char stream))))) + +(defun %read-list (stream) + (skip-whitespaces-and-comments stream) + (let ((ch (%peek-char stream))) + (cond + ((char= ch #\)) + (%read-char stream) + nil) + ((char= ch #\.) + (%read-char stream) + (skip-whitespaces-and-comments stream) + (prog1 (ls-read stream) + (unless (char= (%read-char stream) #\)) + (error "')' was expected.")))) + (t + (cons (ls-read stream) (%read-list stream))))))