-
Notifications
You must be signed in to change notification settings - Fork 41
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Merge subpattern references #18
base: master
Are you sure you want to change the base?
Changes from 126 commits
90ebc6b
bf19675
9bf3bf0
35c05dd
5adc50c
ca8f723
da2bba6
6a493f8
95c400a
b4697b6
ceecaf8
561228d
82fdd76
514cb45
a2a9632
8910783
eb3d9ec
ce1b0fe
972dba5
b7ab328
69f0d7c
55a48e0
38986bd
d79af78
5de7565
fa60aff
09625d5
a4e1eaa
e100f55
ada178a
e7d4eff
0309c76
806857a
047c17e
22c26a8
3bbe139
b05a808
c70985f
cdb513c
4fe74d0
56243a1
8591bd4
8572c7a
4d1c609
e4abae6
36acbdd
87c9afc
6620354
09ad0d4
68d4215
ffca226
e9c94db
d7d8941
c5e06f7
e04ccda
1f1bba8
0b70e23
7bd7c22
f4f8137
a37bf58
8678c2b
41cbc80
8cdc21b
7c501f0
e4dfb25
49878b0
da8f474
2805231
5c0f673
987c5b4
bab5e70
e32cf51
6f0ad13
1b51a27
82414b7
da706f6
5f7af85
6d1bee4
2852e76
7d1ed2b
eed3e27
10a6af6
c3c5e06
3891ee5
2b40341
6c6771a
474b91a
d938c89
ffeff74
c3a7c2a
1627892
9d63ac7
d517e82
bfe5c92
eb26c38
1da422d
0b1b87e
d3a1dee
8db37a9
f08f4e2
f064a0c
0de65d3
adb9156
07c8d92
b1d2ec7
ad4d39f
00c2ca5
e64e5ba
9aaa4da
92b459e
f77686c
f50d7a6
53cdefe
2f4c042
8f838eb
2fc37a6
9b97c91
46a078c
9b0a9c0
81be1e4
a941400
846c22e
b5b406c
72d020e
498e3f0
544fcd1
22082fc
f0bc9f3
2ce2ff7
dc6eaa4
7d5c4d4
a833ffb
bef1a6a
8a288eb
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -86,42 +86,108 @@ such that the call to NEXT-FN after the match would succeed.")) | |
|
||
(defmethod create-matcher-aux ((register register) next-fn) | ||
(declare #.*standard-optimize-settings*) | ||
;; the position of this REGISTER within the whole regex; we start to | ||
;; count at 0 | ||
(let ((num (num register))) | ||
(declare (fixnum num)) | ||
;; STORE-END-OF-REG is a thin wrapper around NEXT-FN which will | ||
;; update the corresponding values of *REGS-START* and *REGS-END* | ||
;; after the inner matcher has succeeded | ||
(flet ((store-end-of-reg (start-pos) | ||
(declare (fixnum start-pos) | ||
(function next-fn)) | ||
(setf (svref *reg-starts* num) (svref *regs-maybe-start* num) | ||
(svref *reg-ends* num) start-pos) | ||
(funcall next-fn start-pos))) | ||
(declare (special register-matchers)) | ||
(let ((num (num register)) | ||
(subregister-count (subregister-count register)) | ||
;; a place to store the next function to call when we arrive | ||
;; here via a subpattern reference | ||
subpattern-ref-continuations) | ||
(declare (fixnum num subregister-count) | ||
(list subpattern-ref-continuations)) | ||
(labels | ||
((push-registers-state (new-starts new-maybe-starts new-ends) | ||
(declare (list new-starts new-maybe-starts new-ends)) | ||
;; only push the register states for this register and registers | ||
;; local to it | ||
(loop for idx from num upto (+ num subregister-count) do | ||
(let () | ||
(declare (fixnum idx)) | ||
(push (svref *reg-ends* idx) (svref *reg-ends-stacks* idx)) | ||
(setf (svref *reg-ends* idx) (pop new-ends)) | ||
(push (svref *regs-maybe-start* idx) (svref *regs-maybe-start-stacks* idx)) | ||
(setf (svref *regs-maybe-start* idx) (pop new-maybe-starts)) | ||
(push (svref *reg-starts* idx) (svref *reg-starts-stacks* idx)) | ||
(setf (svref *reg-starts* idx) (pop new-starts))))) | ||
(pop-registers-state () | ||
;; return the state that was destroyed by this restore | ||
(let (old-starts old-maybe-starts old-ends) | ||
(declare (list old-starts old-maybe-starts old-ends)) | ||
(loop for idx from (+ num subregister-count) downto num do | ||
(let () | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Extra let, lose it. There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. The point of those |
||
(declare (fixnum idx)) | ||
(push (svref *reg-ends* idx) old-ends) | ||
(setf (svref *reg-ends* idx) (pop (svref *reg-ends-stacks* idx))) | ||
(push (svref *regs-maybe-start* idx) old-maybe-starts) | ||
(setf (svref *regs-maybe-start* idx) (pop (svref *regs-maybe-start-stacks* idx))) | ||
(push (svref *reg-starts* idx) old-starts) | ||
(setf (svref *reg-starts* idx) (pop (svref *reg-starts-stacks* idx))))) | ||
(values old-starts old-maybe-starts old-ends))) | ||
;; STORE-END-OF-REG is a thin wrapper around NEXT-FN which | ||
;; will update register offsets after the inner matcher has | ||
;; succeded | ||
(store-end-of-reg (start-pos) | ||
(declare (fixnum start-pos) | ||
(function next-fn)) | ||
(if subpattern-ref-continuations | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Use cond instead of this let |
||
;; we're returning from a register that was entered | ||
;; through a subpattern reference; restore the | ||
;; registers state as it was upon entering the | ||
;; subpattern reference, but save the intermediary | ||
;; state for when we have to backtrack or unwind | ||
(multiple-value-bind (saved-starts saved-maybe-starts saved-ends) | ||
(pop-registers-state) | ||
(let ((next-fn (pop subpattern-ref-continuations))) | ||
(prog1 (funcall (the function next-fn) start-pos) | ||
;; un-restore the registers state so we | ||
;; backtrack/unwind cleanly | ||
(push-registers-state saved-starts saved-maybe-starts saved-ends) | ||
(push next-fn subpattern-ref-continuations)))) | ||
;; we're returning from a register that was entered | ||
;; directly save the start and end positions, and match | ||
;; the rest of the pattern | ||
(progn | ||
(setf (svref *reg-starts* num) (svref *regs-maybe-start* num) | ||
(svref *reg-ends* num) start-pos) | ||
(funcall next-fn start-pos))))) | ||
(declare (inline push-registers-state pop-registers-state)) | ||
;; the inner matcher is a closure corresponding to the regex | ||
;; wrapped by this REGISTER | ||
(let ((inner-matcher (create-matcher-aux (regex register) | ||
#'store-end-of-reg))) | ||
(declare (function inner-matcher)) | ||
;; here comes the actual closure for REGISTER | ||
(lambda (start-pos) | ||
(declare (fixnum start-pos)) | ||
;; remember the old values of *REGS-START* and friends in | ||
;; case we cannot match | ||
(let ((old-*reg-starts* (svref *reg-starts* num)) | ||
(old-*regs-maybe-start* (svref *regs-maybe-start* num)) | ||
(old-*reg-ends* (svref *reg-ends* num))) | ||
;; we cannot use *REGS-START* here because Perl allows | ||
;; regular expressions like /(a|\1x)*/ | ||
(setf (svref *regs-maybe-start* num) start-pos) | ||
(let ((next-pos (funcall inner-matcher start-pos))) | ||
(unless next-pos | ||
;; restore old values on failure | ||
(setf (svref *reg-starts* num) old-*reg-starts* | ||
(svref *regs-maybe-start* num) old-*regs-maybe-start* | ||
(svref *reg-ends* num) old-*reg-ends*)) | ||
next-pos))))))) | ||
;; here comes the actual closure for REGISTER; save it in a | ||
;; special variable so it can be called by subpattern | ||
;; references | ||
(setf (getf (car register-matchers) num) | ||
(lambda (start-pos &optional other-fn) | ||
(declare (fixnum start-pos)) | ||
(if other-fn | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Use cond instead of let |
||
;; the presence of OTHER-FN indicates that this | ||
;; register has been entered via a subpattern | ||
;; reference closure; save the registers state, | ||
;; creating fresh new "bindings" for the local | ||
;; register offsets; restore the state before | ||
;; returning to the caller | ||
(progn | ||
(push other-fn subpattern-ref-continuations) | ||
(push-registers-state nil nil nil) | ||
(prog1 | ||
(funcall inner-matcher start-pos) | ||
(pop-registers-state) | ||
(pop subpattern-ref-continuations))) | ||
(let ((old-*reg-starts* (svref *reg-starts* num)) | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. confusing naming. is this special or not? earmuffs are used for special variables only. There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Those names were there already. Shall I change them anyway? |
||
(old-*regs-maybe-start* (svref *regs-maybe-start* num)) | ||
(old-*reg-ends* (svref *reg-ends* num))) | ||
;; we cannot use *REG-STARTS* here because Perl | ||
;; allows regular expressions like /(a|\1x)*/ | ||
(setf (svref *regs-maybe-start* num) start-pos) | ||
(let ((next-pos (funcall inner-matcher start-pos))) | ||
(unless next-pos | ||
;; restore old values on failure | ||
(setf (svref *reg-starts* num) old-*reg-starts* | ||
(svref *regs-maybe-start* num) old-*regs-maybe-start* | ||
(svref *reg-ends* num) old-*reg-ends*)) | ||
next-pos))))))))) | ||
|
||
(defmethod create-matcher-aux ((lookahead lookahead) next-fn) | ||
(declare #.*standard-optimize-settings*) | ||
|
@@ -427,6 +493,19 @@ against CHR-EXPR." | |
reg-start reg-end) | ||
(funcall next-fn next-pos))))))))) | ||
|
||
(defmethod create-matcher-aux ((subpattern-reference subpattern-reference) next-fn) | ||
(declare #.*standard-optimize-settings*) | ||
(declare (special register-matchers) | ||
(function next-fn)) | ||
;; close over the special variable REGISTER-MATCHERS in order to | ||
;; reference it during the match phase | ||
(let ((num (num subpattern-reference)) | ||
(register-matchers register-matchers)) | ||
(declare (fixnum num) (function next-fn)) | ||
(lambda (start-pos) | ||
(let ((subpattern-matcher (getf (car register-matchers) (1- num)))) | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. extra let, move the expression into the funcall. |
||
(funcall (the function subpattern-matcher) start-pos next-fn))))) | ||
|
||
(defmethod create-matcher-aux ((branch branch) next-fn) | ||
(declare #.*standard-optimize-settings*) | ||
(let* ((test (test branch)) | ||
|
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Remove this gratitious let.