(%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 cdar (x) (cdr (car x)))
(defun cddr (x) (cdr (cdr x)))
+(defun list (&rest args)
+ args)
+
(defun append (list1 list2)
(if (null list1)
list2
(progn ,@(cdar clausules))
(cond ,@(cdr clausules))))))
+
+(defmacro case (form &rest clausules)
+ (let ((!form (make-symbol "FORM")))
+ `(let ((,!form ,form))
+ (cond
+ ,@(mapcar (lambda (clausule)
+ (if (eq (car clausule) t)
+ clausule
+ `((eql ,!form ,(car clausule))
+ ,@(cdr clausule))))
+ clausules)))))
+
+(defmacro ecase (form &rest clausules)
+ `(case ,form
+ ,@(append
+ clausules
+ `((t
+ (error "ECASE expression failed."))))))
+
(defun !reduce (func list initial)
(if (null list)
initial
(defun char= (x y) (= x y))
+(defun digit-char-p (x)
+ (if (and (< #\0 x) (< x #\9))
+ (- x #\0)
+ nil))
+
+(defun parse-integer (string)
+ (let ((value 0)
+ (index 0)
+ (size (string-length string)))
+ (while (< index size)
+ (setq value (+ (* value 10) (digit-char-p (char string index))))
+ (incf index))))
+
+(defun every (function seq)
+ ;; string
+ (let ((ret t)
+ (index 0)
+ (size (string-length seq)))
+ (while (and ret (< index size))
+ (unless (funcall function (char seq index))
+ (setq ret nil)))))
+
+(defun eql (x y)
+ (eq x y))
+
+(defun string= (s1 s2)
+ (equal s1 s2))
+
;;;; Reader
;;; It is a basic Lisp reader. It does not use advanced stuff
(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))))))
+
+(defvar *eof* (make-symbol "EOF"))
+(defun ls-read (stream)
+ (skip-whitespaces-and-comments stream)
+ (let ((ch (%peek-char stream)))
+ (cond
+ ((null ch)
+ *eof*)
+ ((char= ch #\()
+ (%read-char stream)
+ (%read-list stream))
+ ((char= ch #\')
+ (%read-char stream)
+ (list 'quote (ls-read stream)))
+ ((char= ch #\`)
+ (%read-char stream)
+ (list 'backquote (ls-read stream)))
+ ((char= ch #\")
+ (%read-char stream)
+ (prog1 (read-until stream (lambda (ch) (char= ch #\")))
+ (%read-char stream)))
+ ((char= ch #\,)
+ (%read-char stream)
+ (if (eql (%peek-char stream) #\@)
+ (progn (%read-char stream) (list 'unquote-splicing (ls-read stream)))
+ (list 'unquote (ls-read stream))))
+ ((char= ch #\#)
+ (%read-char stream)
+ (ecase (%read-char stream)
+ (#\'
+ (list 'function (ls-read stream)))
+ (#\\
+ (let ((cname
+ (concat (string (%read-char stream))
+ (read-until stream #'terminalp))))
+ (cond
+ ((string= cname "space") (char-code #\space))
+ ((string= cname "newline") (char-code #\newline))
+ (t (char-code (char cname 0))))))
+ (#\+
+ (let ((feature (read-until stream #'terminalp)))
+ (cond
+ ((string= feature "common-lisp")
+ (ls-read stream) ;ignore
+ (ls-read stream))
+ ((string= feature "lispstrack")
+ (ls-read stream))
+ (t
+ (error "Unknown reader form.")))))))
+ (t
+ (let ((string (read-until stream #'terminalp)))
+ (if (every #'digit-char-p string)
+ (parse-integer string)
+ (intern (string-upcase string))))))))