view lisp/progmodes/ebnf-otz.el @ 110523:a5ad4f188e19

Synch Semantic to CEDET 1.0. Move CEDET ChangeLog entries to new file lisp/cedet/ChangeLog. * semantic.el (semantic-version): Update to 2.0. (semantic-mode-map): Add "," and "m" bindings. (navigate-menu): Update. * semantic/symref.el (semantic-symref-calculate-rootdir): New function. (semantic-symref-detect-symref-tool): Use it. * semantic/symref/grep.el (semantic-symref-grep-shell): New var. (semantic-symref-perform-search): Use it. Calculate root dir with semantic-symref-calculate-rootdir. (semantic-symref-derive-find-filepatterns): Improve error message. * semantic/symref/list.el (semantic-symref-results-mode-map): New bindings. (semantic-symref-auto-expand-results): New option. (semantic-symref-results-dump): Obey auto-expand. (semantic-symref-list-expand-all, semantic-symref-regexp) (semantic-symref-list-contract-all) (semantic-symref-list-map-open-hits) (semantic-symref-list-update-open-hits) (semantic-symref-list-create-macro-on-open-hit) (semantic-symref-list-call-macro-on-open-hits): New functions. (semantic-symref-list-menu-entries) (semantic-symref-list-menu): New vars. (semantic-symref-list-map-open-hits): Move cursor to beginning of match before calling the mapped function. * semantic/doc.el (semantic-documentation-comment-preceeding-tag): Do nothing if the mode doesn't provide comment-start-skip. * semantic/scope.el (semantic-analyze-scope-nested-tags-default): Strip duplicates. (semantic-analyze-scoped-inherited-tag-map): Take the tag we are looking for as part of the scoped tags list. * semantic/html.el (semantic-default-html-setup): Add senator-step-at-tag-classes. * semantic/decorate/include.el (semantic-decoration-on-unknown-includes): Change light bgcolor. (semantic-decoration-on-includes-highlight-default): Check that the include tag has a postion. * semantic/complete.el (semantic-collector-local-members): (semantic-complete-read-tag-local-members) (semantic-complete-jump-local-members): New class and functions. (semantic-complete-self-insert): Save excursion before completing. * semantic/analyze/complete.el (semantic-analyze-possible-completions-default): If no completions are found, return the raw by-name-only completion list. Add FLAGS arguments. Add support for 'no-tc (type constraint) and 'no-unique, or no stripping duplicates. (semantic-analyze-possible-completions-default): Add FLAGS arg. * semantic/util-modes.el (semantic-stickyfunc-show-only-functions-p): New option. (semantic-stickyfunc-fetch-stickyline): Don't show stickytext for the very first line in a buffer. * semantic/util.el (semantic-hack-search) (semantic-recursive-find-nonterminal-by-name) (semantic-current-tag-interactive): Deleted. (semantic-describe-buffer): Fix expand-nonterminal. Add lex-syntax-mods, type relation separator char, and command separation char. (semantic-sanity-check): Only message if called interactively. * semantic/tag.el (semantic-tag-deep-copy-one-tag): Copy the :filename property and the tag position. * semantic/lex-spp.el (semantic-lex-spp-lex-text-string): Add recursion limit. * semantic/imenu.el (semantic-imenu-bucketize-type-members): Make this buffer local, not the obsoleted variable. * semantic/idle.el: Add breadcrumbs support. (semantic-idle-summary-current-symbol-info-default) (semantic-idle-tag-highlight) (semantic-idle-completion-list-default): Use semanticdb-without-unloaded-file-searches for speed, and to conform to the controls that specify if the idle timer is supposed to be parsing unparsed includes. (semantic-idle-symbol-highlight-face) (semantic-idle-symbol-maybe-highlight): Rename from *-summary-*. Callers changed. (semantic-idle-work-parse-neighboring-files-flag): Default to nil. (semantic-idle-work-update-headers-flag): New var. (semantic-idle-work-for-one-buffer): Use it. (semantic-idle-local-symbol-highlight): Rename from semantic-idle-tag-highlight. (semantic-idle-truncate-long-summaries): New option. * semantic/ia.el (semantic-ia-cache) (semantic-ia-get-completions): Deleted. Callers changed. (semantic-ia-show-variants): New command. (semantic-ia-show-doc): If doc is empty, don't make a temp buffer. (semantic-ia-show-summary): If there isn't anything to show, say so. * semantic/grammar.el (semantic-grammar-create-package): Save the buffer even in batch mode. * semantic/fw.el (semanticdb-without-unloaded-file-searches): New macro. * semantic/dep.el (semantic-dependency-find-file-on-path): Fix case dereferencing ede-object when it is a list. * semantic/db-typecache.el (semanticdb-expand-nested-tag) (semanticdb-typecache-faux-namespace): New functions. (semanticdb-typecache-file-tags) (semanticdb-typecache-merge-streams): Use them. (semanticdb-typecache-file-tags): When deriving tags from a file, give the mode a chance to monkey with the tag copy. (semanticdb-typecache-find-default): Wrap find in save-excursion. (semanticdb-typecache-find-by-name-helper): Merge found names down. * semantic/db-global.el (semanticdb-enable-gnu-global-in-buffer): Don't show messages if GNU Global is not available and we don't want to throw an error. * semantic/db-find.el (semanticdb-find-result-nth-in-buffer): When trying to normalize the tag to a buffer, don't error if set-buffer method doesn't exist. * semantic/db-file.el (semanticdb-save-db): Simplify msg. * semantic/db.el (semanticdb-refresh-table): If forcing a refresh on a file not in a buffer, use semantic-find-file-noselect and delete the buffer after use. (semanticdb-current-database-list): When calculating root via hooks, force it through true-filename and skip the list of possible roots. * semantic/ctxt.el (semantic-ctxt-imported-packages): New. * semantic/analyze/debug.el (semantic-analyzer-debug-insert-tag): Reset standard output to current buffer. (semantic-analyzer-debug-global-symbol) (semantic-analyzer-debug-missing-innertype): Change "prefix" to "symbol" in messages. * semantic/analyze/refs.el: (semantic-analyze-refs-impl) (semantic-analyze-refs-proto): When calculating value, make sure the found tag is 'similar' to the originating tag. (semantic--analyze-refs-find-tags-with-parent): Attempt to identify matches via imported symbols of parents. (semantic--analyze-refs-full-lookup-with-parents): Do a deep search during the brute search. * semantic/analyze.el (semantic-analyze-find-tag-sequence-default): Be robust to calculated scopes being nil. * semantic/bovine/c.el (semantic-c-describe-environment): Add project macro symbol array. (semantic-c-parse-lexical-token): Add recursion limit. (semantic-ctxt-imported-packages, semanticdb-expand-nested-tag): New overrides. (semantic-expand-c-tag-namelist): Split a full type from a typedef out to its own tag. (semantic-expand-c-tag-namelist): Do not split out a typedef'd inline type if it is an anonymous type. (semantic-c-reconstitute-token): Use the optional initializers as a clue that some function is probably a constructor. When defining the type of these constructors, split the parent name, and use only the class part, if applicable. * semantic/bovine/c-by.el: * semantic/wisent/python-wy.el: Regenerate.

;;; ebnf-otz.el --- syntactic chart OpTimiZer

;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
;;   Free Software Foundation, Inc.

;; Author: Vinicius Jose Latorre <[e-mail]>
;; Maintainer: Vinicius Jose Latorre <[e-mail]>
;; Keywords: wp, ebnf, PostScript
;; Version: 1.0

;; 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)


;; arch-tag: 7ef2249d-9e8b-4bc1-999f-95d784690636
;;; ebnf-otz.el ends here