Clasp updates

code/dispatch.lisp

@@ -195,30 +195,34 @@
     ((cons (member progv))
      -20
      pprint-progv)
-    #+(or clisp ecl mezzano sbcl)
-    ((cons (member #+clisp system::backquote
+    #+(or clasp clisp ecl mezzano sbcl)
+    ((cons (member #+clasp ext:quasiquote
+                   #+clisp system::backquote
                    #+ecl si:quasiquote
                    #+mezzano mezzano.internals::backquote
                    #+sbcl sb-int:quasiquote)
            (cons t null))
      -20
      pprint-macro-char t nil #\`)
-    #+(or clisp ecl mezzano)
-    ((cons (member #+clisp system::unquote
+    #+(or clasp clisp ecl mezzano)
+    ((cons (member #+clasp ext:unquote
+                   #+clisp system::unquote
                    #+ecl si:unquote
                    #+mezzano mezzano.internals::bq-comma)
            (cons t null))
      -20
      pprint-macro-char t t #\,)
-    #+(or clisp ecl mezzano)
-    ((cons (member #+clisp system::splice
+    #+(or clasp clisp ecl mezzano)
+    ((cons (member #+clasp ext:unquote-splice
+                   #+clisp system::splice
                    #+ecl si:unquote-splice
                    #+mezzano mezzano.internals::bq-comma-atsign)
            (cons t null))
      -20
      pprint-macro-char t t #\, #\@)
-    #+(or clisp ecl mezzano)
-    ((cons (member #+clisp system::nsplice
+    #+(or clasp clisp ecl mezzano)
+    ((cons (member #+clasp ext:unquote-nsplice
+                   #+clisp system::nsplice
                    #+ecl si:unquote-nsplice
                    #+mezzano mezzano.internals::bq-comma-dot)
            (cons t null))
@@ -286,33 +290,12 @@
      -10
      pprint-symbol)))
 
-(defvar +quasiquote-entries+
-  #-clasp nil
-  #+clasp
-  '(("ECLECTOR.READER" "QUASIQUOTE"
-     -20
-     pprint-macro-char t nil #\`)
-    ("ECLECTOR.READER" "UNQUOTE"
-     -20
-     pprint-macro-char t t #\,)
-    ("ECLECTOR.READER" "UNQUOTE-SPLICING"
-     -20
-     pprint-macro-char t t #\, #\@)))
-
 (defmethod copy-pprint-dispatch (client (table null) &optional read-only)
   (declare (ignore table))
   (let ((new-table (make-instance 'dispatch-table
                                   :default-dispatch-function (make-dispatch-function client :client-object-stream #'incless:print-object nil))))
     (loop for (type priority name . rest) in +initial-dispatch-entries+
           do (set-pprint-dispatch client new-table type (fdefinition name) priority :client-stream-object rest))
-    (loop for (package symbol priority name . rest) in +quasiquote-entries+
-          for pkg = (find-package package)
-          for sym = (when pkg
-                      (find-symbol symbol pkg))
-          when sym
-            do (set-pprint-dispatch client new-table
-                                    `(cons (member ,sym) (cons t null))
-                                    (fdefinition name) priority :client-stream-object rest))
     (when read-only
       (setf (dispatch-table-read-only-p new-table) t))
     new-table))

code/interface.lisp

@@ -241,7 +241,6 @@
  block, obeying *print-length* and *print-circle*."
          (error "PPRINT-POP must be lexically inside PPRINT-LOGICAL-BLOCK."))
        (defun ,initialize-func (&aux *print-pretty*)
-         (find-unquote-symbols)
          (setf ,initial-pprint-dispatch-var (copy-pprint-dispatch ,client-var nil t)
                ,standard-pprint-dispatch-var (copy-pprint-dispatch ,client-var nil t)
                ,print-pprint-dispatch-var (copy-pprint-dispatch ,client-var nil))

code/packages.lisp

@@ -22,7 +22,6 @@
            #:define-interface
            #:execute-logical-block
            #:expand-logical-block
-           #:find-unquote-symbols
            #:get-named-style
            #:make-dispatch-function
            #:make-pretty-stream

code/types.lisp

@@ -43,27 +43,20 @@
   (and (member kind '(:line-relative :section-relative))
        t))
 
-(defvar +unquote-symbols+ nil)
-
-(defun find-unquote-symbols ()
-  (setf +unquote-symbols+
-        (loop for (package symbol) in #+clasp '(("ECLECTOR.READER" "UNQUOTE")
-                                                ("ECLECTOR.READER" "UNQUOTE-SPLICING"))
-                                      #+ecl '(("SI" "UNQUOTE")
-                                              ("SI" "UNQUOTE-SPLICE")
-                                              ("SI" "UNQUOTE-NSPLICE"))
-                                      #-(or clasp ecl) nil
-              for pkg = (find-package package)
-              for sym = (when pkg
-                          (find-symbol symbol pkg))
-              when sym
-                collect sym)))
-
-(find-unquote-symbols)
+(deftype unquote-form ()
+  '(cons (member #+clasp ext:unquote
+                 #+clasp ext:unquote-splice
+                 #+clasp ext:unquote-nsplice
+                 #+clisp system::unquote
+                 #+clisp system::splice
+                 #+clisp system::nsplice
+                 #+ecl si:unquote
+                 #+ecl si:unquote-splice
+                 #+ecl si:unquote-nsplice
+                 #+mezzano mezzano.internals::bq-comma
+                 #+mezzano mezzano.internals::bq-comma-atsign
+                 #+mezzano mezzano.internals::bq-comma-dot)
+         (cons t null)))
 
 (defun unquote-form-p (form)
-  (and (consp form)
-       (consp (cdr form))
-       (null (cddr form))
-       (member (car form) +unquote-symbols+)
-       t))
+  (typep form 'unquote-form))