clojure.core/isa? port to Typed Racket

clj_port.rkt

;(defn isa?
;  "Returns true if (= child parent), or child is directly or indirectly derived from
;  parent, either via a Java type inheritance relationship or a
;  relationship established via derive. h must be a hierarchy obtained
;  from make-hierarchy, if not supplied defaults to the global
;  hierarchy"
;  {:added "1.0"}
;  ([child parent] (isa? global-hierarchy child parent))
;  ([h child parent]
;   (or (= child parent)
;       (and (class? parent) (class? child)
;            (. ^Class parent isAssignableFrom child))
;       (contains? ((:ancestors h) child) parent)
;       (and (class? child) (some #(contains? ((:ancestors h) %) parent) (supers child)))
;       (and (vector? parent) (vector? child)
;            (= (count parent) (count child))
;            (loop [ret true i 0]
;              (if (or (not ret) (= i (count parent)))
;                ret
;                (recur (isa? h (child i) (parent i)) (inc i))))))))

(require racket/set)

(struct: class ([name : Symbol]))
(struct: hierarchy ([ancestors : (HashTable class (Setof class))]))

(define int-class (class 'int))
(define num-class (class 'num))
(define float-class (class 'float))
(define object-class (class 'object))

(define global-hierarchy (hierarchy 
                          (make-hash (list (cons object-class ((inst set class)))
                                           (cons int-class (set object-class num-class))
                                           (cons num-class (set object-class))
                                           (cons float-class (set num-class object-class))))))

(: class-assignable-from-class? (class class -> Boolean))
(define (class-assignable-from-class? child parent)
  #f)

(: some-super (hierarchy Any class -> Boolean))
(define (some-super h p c)
  #f)

(define-predicate vector-of? (Vectorof Any))

(: isa? (case-lambda
          (Any Any -> Boolean)
          (hierarchy Any Any -> Boolean)))
(define isa?
  (case-lambda
    ((child parent) (isa? global-hierarchy child parent))
    ((h child parent)
     (or (equal? child parent)
         (and (class? parent) (class? child)
              (class-assignable-from-class? child parent))
         (and (class? child)
              (let* ([hs (hierarchy-ancestors h)])
                (and (hash-has-key? hs child)
                     (let ([as (hash-ref hs child)])
                       (set-member? as parent)))))
         (and (class? child) (some-super h parent child))
         (and (vector-of? child) (vector-of? parent)
              (= (vector-length child) (vector-length parent))
              (let: loop : Boolean
                ([ret : Boolean #t] 
                 [i : Integer 0])
                (if (or (not ret) (= i (vector-length parent)))
                    ret
                    (loop (isa? h (vector-ref child i) (vector-ref parent i)) (+ 1 i)))
                ))))))