WHEN, UNLESS
[jscl.git] / test.lisp
index 878a18f..c99c892 100644 (file)
--- a/test.lisp
+++ b/test.lisp
        (%compile-defun ',name))
      (fsetq ,name (lambda ,args ,@body))))
 
        (%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))
 (defun = (x y) (= x y))
 (defun + (x y) (+ x y))
 (defun - (x y) (- x y))
 (defun reverse (list)
   (reverse-aux list '()))
 
 (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)
       '()
 (defun mapcar (func list)
   (if (null list)
       '()
         (join (mapcar (lambda (d) (string (char "0123456789" d)))
                       digits)
               ""))))
         (join (mapcar (lambda (d) (string (char "0123456789" d)))
                       digits)
               ""))))
+
+(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))))))