More nested macros
authorDavid Vazquez <davazp@gmail.com>
Tue, 18 Dec 2012 02:39:43 +0000 (02:39 +0000)
committerDavid Vazquez <davazp@gmail.com>
Tue, 18 Dec 2012 02:39:43 +0000 (02:39 +0000)
lispstrack.lisp
test.lisp

index 59fb5e4..b8cc906 100644 (file)
                  (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)))
index 7d06431..9f58cf2 100644 (file)
--- a/test.lisp
+++ b/test.lisp
   (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)))))