Changeset 37388 in project


Ignore:
Timestamp:
03/17/19 00:59:13 (12 months ago)
Author:
Kon Lovett
Message:

rm dup issue, update test

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

Legend:

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

    r35790 r37388  
    55
    66;; Issues
    7 ;;
    8 ;; - should use more "scheme'y" names for operations?
    97;;
    108;; - all slot options are "lost" after definition.
  • release/5/coops-utils/trunk/tests/coops-utils-test.scm

    r35790 r37388  
    1010(import
    1111  (chicken syntax)
    12   (chicken fixnum)
    1312  (srfi 1)
    1413  (srfi 13)
     
    7675(test-assert (instance? s1xy-inst))
    7776(test-assert (instance-of? s1xy-inst <s1xy>))
    78 
    79 (describe-object s1xy-inst)
    80 
    81 #| FIXME - y = 's1xy-y ?
    82 (define s1xy-inst-x (make <s1xy> 'x 1))
    83 (test-assert (instance? s1xy-inst-x))
    84 (test-assert (instance-of? s1xy-inst-x <s1xy>))
    85 (describe-object s1xy-inst-x)
    86 ;=>
    87 ;coops instance of class `<s1xy>':
    88 ;x: 1
    89 ;y: s1xy-y
    90 |#
     77;(describe-object s1xy-inst)
    9178
    9279(define-class <first> () (next))
     
    10592
    10693(let ()
     94  (define-generic (city-market-class obj))
     95  (define-generic (city-goods obj))
    10796  (define-class city () (name (market-class reader: city-market-class) sellers buyers (goods accessor: city-goods)))
    10897  (define temphawa (make city 'name "Hawa" 'market-class 2))
     
    152141
    153142(define-method (initialize-instance (obj <random-distribution>))
    154   ; The 'ctor' should be a globally defined procedure compiled
    155   ; with procedure-information. So if following nomenclature then the last
    156   ; procedure name element will be the kind of distribution.
     143  ;Reconstruct distribution api ctor invocation parameters
     144  ;(The 'ctor' must be a globally defined procedure compiled
     145  ;with procedure-information. So if following nomenclature then the last
     146  ;procedure name element will be the kind of distribution.)
    157147  (let* (
    158     (temp (slot-value obj 'temp))
     148    (temp (slot@ obj temp))
    159149    (ctor (car temp))
    160150    (procinfo (procedure-information ctor))
    161     (name (and procinfo (pair? procinfo) (symbol->string (car procinfo))))
     151    (name (and (pair? procinfo) (symbol->string (car procinfo))))
    162152    (name
    163153      (and-let* (
    164154        (name)
    165155        (kndpos (string-index-right name #\-)))
    166         (substring/shared name (fx+ kndpos 1)) ) )
     156        (substring/shared name (+ kndpos 1)) ) )
    167157    (dstr-vals (receive (apply ctor (cdr temp))))
    168     (parms (and (fx<= 2 (length dstr-vals)) (receive ((second dstr-vals))))) )
    169     (set! (slot-value obj 'temp) #f) ;"free" the "any" slot
    170     (set! (slot-value obj 'namsym) (string->symbol name))
    171     (set! (slot-value obj 'nxtval) (first dstr-vals))
    172     (set! (slot-value obj 'parms) (and parms (drop-right parms 1))) ) )
     158    (parms (and (<= 2 (length dstr-vals)) (receive ((second dstr-vals))))) )
     159    (slot@ obj temp = #f) ;"free" the "any" slot
     160    (slot@ obj namsym = (string->symbol name))
     161    (slot@ obj nxtval = (first dstr-vals))
     162    (slot@ obj parms = (and parms (drop-right parms 1))) ) )
    173163|#
    174164
Note: See TracChangeset for help on using the changeset viewer.