[functional-tests/regex] rename thread-set to yarn

This commit is contained in:
Joe Thornber 2017-08-19 09:04:48 +01:00
parent c2bfcf7899
commit 150f38cf83

View File

@ -6,7 +6,6 @@
opt opt
star star
plus plus
get-thread-count
compile-rx) compile-rx)
(import (chezscheme) (import (chezscheme)
(fmt fmt) (fmt fmt)
@ -146,46 +145,43 @@
(list->vector (list->vector
(remove-labels rx (label-locations rx)))))) (remove-labels rx (label-locations rx))))))
;; A 'thread' consists of an index into the instructions. A 'bundle' holds ;; A 'thread' consists of an index into the instructions. A 'yarn holds the
;; the current threads. Note there cannot be more threads than instructions, ;; current threads. Note there cannot be more threads than instructions, so
;; so a bundle is represented as a bitvector the same length as the ;; a yarn is represented as a vector the same length as the instructions.
;; instructions. Threads are run in lock step, all taking the same input. ;; Threads are run in lock step, all taking the same input.
(define-record-type thread-set (fields (mutable size) (mutable stack) (mutable seen))) (define-record-type yarn
(fields (mutable size)
(mutable stack)
(mutable seen)))
(define (mk-thread-set count) (define (mk-yarn count)
(make-thread-set 0 (make-vector count) (make-vector count #f))) (make-yarn 0 (make-vector count) (make-vector count #f)))
(define (clear-thread-set! ts) (define (clear-yarn! y)
(thread-set-size-set! ts 0) (yarn-size-set! y 0)
(vector-fill! (thread-set-seen ts) #f)) (vector-fill! (yarn-seen y) #f))
(define thread-count 0) (define (add-thread! y i)
(define (get-thread-count) (unless (vector-ref (yarn-seen y) i)
thread-count) (vector-set! (yarn-seen y) i #t)
(vector-set! (yarn-stack y) (yarn-size y) i)
(yarn-size-set! y (+ 1 (yarn-size y)))))
(define (add-thread! ts i) (define (pop-thread! y)
(unless (vector-ref (thread-set-seen ts) i) (if (zero? (yarn-size y))
;(fmt #t (dsp "adding thread ") (num i) nl)
(set! thread-count (+ 1 thread-count))
(vector-set! (thread-set-seen ts) i #t)
(vector-set! (thread-set-stack ts) (thread-set-size ts) i)
(thread-set-size-set! ts (+ 1 (thread-set-size ts)))))
(define (pop-thread! ts)
(if (zero? (thread-set-size ts))
#f #f
(begin (begin
(thread-set-size-set! ts (- (thread-set-size ts) 1)) (yarn-size-set! y (- (yarn-size y) 1))
(vector-ref (thread-set-stack ts) (thread-set-size ts))))) (vector-ref (yarn-stack y) (yarn-size y)))))
(define (no-threads? ts) (define (no-threads? y)
(zero? (thread-set-size ts))) (zero? (yarn-size y)))
(define (any-matches? ts code) (define (any-matches? y code)
(call/cc (call/cc
(lambda (k) (lambda (k)
(while (i (pop-thread! ts)) (while (i (pop-thread! y))
(if (match-instr? (vector-ref code i)) (if (match-instr? (vector-ref code i))
(k #t))) (k #t)))
#f))) #f)))
@ -201,8 +197,8 @@
(let ((code (compile-rx% rx))) (let ((code (compile-rx% rx)))
;(fmt #t (dsp "running ") (pretty code) nl) ;(fmt #t (dsp "running ") (pretty code) nl)
(let ((code-len (vector-length code))) (let ((code-len (vector-length code)))
(let ((threads (mk-thread-set code-len)) (let ((threads (mk-yarn code-len))
(next-threads (mk-thread-set code-len))) (next-threads (mk-yarn code-len)))
(define (compile-instr instr) (define (compile-instr instr)
(match instr (match instr
@ -248,7 +244,7 @@
#f #f
(begin (begin
(swap threads next-threads) (swap threads next-threads)
(clear-thread-set! next-threads) (clear-yarn! next-threads)
(c-loop (+ 1 c-index))))) (c-loop (+ 1 c-index)))))
(any-matches? threads code)))))))))) (any-matches? threads code))))))))))