(require 'ebnf-otz)
(defvar ebnf-abn-lex nil
"Value returned by `ebnf-abn-lex' function.")
(defun ebnf-abn-parser (start)
"ABNF parser."
(let ((total (+ (- ebnf-limit start) 1))
(bias (1- start))
(origin (point))
rule-list token rule)
(goto-char start)
(setq token (ebnf-abn-lex))
(and (eq token 'end-of-input)
(error "Invalid ABNF file format"))
(and (eq token 'end-of-rule)
(setq token (ebnf-abn-lex)))
(while (not (eq token 'end-of-input))
(ebnf-message-float
"Parsing...%s%%"
(/ (* (- (point) bias) 100.0) total))
(setq token (ebnf-abn-rule token)
rule (cdr token)
token (car token))
(or (ebnf-add-empty-rule-list rule)
(setq rule-list (cons rule rule-list))))
(goto-char origin)
rule-list))
(defun ebnf-abn-rule (token)
(let ((name ebnf-abn-lex)
(action ebnf-action)
elements)
(setq ebnf-action nil)
(or (eq token 'non-terminal)
(error "Invalid rule name"))
(setq token (ebnf-abn-lex))
(or (memq token '(equal incremental-alternative))
(error "Invalid rule: missing `=' or `=/'"))
(and (eq token 'incremental-alternative)
(setq name (concat name " =/")))
(setq elements (ebnf-abn-alternation))
(or (memq (car elements) '(end-of-rule end-of-input))
(error "Invalid rule: there is no end of rule"))
(setq elements (cdr elements))
(ebnf-eps-add-production name)
(cons (ebnf-abn-lex)
(ebnf-make-production name elements action))))
(defun ebnf-abn-alternation ()
(let (body concatenation)
(while (eq (car (setq concatenation
(ebnf-abn-concatenation (ebnf-abn-lex))))
'alternative)
(setq body (cons (cdr concatenation) body)))
(ebnf-token-alternative body concatenation)))
(defun ebnf-abn-concatenation (token)
(let ((term (ebnf-abn-repetition token))
seq)
(or (setq token (car term)
term (cdr term))
(error "Empty element"))
(setq seq (cons term seq))
(while (setq term (ebnf-abn-repetition token)
token (car term)
term (cdr term))
(setq seq (cons term seq)))
(cons token
(ebnf-token-sequence seq))))
(defun ebnf-abn-repetition (token)
(let (lower upper)
(when (eq token 'integer)
(setq lower ebnf-abn-lex
token (ebnf-abn-lex))
(or (eq token 'repeat)
(setq upper lower)))
(when (eq token 'repeat)
(or lower
(setq lower ""
upper ""))
(when (eq (setq token (ebnf-abn-lex)) 'integer)
(setq upper ebnf-abn-lex
token (ebnf-abn-lex))))
(let ((element (ebnf-abn-element token)))
(cond
(lower
(or element
(error "Missing element repetition"))
(setq token (ebnf-abn-lex))
(cond
((and (string= lower "1") (null upper))
(cons token (ebnf-make-one-or-more element)))
((or (and (string= lower "0") (null upper))
(and (string= lower "") (string= upper "")))
(cons token (ebnf-make-zero-or-more element)))
(t
(ebnf-token-repeat lower (cons token element) upper))))
(element
(cons (ebnf-abn-lex) element))
(t
(cons token nil))))))
(defun ebnf-abn-element (token)
(cond
((eq token 'terminal)
(ebnf-make-terminal ebnf-abn-lex))
((eq token 'non-terminal)
(ebnf-make-non-terminal ebnf-abn-lex))
((eq token 'begin-group)
(let ((body (ebnf-abn-alternation)))
(or (eq (car body) 'end-group)
(error "Missing `)'"))
(cdr body)))
((eq token 'begin-optional)
(let ((body (ebnf-abn-alternation)))
(or (eq (car body) 'end-optional)
(error "Missing `]'"))
(ebnf-token-optional (cdr body))))
(t
nil)
))
(defconst ebnf-abn-token-table (make-vector 256 'error)
"Vector used to map characters to a lexical token.")
(defun ebnf-abn-initialize ()
"Initialize EBNF token table."
(let ((char ?\060))
(while (< char ?\072)
(aset ebnf-abn-token-table char 'integer)
(setq char (1+ char)))
(setq char ?\101)
(while (< char ?\133)
(aset ebnf-abn-token-table char 'non-terminal)
(setq char (1+ char)))
(setq char ?\141)
(while (< char ?\173)
(aset ebnf-abn-token-table char 'non-terminal)
(setq char (1+ char)))
(setq char ?\240)
(while (< char ?\400)
(aset ebnf-abn-token-table char 'non-terminal)
(setq char (1+ char)))
(aset ebnf-abn-token-table ?\n 'end-of-rule) (aset ebnf-abn-token-table ?\r 'end-of-rule) (aset ebnf-abn-token-table ?\013 'space) (aset ebnf-abn-token-table ?\t 'space) (aset ebnf-abn-token-table ?\ 'space) (aset ebnf-abn-token-table ?\f 'form-feed) (aset ebnf-abn-token-table ?< 'non-terminal)
(aset ebnf-abn-token-table ?% 'terminal)
(aset ebnf-abn-token-table ?\" 'terminal)
(aset ebnf-abn-token-table ?\( 'begin-group)
(aset ebnf-abn-token-table ?\) 'end-group)
(aset ebnf-abn-token-table ?* 'repeat)
(aset ebnf-abn-token-table ?= 'equal)
(aset ebnf-abn-token-table ?\[ 'begin-optional)
(aset ebnf-abn-token-table ?\] 'end-optional)
(aset ebnf-abn-token-table ?/ 'alternative)
;; Override comment character:
(aset ebnf-abn-token-table ?\; 'comment)))
;; replace the range "\240-\377" (see `ebnf-range-regexp').
(defconst ebnf-abn-non-terminal-chars
(ebnf-range-regexp "-_0-9A-Za-z" ?\240 ?\377))
(defconst ebnf-abn-non-terminal-letter-chars
(ebnf-range-regexp "A-Za-z" ?\240 ?\377))
(defun ebnf-abn-lex ()
"Lexical analyzer for ABNF.
Return a lexical token.
See documentation for variable `ebnf-abn-lex'."
(if (>= (point) ebnf-limit)
'end-of-input
(let (token)
;; skip spaces and comments
(while (if (> (following-char) 255)
(progn
(setq token 'error)
nil)
(setq token (aref ebnf-abn-token-table (following-char)))
(cond
((eq token 'space)
(skip-chars-forward " \013\t" ebnf-limit)
(< (point) ebnf-limit))
((eq token 'comment)
(ebnf-abn-skip-comment))
((eq token 'form-feed)
(forward-char)
(setq ebnf-action 'form-feed))
((eq token 'end-of-rule)
(ebnf-abn-skip-end-of-rule))
(t nil)
)))
(cond
;; end of input
((>= (point) ebnf-limit)
'end-of-input)
;; error
((eq token 'error)
(error "Invalid character"))
;; end of rule
((eq token 'end-of-rule)
'end-of-rule)
;; integer
((eq token 'integer)
(setq ebnf-abn-lex (ebnf-buffer-substring "0-9"))
'integer)
;; terminal: "string" or %[bdx]NNN((.NNN)+|-NNN)?
((eq token 'terminal)
(setq ebnf-abn-lex
(if (= (following-char) ?\")
(ebnf-abn-string)
(ebnf-abn-character)))
'terminal)
;; non-terminal: NAME or <NAME>
((eq token 'non-terminal)
(let ((prose-p (= (following-char) ?<)))
(when prose-p
(forward-char)
(or (looking-at ebnf-abn-non-terminal-letter-chars)
(error "Invalid prose value")))
(setq ebnf-abn-lex
(ebnf-buffer-substring ebnf-abn-non-terminal-chars))
(when prose-p
(or (= (following-char) ?>)
(error "Invalid prose value"))
(setq ebnf-abn-lex (concat "<" ebnf-abn-lex ">"))))
'non-terminal)
;; equal: =, =/
((eq token 'equal)
(forward-char)
(if (/= (following-char) ?/)
'equal
(forward-char)
'incremental-alternative))
;; miscellaneous: (, ), [, ], /, *
(t
(forward-char)
token)
))))
(defun ebnf-abn-skip-end-of-rule ()
(let (eor-p)
(while (progn
;; end of rule ==> 2 or more consecutive end of lines
(setq eor-p (or (> (skip-chars-forward "\r\n" ebnf-limit) 1)
eor-p))
;; skip spaces
(skip-chars-forward " \013\t" ebnf-limit)
;; skip comments
(and (= (following-char) ?\;)
(ebnf-abn-skip-comment))))
(not eor-p)))
;; replace the range "\177-\237" (see `ebnf-range-regexp').
(defconst ebnf-abn-comment-chars
(ebnf-range-regexp "^\n\000-\010\016-\037" ?\177 ?\237))
(defun ebnf-abn-skip-comment ()
(forward-char)
(cond
;; open EPS file
((and ebnf-eps-executing (= (following-char) ?\[))
(ebnf-eps-add-context (ebnf-abn-eps-filename)))
;; close EPS file
((and ebnf-eps-executing (= (following-char) ?\]))
(ebnf-eps-remove-context (ebnf-abn-eps-filename)))
;; any other action in comment
(t
(setq ebnf-action (aref ebnf-comment-table (following-char)))
(skip-chars-forward ebnf-abn-comment-chars ebnf-limit))
)
;; check for a valid end of comment
(cond ((>= (point) ebnf-limit)
nil)
((= (following-char) ?\n)
t)
(t
(error "Invalid character"))
))
(defun ebnf-abn-eps-filename ()
(forward-char)
(ebnf-buffer-substring ebnf-abn-comment-chars))
;; replace the range "\240-\377" (see `ebnf-range-regexp').
(defconst ebnf-abn-string-chars
(ebnf-range-regexp " -!#-~" ?\240 ?\377))
(defun ebnf-abn-string ()
(buffer-substring-no-properties
(progn
(forward-char)
(point))
(progn
(skip-chars-forward ebnf-abn-string-chars ebnf-limit)
(or (= (following-char) ?\")
(error "Missing `\"'"))
(prog1
(point)
(forward-char)))))
(defun ebnf-abn-character ()
(buffer-substring-no-properties
(point)
(progn
(forward-char)
(let* ((char (following-char))
(chars (cond ((or (= char ?B) (= char ?b)) "01")
((or (= char ?D) (= char ?d)) "0-9")
((or (= char ?X) (= char ?x)) "0-9A-Fa-f")
(t (error "Invalid terminal value")))))
(forward-char)
(or (> (skip-chars-forward chars ebnf-limit) 0)
(error "Invalid terminal value"))
(if (= (following-char) ?-)
(progn
(forward-char)
(or (> (skip-chars-forward chars ebnf-limit) 0)
(error "Invalid terminal value range")))
(while (= (following-char) ?.)
(forward-char)
(or (> (skip-chars-forward chars ebnf-limit) 0)
(error "Invalid terminal value")))))
(point))))
(provide 'ebnf-abn)