Changeset 37866 in project for release/5/coops-utils/trunk/coops-introspection.scm

Timestamp:

09/01/19 10:23:31 (17 months ago)

Author:

Kon Lovett

Message:

internal refactore

File:

• release/5/coops-utils/trunk/coops-introspection.scm (modified) (5 diffs)

release/5/coops-utils/trunk/coops-introspection.scm

@@ -55 +55 @@
 ;;; Helpers
 
+(define +class-primitive+ #t)
+
 (: union-class-property-values (procedure (list-of coops-class) --> list))
 ;
@@ -93 +95 @@
   (union-class-supers (*class-supers class)) )
 
-(: strict-subclass? (coops-class coops-class --> boolean))
+(: class< (coops-class coops-class --> boolean))
 ;
 ;c1 < c2
-(define (strict-subclass? c1 c2)
+(define (class< c1 c2)
   (subclass? c1 c2) )
 
-(: loose-subclass? (coops-class coops-class --> boolean))
-;
-;c1 <= c2
-(define (loose-subclass? c1 c2)
+(: class<= (coops-class coops-class --> boolean))
+;
+(define (class<= c1 c2)
   (or
     (eq? c1 c2)
-    (strict-subclass? c1 c2)) )
+    (class< c1 c2)) )
 
 (: *method-specializers (pair --> *))
@@ -133 +134 @@
   (vector-ref (check-generic-form loc obj idx vector-boxed-list?) 0) )
 
-(: top-instance-of? (* coops-class --> *))
+(: top-instance-of? (* coops-class --> boolean))
 ;
 (define (top-instance-of? x class)
   (let ((class-x (class-of x)))
     (or
-      (eq? #t class-x) ;primitive
-      (loose-subclass? class class-x) ) ) )
+      (eq? +class-primitive+ class-x)
+      (class<= class class-x) ) ) )
 
 ;; call-by-ref
 
-(: generic-name? (* --> *))
+(: generic-name? (* --> boolean))
 ;
 (define (generic-name? obj)
@@ -150 +151 @@
     (symbol? obj)) )
 
-(: vector-boxed-list? (* --> *))
+(: vector-boxed-list? (* --> boolean))
 ;
 (define (vector-boxed-list? obj)
@@ -163 +164 @@
 ;
 (define (instance-of? x class)
-  (loose-subclass? (class-of x) class) )
+  (class<= (class-of x) class) )
 
 (: class? (* -> boolean : coops-class))