Changeset 17249 in project


Ignore:
Timestamp:
02/13/10 06:56:18 (10 years ago)
Author:
Kon Lovett
Message:

Save

Location:
release/4/srfi-27/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/srfi-27/trunk/composite-random-source.scm

    r17246 r17249  
    2121
    2222(define *composite-random-source
    23   (let ((random-state?
     23  (let ((random-states?
    2424         (lambda (obj k n)
    25            (and (list? obj) (pair? obj)
     25           (and (pair? obj)
    2626                (eq? k (car obj))
     27                (list? obj)
    2728                (fx= n (fx- (length obj) 1)))))
    2829        (state-ref (lambda (s) ((@random-source-state-ref s))))
     
    4950          ;state-set!
    5051          (lambda (state)
    51             (unless (random-state? state kind srcs-cnt)
    52               (error-argument-type (string->symbol (conc kind #\- 'state-set!)) state 'composite-random-state))
    53             (for-each state-set! srcs (cdr state)))
     52            (if (random-states? state kind srcs-cnt) (for-each state-set! srcs (cdr state))
     53                (error-argument-type
     54                  (string->symbol (conc kind #\- 'state-set!)) state 'composite-random-state) ) )
    5455          ;randomize!
    5556          (lambda (e) (for-each (lambda (s) ((@random-source-randomize! s) e)) srcs))
    5657          ;pseudo-randomize!
    57           (lambda (i j)
    58             (for-each (lambda (s) ((*random-source-pseudo-randomize! s) i j) ) srcs) )
     58          (lambda (i j) (for-each (lambda (s) ((*random-source-pseudo-randomize! s) i j) ) srcs) )
    5959          ;make-integers
    6060          (lambda () (lambda (n) (comb-int (map (cut <> n) make-integers) n)))
     
    8080            (comb-real (lambda (reals unit) (apply * reals)))
    8181          #!rest srcs0)
    82   (when (null? srcs0)
    83     (error 'composite-random-source "no random-sources to combine") )
    84   (for-each (cut check-random-source 'composite-random-source <>) srcs0)
     82  (if (null? srcs0) (error 'composite-random-source "no random-sources to combine")
     83      (for-each (cut check-random-source 'composite-random-source <>) srcs0) )
    8584  (let loop ((srcs srcs0)
    8685             (kinds '())
     
    9190    (if (null? srcs)
    9291        ;then make composed random-source
    93         (let ((kind (string->symbol (reverse-string-append (intersperse kinds "+")))))
    94           (values kind
    95                   (*composite-random-source
    96                     comb-int comb-real
    97                     (string->symbol (reverse-string-append (intersperse kinds "+")))
    98                     (reverse-string-append (intersperse docus " & "))
    99                     ;FIXME minimum? (if this is good then apply along the way)
    100                     (apply min log2-periods)
    101                     (apply min maxrngs)
    102                     (apply min maxmods)
    103                     srcs)) )
     92        (*composite-random-source
     93          comb-int comb-real
     94          (string->symbol (reverse-string-append (intersperse kinds "+")))
     95          (reverse-string-append (intersperse docus " & "))
     96          ;FIXME minimum? (if this is good then apply along the way)
     97          (apply min log2-periods)
     98          (apply min maxrngs)
     99          (apply min maxmods)
     100          srcs)
    104101        ;else collect info
    105102        (let ((s (car srcs)))
  • release/4/srfi-27/trunk/thread-support.scm

    r16436 r17249  
    7474;;
    7575
    76 (define (thread-blocked?/termination thread)
    77   (and (thread-blocked? thread)
    78        (thread-recipients? thread)) )
    79 
    80 (define (thread-blocked?/io thread)
    81   (and (thread-blocked? thread)
    82        (thread-blockers? thread)) )
    83 
    84 (define (thread-blocked?/timeout thread)
    85   (and (thread-blocked? thread)
    86        (thread-timeout? thread)) )
     76(define (thread-blocked?/termination thread) (and (thread-blocked? thread) (thread-recipients? thread)))
     77(define (thread-blocked?/io thread) (and (thread-blocked? thread) (thread-blockers? thread)))
     78(define (thread-blocked?/timeout thread) (and (thread-blocked? thread) (thread-timeout? thread)))
    8779
    8880;;
     
    9183        (when (thread-blocked? thread)
    9284    (cond #; ;CANNOT UNBLOCK
    93           ((thread-recipients? thread)
    94             (##sys#thread-unblock! thread))
     85          ((thread-recipients? thread)  (##sys#thread-unblock! thread))
    9586          #; ;CANNOT UNBLOCK
    96           ((thread-blockers? thread)
    97             (##sys#thread-unblock! thread))
    98           ((thread-timeout? thread)
    99             (##sys#thread-unblock! thread)) ) ) )
     87          ((thread-blockers? thread)    (##sys#thread-unblock! thread))
     88          ((thread-timeout? thread)     (##sys#thread-unblock! thread)) ) ) )
    10089
    10190;;
  • release/4/srfi-27/trunk/timed-resource.scm

    r16436 r17249  
    3131  (*make-timed-resource op cl to th it)
    3232  *timed-resource?
    33   (op timed-resource-opener)
    34   (cl timed-resource-closer)
     33  (op @timed-resource-open)
     34  (cl @timed-resource-close)
    3535  (to timed-resource-timeout)
    3636  (th timed-resource-thread timed-resource-thread-set!)
     
    4040
    4141(define (timed-resource-close tr)
    42   ((timed-resource-closer tr) (timed-resource-item tr))
     42  ((@timed-resource-close tr) (timed-resource-item tr))
    4343  (timed-resource-item-set! tr #f) )
    4444
    45 (define (timed-resource-open trmtx tr)
    46   (let ((res ((timed-resource-opener tr))))
     45(define (timed-resource-open tr)
     46  (let ((res ((@timed-resource-open tr))))
    4747    (timed-resource-item-set! tr res)
    4848    res ) )
     
    8383    (thread-reap! (timed-resource-thread tr)) ) )
    8484
    85 (define ((timed-resource-timer trmtx tr))
     85(define ((make-timed-resource-timer trmtx tr))
    8686  (thread-sleep! (timed-resource-timeout tr))
    8787  (timed-resource-drop! trmtx) )
    8888
    8989(define (timed-resource-timer-start! trmtx tr)
    90   (let ((thread (make-thread (timed-resource-timer trmtx tr) (gensym 'timed-resource:))))
     90  (let ((thread (make-thread (make-timed-resource-timer trmtx tr) (gensym 'timed-resource:))))
    9191    (timed-resource-thread-set! tr thread)
    9292    (add-timed-resource! tr)
     
    9696  (or (timed-resource-item tr)
    9797      (begin0
    98         (timed-resource-open trmtx tr)
     98        (timed-resource-open tr)
    9999        (timed-resource-timer-start! trmtx tr) ) ) )
    100100
Note: See TracChangeset for help on using the changeset viewer.