mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-15 09:47:20 +00:00
700 lines
19 KiB
EmacsLisp
700 lines
19 KiB
EmacsLisp
;;; ebnf-otz.el --- syntactic chart OpTimiZer
|
||
|
||
;; Copyright (C) 1999-2017 Free Software Foundation, Inc.
|
||
|
||
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
|
||
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
|
||
;; Keywords: wp, ebnf, PostScript
|
||
;; Old-Version: 1.0
|
||
;; Package: ebnf2ps
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; GNU Emacs 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 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;;
|
||
;;
|
||
;; This is part of ebnf2ps package.
|
||
;;
|
||
;; This package defines an optimizer for ebnf2ps.
|
||
;;
|
||
;; See ebnf2ps.el for documentation.
|
||
;;
|
||
;;
|
||
;; Optimizations
|
||
;; -------------
|
||
;;
|
||
;;
|
||
;; *To be implemented*:
|
||
;; left recursion:
|
||
;; A = B | A C B | A C D. ==> A = B {C (B | D)}*.
|
||
;;
|
||
;; right recursion:
|
||
;; A = B | C A. ==> A = {C}* B.
|
||
;; A = B | D | C A | E A. ==> A = { C | E }* ( B | D ).
|
||
;;
|
||
;; optional:
|
||
;; A = B | C B. ==> A = [C] B.
|
||
;; A = B | B C. ==> A = B [C].
|
||
;; A = D | B D | B C D. ==> A = [B [C]] D.
|
||
;;
|
||
;;
|
||
;; *Already implemented*:
|
||
;; left recursion:
|
||
;; A = B | A C. ==> A = B {C}*.
|
||
;; A = B | A B. ==> A = {B}+.
|
||
;; A = | A B. ==> A = {B}*.
|
||
;; A = B | A C B. ==> A = {B || C}+.
|
||
;; A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
|
||
;;
|
||
;; optional:
|
||
;; A = B | . ==> A = [B].
|
||
;; A = | B . ==> A = [B].
|
||
;;
|
||
;; factorization:
|
||
;; A = B C | B D. ==> A = B (C | D).
|
||
;; A = C B | D B. ==> A = (C | D) B.
|
||
;; A = B C E | B D E. ==> A = B (C | D) E.
|
||
;;
|
||
;; none:
|
||
;; A = B | C | . ==> A = B | C | .
|
||
;; A = B | C A D. ==> A = B | C A D.
|
||
;;
|
||
;;
|
||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
||
;;; Code:
|
||
|
||
|
||
(require 'ebnf2ps)
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
||
|
||
(defvar ebnf-empty-rule-list nil
|
||
"List of empty rule name.")
|
||
|
||
|
||
(defun ebnf-add-empty-rule-list (rule)
|
||
"Add empty RULE in `ebnf-empty-rule-list'."
|
||
(and ebnf-ignore-empty-rule
|
||
(eq (ebnf-node-kind (ebnf-node-production rule))
|
||
'ebnf-generate-empty)
|
||
(setq ebnf-empty-rule-list (cons (ebnf-node-name rule)
|
||
ebnf-empty-rule-list))))
|
||
|
||
|
||
(defun ebnf-otz-initialize ()
|
||
"Initialize optimizer."
|
||
(setq ebnf-empty-rule-list nil))
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; Eliminate empty rules
|
||
|
||
|
||
(defun ebnf-eliminate-empty-rules (syntax-list)
|
||
"Eliminate empty rules."
|
||
(while ebnf-empty-rule-list
|
||
(let ((ebnf-total (length syntax-list))
|
||
(ebnf-nprod 0)
|
||
(prod-list syntax-list)
|
||
new-list before)
|
||
(while prod-list
|
||
(ebnf-message-info "Eliminating empty rules")
|
||
(let ((rule (car prod-list)))
|
||
;; if any non-terminal pertains to ebnf-empty-rule-list
|
||
;; then eliminate non-terminal from rule
|
||
(if (ebnf-eliminate-empty rule)
|
||
(setq before prod-list)
|
||
;; eliminate empty rule from syntax-list
|
||
(setq new-list (cons (ebnf-node-name rule) new-list))
|
||
(if before
|
||
(setcdr before (cdr prod-list))
|
||
(setq syntax-list (cdr syntax-list)))))
|
||
(setq prod-list (cdr prod-list)))
|
||
(setq ebnf-empty-rule-list new-list)))
|
||
syntax-list)
|
||
|
||
|
||
;; [production width-func entry height width name production action]
|
||
;; [sequence width-func entry height width list]
|
||
;; [alternative width-func entry height width list]
|
||
;; [non-terminal width-func entry height width name default]
|
||
;; [empty width-func entry height width]
|
||
;; [terminal width-func entry height width name default]
|
||
;; [special width-func entry height width name default]
|
||
|
||
(defun ebnf-eliminate-empty (rule)
|
||
(let ((kind (ebnf-node-kind rule)))
|
||
(cond
|
||
;; non-terminal
|
||
((eq kind 'ebnf-generate-non-terminal)
|
||
(if (member (ebnf-node-name rule) ebnf-empty-rule-list)
|
||
nil
|
||
rule))
|
||
;; sequence
|
||
((eq kind 'ebnf-generate-sequence)
|
||
(let ((seq (ebnf-node-list rule))
|
||
(header (ebnf-node-list rule))
|
||
before elt)
|
||
(while seq
|
||
(setq elt (car seq))
|
||
(if (ebnf-eliminate-empty elt)
|
||
(setq before seq)
|
||
(if before
|
||
(setcdr before (cdr seq))
|
||
(setq header (cdr header))))
|
||
(setq seq (cdr seq)))
|
||
(when header
|
||
(ebnf-node-list rule header)
|
||
rule)))
|
||
;; alternative
|
||
((eq kind 'ebnf-generate-alternative)
|
||
(let ((seq (ebnf-node-list rule))
|
||
(header (ebnf-node-list rule))
|
||
before elt)
|
||
(while seq
|
||
(setq elt (car seq))
|
||
(if (ebnf-eliminate-empty elt)
|
||
(setq before seq)
|
||
(if before
|
||
(setcdr before (cdr seq))
|
||
(setq header (cdr header))))
|
||
(setq seq (cdr seq)))
|
||
(when header
|
||
(if (= (length header) 1)
|
||
(car header)
|
||
(ebnf-node-list rule header)
|
||
rule))))
|
||
;; production
|
||
((eq kind 'ebnf-generate-production)
|
||
(let ((prod (ebnf-eliminate-empty (ebnf-node-production rule))))
|
||
(when prod
|
||
(ebnf-node-production rule prod)
|
||
rule)))
|
||
;; terminal, special and empty
|
||
(t
|
||
rule)
|
||
)))
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; Optimizations
|
||
|
||
|
||
;; *To be implemented*:
|
||
;; left recursion:
|
||
;; A = B | A C B | A C D. ==> A = B {C (B | D)}*.
|
||
|
||
;; right recursion:
|
||
;; A = B | C A. ==> A = {C}* B.
|
||
;; A = B | D | C A | E A. ==> A = { C | E }* ( B | D ).
|
||
|
||
;; optional:
|
||
;; A = B | C B. ==> A = [C] B.
|
||
;; A = B | B C. ==> A = B [C].
|
||
;; A = D | B D | B C D. ==> A = [B [C]] D.
|
||
|
||
|
||
;; *Already implemented*:
|
||
;; left recursion:
|
||
;; A = B | A C. ==> A = B {C}*.
|
||
;; A = B | A B. ==> A = {B}+.
|
||
;; A = | A B. ==> A = {B}*.
|
||
;; A = B | A C B. ==> A = {B || C}+.
|
||
;; A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
|
||
|
||
;; optional:
|
||
;; A = B | . ==> A = [B].
|
||
;; A = | B . ==> A = [B].
|
||
|
||
;; factorization:
|
||
;; A = B C | B D. ==> A = B (C | D).
|
||
;; A = C B | D B. ==> A = (C | D) B.
|
||
;; A = B C E | B D E. ==> A = B (C | D) E.
|
||
|
||
;; none:
|
||
;; A = B | C | . ==> A = B | C | .
|
||
;; A = B | C A D. ==> A = B | C A D.
|
||
|
||
(defun ebnf-optimize (syntax-list)
|
||
"Syntactic chart optimizer."
|
||
(if (not ebnf-optimize)
|
||
syntax-list
|
||
(let ((ebnf-total (length syntax-list))
|
||
(ebnf-nprod 0)
|
||
new)
|
||
(while syntax-list
|
||
(setq new (cons (ebnf-optimize1 (car syntax-list)) new)
|
||
syntax-list (cdr syntax-list)))
|
||
(nreverse new))))
|
||
|
||
|
||
;; left recursion:
|
||
;; 1. A = B | A C. ==> A = B {C}*.
|
||
;; 2. A = B | A B. ==> A = {B}+.
|
||
;; 3. A = | A B. ==> A = {B}*.
|
||
;; 4. A = B | A C B. ==> A = {B || C}+.
|
||
;; 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
|
||
|
||
;; optional:
|
||
;; 6. A = B | . ==> A = [B].
|
||
;; 7. A = | B . ==> A = [B].
|
||
|
||
;; factorization:
|
||
;; 8. A = B C | B D. ==> A = B (C | D).
|
||
;; 9. A = C B | D B. ==> A = (C | D) B.
|
||
;; 10. A = B C E | B D E. ==> A = B (C | D) E.
|
||
|
||
(defun ebnf-optimize1 (prod)
|
||
(ebnf-message-info "Optimizing syntactic chart")
|
||
(let ((production (ebnf-node-production prod)))
|
||
(and (eq (ebnf-node-kind production) 'ebnf-generate-alternative)
|
||
(let* ((hlist (ebnf-split-header-prefix
|
||
(ebnf-node-list production)
|
||
(ebnf-node-name prod)))
|
||
(nlist (car hlist))
|
||
(zlist (cdr hlist))
|
||
(elist (ebnf-split-header-suffix nlist zlist)))
|
||
(ebnf-node-production
|
||
prod
|
||
(cond
|
||
;; cases 2., 4.
|
||
(elist
|
||
(and (eq elist t)
|
||
(setq elist nil))
|
||
(setq elist (or (ebnf-prefix-suffix elist)
|
||
elist))
|
||
(let* ((nl (ebnf-extract-empty nlist))
|
||
(el (or (ebnf-prefix-suffix (cdr nl))
|
||
(ebnf-create-alternative (cdr nl)))))
|
||
(if (car nl)
|
||
(ebnf-make-zero-or-more el elist)
|
||
(ebnf-make-one-or-more el elist))))
|
||
;; cases 1., 3., 5.
|
||
(zlist
|
||
(let* ((xlist (cdr (ebnf-extract-empty zlist)))
|
||
(znode (ebnf-make-zero-or-more
|
||
(or (ebnf-prefix-suffix xlist)
|
||
(ebnf-create-alternative xlist))))
|
||
(nnode (ebnf-map-list-to-optional nlist)))
|
||
(and nnode
|
||
(setq nlist (list nnode)))
|
||
(if (or (null nlist)
|
||
(and (= (length nlist) 1)
|
||
(eq (ebnf-node-kind (car nlist))
|
||
'ebnf-generate-empty)))
|
||
znode
|
||
(ebnf-make-sequence
|
||
(list (or (ebnf-prefix-suffix nlist)
|
||
(ebnf-create-alternative nlist))
|
||
znode)))))
|
||
;; cases 6., 7.
|
||
((ebnf-map-node-to-optional production)
|
||
)
|
||
;; cases 8., 9., 10.
|
||
((ebnf-prefix-suffix nlist)
|
||
)
|
||
;; none
|
||
(t
|
||
production)
|
||
))))
|
||
prod))
|
||
|
||
|
||
(defun ebnf-split-header-prefix (node-list header)
|
||
(let* ((hlist (ebnf-split-header-prefix1 node-list header))
|
||
(nlist (car hlist))
|
||
zlist empty-p)
|
||
(while (setq hlist (cdr hlist))
|
||
(let ((elt (car hlist)))
|
||
(if (eq (ebnf-node-kind elt) 'ebnf-generate-sequence)
|
||
(setq zlist (cons
|
||
(let ((seq (cdr (ebnf-node-list elt))))
|
||
(if (= (length seq) 1)
|
||
(car seq)
|
||
(ebnf-node-list elt seq)
|
||
elt))
|
||
zlist))
|
||
(setq empty-p t))))
|
||
(and empty-p
|
||
(setq zlist (cons (ebnf-make-empty)
|
||
zlist)))
|
||
(cons nlist (nreverse zlist))))
|
||
|
||
|
||
(defun ebnf-split-header-prefix1 (node-list header)
|
||
(let (hlist nlist)
|
||
(while node-list
|
||
(if (ebnf-node-equal-header (car node-list) header)
|
||
(setq hlist (cons (car node-list) hlist))
|
||
(setq nlist (cons (car node-list) nlist)))
|
||
(setq node-list (cdr node-list)))
|
||
(cons (nreverse nlist) (nreverse hlist))))
|
||
|
||
|
||
(defun ebnf-node-equal-header (node header)
|
||
(let ((kind (ebnf-node-kind node)))
|
||
(cond
|
||
((eq kind 'ebnf-generate-sequence)
|
||
(ebnf-node-equal-header (car (ebnf-node-list node)) header))
|
||
((eq kind 'ebnf-generate-non-terminal)
|
||
(string= (ebnf-node-name node) header))
|
||
(t
|
||
nil)
|
||
)))
|
||
|
||
|
||
(defun ebnf-map-node-to-optional (node)
|
||
(and (eq (ebnf-node-kind node) 'ebnf-generate-alternative)
|
||
(ebnf-map-list-to-optional (ebnf-node-list node))))
|
||
|
||
|
||
(defun ebnf-map-list-to-optional (nlist)
|
||
(and (= (length nlist) 2)
|
||
(let ((first (nth 0 nlist))
|
||
(second (nth 1 nlist)))
|
||
(cond
|
||
;; empty second
|
||
((eq (ebnf-node-kind first) 'ebnf-generate-empty)
|
||
(ebnf-make-optional second))
|
||
;; first empty
|
||
((eq (ebnf-node-kind second) 'ebnf-generate-empty)
|
||
(ebnf-make-optional first))
|
||
;; first second
|
||
(t
|
||
nil)
|
||
))))
|
||
|
||
|
||
(defun ebnf-extract-empty (elist)
|
||
(let ((now elist)
|
||
before empty-p)
|
||
(while now
|
||
(if (not (eq (ebnf-node-kind (car now)) 'ebnf-generate-empty))
|
||
(setq before now)
|
||
(setq empty-p t)
|
||
(if before
|
||
(setcdr before (cdr now))
|
||
(setq elist (cdr elist))))
|
||
(setq now (cdr now)))
|
||
(cons empty-p elist)))
|
||
|
||
|
||
(defun ebnf-split-header-suffix (nlist zlist)
|
||
(let (new empty-p)
|
||
(and (cond
|
||
((= (length nlist) 1)
|
||
(let ((ok t)
|
||
(elt (car nlist)))
|
||
(while (and ok zlist)
|
||
(setq ok (ebnf-split-header-suffix1 elt (car zlist))
|
||
zlist (cdr zlist))
|
||
(if (eq ok t)
|
||
(setq empty-p t)
|
||
(setq new (cons ok new))))
|
||
ok))
|
||
((= (length nlist) (length zlist))
|
||
(let ((ok t))
|
||
(while (and ok zlist)
|
||
(setq ok (ebnf-split-header-suffix1 (car nlist) (car zlist))
|
||
nlist (cdr nlist)
|
||
zlist (cdr zlist))
|
||
(if (eq ok t)
|
||
(setq empty-p t)
|
||
(setq new (cons ok new))))
|
||
ok))
|
||
(t
|
||
nil)
|
||
)
|
||
(let* ((lis (ebnf-unique-list new))
|
||
(len (length lis)))
|
||
(cond
|
||
((zerop len)
|
||
t)
|
||
((= len 1)
|
||
(setq lis (car lis))
|
||
(if empty-p
|
||
(ebnf-make-optional lis)
|
||
lis))
|
||
(t
|
||
(and empty-p
|
||
(setq lis (cons (ebnf-make-empty) lis)))
|
||
(ebnf-create-alternative (nreverse lis)))
|
||
)))))
|
||
|
||
|
||
(defun ebnf-split-header-suffix1 (ne ze)
|
||
(cond
|
||
((eq (ebnf-node-kind ne) 'ebnf-generate-sequence)
|
||
(and (eq (ebnf-node-kind ze) 'ebnf-generate-sequence)
|
||
(let ((nl (ebnf-node-list ne))
|
||
(zl (ebnf-node-list ze))
|
||
len z)
|
||
(and (>= (length zl) (length nl))
|
||
(let ((ok t))
|
||
(setq len (- (length zl) (length nl))
|
||
z (nthcdr len zl))
|
||
(while (and ok z)
|
||
(setq ok (ebnf-node-equal (car z) (car nl))
|
||
z (cdr z)
|
||
nl (cdr nl)))
|
||
ok)
|
||
(if (zerop len)
|
||
t
|
||
(setcdr (nthcdr (1- len) zl) nil)
|
||
ze)))))
|
||
((eq (ebnf-node-kind ze) 'ebnf-generate-sequence)
|
||
(let* ((zl (ebnf-node-list ze))
|
||
(len (length zl)))
|
||
(and (ebnf-node-equal ne (car (nthcdr (1- len) zl)))
|
||
(cond
|
||
((= len 1)
|
||
t)
|
||
((= len 2)
|
||
(car zl))
|
||
(t
|
||
(setcdr (nthcdr (- len 2) zl) nil)
|
||
ze)
|
||
))))
|
||
(t
|
||
(ebnf-node-equal ne ze))
|
||
))
|
||
|
||
|
||
(defun ebnf-prefix-suffix (lis)
|
||
(and lis (listp lis)
|
||
(let* ((prefix (ebnf-split-prefix lis))
|
||
(suffix (ebnf-split-suffix (cdr prefix)))
|
||
(middle (cdr suffix)))
|
||
(setq prefix (car prefix)
|
||
suffix (car suffix))
|
||
(and (or prefix suffix)
|
||
(ebnf-make-sequence
|
||
(nconc prefix
|
||
(and middle
|
||
(list (or (ebnf-map-list-to-optional middle)
|
||
(ebnf-create-alternative middle))))
|
||
suffix))))))
|
||
|
||
|
||
(defun ebnf-split-prefix (lis)
|
||
(let* ((len (length lis))
|
||
(tail lis)
|
||
(head (if (eq (ebnf-node-kind (car lis)) 'ebnf-generate-sequence)
|
||
(ebnf-node-list (car lis))
|
||
(list (car lis))))
|
||
(ipre (1+ len)))
|
||
;; determine prefix length
|
||
(while (and (> ipre 0) (setq tail (cdr tail)))
|
||
(let ((cur head)
|
||
(this (if (eq (ebnf-node-kind (car tail)) 'ebnf-generate-sequence)
|
||
(ebnf-node-list (car tail))
|
||
(list (car tail))))
|
||
(i 0))
|
||
(while (and cur this
|
||
(ebnf-node-equal (car cur) (car this)))
|
||
(setq cur (cdr cur)
|
||
this (cdr this)
|
||
i (1+ i)))
|
||
(setq ipre (min ipre i))))
|
||
(if (or (zerop ipre) (> ipre len))
|
||
;; no prefix at all
|
||
(cons nil lis)
|
||
(let* ((tail (nthcdr ipre head))
|
||
;; get prefix
|
||
(prefix (progn
|
||
(and tail
|
||
(setcdr (nthcdr (1- ipre) head) nil))
|
||
head))
|
||
empty-p before)
|
||
;; adjust first element
|
||
(if (or (not (eq (ebnf-node-kind (car lis)) 'ebnf-generate-sequence))
|
||
(null tail))
|
||
(setq lis (cdr lis)
|
||
tail lis
|
||
empty-p t)
|
||
(if (= (length tail) 1)
|
||
(setcar lis (car tail))
|
||
(ebnf-node-list (car lis) tail))
|
||
(setq tail (cdr lis)))
|
||
;; eliminate prefix from lis based on ipre
|
||
(while tail
|
||
(let ((elt (car tail))
|
||
rest)
|
||
(if (and (eq (ebnf-node-kind elt) 'ebnf-generate-sequence)
|
||
(setq rest (nthcdr ipre (ebnf-node-list elt))))
|
||
(progn
|
||
(if (= (length rest) 1)
|
||
(setcar tail (car rest))
|
||
(ebnf-node-list elt rest))
|
||
(setq before tail))
|
||
(setq empty-p t)
|
||
(if before
|
||
(setcdr before (cdr tail))
|
||
(setq lis (cdr lis))))
|
||
(setq tail (cdr tail))))
|
||
(cons prefix (ebnf-unique-list
|
||
(if empty-p
|
||
(nconc lis (list (ebnf-make-empty)))
|
||
lis)))))))
|
||
|
||
|
||
(defun ebnf-split-suffix (lis)
|
||
(let* ((len (length lis))
|
||
(tail lis)
|
||
(head (nreverse
|
||
(if (eq (ebnf-node-kind (car lis)) 'ebnf-generate-sequence)
|
||
(ebnf-node-list (car lis))
|
||
(list (car lis)))))
|
||
(isuf (1+ len)))
|
||
;; determine suffix length
|
||
(while (and (> isuf 0) (setq tail (cdr tail)))
|
||
(let* ((cur head)
|
||
(tlis (nreverse
|
||
(if (eq (ebnf-node-kind (car tail)) 'ebnf-generate-sequence)
|
||
(ebnf-node-list (car tail))
|
||
(list (car tail)))))
|
||
(this tlis)
|
||
(i 0))
|
||
(while (and cur this
|
||
(ebnf-node-equal (car cur) (car this)))
|
||
(setq cur (cdr cur)
|
||
this (cdr this)
|
||
i (1+ i)))
|
||
(nreverse tlis)
|
||
(setq isuf (min isuf i))))
|
||
(setq head (nreverse head))
|
||
(if (or (zerop isuf) (> isuf len))
|
||
;; no suffix at all
|
||
(cons nil lis)
|
||
(let* ((n (- (length head) isuf))
|
||
;; get suffix
|
||
(suffix (nthcdr n head))
|
||
(tail (and (> n 0)
|
||
(progn
|
||
(setcdr (nthcdr (1- n) head) nil)
|
||
head)))
|
||
before empty-p)
|
||
;; adjust first element
|
||
(if (or (not (eq (ebnf-node-kind (car lis)) 'ebnf-generate-sequence))
|
||
(null tail))
|
||
(setq lis (cdr lis)
|
||
tail lis
|
||
empty-p t)
|
||
(if (= (length tail) 1)
|
||
(setcar lis (car tail))
|
||
(ebnf-node-list (car lis) tail))
|
||
(setq tail (cdr lis)))
|
||
;; eliminate suffix from lis based on isuf
|
||
(while tail
|
||
(let ((elt (car tail))
|
||
rest)
|
||
(if (and (eq (ebnf-node-kind elt) 'ebnf-generate-sequence)
|
||
(setq rest (ebnf-node-list elt)
|
||
n (- (length rest) isuf))
|
||
(> n 0))
|
||
(progn
|
||
(if (= n 1)
|
||
(setcar tail (car rest))
|
||
(setcdr (nthcdr (1- n) rest) nil)
|
||
(ebnf-node-list elt rest))
|
||
(setq before tail))
|
||
(setq empty-p t)
|
||
(if before
|
||
(setcdr before (cdr tail))
|
||
(setq lis (cdr lis))))
|
||
(setq tail (cdr tail))))
|
||
(cons suffix (ebnf-unique-list
|
||
(if empty-p
|
||
(nconc lis (list (ebnf-make-empty)))
|
||
lis)))))))
|
||
|
||
|
||
(defun ebnf-unique-list (nlist)
|
||
(let ((current nlist)
|
||
before)
|
||
(while current
|
||
(let ((tail (cdr current))
|
||
(head (car current))
|
||
remove-p)
|
||
(while tail
|
||
(if (not (ebnf-node-equal head (car tail)))
|
||
(setq tail (cdr tail))
|
||
(setq remove-p t
|
||
tail nil)
|
||
(if before
|
||
(setcdr before (cdr current))
|
||
(setq nlist (cdr nlist)))))
|
||
(or remove-p
|
||
(setq before current))
|
||
(setq current (cdr current))))
|
||
nlist))
|
||
|
||
|
||
(defun ebnf-node-equal (A B)
|
||
(let ((kindA (ebnf-node-kind A))
|
||
(kindB (ebnf-node-kind B)))
|
||
(and (eq kindA kindB)
|
||
(cond
|
||
;; empty
|
||
((eq kindA 'ebnf-generate-empty)
|
||
t)
|
||
;; non-terminal, terminal, special
|
||
((memq kindA '(ebnf-generate-non-terminal
|
||
ebnf-generate-terminal
|
||
ebnf-generate-special))
|
||
(string= (ebnf-node-name A) (ebnf-node-name B)))
|
||
;; alternative, sequence
|
||
((memq kindA '(ebnf-generate-alternative ; any order
|
||
ebnf-generate-sequence)) ; order is important
|
||
(let ((listA (ebnf-node-list A))
|
||
(listB (ebnf-node-list B)))
|
||
(and (= (length listA) (length listB))
|
||
(let ((ok t))
|
||
(while (and ok listA)
|
||
(setq ok (ebnf-node-equal (car listA) (car listB))
|
||
listA (cdr listA)
|
||
listB (cdr listB)))
|
||
ok))))
|
||
;; production
|
||
((eq kindA 'ebnf-generate-production)
|
||
(and (string= (ebnf-node-name A) (ebnf-node-name B))
|
||
(ebnf-node-equal (ebnf-node-production A)
|
||
(ebnf-node-production B))))
|
||
;; otherwise
|
||
(t
|
||
nil)
|
||
))))
|
||
|
||
|
||
(defun ebnf-create-alternative (alt)
|
||
(if (> (length alt) 1)
|
||
(ebnf-make-alternative alt)
|
||
(car alt)))
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
||
|
||
(provide 'ebnf-otz)
|
||
|
||
|
||
;;; ebnf-otz.el ends here
|