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

[functional-tests/regex] Removed call/cc, made v. little difference.

Browse Source 
Something is still allocating a lot of memory.
This commit is contained in:
Joe Thornber 2017-08-18 20:51:24 +01:00
parent 27eb4d8ce4
commit ecd616a28c
1 changed files with 26 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
functional-tests/regex.scm
View File

@ -209,40 +209,49 @@
(define (compile-instr instr) (define (compile-instr instr)
(match instr (match instr
(('match) (('match)
(lambda (in-c pc k) (k #t))) (lambda (in-c pc) 'match))
(('char c) (('char c)
(lambda (in-c pc k) (lambda (in-c pc)
(when (char=? c in-c) (when (char=? c in-c)
(add-thread! next-threads (+ 1 pc))))) (add-thread! next-threads (+ 1 pc)))))
(('jmp l) (('jmp l)
(lambda (in-c pc k) (lambda (in-c pc)
(add-thread! threads l))) (add-thread! threads l)))
(('split l1 l2) (('split l1 l2)
(lambda (in-c pc k) (lambda (in-c pc)
(add-thread! threads l1) (add-thread! threads l1)
(add-thread! threads l2))))) (add-thread! threads l2)))))
;; compile to thunks to avoid calling match in the loop. ;; compile to thunks to avoid calling match in the loop.
(let ((code (vector-copy code))) (let ((code (vector-copy code)))
(define (step in-c)
(let loop ((pc (pop-thread! threads)))
(if pc
(if (eq? 'match ((vector-ref code pc) in-c pc))
'match
(loop (pop-thread! threads)))
#f)))
(upto (n code-len) (upto (n code-len)
(vector-set! code n (compile-instr (vector-ref code n)))) (vector-set! code n (compile-instr (vector-ref code n))))
(lambda (txt) (lambda (txt)
(call/cc (add-thread! threads 0)
(lambda (k) (let ((txt-len (string-length txt)))
(add-thread! threads 0) (let c-loop ((c-index 0))
(string-iter (in-c txt) (if (< c-index txt-len)
; (fmt #t (dsp "processing: ") (wrt in-c) nl) (if (eq? 'match (step (string-ref txt c-index)))
(while (pc (pop-thread! threads)) #t
((vector-ref code pc) in-c pc k)) (if (no-threads? next-threads)
(if (no-threads? next-threads) #f
(k #f) (begin
(begin (swap threads next-threads)
(swap threads next-threads) (clear-thread-set! next-threads)
(clear-thread-set! next-threads)))) (c-loop (+ 1 c-index)))))
(any-matches? threads code))))))))) (any-matches? threads code))))))))))
) )