(defvar *precompiled-pprint-dispatch-funs*
(list (frob (typep object 'array))
(frob (and (consp object)
(defvar *precompiled-pprint-dispatch-funs*
(list (frob (typep object 'array))
(frob (and (consp object)
(destructuring-bind (type) (cdr type)
`(not ,(compute-test-expr type object))))
(and
(destructuring-bind (type) (cdr type)
`(not ,(compute-test-expr type object))))
(and
- `(and ,@(mapcar #'(lambda (type)
- (compute-test-expr type object))
+ `(and ,@(mapcar (lambda (type)
+ (compute-test-expr type object))
- `(or ,@(mapcar #'(lambda (type)
- (compute-test-expr type object))
+ `(or ,@(mapcar (lambda (type)
+ (compute-test-expr type object))
(new (make-pprint-dispatch-table
:entries (copy-list (pprint-dispatch-table-entries orig))))
(new-cons-entries (pprint-dispatch-table-cons-entries new)))
(new (make-pprint-dispatch-table
:entries (copy-list (pprint-dispatch-table-entries orig))))
(new-cons-entries (pprint-dispatch-table-cons-entries new)))
;; printers for regular types
(/show0 "doing SET-PPRINT-DISPATCH for regular types")
(set-pprint-dispatch 'array #'pprint-array)
;; printers for regular types
(/show0 "doing SET-PPRINT-DISPATCH for regular types")
(set-pprint-dispatch 'array #'pprint-array)
(set-pprint-dispatch 'cons #'pprint-fill -2)
;; cons cells with interesting things for the car
(/show0 "doing SET-PPRINT-DISPATCH for CONS with interesting CAR")
(set-pprint-dispatch 'cons #'pprint-fill -2)
;; cons cells with interesting things for the car
(/show0 "doing SET-PPRINT-DISPATCH for CONS with interesting CAR")