guile18/lang/elisp/primitives/match.scm

   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) %nil)))
  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)