1 |
|
(define-module (lang elisp primitives match) |
2 |
|
#:use-module (lang elisp internals fset) |
3 |
|
#:use-module (ice-9 regex) |
4 |
|
#:use-module (ice-9 optargs)) |
5 |
|
|
6 |
|
(define last-match #f) |
7 |
|
|
8 |
|
(fset 'string-match |
9 |
|
(lambda (regexp string . start) |
10 |
|
|
11 |
|
(define emacs-string-match |
12 |
|
|
13 |
|
(if (defined? 'make-emacs-regexp) |
14 |
|
|
15 |
|
;; This is what we would do if we had an |
16 |
|
;; Emacs-compatible regexp primitive, here called |
17 |
|
;; `make-emacs-regexp'. |
18 |
|
(lambda (pattern str . args) |
19 |
|
(let ((rx (make-emacs-regexp pattern)) |
20 |
|
(start (if (pair? args) (car args) 0))) |
21 |
|
(regexp-exec rx str start))) |
22 |
|
|
23 |
|
;; But we don't have Emacs-compatible regexps, and I |
24 |
|
;; don't think it's worthwhile at this stage to write |
25 |
|
;; generic regexp conversion code. So work around the |
26 |
|
;; discrepancies between Guile/libc and Emacs regexps by |
27 |
|
;; substituting the regexps that actually occur in the |
28 |
|
;; elisp code that we want to read. |
29 |
|
(lambda (pattern str . args) |
30 |
|
(let loop ((discrepancies '(("^[0-9]+\\.\\([0-9]+\\)" . |
31 |
|
"^[0-9]+\\.([0-9]+)")))) |
32 |
|
(or (null? discrepancies) |
33 |
|
(if (string=? pattern (caar discrepancies)) |
34 |
|
(set! pattern (cdar discrepancies)) |
35 |
|
(loop (cdr discrepancies))))) |
36 |
|
(apply string-match pattern str args)))) |
37 |
|
|
38 |
|
(let ((match (apply emacs-string-match regexp string start))) |
39 |
|
(set! last-match |
40 |
|
(if match |
41 |
|
(apply append! |
42 |
|
(map (lambda (n) |
43 |
|
(list (match:start match n) |
44 |
|
(match:end match n))) |
45 |
|
(iota (match:count match)))) |
46 |
|
#f))) |
47 |
|
|
48 |
|
(if last-match (car last-match) #f))) |
49 |
|
|
50 |
|
(fset 'match-beginning |
51 |
|
(lambda (subexp) |
52 |
|
(list-ref last-match (* 2 subexp)))) |
53 |
|
|
54 |
|
(fset 'match-end |
55 |
|
(lambda (subexp) |
56 |
|
(list-ref last-match (+ (* 2 subexp) 1)))) |
57 |
|
|
58 |
|
(fset 'substring substring) |
59 |
|
|
60 |
|
(fset 'match-data |
61 |
|
(lambda* (#:optional integers reuse) |
62 |
|
last-match)) |
63 |
|
|
64 |
|
(fset 'set-match-data |
65 |
|
(lambda (list) |
66 |
|
(set! last-match list))) |
67 |
|
|
68 |
|
(fset 'store-match-data 'set-match-data) |