Changeset 37867 in project


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

refactor

File:
1 edited

Legend:

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

    r37866 r37867  
    5757(define +class-primitive+ #t)
    5858
    59 (: union-class-property-values (procedure (list-of coops-class) --> list))
     59(: union-class-property-values (procedure (list-of coops-class) -> list))
    6060;
    6161(define (union-class-property-values getter classes)
     
    6565    classes) )
    6666
    67 (: *class-slots (coops-class --> list))
     67(: *class-slots (coops-class -> list))
    6868;
    6969(define (*class-slots class)
    7070  (slot-value class 'slots) )
    7171
    72 (: *class-supers (coops-class --> list))
     72(: *class-supers (coops-class -> list))
    7373;
    7474(define (*class-supers class)
    7575  (slot-value class 'class-precedence-list) )
    7676
    77 (: union-class-slots ((list-of coops-class) --> list))
     77(: union-class-slots ((list-of coops-class) -> list))
    7878;
    7979(define (union-class-slots classes)
    8080  (union-class-property-values *class-slots classes) )
    8181
    82 (: union-class-supers ((list-of coops-class) --> list))
     82(: union-class-supers ((list-of coops-class) -> list))
    8383;
    8484(define (union-class-supers classes)
    8585  (union-class-property-values *class-supers classes) )
    8686
    87 (: class-supers-slots (coops-class --> list))
     87(: class-supers-slots (coops-class -> list))
    8888;
    8989(define (class-supers-slots class)
    9090  (union-class-slots (*class-supers class)) )
    9191
    92 (: class-supers-supers (coops-class --> list))
     92(: class-supers-supers (coops-class -> list))
    9393;
    9494(define (class-supers-supers class)
    9595  (union-class-supers (*class-supers class)) )
    9696
    97 (: class< (coops-class coops-class --> boolean))
     97(: class< (coops-class coops-class -> boolean))
    9898;
    9999;c1 < c2
     
    101101  (subclass? c1 c2) )
    102102
    103 (: class<= (coops-class coops-class --> boolean))
     103(: class<= (coops-class coops-class -> boolean))
    104104;
    105105(define (class<= c1 c2)
     
    108108    (class< c1 c2)) )
    109109
    110 (: *method-specializers (pair --> *))
     110(: *method-specializers (pair -> *))
    111111;
    112112(define *method-specializers car)
    113113
    114 (: *method-procedure (pair --> *))
     114(: *method-procedure (pair -> *))
    115115;
    116116(define *method-procedure cdr)
     
    121121  (error loc "generic closure form violation" obj idx) )
    122122
    123 (: check-generic-form (symbol * fixnum procedure --> *))
     123(: check-generic-form (symbol * fixnum procedure -> *))
    124124;
    125125(define (check-generic-form loc obj0 idx type-pred?)
     
    129129    obj ) )
    130130
    131 (: check-generic-methods (symbol * fixnum --> *))
    132 ;
    133 (define (check-generic-methods loc obj idx)
     131(: checked-generic-methods (symbol * fixnum -> *))
     132;
     133(define (checked-generic-methods loc obj idx)
    134134  (vector-ref (check-generic-form loc obj idx vector-boxed-list?) 0) )
    135135
    136 (: top-instance-of? (* coops-class --> boolean))
     136(: top-instance-of? (* coops-class -> boolean))
    137137;
    138138(define (top-instance-of? x class)
     
    144144;; call-by-ref
    145145
    146 (: generic-name? (* --> boolean))
     146(: generic-name? (* -> boolean))
    147147;
    148148(define (generic-name? obj)
     
    151151    (symbol? obj)) )
    152152
    153 (: vector-boxed-list? (* --> boolean))
     153(: vector-boxed-list? (* -> boolean))
    154154;
    155155(define (vector-boxed-list? obj)
     
    161161;;; Predicates
    162162
    163 (: instance-of? (* coops-class --> boolean))
     163(: instance-of? (* coops-class -> boolean))
    164164;
    165165(define (instance-of? x class)
     
    205205;; Class Properties
    206206
    207 (: class-precedence-list (coops-class --> list))
     207(: class-precedence-list (coops-class -> list))
    208208;
    209209(define (class-precedence-list class)
    210210  (*class-supers (check-class 'class-precedence-list class)) )
    211211
    212 (: class-slots (coops-class --> list))
     212(: class-slots (coops-class -> list))
    213213;
    214214(define (class-slots class)
     
    218218
    219219;those supers declared in the direct class & not inherited
    220 (: class-direct-supers (coops-class --> list))
     220(: class-direct-supers (coops-class -> list))
    221221;
    222222(define (class-direct-supers class)
     
    225225
    226226;those slots declared in the direct class & not inherited
    227 (: class-direct-slots (coops-class --> list))
     227(: class-direct-slots (coops-class -> list))
    228228;
    229229(define (class-direct-slots class)
     
    240240    (not (##sys#slot generic 1)) ) )
    241241
    242 (: generic-name (coops-generic --> symbol))
     242(: generic-name (coops-generic -> symbol))
    243243;
    244244(define (generic-name generic)
    245245  (check-generic-form 'generic-name generic 1 generic-name?) )
    246246
    247 (: generic-specialized-arguments (coops-generic --> list))
     247(: generic-specialized-arguments (coops-generic -> list))
    248248;
    249249(define (generic-specialized-arguments generic)
    250250  (check-generic-form 'generic-specialized-args generic 7 pair?) )
    251251
    252 (: generic-primary-methods (coops-generic --> list))
     252(: generic-primary-methods (coops-generic -> list))
    253253;
    254254(define (generic-primary-methods generic)
    255   (check-generic-methods 'generic-primary-methods generic 2) )
    256 
    257 (: generic-before-methods (coops-generic --> list))
     255  (checked-generic-methods 'generic-primary-methods generic 2) )
     256
     257(: generic-before-methods (coops-generic -> list))
    258258;
    259259(define (generic-before-methods generic)
    260   (check-generic-methods 'generic-before-methods generic 3) )
    261 
    262 (: generic-after-methods (coops-generic --> list))
     260  (checked-generic-methods 'generic-before-methods generic 3) )
     261
     262(: generic-after-methods (coops-generic -> list))
    263263;
    264264(define (generic-after-methods generic)
    265   (check-generic-methods 'generic-after-methods generic 4) )
    266 
    267 (: generic-around-methods (coops-generic --> list))
     265  (checked-generic-methods 'generic-after-methods generic 4) )
     266
     267(: generic-around-methods (coops-generic -> list))
    268268;
    269269(define (generic-around-methods generic)
    270   (check-generic-methods 'generic-around-methods generic 5) )
     270  (checked-generic-methods 'generic-around-methods generic 5) )
    271271
    272272;; Method Properties
    273273
    274 (: method-specializers (coops-method --> list))
     274(: method-specializers (coops-method -> list))
    275275;
    276276(define (method-specializers method)
    277277  (*method-specializers (check-method 'method-specializers method)) )
    278278
    279 (: method-procedure (coops-method --> list))
     279(: method-procedure (coops-method -> list))
    280280;
    281281(define (method-procedure method)
Note: See TracChangeset for help on using the changeset viewer.