[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

RFC: Parsing a Regexp to a `rx' for Introspection

From: Nordlöw
Subject: RFC: Parsing a Regexp to a `rx' for Introspection
Date: Mon, 26 Oct 2009 07:34:59 -0700 (PDT)
User-agent: G2/1.0

This is a preliminary code for parsing a regexp string to an rx

Tested on Emacs 23.1.
I have chosen a character-serial approach to parsing the string
inserted into a buffer, that is I have used char-after() plus forward-
char() rather than the use of looking-at(). This makes it easier to
create high-performing ports into other languages such as C.

TODO: alternatives and syntax specific charcters.

I have a question regarding evaluation and rx().
We could very conveniently test this package by automatically doing a
round-trip of regexp-to-rx-to-regex in a single evaluation and check
that we return the string we put in.

This is works
  (rx-to-string (regexp-parse-string "a") t)
  (rx-to-string (regexp-parse-string "a+") t)
gives error:
Symbol's function definition is void: x

What on earth have I missed?

Thanks in advance,

;;; regexp-utils.el --- Extensions and add-ons to package `rx'.
;; Filename: regexp-utils.el
;; Description:
;; Author: Per Nordlöw
;; Maintainer:
;; Created: tor okt 22 12:02:46 2009 (+0200)
;; Version:
;; Last-Updated:
;;           By:
;;     Update #: 428
;; URL:
;; Keywords:
;; Compatibility:
;; Features that might be required by this library:
;;   `rx'.
;;; Commentary:
;;; Change log:
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;; Code:

(require 'rx)

;; Use:
;; - `char-before', `char-after'
;; - `looking-at', `looking-back'
;; - `search-forward', `search-backward'
;; - `re-search-forward', `re-search-backward'
;; - `skip-chars-forward',`skip-chars-backward'
;; - `bolp', `eolp'
;; - `string-equal'
;; - `defun'
;; - `make-string', `string', `char-to-string'
;; - `make-symbol'

(defun regexp-parse-char-alt ()
  "Parse Emacs-Style Regular Expression Character Alternative to
`rx' representation."
  (let (tree)
    (while (not (eq (char-after) ?\]))
      (let ((c0 (char-after)))
        (cond ((eobp)
               (error "Incomplete Character Alternative!")
              ((eq c0 ?-)
               (push (if tree
                         (let ((c1 (char-after)))
                           (if (or (eq c1 ?\]) ;`c0' is last char
                                   (consp (car tree))) ;if previous is
a completed range
                               c0                      ;as is
                             (cons (pop tree) c1))) ;ranges are given
as (cons LOW HIGH)
                       c0)              ;if first character
                     tree)              ;push ?- as is
              ((looking-at "\\[:\\([a-zA-Z-_]+\\):]") ;for example
               (goto-char (match-end 1)) ;skip whole class
               (push (make-symbol (match-string-no-properties 1))
tree) ;push class as is
               (push c0 tree) (forward-char) ;push character as is
    (unless (eobp) (forward-char))
    ;;(uniquify-list-members tree)        ;uniquify list
    (setq tree (nreverse tree))
    (when tree (push 'any tree))

(defun rx-simplify (tree)
  "Simplify the `rx'-expression tree TREE. See `rx` for details."

(defconst regexp-special-chars-list
  '(?$ ?^ ?. ?* ?+ ?? ?\[ ?\\)
  "List of characters that have a special meaning in Emacs
Regular Expression.")

(defun regexp-parse-string (regexp &optional format)
  "Parse the regular expression REGEXP into a lisp expression.
Expression syntax is given by FORMAT, defaulting to `rx'.  See
the package `sregex' and `rx' for details returned
structure. Note: This function is written as a state machine with
code clarity in mind, so easily can transform it optimcal. Each
state transition is typically triggered by character reads."
  (let (tree        ;expression tree (stack)
        groups      ;group arguments counts into `tree'
      (insert regexp)
      (goto-char (point-min))
      (display-buffer (current-buffer))
      (while (not (eobp))
        (let ((c0 (char-after)))
          (cond ((memq c0 '(?? ?* ?+))  ;special regexp operator
                 (let ((op (char-to-string c0))) ;operator string
                   (forward-char)         ;skip char
                   (when (eq (char-after) ??) ;if greedy operator
                     (setq op (concat op (char-to-string ??))) ;append
to operator
                     (forward-char))    ;skip greedy operator
                   (push (if tree       ;if postfix operator has
                             (list (make-symbol op) (pop tree)) ;use
it as operator
                           c0)          ;otherwise use as a plain
                ((eq c0 ?.)         ;any single character except a
                 (push 'nonl tree) (forward-char)
                ((eq c0 ?^)            ;beginning of line
                 (push 'bol tree) (forward-char)
                ((eq c0 ?$)            ;end of line
                 (push 'eol tree) (forward-char)
                ((eq c0 ?\[)            ;opening hook: start
                 (let ((alt-tree (regexp-parse-char-alt)))
                   (when alt-tree (push alt-tree tree)))
                ((eq c0 ?\\)            ;backquoting
                 (let ((c1 (char-after)))
                   (cond ((memq c1 regexp-special-chars-list)
                          (push c1 tree) (forward-char) ;as is
                         ((eq c1 ?_)    ;backqoute underscore
                          (let ((c2 (char-after)))
                            (cond ((eq c2 ?<)
                                   (push 'symbol-start tree) (forward-
                                  ((eq c2 ?>)
                                   (push 'symbol-end tree) (forward-
                                   (push (string c0 c1)
tree) ;backqouted character as is
                         ((memq c1 '(0 1 2 3 4 5 6 7 8 9)) ;same text
that matched the digitth occurrence of a grouping (‘\( ... \)’)
                          (push `(backref (- c1 ?0)) tree) (forward-
                         ((eq c1 ?\()    ;beginning of group
                          (push 0 groups)
                          (if (looking-at "?:")
                              (progn (forward-char 2)
                                     (push 'shy-start tree))
                            (push 'group-start tree))
                         ((eq c1 ?\))    ;end of word
                          (if groups (pop groups) (error "Unbalanced
Group End!"))
                          (let (group-tree)
                            ;; push all arguments until we find `group-
                            (while (and tree ;args left
                                        (not (memq (car tree) '(shy-
start group-start))))
                              (push (pop tree) group-tree))
                            (if tree
                                (let ((g-sym (pop tree)))
                                  (cond ((eq 'group-start g-sym)
                                         (push `(group ,@group-tree)
                                        ((eq 'shy-start g-sym)
                                         (push `(: ,@group-tree)
                                         (error "Unbalanced Group
                              (error "Unbalanced Group End!"))
                         ((eq c1 ?<)    ;beginning of word
                          (push 'bow tree) (forward-char)
                         ((eq c1 ?>)    ;end of word
                          (push 'eow tree) (forward-char)
                         ((eq c1 ?`)    ;beginning of buffer/string/
                          (push 'bot tree) (forward-char)
                         ((eq c1 ?')    ;end of buffer/string/text
                          (push 'eot tree) (forward-char)
                         ((eq c1 ?w) ;any word-constituent character.
The editor syntax table determines which characters these are. See
Syntax Tables.
                          (push 'wordchar tree) (forward-char)
                         ((eq c1 ?W)    ;any character that is not a
word constituent.
                          (push 'not-wordchar tree) (forward-char)
                         (t             ;any other backquoted
                          (push (string c0 c1) tree) (forward-
char) ;backqouted character as is
                (c0                     ;if we have character
                 (when nil
                   (if (and (looking-at (concat regexp-ordinary-char-
regexp "+")) ;one or more number of ordinary chars
                            (> (match-length 0) 0))
                         ;; TODO: if next char c1 fullfils (memq c1
'(?? ?* ?+)) push all but last to string and push last on stack
                         (goto-char (match-end 0)) ;goto end of string
                         (push (match-string-no-properties 0)
tree) ;list as is
                     (error "Unhandled regexp special character %s!"

                 (forward-char) (push c0 tree) ;regexp as is
    (setq tree (nreverse tree))
    (push ': tree)
(defalias 're-parse 'regexp-parse-string)
(defalias 'make-rx 'regexp-parse-string)
(when nil
  (regexp-parse-string (concat  "\\(ab\\)"))
  (regexp-parse-string (concat  "\\(?:ab?\\)"))
  (let ((str (concat "\\([]\\)"
                     "\\`" "^" "\\_<" "\\<" "\\w" "\\W" "a\\*" "a"
"\b" "\0" "\\>" "\\_>" "aa*bb*" "$" "\\'")))
    (regexp-parse-string str))
;; Use: (eval `(rx-to-string ',(regexp-parse-string "ab+") t))
;; (rx-to-string '(: "f" "g"))

(when nil
  (let* ((re "aa.*bb.?cc.+dd")
         (rt (regexp-parse-string re)))
    ;;(eval `(rx ,re)))
    (equal re
           (when rt (eval `(rx ,rt))))))

(provide 'regexp-utils)

;;; rx-utils.el ends here

reply via email to

[Prev in Thread] Current Thread [Next in Thread]