emo/thin-provisioning-tools
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

[functional-tests/regex] Restructure the matcher to try and reduce

Browse Source 
memory
This commit is contained in:
Joe Thornber 2017-08-18 18:32:05 +01:00
parent 9202e31725
commit b2b8d2b3c7
1 changed files with 36 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
functional-tests/regex.scm
View File

@ -156,6 +156,10 @@
(define (mk-thread-set count) (define (mk-thread-set count)
(make-thread-set '() (make-vector count #f))) (make-thread-set '() (make-vector count #f)))
(define (clear-thread-set! ts)
(thread-set-stack-set! ts '())
(vector-fill! (thread-set-seen ts) #f))
(define (add-thread! ts i) (define (add-thread! ts i)
(unless (vector-ref (thread-set-seen ts) i) (unless (vector-ref (thread-set-seen ts) i)
(vector-set! (thread-set-seen ts) i #t) (vector-set! (thread-set-seen ts) i #t)
@ -184,34 +188,45 @@
(add-thread! ts 0) (add-thread! ts 0)
ts)) ts))
(define-syntax string-iter
(syntax-rules ()
((_ (var str) body ...)
(string-for-each (lambda (var) body ...) str))))
(define (match-rx code txt) (define (match-rx code txt)
(fmt #t (dsp "running ") (pretty code) nl) (fmt #t (dsp "running ") (pretty code) nl)
(call/cc (call/cc
(lambda (k) (lambda (k)
(let ((code-len (vector-length code))) (let ((code-len (vector-length code)))
(let loop ((threads (mk-init-thread-set code-len)) (let ((threads (mk-thread-set code-len))
(input (string->list txt))) (next-threads (mk-thread-set code-len)))
(if (null? input)
(any-matches? threads code)
(let ((in-c (car input))
(next-threads (mk-thread-set code-len)))
(fmt #t (dsp "processing: ") (wrt in-c) nl)
(while (i (pop-thread! threads))
(match (vector-ref code i)
(('match) (k #t))
(('char c) (define (swap-ts)
(when (eq? c in-c) (let ((tmp threads))
(add-thread! next-threads (+ 1 i)))) (set! threads next-threads)
(clear-thread-set! tmp)
(set! next-threads tmp)))
(('jmp l) (add-thread! threads l)) (add-thread! threads 0)
(string-iter (in-c txt)
(fmt #t (dsp "processing: ") (wrt in-c) nl)
(while (i (pop-thread! threads))
(match (vector-ref code i)
(('match) (k #t))
(('split l1 l2) (('char c)
(begin (when (char=? c in-c)
(add-thread! threads l1) (add-thread! next-threads (+ 1 i))))
(add-thread! threads l2)))))
(if (no-threads? next-threads) (('jmp l) (add-thread! threads l))
#f
(loop next-threads (cdr input)))))))))) (('split l1 l2)
(begin
(add-thread! threads l1)
(add-thread! threads l2)))))
(if (no-threads? next-threads)
(k #f)
(swap-ts)))
(any-matches? threads code))))))
) )