/[cmucl]/src/code/backq.lisp
ViewVC logotype

Diff of /src/code/backq.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by wlott, Thu Jan 16 19:08:55 1992 UTC revision 1.4 by ram, Wed Feb 12 01:45:44 1992 UTC
# Line 56  Line 56 
56    (declare (ignore ignore))    (declare (ignore ignore))
57    (let ((*backquote-count* (1+ *backquote-count*)))    (let ((*backquote-count* (1+ *backquote-count*)))
58      (multiple-value-bind (flag thing)      (multiple-value-bind (flag thing)
59                           (backquotify (read stream t nil t))                           (backquotify stream (read stream t nil t))
60        (if (eq flag *bq-at-flag*)        (if (eq flag *bq-at-flag*)
61            (error ",@ after backquote in ~S" thing))            (%reader-error stream ",@ after backquote in ~S" thing))
62        (if (eq flag *bq-dot-flag*)        (if (eq flag *bq-dot-flag*)
63            (error ",. after backquote in ~S" thing))            (%reader-error stream ",. after backquote in ~S" thing))
64        (values (backquotify-1 flag thing) 'list))))        (values (backquotify-1 flag thing) 'list))))
65    
66  (defun comma-macro (stream ignore)  (defun comma-macro (stream ignore)
# Line 68  Line 68 
68    (unless (> *backquote-count* 0)    (unless (> *backquote-count* 0)
69      (when *read-suppress*      (when *read-suppress*
70        (return-from comma-macro nil))        (return-from comma-macro nil))
71      (error "Comma not inside a backquote."))      (%reader-error stream "Comma not inside a backquote."))
72    (let ((c (read-char stream))    (let ((c (read-char stream))
73          (*backquote-count* (1- *backquote-count*)))          (*backquote-count* (1- *backquote-count*)))
74      (values      (values
# Line 81  Line 81 
81       'list)))       'list)))
82    
83  ;;; This does the expansion from table 2.  ;;; This does the expansion from table 2.
84  (defun backquotify (code)  (defun backquotify (stream code)
85    (cond ((atom code)    (cond ((atom code)
86           (cond ((null code) (values nil nil))           (cond ((null code) (values nil nil))
87                 ((or (numberp code)                 ((or (numberp code)
# Line 95  Line 95 
95          ((eq (car code) *bq-comma-flag*)          ((eq (car code) *bq-comma-flag*)
96           (comma (cdr code)))           (comma (cdr code)))
97          ((eq (car code) *bq-vector-flag*)          ((eq (car code) *bq-vector-flag*)
98           (multiple-value-bind (dflag d) (backquotify (cdr code))           (multiple-value-bind (dflag d) (backquotify stream (cdr code))
99             (values 'vector (backquotify-1 dflag d))))             (values 'vector (backquotify-1 dflag d))))
100          (t (multiple-value-bind (aflag a) (backquotify (car code))          (t (multiple-value-bind (aflag a) (backquotify stream (car code))
101               (multiple-value-bind (dflag d) (backquotify (cdr code))               (multiple-value-bind (dflag d) (backquotify stream (cdr code))
102                 (if (eq dflag *bq-at-flag*)                 (if (eq dflag *bq-at-flag*)
103                     ;; get the errors later.                     ;; get the errors later.
104                     (error ",@ after dot in ~S" code))                     (%reader-error stream ",@ after dot in ~S" code))
105                 (if (eq dflag *bq-dot-flag*)                 (if (eq dflag *bq-dot-flag*)
106                     (error ",. after dot in ~S" code))                     (%reader-error stream ",. after dot in ~S" code))
107                 (cond                 (cond
108                  ((eq aflag *bq-at-flag*)                  ((eq aflag *bq-at-flag*)
109                   (if (null dflag)                   (if (null dflag)

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

  ViewVC Help
Powered by ViewVC 1.1.5