summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--types.lisp75
1 files changed, 41 insertions, 34 deletions
diff --git a/types.lisp b/types.lisp
index 22c9940..267e34a 100644
--- a/types.lisp
+++ b/types.lisp
@@ -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)))))))