From: David Vázquez <davazp@gmail.com>
Date: Wed, 8 May 2013 21:43:02 +0000 (+0100)
Subject: *features* support for the reader
X-Git-Url: http://repo.macrolet.net/gitweb/?p=jscl.git;a=commitdiff_plain;h=2cfa0e65959624b3ed1caebb829e829ed50e5a6f

*features* support for the reader
---

diff --git a/jscl.lisp b/jscl.lisp
index 01f75c6..5e393d6 100644
--- a/jscl.lisp
+++ b/jscl.lisp
@@ -102,7 +102,8 @@
 
 
 (defun bootstrap ()
-  (let ((*package* (find-package "JSCL")))
+  (let ((*features* (cons :jscl *features*))
+        (*package* (find-package "JSCL")))
     (setq *environment* (make-lexenv))
     (setq *literal-table* nil)
     (setq *variable-counter* 0
diff --git a/src/compiler.lisp b/src/compiler.lisp
index 61c57a4..4a27413 100644
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -68,7 +68,7 @@
         (incf index))
       output)))
 
-#+common-lisp
+#-jscl
 (defun indent (&rest string)
   (with-output-to-string (*standard-output*)
     (with-input-from-string (input (apply #'code string))
@@ -511,7 +511,7 @@
 ;;; evaluated. For this reason we define a valid macro-function for
 ;;; this symbol.
 (defvar *magic-unquote-marker* (gensym "MAGIC-UNQUOTE"))
-#+common-lisp
+#-jscl
 (setf (macro-function *magic-unquote-marker*)
       (lambda (form &optional environment)
         (declare (ignore environment))
@@ -524,7 +524,7 @@
   (code "l" (incf *literal-counter*)))
 
 (defun dump-symbol (symbol)
-  #+common-lisp
+  #-jscl
   (let ((package (symbol-package symbol)))
     (if (eq package (find-package "KEYWORD"))
         (code "(new Symbol(" (dump-string (symbol-name symbol)) ", " (dump-string (package-name package)) "))")
@@ -1609,7 +1609,7 @@
             `(%js-vref ,var))))
 
 
-#+common-lisp
+#-jscl
 (defvar *macroexpander-cache*
   (make-hash-table :test #'eq))
 
@@ -1620,7 +1620,7 @@
     (if (and b (eq (binding-type b) 'macro))
         (let ((expander (binding-value b)))
           (cond
-            #+common-lisp
+            #-jscl
             ((gethash b *macroexpander-cache*)
              (setq expander (gethash b *macroexpander-cache*)))
             ((listp expander)
@@ -1633,7 +1633,7 @@
                ;; function with the compiled one.
                ;;
                #+jscl (setf (binding-value b) compiled)
-               #+common-lisp (setf (gethash b *macroexpander-cache*) compiled)
+               #-jscl (setf (gethash b *macroexpander-cache*) compiled)
                (setq expander compiled))))
           expander)
         nil)))
@@ -1667,7 +1667,7 @@
        (concat (translate-function function) arglist))
       ((and (symbolp function)
             #+jscl (eq (symbol-package function) (find-package "COMMON-LISP"))
-            #+common-lisp t)
+            #-jscl t)
        (code (ls-compile `',function) ".fvalue" arglist))
       (t
        (code (ls-compile `#',function) arglist)))))
diff --git a/src/lambda-list.lisp b/src/lambda-list.lisp
index d706d50..34f7419 100644
--- a/src/lambda-list.lisp
+++ b/src/lambda-list.lisp
@@ -338,7 +338,7 @@
 ;;; defmacro to avoid a circularity. So just define the macro function
 ;;; explicitly.
 
-#+common-lisp
+#-jscl
 (defmacro !destructuring-bind (lambda-list expression &body body)
   (apply #'!expand-destructuring-bind lambda-list expression body))
 
diff --git a/src/read.lisp b/src/read.lisp
index c3cde1b..3c15f9d 100644
--- a/src/read.lisp
+++ b/src/read.lisp
@@ -237,20 +237,17 @@
            ((string= cname "tab") #\tab)
            ((string= cname "newline") #\newline)
            (t (char cname 0)))))
-      ((char= ch #\+)
+      ((or (char= ch #\+)
+           (char= ch #\-))
        (let ((feature (let ((symbol (ls-read stream eof-error-p eof-value t)))
                         (unless (symbolp symbol)
                           (error "Invalid feature ~S" symbol))
                         (intern (string symbol) "KEYWORD"))))
-         (ecase feature
-           (:common-lisp
-              (ls-read stream)
-              (ls-read stream eof-error-p eof-value t))
-           (:jscl
-              (ls-read stream eof-error-p eof-value t))
-           (:nil
-              (ls-read stream)
-              (ls-read stream eof-error-p eof-value t)))))
+         (if (eql (char= ch #\+)
+                  (and (find feature *features*) t))
+              (ls-read stream eof-error-p eof-value t)
+              (prog2 (ls-read stream)
+                  (ls-read stream eof-error-p eof-value t)))))
       ((and ch (digit-char-p ch))
        (let ((id (digit-char-p ch)))
          (while (and (%peek-char stream)
diff --git a/src/utils.lisp b/src/utils.lisp
index d586cdd..430b6a7 100644
--- a/src/utils.lisp
+++ b/src/utils.lisp
@@ -83,4 +83,4 @@
 
 (defun float-to-string (x)
   #+jscl (float-to-string x)
-  #+common-lisp (format nil "~f" x))
+  #-jscl (format nil "~f" x))