[Mew-dist 14542] Re: incdir Re: b68

[Yoshinari Nomura]

ごぶさたしています。乃村です。

On Fri, 13 Oct 2000 11:23:38 +0900,
	Kazu Yamamoto (山本和彦) <kazu at example.com> said:

> 来週中に beta に復帰したいなぁ。(Pick の pattern が難関だぁ。コンパイ
> ラ勉強中。)

mhc で、カテゴリの検索式を parse するために、parser もどきを
作ったので、もし役に立つなら使ってあげてください。
よくある再帰下降型 (っていうだっけ?) の paerser です。

  (mew-expr-parse  "(subject != mew-dist || from = nom) && to = kazu")

とやると、

  (and 
   (or (not (xxx-my-search-in-buffer "subject" "mew-dist"))
       (xxx-my-search-in-buffer "from" "nom"))
   (xxx-my-search-in-buffer "to" "kazu"))

のような S式を吐きます。mew-expr-compile で bytecompile してくれます。
xxx-my-search-in-buffer を適当な値に変更すると使えるのではないかと。

# もしかして、そういう意味ではないのかしら?
--
nom


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; lexical analyzer part for category.
;;

(defsubst mew-expr/new ()
  (vector nil nil nil nil))

(defsubst mew-expr/token (expr-obj)        ;; literal
  (aref expr-obj 0))
(defsubst mew-expr/token-type (expr-obj)   ;; symbolized
  (aref expr-obj 1))
(defsubst mew-expr/string (expr-obj)       ;; currently parsing string.
  (aref expr-obj 2))

(defsubst mew-expr/set-token (expr-obj val)
  (aset expr-obj 0 val))
(defsubst mew-expr/set-token-type (expr-obj val)
  (aset expr-obj 1 val))
(defsubst mew-expr/set-string (expr-obj val)
  (aset expr-obj 2 val))

;; keep the order of elements for first matching !!
(defconst mew-expr-token-type-alist
  '(
    ("[^=!&|()\t \n]+" . symbol)
    ("!="             . neqop)
    ("="              . eqop)
    ("!"              . negop)
    ("&&"             . andop)
    ("||"             . orop)
    ("("              . lparen)
    (")"              . rparen)))

;; Eat one token from parsing string in obj.
(defun mew-expr/gettoken (obj)
  (let ((string (mew-expr/string obj))
	(token-alist mew-expr-token-type-alist)
	(token-type nil)
	(token      nil))
    ;; delete leading white spaces.
    (if (string-match "^[\t ]+" string)
	(setq string (substring string (match-end 0))))
    (while (and token-alist (not token-type))
      (if (string-match (concat "^" (car (car token-alist))) string)
	  (setq token      (substring string 0 (match-end 0))
		string     (substring string (match-end 0))
		token-type (cdr (car token-alist))))
      (setq token-alist (cdr token-alist)))

    (mew-expr/set-token      obj token)
    (mew-expr/set-string     obj string)
    (mew-expr/set-token-type obj token-type)
    obj))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; recursive descent parser
;;

;;
;; expression -> term ("||" term)*
;;
(defun mew-expr/expression (obj)
  (let ((ret (list (mew-expr/term obj))))
    (while (eq (mew-expr/token-type obj) 'orop)
      (mew-expr/gettoken obj)
      (setq ret (cons (mew-expr/term obj) ret)))
    (if (= 1 (length ret))
	(car ret)
      (cons 'or (nreverse ret)))))

;;
;; term       -> factor ("&&" factor)*
;;
(defun mew-expr/term (obj)
  (let ((ret (list (mew-expr/factor obj))))
    (while (eq (mew-expr/token-type obj) 'andop)
      (mew-expr/gettoken obj)
      (setq ret (cons (mew-expr/factor obj) ret)))
    (if (= 1 (length ret))
	(car ret)
      (cons 'and (nreverse ret)))))

;;
;; factor     -> "!"* xxx "!"?"=" yyy || "(" expression ")"
;;
(defun mew-expr/factor (obj)
  (let ((ret)
	(neg-flag nil)
	(not-flag nil))
    (while (eq (mew-expr/token-type obj) 'negop)
      (setq neg-flag (not neg-flag))
      (mew-expr/gettoken obj))
    (cond
     ;; symbol != symbol, symbol = symbol
     ((eq (mew-expr/token-type obj) 'symbol)
      (setq ret (list 'xxx-my-search-in-buffer (mew-expr/token obj)))
      (mew-expr/gettoken obj)
      (cond 
       ((eq (mew-expr/token-type obj) 'eqop)
	(setq not-flag nil))
       ((eq (mew-expr/token-type obj) 'neqop)
	(setq not-flag t))
       (t
	(error "Syntax Error")))
      (mew-expr/gettoken obj)
      (if (eq (mew-expr/token-type obj) 'symbol)
	  (setq ret (append ret (list (mew-expr/token obj))))
	(error "Syntax Error"))
      (if not-flag
	  (setq ret (list 'not ret)))
      (mew-expr/gettoken obj))
     ;; ( expression )
     ((eq (mew-expr/token-type obj) 'lparen)
      (mew-expr/gettoken obj)
      (setq ret (mew-expr/expression obj))
      (if (not (eq (mew-expr/token-type obj) 'rparen))
	  (error "Syntax error."))
      (mew-expr/gettoken obj))
     ;; error
     (t
      (error "Syntax error.")
      ;; (error "Missing category name or `(' %s %s"
      ;;  mew-expr-token mew-expr-parsing-string)
      ))
    (if neg-flag (list 'not ret) ret)))

(defun mew-expr-parse (string)
  (let ((obj (mew-expr/new)) (ret nil))
    (if (or (not string) (string= string ""))
	t
      (mew-expr/set-string obj string)
      (mew-expr/gettoken obj)
      (setq ret (mew-expr/expression obj))
      (if (mew-expr/token obj)
	  (error "Syntax Error.")
	ret))))

(defun mew-expr-compile (string)
  (byte-compile
   `(lambda ()
      ,(mew-expr-parse string)
      )))