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

31
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,24 +188,34 @@
(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)))
(if (null? input)
(any-matches? threads code)
(let ((in-c (car input))
(next-threads (mk-thread-set code-len))) (next-threads (mk-thread-set code-len)))
(define (swap-ts)
(let ((tmp threads))
(set! threads next-threads)
(clear-thread-set! tmp)
(set! next-threads tmp)))
(add-thread! threads 0)
(string-iter (in-c txt)
(fmt #t (dsp "processing: ") (wrt in-c) nl) (fmt #t (dsp "processing: ") (wrt in-c) nl)
(while (i (pop-thread! threads)) (while (i (pop-thread! threads))
(match (vector-ref code i) (match (vector-ref code i)
(('match) (k #t)) (('match) (k #t))
(('char c) (('char c)
(when (eq? c in-c) (when (char=? c in-c)
(add-thread! next-threads (+ 1 i)))) (add-thread! next-threads (+ 1 i))))
(('jmp l) (add-thread! threads l)) (('jmp l) (add-thread! threads l))
@ -211,7 +225,8 @@
(add-thread! threads l1) (add-thread! threads l1)
(add-thread! threads l2))))) (add-thread! threads l2)))))
(if (no-threads? next-threads) (if (no-threads? next-threads)
#f (k #f)
(loop next-threads (cdr input)))))))))) (swap-ts)))
(any-matches? threads code))))))
) )