Changeset 37866 in project


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

internal refactore

Location:
release/5/coops-utils/trunk
Files:
2 edited

Legend:

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

    r36627 r37866  
    4040(define (plist-key? key ls)
    4141  ;search plist for key name
    42   (let loop ((ls ls))
     42  (let adv ((ls ls))
    4343    (and
    4444      (not (null? ls))
    4545      (or
    4646        (eq? key (car ls))
    47         (loop (cddr ls)) ) ) ) )
     47        (adv (cddr ls)) ) ) ) )
    4848
    4949(: plist-cons (symbol * plist --> plist))
  • 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.