148 |
(check-subtypep type2 `(not ,type1) t) |
(check-subtypep type2 `(not ,type1) t) |
149 |
(check-subtypep `(and ,type1 ,type2) nil t) |
(check-subtypep `(and ,type1 ,type2) nil t) |
150 |
(check-subtypep `(and ,type2 ,type1) nil t) |
(check-subtypep `(and ,type2 ,type1) nil t) |
151 |
|
(check-subtypep `(and ,type1 (not ,type2)) type1 t) |
152 |
|
(check-subtypep `(and (not ,type2) ,type1) type1 t) |
153 |
|
(check-subtypep `(and ,type2 (not ,type1)) type2 t) |
154 |
|
(check-subtypep `(and (not ,type1) ,type2) type2 t) |
155 |
|
(check-subtypep type1 `(or ,type1 (not ,type2)) t) |
156 |
|
(check-subtypep type1 `(or (not ,type2) ,type1) t) |
157 |
|
(check-subtypep type2 `(or ,type2 (not ,type1)) t) |
158 |
|
(check-subtypep type2 `(or (not ,type1) ,type2) t) |
159 |
))) |
))) |
160 |
|
|
161 |
(defun check-subtypep (type1 type2 is-sub &optional should-be-valid) |
(defun check-subtypep (type1 type2 is-sub &optional should-be-valid) |
629 |
|
|
630 |
(defun types-6-body () |
(defun types-6-body () |
631 |
(loop |
(loop |
632 |
for p in *subtype-table* count |
for p in *subtype-table* |
633 |
(let ((tp (car p))) |
for tp = (car p) |
634 |
(when (and (not (member tp '(sequence cons list t))) |
append |
635 |
(not (subtypep* tp 'atom))) |
(and (not (member tp '(sequence cons list t))) |
636 |
(format t "~%Problem! Did not find to be an atomic type: ~S" tp) |
(let ((message (check-subtypep tp 'atom t t))) |
637 |
t)))) |
(if message (list message)))))) |
638 |
|
|
639 |
(defparameter *type-list* nil) |
(defparameter *type-list* nil) |
640 |
(defparameter *supertype-table* nil) |
(defparameter *supertype-table* nil) |