(compile-funcall (car sexp) (cdr sexp) env fenv)))
(ls-compile sexp env fenv))))))
+
+(defun ls-compile (sexp &optional env fenv)
+ (cond
+ ((symbolp sexp) (lookup-variable sexp env))
+ ((integerp sexp) (integer-to-string sexp))
+ ((stringp sexp) (concat "\"" sexp "\""))
+ ((listp sexp)
+ (if (assoc (car sexp) *compilations*)
+ (let ((comp (second (assoc (car sexp) *compilations*))))
+ (apply comp env fenv (cdr sexp)))
+ (let ((fn (cdr (assoc (car sexp) *fenv*))))
+ (if (and (listp fn) (eq (car fn) 'macro))
+ (ls-compile (ls-macroexpand-1 sexp env fenv) env fenv)
+ (compile-funcall (car sexp) (cdr sexp) env fenv)))))))
+
+
(defun ls-compile-toplevel (sexp)
(setq *toplevel-compilations* nil)
(let ((code (ls-compile sexp)))
(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 %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 skip-whitespaces (stream)
+ (let (ch)
+ (setq ch (%peek-char stream))
+ (while (and ch (whitespacep ch))
+ (%read-char stream)
+ (setq ch (%peek-char stream)))))