X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=test.lisp;h=c99c8929bb163017366bc957a3077f598cdbd8d3;hb=bde4a4bf8433a91cfe6f0996af8b53bc1b778903;hp=9871a0054ac662b7a615c0e880784384f3b9ab6d;hpb=1e690546f80d46bb908c3c4feb362bb085783019;p=jscl.git

diff --git a/test.lisp b/test.lisp
index 9871a00..c99c892 100644
--- a/test.lisp
+++ b/test.lisp
@@ -12,8 +12,8 @@
        (%compile-defvar ',name))
      (setq ,name ,value)))
 
-(defvar nil 'nil)
 (defvar t 't)
+(defvar nil 'nil)
 
 (defmacro defun (name args &rest body)
   `(progn
@@ -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))
@@ -55,6 +61,19 @@
 (defun reverse (list)
   (reverse-aux list '()))
 
+(defmacro incf (x)
+  `(setq ,x (1+ ,x)))
+
+(defmacro decf (x)
+  `(setq ,x (1- ,x)))
+
+(defun length (list)
+  (let ((l 0))
+    (while (not (null list))
+      (incf l)
+      (setq list (cdr list)))
+    l))
+
 (defun mapcar (func list)
   (if (null list)
       '()
@@ -123,11 +142,110 @@
   (if (zerop x)
       "0"
       (let ((digits nil))
-        (while (not (= x 0))
+        (while (not (zerop x 0))
           (push (mod x 10) digits)
           (setq x (truncate x 10)))
         (join (mapcar (lambda (d) (string (char "0123456789" d)))
                       digits)
               ""))))
 
-(debug (integer-to-string 323))
+(defmacro and (&rest forms)
+  (cond
+    ((null forms)
+     t)
+    ((null (cdr forms))
+     (car forms))
+    (t
+     `(if ,(car forms)
+          (and ,@(cdr forms))
+          nil))))
+
+
+(defmacro or (&rest forms)
+  (cond
+    ((null forms)
+     nil)
+    ((null (cdr forms))
+     (car forms))
+    (t
+     `(if ,(car forms)
+          t
+          (or ,@(cdr forms))))))
+
+
+(defmacro prog1 (form &rest body)
+  (let ((value (make-symbol "VALUE")))
+    `(let ((,value ,form))
+       ,@body
+       ,value)))
+
+
+(defun char= (x y) (= x y))
+
+
+;;;; Reader
+
+;;; It is a basic Lisp reader. It does not use advanced stuff
+;;; intentionally, because we want to use it to bootstrap a simple
+;;; Lisp. The main entry point is the function `ls-read', which
+;;; accepts a strings as argument and return the Lisp expression.
+(defun make-string-stream (string)
+  (cons string 0))
+
+(defun %peek-char (stream)
+  (and (< (cdr stream) (length (car stream)))
+       (char (car stream) (cdr stream))))
+
+(defun %read-char (stream)
+  (and (< (cdr stream) (length (car stream)))
+       (prog1 (char (car stream) (cdr stream))
+         (setcdr stream (1+ (cdr stream))))))
+
+(defun whitespacep (ch)
+  (or (char= ch #\space) (char= ch #\newline) (char= ch #\tab)))
+
+(defun skip-whitespaces (stream)
+  (let (ch)
+    (setq ch (%peek-char stream))
+    (while (and ch (whitespacep ch))
+      (%read-char stream)
+      (setq ch (%peek-char stream)))))
+
+(defun terminalp (ch)
+  (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))))))