+(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 (eql ch #\;))
+ (read-until stream (lambda (x) (eql 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 ((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))))))))
+
+(defun ls-read-from-string (string)
+ (ls-read (make-string-stream string)))
+
+
+;;;; Compiler
+
+(let ((counter 0))
+ (defun make-var-binding (symbol)
+ (cons symbol (concat "v" (integer-to-string (incf counter))))))
+
+(let ((counter 0))
+ (defun make-func-binding (symbol)
+ (cons symbol (concat "f" (integer-to-string (incf counter))))))
+
+(defvar *compilations* nil)
+
+(defun ls-compile-block (sexps env fenv)
+ (join-trailing (mapcar (lambda (x)
+ (ls-compile x env fenv))
+ sexps)
+ ";
+"))