Changeset 37007 in project


Ignore:
Timestamp:
12/16/18 19:26:27 (6 months ago)
Author:
kon
Message:

better shuffle

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/5/synch/trunk/tests/synch-continuation-test.scm

    r36997 r37007  
    44;;
    55
     6(cond-expand
     7  (chicken-5
     8    (import
     9      (chicken type)
     10      (only (chicken fixnum) fx= fx+ fx- fxmod)
     11      (only (chicken random) pseudo-random-integer) )
     12    (define platform-random pseudo-random-integer) )
     13  (chicken-4
     14    (use
     15      (only chicken fx= fx+ fx- fxmod)
     16      (only extras random))
     17    (define platform-random random) ) )
     18
     19(: vector-shuffle! ((vector-of *) #!optional (procedure (fixnum) fixnum) -> void))
     20;
     21(define (vector-shuffle! vec #!optional (rnd platform-random))
     22  (let (
     23    (len (vector-length vec)) )
     24    (define (swap-adj! i)
     25      (let (
     26        (i+1 (fxmod (fx+ i 1) len))
     27        (tmp (vector-ref vec i)) )
     28        (vector-set! vec i (vector-ref vec i+1))
     29        (vector-set! vec i+1 tmp) ) )
     30    (do ((n len (fx- n 1)))
     31        ((fx= n 0))
     32      (swap-adj! (rnd len)) ) ) )
     33
     34(: shuffle ((list-of *) #!optional (procedure (fixnum) fixnum) -> (list-of *)))
     35;
     36(define (shuffle ls #!optional (rnd platform-random))
     37  (let (
     38    (vec (list->vector ls)) )
     39    (vector-shuffle! vec rnd)
     40    (vector->list vec) ) )
     41
     42;;
     43
    644(define (eof-object) #!eof)
     45
     46;; SRFI 121
     47
     48(define (make-coroutine-generator proc)
     49  (define return #f)
     50  (define resume #f)
     51  (define yield (lambda (v) (call/cc (lambda (r) (set! resume r) (return v)))))
     52  (lambda () (call/cc (lambda (cc) (set! return cc)
     53                        (if resume
     54                          (resume (if #f #f))  ; void? or yield again?
     55                          (begin (proc yield)
     56                                 (set! resume (lambda (v) (return (eof-object))))
     57                                 (return (eof-object))))))))
     58
     59;; srfi-154
    760
    861(define (current-dynamic-extent)
     
    2174           (call-with-values thunk k))))))
    2275
    23 ;; SRFI-121
    24 
    25 ;; make-coroutine-generator
    26 (define (make-coroutine-generator proc)
    27   (define return #f)
    28   (define resume #f)
    29   (define yield (lambda (v) (call/cc (lambda (r) (set! resume r) (return v)))))
    30   (lambda () (call/cc (lambda (cc) (set! return cc)
    31                         (if resume
    32                           (resume (if #f #f))  ; void? or yield again?
    33                           (begin (proc yield)
    34                                  (set! resume (lambda (v) (return (eof-object))))
    35                                  (return (eof-object))))))))
    36 
    37 ;; SRFI-154
    38 
    3976(define-syntax dynamic-lambda
    4077  (syntax-rules ()
     
    4380       (lambda formals
    4481         (dynamic-extent (lambda () body ...)))))))
    45 
    46 ;;
    47 
    48 (import (chicken fixnum) (chicken random) (chicken sort) (srfi 1))
    49 
    50 (: fx<car ((pair fixnum *) (pair fixnum *) --> boolean))
    51 ;
    52 (define (fx<car a b) (fx< (car a) (car b)))
    53 
    54 (: shuffle ((list-of *) #!optional (procedure (fixnum) fixnum) -> (list-of *)))
    55 ;
    56 (define (shuffle ls #!optional (rand pseudo-random-integer))
    57   (let* (
    58     (len (length ls))
    59     (tagged-ls (map (lambda (x) (cons (rand len) x)) ls)) )
    60     (map! cdr (sort! tagged-ls fx<car) ) ) )
    6182
    6283;;
     
    97118  (randomize-run-in-threads)
    98119  (start-run-in-threads)
     120  ;(thread-yield!)
    99121  (randomize-run-in-threads)
    100122  (join-run-in-threads) )
    101123
    102124;; Test
    103 
    104125
    105126(define *statement* #<<EOS
    106127;*** Tests Will Fail ***
    107128;Which depends on how threads are scheduled.
    108 ;But the myth of \"isolation\" is broken.
    109 ;Need to know what is being synch'ed.
    110 ;Using Coroutine Generators OK, Dynamic-Lambda, not OK.
     129;Shows a reasonable use of an exit continuation breaks the implied
     130;"isolation". Need to know what is being synch'ed.
     131;Coroutine Generators OK, Dynamic-Lambda, not OK.
    111132EOS
    112133)
    113134
     135;
    114136
    115137(test-begin "Synch Examples")
    116138
    117 ;
    118 
    119 (define mx1 (make-mutex 'mx1))
    120 
     139;#;
    121140(let ((genny (count-to-coroutine 5)) (end-state #f))
    122   (run-in-thread
    123     (test-group "Genny"
     141(run-in-thread
     142  (test-group "Genny"
     143    ;(let ((genny (count-to-coroutine 5)) (end-state #f))
    124144      (let loop ((i (genny)))
    125145        (unless (eof-object? i)
     
    127147          (thread-yield!)
    128148          (loop (genny)) ) )
    129       (test "ran to end" 4 end-state)
    130     )
    131   )
    132 )
     149      (test "ran to end" 4 end-state) )
     150  )
     151)
     152
     153;#;
     154(let ((iter (count-to-iteration 5)) (end-state #f))
     155(run-in-thread
     156  (test-group "Dynamic Context"
     157    ;(let ((iter (count-to-iteration 5)) (end-state #f))
     158      (iter (lambda (state)
     159        (thread-yield!)
     160        (set! end-state state)))
     161      (test "ran to end" 4 end-state) )
     162  )
     163)
     164
     165;
    133166
    134167(import synch-wrapped)
     168
     169(define mx1 (make-mutex 'mx1))
     170
     171;#;
    135172(let ((genny (count-to-coroutine 5)) (end-state #f))
    136   (run-in-thread
    137     ;(import synch-wrapped) ;Error: unbound variable: synch-params#current-synch-abandon?
    138     (test-group "Synch Genny"
     173(run-in-thread
     174  (test-group "Synch Genny"
     175    ;(let ((genny (count-to-coroutine 5)) (end-state #f))
    139176      (synch mx1
    140177        (let loop ((i (genny)))
     
    142179          (unless (eof-object? i)
    143180            (set! end-state i)
    144           (thread-yield!)
     181            (thread-yield!)
    145182            (loop (genny)) ) ) )
    146183      (test "ran to end" 4 end-state)
    147       (test "unlocked" 'not-abandoned (mutex-state mx1))
    148     )
    149   )
    150 )
    151 
    152 (run-in-thread
    153   (test-group "Dynamic Context"
    154     (let ((iter (count-to-iteration 5)) (end-state #f))
    155       (iter (lambda (state)
    156           (thread-yield!)
    157         (set! end-state state) ) )
    158       (test "ran to end" 4 end-state) )
    159  )
    160 )
    161 
     184      (test "unlocked" 'not-abandoned (mutex-state mx1)) )
     185  )
     186)
     187
     188;#;
     189(let ((iter (count-to-iteration 5)) (end-state #f))
    162190(run-in-thread
    163191  (test-group "Synch Dynamic Context (Early Exit Handler Call)"
    164     (let ((iter (count-to-iteration 5)) (end-state #f))
     192    ;(let ((iter (count-to-iteration 5)) (end-state #f))
    165193      (synch mx1
    166194        (iter (lambda (state)
     
    170198      (test "ran to end" 4 end-state)
    171199      (test "unlocked" 'not-abandoned (mutex-state mx1)) )
    172  )
    173 )
     200  )
     201)
     202
     203;
     204
     205;(test-begin "Synch Examples") ;interesting: test impl artifact?
    174206
    175207(print *statement*)
     
    179211
    180212(test-exit)
    181 
Note: See TracChangeset for help on using the changeset viewer.