From: David Vazquez <davazp@gmail.com>
Date: Tue, 18 Dec 2012 02:39:43 +0000 (+0000)
Subject: More nested macros
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=399f7409d326005321b88b2d973c35fb733dfe5d;p=jscl.git

More nested macros
---

diff --git a/lispstrack.lisp b/lispstrack.lisp
index 59fb5e4..b8cc906 100644
--- a/lispstrack.lisp
+++ b/lispstrack.lisp
@@ -534,6 +534,22 @@
                  (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)))
diff --git a/test.lisp b/test.lisp
index 7d06431..9f58cf2 100644
--- a/test.lisp
+++ b/test.lisp
@@ -190,17 +190,17 @@
   (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)))))