Changeset 9527

May 16, 2008, 2:16:37 AM (11 years ago)

Move the istruct definitions to lispequ. Use TYPEP.

1 edited


  • branches/working-0711-perf/ccl/lib/pprint.lisp

    r9237 r9527  
    128128  "initial print dispatch table.")
     130(eval-when (:compile-toplevel :execute)
     131  (declaim (inline xp-structure-p)))
     133(defun xp-structure-p (x)
     134  (istruct-typep x 'xp-structure))
     137(defun entry-p (x)
     138  (istruct-typep x 'entry))
    130142;default (bad) definitions for the non-portable functions
    172 (eval-when (:compile-toplevel :execute)
    173   (def-accessors uvref ; %svref
    174     ()                                  ;'entry
    175     entry-test                          ;predicate function or count of higher priority others.
    176     entry-fn                            ;pprint function
    177     entry-full-spec                     ;list of priority and type specifier
    178     ))
    180186(defun make-entry (&key test fn full-spec)
    372378  (eval-when (:compile-toplevel :execute)
    373     (def-accessors %svref
    374         ()                              ; 'xp-structure
    375       xp-base-stream;;The stream io eventually goes to.
    376       xp-linel;;The line length to use for formatting.
    377       xp-line-limit;;If non-NIL the max number of lines to print.
    378       xp-line-no;;number of next line to be printed.
    379       xp-char-mode;;NIL :UP :DOWN :CAP0 :CAP1 :CAPW
    380       xp-char-mode-counter              ;depth of nesting of ~(...~)
    381       xp-depth-in-blocks;;Number of logical blocks at QRIGHT that
    382       ;;are started but not ended.             
    383       xp-block-stack
    384       xp-block-stack-ptr
    385       ;;This stack is pushed and popped in accordance with the way blocks are
    386       ;;nested at the moment they are entered into the queue.  It contains the
    387       ;;following block specific value.
    388       ;;SECTION-START total position where the section (see AIM-1102)
    389       ;;that is rightmost in the queue started.
    390       xp-buffer
    391       xp-charpos
    392       xp-buffer-ptr
    393       xp-buffer-offset
    394       ;;This is a vector of characters (eg a string) that builds up the
    395       ;;line images that will be printed out.  BUFFER-PTR is the
    396       ;;buffer position where the next character should be inserted in
    397       ;;the string.  CHARPOS is the output character position of the
    398       ;;first character in the buffer (non-zero only if a partial line
    399       ;;has been output).  BUFFER-OFFSET is used in computing total lengths.
    400       ;;It is changed to reflect all shifting and insertion of prefixes so that
    401       ;;total length computes things as they would be if they were
    402       ;;all on one line.  Positions are kept three different ways
    403       ;; Buffer position (eg BUFFER-PTR)
    404       ;; Line position (eg (+ BUFFER-PTR CHARPOS)).  Indentations are stored in this form.
    405       ;; Total position if all on one line (eg (+ BUFFER-PTR BUFFER-OFFSET))
    406       ;;  Positions are stored in this form.
    407       xp-queue
    408       xp-qleft
    409       xp-qright
    410       ;;This holds a queue of action descriptors.  QLEFT and QRIGHT
    411       ;;point to the next entry to dequeue and the last entry enqueued
    412       ;;respectively.  The queue is empty when
    413       ;;(> QLEFT QRIGHT).  The queue entries have several parts:
    414       ;;QTYPE one of :NEWLINE/:IND/:START-BLOCK/:END-BLOCK
    416       ;; or :BLOCK/:CURRENT
    417       ;;QPOS total position corresponding to this entry
    418       ;;QDEPTH depth in blocks of this entry.
    419       ;;QEND offset to entry marking end of section this entry starts. (NIL until known.)
    420       ;; Only :start-block and non-literal :newline entries can start sections.
    421       ;;QOFFSET offset to :END-BLOCK for :START-BLOCK (NIL until known).
    422       ;;QARG for :IND indentation delta
    423       ;;     for :START-BLOCK suffix in the block if any.
    424       ;;                      or if per-line-prefix then cons of suffix and
    425       ;;                      per-line-prefix.
    426       ;;     for :END-BLOCK suffix for the block if any.
    427       xp-prefix
    428       ;;this stores the prefix that should be used at the start of the line
    429       xp-prefix-stack
    430       xp-prefix-stack-ptr
    431       ;;This stack is pushed and popped in accordance with the way blocks
    432       ;;are nested at the moment things are taken off the queue and printed.
    433       ;;It contains the following block specific values.
    434       ;;PREFIX-PTR current length of PREFIX.
    435       ;;SUFFIX-PTR current length of pending suffix
    436       ;;NON-BLANK-PREFIX-PTR current length of non-blank prefix.
    437       ;;INITIAL-PREFIX-PTR prefix-ptr at the start of this block.
    438       ;;SECTION-START-LINE line-no value at last non-literal break at this level.
    439       xp-suffix
    440       ;;this stores the suffixes that have to be printed to close of the current
    441       ;;open blocks.  For convenient in popping, the whole suffix
    442       ;;is stored in reverse order.
    443       xp-stream  ;;; the xp-stream containing this structure
    444       xp-string-stream;; string-stream for output until first circularity (in case none)
    445       )
    446380    )
    488422    (write-internal-1 (xp-stream xp-struc) object level list-kludge))
    490   (defmacro xp-structure-p (x)
    491     `(istruct-typep ,x 'xp-structure))
    493426  (defun get-xp-stream (pp)
Note: See TracChangeset for help on using the changeset viewer.