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

[functional-tests/regex] more optimisation.

Browse Source 
I think we're going to have to lose the call/cc; something is allocating
a lot of memory.
This commit is contained in:
Joe Thornber 2017-08-18 19:28:07 +01:00
parent 2fb7eb265f
commit 27eb4d8ce4
2 changed files with 51 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
functional-tests/regex-bench.scm Normal file
View File

@ -0,0 +1,11 @@
(import (chezscheme)
(regex)
(loops))
(let ((rx (compile-rx
(seq (seq (star (lit "a"))
(lit "foo"))
(plus
(lit "b"))))))
(time (upto (n 1000000)
(rx "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaafoobbbbbbb"))))

79
functional-tests/regex.scm
View File

@ -6,8 +6,7 @@
opt
star
plus
compile-rx
match-rx)
compile-rx)
(import (chezscheme)
(fmt fmt)
(loops)
@ -140,7 +139,7 @@
(_ _)))
code)
(define (compile-rx rx)
(define (compile-rx% rx)
(let ((rx (append-instr rx (match-instr))))
(optimise-jumps!
(list->vector
@ -200,48 +199,50 @@
(set! x y)
(set! y tmp)))))
(define (match-rx code txt)
(define (compile-rx rx)
; (fmt #t (dsp "running ") (pretty code) nl)
(call/cc
(lambda (k)
(let ((code-len (vector-length code)))
(let ((threads (mk-thread-set code-len))
(next-threads (mk-thread-set code-len)))
(let ((code (compile-rx% rx)))
(let ((code-len (vector-length code)))
(let ((threads (mk-thread-set code-len))
(next-threads (mk-thread-set code-len)))
(define (compile-instr instr)
(match instr
(('match)
(lambda (_ pc) (k #t)))
(define (compile-instr instr)
(match instr
(('match)
(lambda (in-c pc k) (k #t)))
(('char c)
(lambda (in-c pc)
(when (char=? c in-c)
(add-thread! next-threads (+ 1 pc)))))
(('char c)
(lambda (in-c pc k)
(when (char=? c in-c)
(add-thread! next-threads (+ 1 pc)))))
(('jmp l)
(lambda (in-c pc)
(add-thread! threads l)))
(('jmp l)
(lambda (in-c pc k)
(add-thread! threads l)))
(('split l1 l2)
(lambda (in-c pc)
(add-thread! threads l1)
(add-thread! threads l2)))))
(('split l1 l2)
(lambda (in-c pc k)
(add-thread! threads l1)
(add-thread! threads l2)))))
;; compile to thunks to avoid calling match in the loop.
(let ((code (vector-copy code)))
(upto (n code-len)
(vector-set! code n (compile-instr (vector-ref code n))))
;; compile to thunks to avoid calling match in the loop.
(let ((code (vector-copy code)))
(upto (n code-len)
(vector-set! code n (compile-instr (vector-ref code n))))
(add-thread! threads 0)
(string-iter (in-c txt)
; (fmt #t (dsp "processing: ") (wrt in-c) nl)
(while (pc (pop-thread! threads))
((vector-ref code pc) in-c pc))
(if (no-threads? next-threads)
(k #f)
(begin
(swap threads next-threads)
(clear-thread-set! next-threads)))))
(any-matches? threads code))))))
(lambda (txt)
(call/cc
(lambda (k)
(add-thread! threads 0)
(string-iter (in-c txt)
; (fmt #t (dsp "processing: ") (wrt in-c) nl)
(while (pc (pop-thread! threads))
((vector-ref code pc) in-c pc k))
(if (no-threads? next-threads)
(k #f)
(begin
(swap threads next-threads)
(clear-thread-set! next-threads))))
(any-matches? threads code)))))))))
)