Changeset 16484


Ignore:
Timestamp:
Jul 20, 2015, 2:43:47 AM (4 years ago)
Author:
svspire
Message:

Add #'sparse-vector-count for completeness.
Reinstate second value of #'%get-readtable-char because quicklisp system "named-readtables"
depends on it.

Location:
trunk/source/level-1
Files:
2 edited

Legend:

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

    r16447 r16484  
    20232023  (let* ((attr (%character-attribute char (rdtab.ttab readtable))))
    20242024    (declare (fixnum attr))
    2025     (values attr )))
     2025    (values attr (if (logbitp $cht_macbit attr)
     2026                     (sparse-vector-ref
     2027                      (rdtab.macros readtable)
     2028                      (need-char-code char))))))
    20262029
    20272030(defun copy-macro-table (table)
  • trunk/source/level-1/sysutils.lisp

    r16085 r16484  
    949949        (uvref v (logand i #xff))))))
    950950
     951(defun sparse-vector-count (sv)
     952  "Returns number of entries in sparse vector.
     953  (Actually, it just counts how many elements are not the default value.
     954  So this can be fooled because it can't distinguish the default value from a valid value that happens to be eql to default.)"
     955  (with-lock-grabbed ((sparse-vector-lock sv))
     956    (let* ((table (sparse-vector-table sv))
     957           (majormax (length table))
     958           (default (sparse-vector-default sv))
     959           (total 0))
     960      (declare (fixnum total))
     961      (flet ((tally-vector (v)
     962               (dotimes (i 256)
     963                 (declare (fixnum i))
     964                 (unless (eql default (uvref v i))
     965                   (incf total)))))
     966        (dotimes (i majormax)
     967          (declare (fixnum i))
     968          (let ((v (svref table i)))
     969            (when v (tally-vector v))))
     970        total))))
     971
    951972(defun (setf sparse-vector-ref) (new sv i)
    952973  (unless (and (typep i 'fixnum)
Note: See TracChangeset for help on using the changeset viewer.