Delete unused type predicates.
Toshimi Sawada
5 years ago
| 876 | 876 |
`(axiom-condition (demod-axiom ,_demod)))
|
| 877 | 877 |
|
| 878 | 878 |
(eval-when (:execute :load-toplevel)
|
| 879 | |
(setf (get 'demod :type-predicate) (symbol-function 'demod-p))
|
| 880 | 879 |
(setf (get 'demod :print) 'print-demod-internal)
|
| 881 | 880 |
)
|
| 882 | 881 |
|
| 74 | 74 |
)
|
| 75 | 75 |
|
| 76 | 76 |
(eval-when (:execute :load-toplevel)
|
| 77 | |
(setf (get 'rewrite-rule :type-predicate)
|
| 78 | |
(symbol-function 'rewrite-rule-p))
|
| 79 | 77 |
(setf (get 'rewrite-rule :print) 'print-rule-internal))
|
| 80 | 78 |
|
| 81 | 79 |
(defun print-rule-object (obj stream &rest ignore)
|
|
| 124 | 122 |
(extensions nil :type list))
|
| 125 | 123 |
|
| 126 | 124 |
(eval-when (:execute :load-toplevel)
|
| 127 | |
(setf (get 'ex-rewrite-rule :type-predicate)
|
| 128 | |
(symbol-function 'ex-rewrite-rule-p))
|
| 129 | 125 |
(setf (get 'ex-rewrite-rule :print)
|
| 130 | 126 |
'print-rule-internal))
|
| 131 | 127 |
|
|
| 163 | 159 |
)
|
| 164 | 160 |
|
| 165 | 161 |
(eval-when (:execute :load-toplevel)
|
| 166 | |
(setf (get 'axiom :type-predicate) (symbol-function 'axiom-p))
|
| 167 | 162 |
(setf (get 'axiom :print) 'print-axiom-brief)
|
| 168 | 163 |
)
|
| 169 | 164 |
|
| 534 | 534 |
(op-maps nil :type list))
|
| 535 | 535 |
|
| 536 | 536 |
(eval-when (:execute :load-toplevel)
|
| 537 | |
(setf (symbol-function 'is-view-struct) (symbol-function 'view-struct-p))
|
| 538 | |
(setf (get 'view-struct :type-predicate) (symbol-function 'view-struct-p))
|
| 539 | 537 |
(setf (get 'view-struct :print) 'print-view-internal))
|
| 540 | 538 |
|
| 541 | 539 |
(defun print-view-struct-object (obj stream &rest ignore)
|
| 138 | 138 |
)
|
| 139 | 139 |
|
| 140 | 140 |
(eval-when (:execute :load-toplevel)
|
| 141 | |
(setf (get 'operator :type-predicate) (symbol-function 'operator-p))
|
| 142 | 141 |
(setf (get 'operator :print) 'print-operator-internal))
|
| 143 | 142 |
|
| 144 | 143 |
(defun print-operator-object (obj stream &rest ignore)
|
|
| 433 | 432 |
(id-symbol nil :type symbol))
|
| 434 | 433 |
|
| 435 | 434 |
(eval-when (:execute :load-toplevel)
|
| 436 | |
(setf (get 'method :type-predicate) (symbol-function 'method-p))
|
| 437 | 435 |
(setf (get 'method :print) 'print-method-internal))
|
| 438 | 436 |
|
| 439 | 437 |
(defun print-method-object (obj stream &rest ignore)
|
|
| 632 | 630 |
)
|
| 633 | 631 |
|
| 634 | 632 |
(eval-when (:execute :load-toplevel)
|
| 635 | |
(setf (get '!method-info :type-predicate) (symbol-function '!method-info-p))
|
| 636 | 633 |
(setf (get '!method-info :print) nil))
|
| 637 | 634 |
|
| 638 | 635 |
;;;
|
| 130 | 130 |
)
|
| 131 | 131 |
|
| 132 | 132 |
(eval-when (:execute :load-toplevel)
|
| 133 | |
(setf (get 'sort :type-predicate) (symbol-function 'sort-p))
|
| 134 | |
(setf (get 'sort :eval) nil)
|
| 135 | 133 |
(setf (get 'sort :print) 'print-sort-internal))
|
| 136 | 134 |
|
| 137 | 135 |
;;; Common sort accessors -----------------------------------------------------
|
|
| 232 | 230 |
(info nil :type list))
|
| 233 | 231 |
|
| 234 | 232 |
(eval-when (:execute :load-toplevel)
|
| 235 | |
(setf (get 'bsort :type-predicate) (symbol-function 'bsort-p))
|
| 236 | 233 |
(setf (get 'bsort :print) 'print-bsort-internal))
|
| 237 | 234 |
|
| 238 | 235 |
(defun print-bsort-object (obj stream &rest ignore)
|
|
| 308 | 305 |
(components nil :type list))
|
| 309 | 306 |
|
| 310 | 307 |
(eval-when (:execute :load-toplevel)
|
| 311 | |
(setf (get 'and-sort :type-predicate)
|
| 312 | |
(symbol-function 'and-sort-p))
|
| 313 | 308 |
(setf (get 'and-sort :print)
|
| 314 | 309 |
'print-and-sort-internal))
|
| 315 | 310 |
|
|
| 351 | 346 |
(components nil :type list))
|
| 352 | 347 |
|
| 353 | 348 |
(eval-when (:execute :load-toplevel)
|
| 354 | |
(setf (get 'or-sort :type-predicate) (symbol-function 'or-sort-p))
|
| 355 | 349 |
(setf (get 'or-sort :print) 'print-or-sort-internal))
|
| 356 | 350 |
|
| 357 | 351 |
(defun print-or-sort-object (obj stream &rest ignore)
|
|
| 388 | 382 |
(lowers nil :type list))
|
| 389 | 383 |
|
| 390 | 384 |
(eval-when (:execute :load-toplevel)
|
| 391 | |
(setf (get 'err-sort :type-predicate) (symbol-function 'err-sort-p))
|
| 392 | 385 |
(setf (get 'err-sort :print) 'print-err-sort-internal))
|
| 393 | 386 |
|
| 394 | 387 |
(defun print-err-sort-object (obj stream &rest ignore)
|
| 298 | 298 |
(si::define-inline-function %is-chaos-term? (ast)
|
| 299 | 299 |
(and (not (stringp ast)) (chaos-object? ast) (get (object-type ast) ':category)))
|
| 300 | 300 |
|
|
301 |
;;; AST is defined by 'defterm'
|
|
302 |
;;;
|
|
303 |
(declaim (inline is-ast))
|
|
304 |
(defun is-ast (obj)
|
|
305 |
(declare (optimize (speed 3) (safety 0)))
|
|
306 |
(and (consp obj)
|
|
307 |
(let ((cat (car obj)))
|
|
308 |
(and (symbolp cat)
|
|
309 |
(getf (symbol-plist cat) :category)))))
|
|
310 |
|
| 301 | 311 |
;;; EOF
|
| 87 | 87 |
(setf flg t))
|
| 88 | 88 |
(princ ")")))
|
| 89 | 89 |
(t (princ ast))))
|
| 90 | |
|
| 91 | |
(declaim (inline is-ast))
|
| 92 | |
(defun is-ast (obj)
|
| 93 | |
(declare (optimize (speed 3) (safety 0)))
|
| 94 | |
(and (consp obj)
|
| 95 | |
(let ((cat (car obj)))
|
| 96 | |
(and (symbolp cat)
|
| 97 | |
(getf (symbol-plist cat) :category)))))
|
| 98 | 90 |
|
| 99 | 91 |
;;;====================================================
|
| 100 | 92 |
;;; TERM PRINTER
|