Ignore:
Timestamp:
09/01/19 10:23:31 (17 months ago)
Author:
Kon Lovett
Message:

internal refactore

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/5/coops-utils/trunk/coops-introspection.scm

    r37388 r37866  
    5555;;; Helpers
    5656
     57(define +class-primitive+ #t)
     58
    5759(: union-class-property-values (procedure (list-of coops-class) --> list))
    5860;
     
    9395  (union-class-supers (*class-supers class)) )
    9496
    95 (: strict-subclass? (coops-class coops-class --> boolean))
     97(: class< (coops-class coops-class --> boolean))
    9698;
    9799;c1 < c2
    98 (define (strict-subclass? c1 c2)
     100(define (class< c1 c2)
    99101  (subclass? c1 c2) )
    100102
    101 (: loose-subclass? (coops-class coops-class --> boolean))
    102 ;
    103 ;c1 <= c2
    104 (define (loose-subclass? c1 c2)
     103(: class<= (coops-class coops-class --> boolean))
     104;
     105(define (class<= c1 c2)
    105106  (or
    106107    (eq? c1 c2)
    107     (strict-subclass? c1 c2)) )
     108    (class< c1 c2)) )
    108109
    109110(: *method-specializers (pair --> *))
     
    133134  (vector-ref (check-generic-form loc obj idx vector-boxed-list?) 0) )
    134135
    135 (: top-instance-of? (* coops-class --> *))
     136(: top-instance-of? (* coops-class --> boolean))
    136137;
    137138(define (top-instance-of? x class)
    138139  (let ((class-x (class-of x)))
    139140    (or
    140       (eq? #t class-x) ;primitive
    141       (loose-subclass? class class-x) ) ) )
     141      (eq? +class-primitive+ class-x)
     142      (class<= class class-x) ) ) )
    142143
    143144;; call-by-ref
    144145
    145 (: generic-name? (* --> *))
     146(: generic-name? (* --> boolean))
    146147;
    147148(define (generic-name? obj)
     
    150151    (symbol? obj)) )
    151152
    152 (: vector-boxed-list? (* --> *))
     153(: vector-boxed-list? (* --> boolean))
    153154;
    154155(define (vector-boxed-list? obj)
     
    163164;
    164165(define (instance-of? x class)
    165   (loose-subclass? (class-of x) class) )
     166  (class<= (class-of x) class) )
    166167
    167168(: class? (* -> boolean : coops-class))
Note: See TracChangeset for help on using the changeset viewer.