diff options
-rw-r--r-- | types.lisp | 75 |
1 files changed, 41 insertions, 34 deletions
@@ -10,39 +10,44 @@ ;(defvar *type-table*) -(setq *subtype-relationships* - '((base-char . (character)) - (bignum . (integer)) - (bit-vector . (vector)) - (broadcast-stream . (stream)) - (complex . (number)) - (concatenated-stream . (stream)) - (cons . (list)) - (double-float . (float)) - (echo-stream . (stream)) - (extended-char . (character)) - (file-stream . (stream)) - (fixnum . (integer)) - (float . (real)) - (integer . (rational)) - (list . (sequence)) - (long-float . (float)) - (null . (list symbol)) - (ratio . (rational)) - (rational . (real)) - (real . (number)) - (short-float . (float)) - (simple-array . (array)) - (simple-bit-vector . (simple-array)) - (simple-string . (simple-array)) - (simple-vector . (simple-array)) - (single-float . (float)) - (standard-char . (base-char)) - (string . (vector)) - (string-stream . (stream)) - (synonym-stream . (stream)) - (two-way-stream . (stream)) - (vector . (array sequence)))) +(setq *subtype-supertypes-dict* + (let ((relationship-alist + '((base-char . (character)) + (bignum . (integer)) + (bit-vector . (vector)) + (broadcast-stream . (stream)) + (complex . (number)) + (concatenated-stream . (stream)) + (cons . (list)) + (double-float . (float)) + (echo-stream . (stream)) + (extended-char . (character)) + (file-stream . (stream)) + (fixnum . (integer)) + (float . (real)) + (integer . (rational)) + (list . (sequence)) + (long-float . (float)) + (null . (list symbol)) + (ratio . (rational)) + (rational . (real)) + (real . (number)) + (short-float . (float)) + (simple-array . (array)) + (simple-bit-vector . (simple-array)) + (simple-string . (simple-array)) + (simple-vector . (simple-array)) + (single-float . (float)) + (standard-char . (base-char)) + (string . (vector)) + (string-stream . (stream)) + (synonym-stream . (stream)) + (two-way-stream . (stream)) + (vector . (array sequence)))) + (dict (send-by-name (find-objc-class "NSMutableDictionary") + "dictionary"))) + (dolist (pair relationship-alist dict) + (send-by-name dict "setObject:forKey:" (cdr pair) (car pair))))) (setq most-positive-fixnum 32767) @@ -138,5 +143,7 @@ ;;FIXME? (subtypep type1 (first type2) environment)))) (t (or (eq type1 type2) - (let ((supertypes (assoc type1 *subtype-relationships* :test 'eq))) + (let ((supertypes (send-by-name *subtype-supertypes-dict* + "objectForKey:" + type1))) (some1 (lambda (x) (subtypep x type2 environment)) supertypes))))))) |