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

[functional-tests/regex] use indirect-lambda to hotpatch rx

Browse Source
This commit is contained in:
Joe Thornber 2017-08-29 09:27:28 +01:00
parent e5ca0bc5e1
commit 1940945d6f
1 changed files with 23 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
functional-tests/regex.scm
View File

@ -326,15 +326,6 @@
;;----------------------------------------------------------- ;;-----------------------------------------------------------
;; Higher level combinators, these build a symbolic rx ;; Higher level combinators, these build a symbolic rx
;; FIXME: move a hotpatch form to (utils)
(define rx
(let ((this (lambda xs #f)))
(lambda args
(if (and (= (length args) 2)
(eq? (car args) 'hotpatch))
(set! this (cadr args))
(apply this args)))))
;; group := "(" rx ")" ;; group := "(" rx ")"
(define group (define group
(bracket (p:lit "(") (bracket (p:lit "(")
@ -365,26 +356,36 @@
(define simple-rx (define simple-rx
(p:lift combine (p:many+ basic-rx))) (p:lift combine (p:many+ basic-rx)))
;; There's mutual recursion here which would send the combinators into an
;; infinite loop whilst they are being built (not during parsing). So we hot
;; patch rx, making it available for construction, and then redefine it on
;; first use.
(define rx
(indirect-lambda ()
(p:error-m "rx not bound")))
;; rx := simple-rx ("|" simple-rx)*
(define hotpatch-rx
(let ((patched #f))
(lambda ()
(unless patched
(set! patched #t)
(set-lambda! rx
(p:lift2 (lambda (r rs)
(fold-left alt r rs))
simple-rx
(p:many* (p:>> (p:lit "|") simple-rx))))))))
;;----------------------------------------------------------------------- ;;-----------------------------------------------------------------------
;; The top level routine, parses the regex string and compiles it into a ;; The top level routine, parses the regex string and compiles it into a
;; matcher, or returns false if the parse failed. ;; matcher, or returns false if the parse failed.
;; regex :: string -> (matcher <string>) ;; regex :: string -> (matcher <string>)
;; FIXME: it's tempting to return a function that raises if there's a parse error. ;; FIXME: it's tempting to return a function that raises if there's a parse error.
(define regex (define (regex str)
(let ((patched #f)) (hotpatch-rx)
(lambda (str)
(unless patched
(set! patched #t)
;; rx := simple-rx ("|" simple-rx)*
(rx 'hotpatch
(p:lift2 (lambda (r rs)
(fold-left alt r rs))
simple-rx
(p:many* (p:>> (p:lit "|") simple-rx)))))
(receive (v st) (p:parse rx str) (receive (v st) (p:parse rx str)
(if (p:success? st) (if (p:success? st)
(compile-rx v) (compile-rx v)
#f)))))) #f))))