Changeset 16447


Ignore:
Timestamp:
Jul 2, 2015, 5:14:55 PM (4 years ago)
Author:
gb
Message:

finish removing alist-based readtable macro tables.
fix typo in COPY-MACRO-TABLE (fixes ticket:1290 in the trunk)
Get back to work.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-reader.lisp

    r16443 r16447  
    20232023  (let* ((attr (%character-attribute char (rdtab.ttab readtable))))
    20242024    (declare (fixnum attr))
    2025     (values attr (if (logbitp $cht_macbit attr)
    2026                      (let ((macros (rdtab.macros readtable)))
    2027                        (if (typep macros 'list)
    2028                            (assoc char macros)
    2029                            (sparse-vector-ref macros (need-char-code char))))))))
     2025    (values attr )))
    20302026
    20312027(defun copy-macro-table (table)
     
    20392035            (let* ((datum (svref v j)))
    20402036              (when (consp datum)
    2041                 (setf (svref v i)
     2037                (setf (svref v j)
    20422038                      (cons (car datum)
    20432039                            (copy-macro-table (cdr datum))))))))))))
     
    20532049                         (copy-sparse-vector fttab)
    20542050                         nil (rdtab.case from))))
    2055     (if (listp (rdtab.macros from))
    2056       (setf (rdtab.macros to) (copy-tree (rdtab.macros from)))
    2057       (setf (rdtab.macros to) (copy-macro-table (rdtab.macros from))))
     2051    (setf (rdtab.macros to) (copy-macro-table (rdtab.macros from)))
    20582052
    20592053
     
    21132107  be embedded in a symbol name."
    21142108  (setq readtable (readtable-arg readtable))
    2115   (if (listp (rdtab.macros readtable))
    2116     (multiple-value-bind (attr info) (%get-readtable-char char readtable)
    2117       (declare (fixnum attr) (list info))
    2118       (let* ((def (cdr info)))
    2119         (values (if (consp def) (car def) def)
    2120                 (= attr $cht_ntmac))))
    2121     (let* ((code (need-char-code char))
    2122            (info (sparse-vector-ref (rdtab.macros readtable) code)))
     2109   
     2110  (let* ((code (need-char-code char))
     2111         (info (sparse-vector-ref (rdtab.macros readtable) code)))
    21232112     
    21242113             
    2125       (values (if (atom info) info (car info))
    2126               (= (%character-attribute  char (rdtab.ttab readtable)) $cht_ntmac)))))
     2114    (values (if (atom info) info (car info))
     2115            (= (%character-attribute  char (rdtab.ttab readtable)) $cht_ntmac))))
    21272116
    21282117     
     
    21392128  (%set-character-attribute char readtable
    21402129                            (if (null fn) $cht_cnst (if non-terminating-p $cht_ntmac $cht_tmac)))
    2141   (if (listp (rdtab.macros readtable))
    2142     (let* ((info (nth-value 1 (%get-readtable-char char readtable))))
    2143       (declare (list info))
    2144       (without-interrupts
    2145      
    2146        (if (and (null fn) info)
    2147          (setf (rdtab.macros readtable) (delete info (rdtab.macros readtable) :test #'eq))
    2148          (if (null info)
    2149            (push (cons char fn) (rdtab.macros readtable))
    2150            (let* ((def (cdr info)))
    2151              (if (atom def)
    2152                (setf (cdr info) fn)     ; Non-dispatching
    2153                (setf (car def) fn)))))) ; Dispatching
    2154       t)
    2155     (let* ((code (or (need-char-code char) ))
    2156            (info (sparse-vector-ref (rdtab.macros readtable) code)))
    2157       (if (consp info)
    2158         (setf (car info) fn)
    2159         (setf (sparse-vector-ref (rdtab.macros readtable) code) fn))
    2160       t)))
     2130  (let* ((code (or (need-char-code char) ))
     2131         (info (sparse-vector-ref (rdtab.macros readtable) code)))
     2132    (if (consp info)
     2133      (setf (car info) fn)
     2134      (setf (sparse-vector-ref (rdtab.macros readtable) code) fn))
     2135    t))
    21612136
    21622137(defun readtable-case (readtable)
     
    21832158  (setq char (require-type char 'base-char))
    21842159  (%set-character-attribute char readtable
    2185            (if non-terminating-p $cht_ntmac $cht_tmac))
    2186   (if (listp (rdtab.macros readtable))
    2187    
    2188   (let* ((info (nth-value 1 (%get-readtable-char char readtable))))
    2189     (declare (list info))
    2190     (without-interrupts
    2191           (if info
    2192        (rplacd (cdr info) nil)
    2193        (push (cons char (cons #'read-dispatch nil)) (rdtab.macros readtable)))))
    2194     (setf (sparse-vector-ref (rdtab.macros readtable) (need-char-code char))
    2195           (cons #'read-dispatch (make-sparse-vector char-code-limit t nil))))
     2160                            (if non-terminating-p $cht_ntmac $cht_tmac))
     2161  (setf (sparse-vector-ref (rdtab.macros readtable) (need-char-code char))
     2162        (cons #'read-dispatch (make-sparse-vector char-code-limit t nil)))
    21962163  t)
    21972164
     
    22032170  (setq sub-ch (char-upcase (require-type sub-ch 'base-char)))
    22042171  (unless (digit-char-p sub-ch 10)
    2205     (if (listp (rdtab.macros readtable))
    2206       (let* ((def (cdr (nth-value 1 (%get-readtable-char disp-ch readtable)))))
    2207         (if (consp def)
    2208           (cdr (assq sub-ch (cdr def)))
    2209           (error "~A is not a dispatching macro character in ~s ." disp-ch readtable)))
    2210       (let* ((code (char-code disp-ch))
    2211              (info (sparse-vector-ref (rdtab.macros readtable) code)))
    2212         (if (atom info)
    2213           (error "~A is not a dispatching macro character in ~s ." disp-ch readtable)
    2214           (let* ((subcode (char-code sub-ch)))
    2215             (sparse-vector-ref (cdr info) subcode)))))))
     2172    (let* ((code (char-code disp-ch))
     2173           (info (sparse-vector-ref (rdtab.macros readtable) code)))
     2174      (if (atom info)
     2175        (error "~A is not a dispatching macro character in ~s ." disp-ch readtable)
     2176        (let* ((subcode (char-code sub-ch)))
     2177          (sparse-vector-ref (cdr info) subcode))))))
    22162178
    22172179(defun set-dispatch-macro-character (disp-ch sub-ch fn &optional readtable)
     
    22232185  (when (digit-char-p sub-ch 10)
    22242186    (error "subchar can't be a decimal digit - ~a ." sub-ch))
    2225   (if (listp (rdtab.macros readtable))
    2226     (let* ((info (nth-value 1 (%get-readtable-char disp-ch readtable)))
    2227            (def (cdr info)))
    2228       (declare (list info))
    2229       (unless (consp def)
    2230         (error "~A is not a dispatching macro character in ~s ." disp-ch readtable))
    2231       (let* ((alist (cdr def))
    2232              (pair (assq sub-ch alist)))
    2233         (if pair
    2234           (setf (cdr pair) fn)
    2235           (push (cons sub-ch fn) (cdr def))))
    2236       t)
    2237     (let* ((code (char-code disp-ch))
    2238            (info (sparse-vector-ref (rdtab.macros readtable) code)))
    2239       (if (atom info)
    2240         (error "~A is not a dispatching macro character in ~s ." disp-ch readtable)
    2241         (let* ((subcode (char-code sub-ch)))
    2242           (setf (sparse-vector-ref (cdr info) subcode) fn))))))
    2243 
    2244 
     2187  (let* ((code (char-code disp-ch))
     2188         (info (sparse-vector-ref (rdtab.macros readtable) code)))
     2189    (if (atom info)
     2190      (error "~A is not a dispatching macro character in ~s ." disp-ch readtable)
     2191      (let* ((subcode (char-code sub-ch)))
     2192        (setf (sparse-vector-ref (cdr info) subcode) fn)))))
     2193
     2194
     2195#+bootstrapping
    22452196(defun convert-readtable-macros (readtable)
    22462197  (let*  ((alist (rdtab.macros readtable)))
     
    26072558                     (if (not (logbitp $cht_macbit attr))
    26082559                       (%parse-token stream firstchar dot-ok)
    2609                        (let* ((def (if (listp (rdtab.macros readtable))
    2610                                      (cdr (assq firstchar (rdtab.macros readtable)))
    2611                                      (sparse-vector-ref (rdtab.macros readtable) (need-char-code firstchar )))))
     2560                       (let* ((def (sparse-vector-ref (rdtab.macros readtable) (need-char-code firstchar ))))
    26122561                         (cond ((null def))
    26132562                               ((atom def)
Note: See TracChangeset for help on using the changeset viewer.