Shinmera / qtools

Qtools is a collection of utilities to aid development with CommonQt
https://shinmera.github.io/qtools
zlib License
210 stars 17 forks source link

Q+ Readtable Muckery is Not Standards Compliant #7

Closed Shinmera closed 9 years ago

Shinmera commented 9 years ago

As documented in the Q+ section, the current method of hacking the Q+ package is not standards compliant by unreading more than once on the input stream and thus breaks on some implementations like ECL. A better technique should be discovered to avoid this.

dkochmanski commented 9 years ago
diff --git a/dynamic.lisp b/dynamic.lisp
index 817529e..f2a01bc 100644
--- a/dynamic.lisp
+++ b/dynamic.lisp
@@ -223,13 +223,14 @@ as per the hyperspec. An alternative solution to this
 problem should be found as it will break on various
 conforming implementations."
   (let ((buffer ()))
-    (prog1
-        (loop for char across (target-package-symbol-string)
-              for read = (read-char stream)
-              do (push read buffer)
-              always (string= char (to-readtable-case (string read))))
-      (dolist (char buffer)
-        (unread-char char stream)))))
+    (values
+     (loop for char across (target-package-symbol-string)
+        for read = (read-char stream)
+        do (push read buffer)
+        always (string= char (to-readtable-case (string read))))
+     #-(or)(make-string-input-stream (coerce (reverse buffer) 'string))
+     #+(or)(dolist (char buffer)
+             (unread-char char stream)))))

 (defun q+-symbol-name (string)
   "Returns the symbol name of a *TARGET-PACKAGE* symbol in printed, string form.
@@ -253,12 +254,15 @@ See QTOOLS:Q+-SYMBOL-P
 See QTOOLS:Q+-SYMBOL-NAME
 See QTOOLS:Q+
 See QTOOLS:*STANDARD-PAREN-READER*"
-    (if (q+-symbol-p stream)
-        (let* ((name (q+-symbol-name (read-name stream)))
-               (contents (read-list-until #\) stream)))
-          (read-char stream) ;consume closing ).
-          `(q+ ,name ,@contents))
-        (funcall *standard-paren-reader* stream char)))
+    (multiple-value-bind (q+-symbol? consumed-stream)
+        (q+-symbol-p stream)
+      (let (#-(or)(stream (make-concatenated-stream consumed-stream stream)))
+        (if q+-symbol?
+            (let* ((name (q+-symbol-name (read-name stream)))
+                   (contents (read-list-until #\) stream)))
+              (read-char stream) ;consume closing ).
+              `(q+ ,name ,@contents))
+            (funcall *standard-paren-reader* stream char)))))

   (set-macro-character #\( #'read-paren NIL (named-readtables:find-readtable :qtools)))