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

35
functional-tests/regex.scm
View File

@ -209,40 +209,49 @@
(define (compile-instr instr)
(match instr
(('match)
(lambda (in-c pc k) (k #t)))
(lambda (in-c pc) 'match))
(('char c)
(lambda (in-c pc k)
(lambda (in-c pc)
(when (char=? c in-c)
(add-thread! next-threads (+ 1 pc)))))
(('jmp l)
(lambda (in-c pc k)
(lambda (in-c pc)
(add-thread! threads l)))
(('split l1 l2)
(lambda (in-c pc k)
(lambda (in-c pc)
(add-thread! threads l1)
(add-thread! threads l2)))))
;; compile to thunks to avoid calling match in the loop.
(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)
(vector-set! code n (compile-instr (vector-ref code n))))
(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))
(let ((txt-len (string-length txt)))
(let c-loop ((c-index 0))
(if (< c-index txt-len)
(if (eq? 'match (step (string-ref txt c-index)))
#t
(if (no-threads? next-threads)
(k #f)
#f
(begin
(swap threads next-threads)
(clear-thread-set! next-threads))))
(any-matches? threads code)))))))))
(clear-thread-set! next-threads)
(c-loop (+ 1 c-index)))))
(any-matches? threads code))))))))))
)