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)))))))  | 
