Changeset 37388 in project for release/5/coops-utils/trunk

Timestamp:

03/17/19 00:59:13 (22 months ago)

Author:

Kon Lovett

Message:

rm dup issue, update test

Location:

release/5/coops-utils/trunk

Files:

• coops-introspection.scm (modified) (1 diff)
• tests/coops-utils-test.scm (modified) (4 diffs)

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

@@ -5 +5 @@
 
 ;; Issues
-;;
-;; - should use more "scheme'y" names for operations?
 ;;
 ;; - all slot options are "lost" after definition.

release/5/coops-utils/trunk/tests/coops-utils-test.scm

@@ -10 +10 @@
 (import
   (chicken syntax)
-  (chicken fixnum)
   (srfi 1)
   (srfi 13)
@@ -76 +75 @@
 (test-assert (instance? s1xy-inst))
 (test-assert (instance-of? s1xy-inst <s1xy>))
-
-(describe-object s1xy-inst)
-
-#| FIXME - y = 's1xy-y ?
-(define s1xy-inst-x (make <s1xy> 'x 1))
-(test-assert (instance? s1xy-inst-x))
-(test-assert (instance-of? s1xy-inst-x <s1xy>))
-(describe-object s1xy-inst-x)
-;=>
-;coops instance of class `<s1xy>':
-;x: 1
-;y: s1xy-y
-|#
+;(describe-object s1xy-inst)
 
 (define-class <first> () (next))
@@ -105 +92 @@
 
 (let ()
+  (define-generic (city-market-class obj))
+  (define-generic (city-goods obj))
   (define-class city () (name (market-class reader: city-market-class) sellers buyers (goods accessor: city-goods)))
   (define temphawa (make city 'name "Hawa" 'market-class 2))
@@ -152 +141 @@
 
 (define-method (initialize-instance (obj <random-distribution>))
-  ; The 'ctor' should be a globally defined procedure compiled
-  ; with procedure-information. So if following nomenclature then the last
-  ; procedure name element will be the kind of distribution.
+  ;Reconstruct distribution api ctor invocation parameters
+  ;(The 'ctor' must be a globally defined procedure compiled
+  ;with procedure-information. So if following nomenclature then the last
+  ;procedure name element will be the kind of distribution.)
   (let* (
-    (temp (slot-value obj 'temp))
+    (temp (slot@ obj temp))
     (ctor (car temp))
     (procinfo (procedure-information ctor))
-    (name (and procinfo (pair? procinfo) (symbol->string (car procinfo))))
+    (name (and (pair? procinfo) (symbol->string (car procinfo))))
     (name
       (and-let* (
         (name)
         (kndpos (string-index-right name #\-)))
-        (substring/shared name (fx+ kndpos 1)) ) )
+        (substring/shared name (+ kndpos 1)) ) )
     (dstr-vals (receive (apply ctor (cdr temp))))
-    (parms (and (fx<= 2 (length dstr-vals)) (receive ((second dstr-vals))))) )
-    (set! (slot-value obj 'temp) #f) ;"free" the "any" slot
-    (set! (slot-value obj 'namsym) (string->symbol name))
-    (set! (slot-value obj 'nxtval) (first dstr-vals))
-    (set! (slot-value obj 'parms) (and parms (drop-right parms 1))) ) )
+    (parms (and (<= 2 (length dstr-vals)) (receive ((second dstr-vals))))) )
+    (slot@ obj temp = #f) ;"free" the "any" slot
+    (slot@ obj namsym = (string->symbol name))
+    (slot@ obj nxtval = (first dstr-vals))
+    (slot@ obj parms = (and parms (drop-right parms 1))) ) )
 |#