esrap-peg パッケージを実際に使ってみる オマケ

PEG 定義

変数入れてみたこと以外は、前回のものと同じ。エラー処理はいいかげんです。いろいろまずいところがあるのはわかっているけれど、骨子の分かりやすさではこんなものの方がわかりやすいかも・・・

statement <- spaces (definition / expression) spaces

definition <- identifier spaces define spaces expression

expression <- (expression spaces add spaces multiplicative_expression)
    / (expression spaces sub spaces multiplicative_expression)
    / multiplicative_expression

multiplicative_expression <-
    (multiplicative_expression spaces mult spaces primary_expression)
    / (multiplicative_expression spaces div spaces primary_expression)
    / (multiplicative_expression spaces mod spaces primary_expression)
    / primary_expression

primary_expression <- constant
    / identifier
    / ('(' spaces expression spaces ')')

identifier <- identifier_start identifier_continuas*

identifier_continuas <- alphabet / underscore / digit

identifier_start <- alphabet / underscore

constant <- integer_constant

integer_constant <- decimal_integer_constant

decimal_integer_constant <- sign_part? digit+

sign_part <- '+' / '-'

## Lex!

alphabet <- [a-zA-Z]

digit <- [0-9]

underscore <- '_'

operator <- add / sub / mult / div / mod / define

# operator

add <- '+'

sub <- '-'

mult <- '*'

div <- '/'

mod <- '%'

define <- '='

#

spaces <- [ \t]*

eol <- '\r\n' / '\n' / '\r' / eof

eof <- !.

Lisp コード

(defvar id-table)

(defun clean-identifier-table ()
  (setf id-table (make-hash-table :test #'equal)))

(clean-identifier-table)

(peg-compile
  (parse-peg-file "foo.peg"))

(defun val_digits (x &optional (y 0))
  (cond ((not x) y)
        ('t (val_digits (cdr x) (+ (* 10 y) (parse-integer (cadr (car x))))))))

(def-peg-fun statement (x) (ast-eval (second x)))

(defun id-cont-key (x)
  (if (car x)
      (concatenate 'string (cadr (cadr (car x))) (id-cont-key (cdr x)))))

(defun id-key (x)
  (concatenate 'string (cadr (cadr (car x))) (id-cont-key (cadr x))))

(defun id-value (x) (fifth x))

(def-peg-fun identifier (x)
  (let* ((id-str (id-key x)) (res (gethash id-str id-table)))
    (if res
        (ast-eval res)
        (format 't "Undefined identifier: ~S" id-str))))

(def-peg-fun definition (x)
  (setf (gethash (id-key (cadr (car x))) id-table) (id-value x)))

(def-peg-fun expression (x)
  (cond ((atom (car x)) (ast-eval x)) ; x == MULTIPLICATIVE_EXPRESSION
        ((eq 'add (car (third x))) (+ (ast-eval (car x)) (ast-eval (fifth x))))
        ((eq 'sub (car (third x))) (- (ast-eval (car x)) (ast-eval (fifth x))))
        ('t (break))))

(def-peg-fun multiplicative_expression (x)
  (cond ((atom (car x)) (ast-eval x)) ; x == PRIMARY_EXPRESSION
        ((eq 'mult (car (third x))) (* (ast-eval (car x)) (ast-eval (fifth x))))
        ((eq 'div (car (third x))) (/ (ast-eval (car x)) (ast-eval (fifth x))))
        ((eq 'mod (car (third x))) (mod (ast-eval (car x)) (ast-eval (fifth x))))
        ('t (progn (format 't "MULTIPLICATIVE EXPRESSION ERROR: ~A" (third x))))))

(def-peg-fun primary_expression (x)
  (cond ((eq 'constant (car x)) (ast-eval x))
        ((eq 'identifier (car x)) (ast-eval x))
        ('t (ast-eval (third x))))) ; open-r-brachet spaces EXPRESSION spaces close-r-bracket

(def-peg-fun constant (x) (ast-eval x))

(def-peg-fun integer_constant (x) (ast-eval x))

(def-peg-fun decimal_integer_constant (x)
  (cond ((not (car x)) (val_digits (cadr x)))
        ((equal (cadr (car x)) "-") (- (val_digits (cadr x))))
        ('t (val_digits (cadr x)))))

ここでのコードのライセンスについて

上記、PEG ならびに Common Lisp のコードはこのサイトで提示しているコードの基本 License に掲げるものに従う。