X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fbackq.lisp;h=b82b4641ac874eeede936189c0ba93d6ce34cebd;hb=b420873de742dd0e9ff0d2231d2cc37cf6aba3f8;hp=4c13b437b737705d1fc8b99ba2babb2e890a3086;hpb=f4f423b699b25a78e70fb990ca3a434f3e2cbba2;p=sbcl.git

diff --git a/src/code/backq.lisp b/src/code/backq.lisp
index 4c13b43..b82b464 100644
--- a/src/code/backq.lisp
+++ b/src/code/backq.lisp
@@ -55,11 +55,11 @@
   (let ((*backquote-count* (1+ *backquote-count*)))
     (multiple-value-bind (flag thing)
 	(backquotify stream (read stream t nil t))
-      (if (eq flag *bq-at-flag*)
-	  (%reader-error stream ",@ after backquote in ~S" thing))
-      (if (eq flag *bq-dot-flag*)
-	  (%reader-error stream ",. after backquote in ~S" thing))
-      (values (backquotify-1 flag thing) 'list))))
+      (when (eq flag *bq-at-flag*)
+	(%reader-error stream ",@ after backquote in ~S" thing))
+      (when (eq flag *bq-dot-flag*)
+	(%reader-error stream ",. after backquote in ~S" thing))
+      (backquotify-1 flag thing))))
 
 (/show0 "backq.lisp 64")
 
@@ -71,14 +71,12 @@
     (%reader-error stream "comma not inside a backquote"))
   (let ((c (read-char stream))
 	(*backquote-count* (1- *backquote-count*)))
-    (values
-     (cond ((char= c #\@)
-	    (cons *bq-at-flag* (read stream t nil t)))
-	   ((char= c #\.)
-	    (cons *bq-dot-flag* (read stream t nil t)))
-	   (t (unread-char c stream)
-	      (cons *bq-comma-flag* (read stream t nil t))))
-     'list)))
+    (cond ((char= c #\@)
+	   (cons *bq-at-flag* (read stream t nil t)))
+	  ((char= c #\.)
+	   (cons *bq-dot-flag* (read stream t nil t)))
+	  (t (unread-char c stream)
+	     (cons *bq-comma-flag* (read stream t nil t))))))
 
 (/show0 "backq.lisp 83")
 
@@ -108,11 +106,11 @@
 	   (values 'vector (backquotify-1 dflag d))))
 	(t (multiple-value-bind (aflag a) (backquotify stream (car code))
 	     (multiple-value-bind (dflag d) (backquotify stream (cdr code))
-	       (if (eq dflag *bq-at-flag*)
-		   ;; Get the errors later.
-		   (%reader-error stream ",@ after dot in ~S" code))
-	       (if (eq dflag *bq-dot-flag*)
-		   (%reader-error stream ",. after dot in ~S" code))
+	       (when (eq dflag *bq-at-flag*)
+		 ;; Get the errors later.
+		 (%reader-error stream ",@ after dot in ~S" code))
+	       (when (eq dflag *bq-dot-flag*)
+		 (%reader-error stream ",. after dot in ~S" code))
 	       (cond
 		((eq aflag *bq-at-flag*)
 		 (if (null dflag)
@@ -204,7 +202,7 @@
 ;;; Define synonyms for the lisp functions we use, so that by using
 ;;; them, the backquoted material will be recognizable to the
 ;;; pretty-printer.
-(macrolet ((def-frob (b-name name)
+(macrolet ((def (b-name name)
 	     (let ((args (gensym "ARGS")))
 	       ;; FIXME: This function should be INLINE so that the lists
 	       ;; aren't consed twice, but I ran into an optimizer bug the
@@ -213,11 +211,11 @@
 	       ;; then make these INLINE.
 	       `(defun ,b-name (&rest ,args)
 		  (apply #',name ,args)))))
-  (def-frob backq-list list)
-  (def-frob backq-list* list*)
-  (def-frob backq-append append)
-  (def-frob backq-nconc nconc)
-  (def-frob backq-cons cons))
+  (def backq-list list)
+  (def backq-list* list*)
+  (def backq-append append)
+  (def backq-nconc nconc)
+  (def backq-cons cons))
 
 (/show0 "backq.lisp 204")
 
@@ -246,4 +244,17 @@
   (set-macro-character #\, #'comma-macro))
 #+sb-xc-host (!backq-cold-init)
 
+;;; The pretty-printer needs to know about our special tokens
+(defvar *backq-tokens*
+  '(backq-comma backq-comma-at backq-comma-dot backq-list
+    backq-list* backq-append backq-nconc backq-cons backq-vector))
+
+;;; Since our backquote is installed on the host lisp, and since
+;;; developers make mistakes with backquotes and commas too, let's
+;;; ensure that we can report errors rather than get an undefined
+;;; function condition on %READER-ERROR.
+#+sb-xc-host ; proper definition happens for the target
+(defun %reader-error (stream format-string &rest format-args)
+  (bug "READER-ERROR on stream ~S: ~?" stream format-string format-args))
+
 (/show0 "done with backq.lisp")