lisp/progmodes/ebnf-otz.el

   1 ;;; ebnf-otz.el --- syntactic chart OpTimiZer
   2
   3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
   7 ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
   8 ;; Keywords: wp, ebnf, PostScript
   9 ;; Version: 1.0
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  26 ;; Boston, MA 02110-1301, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  31 ;;
  32 ;;
  33 ;; This is part of ebnf2ps package.
  34 ;;
  35 ;; This package defines an optimizer for ebnf2ps.
  36 ;;
  37 ;; See ebnf2ps.el for documentation.
  38 ;;
  39 ;;
  40 ;; Optimizations
  41 ;; -------------
  42 ;;
  43 ;;
  44 ;; *To be implemented*:
  45 ;;    left recursion:
  46 ;;    A = B | A C B | A C D.   ==>   A = B {C (B | D)}*.
  47 ;;
  48 ;;    right recursion:
  49 ;;    A = B | C A.             ==>   A = {C}* B.
  50 ;;    A = B | D | C A | E A.   ==>   A = { C | E }* ( B | D ).
  51 ;;
  52 ;;    optional:
  53 ;;    A = B | C B.             ==>   A = [C] B.
  54 ;;    A = B | B C.             ==>   A = B [C].
  55 ;;    A = D | B D | B C D.     ==>   A = [B [C]] D.
  56 ;;
  57 ;;
  58 ;; *Already implemented*:
  59 ;;    left recursion:
  60 ;;    A = B | A C.             ==>   A = B {C}*.
  61 ;;    A = B | A B.             ==>   A = {B}+.
  62 ;;    A =   | A B.             ==>   A = {B}*.
  63 ;;    A = B | A C B.           ==>   A = {B || C}+.
  64 ;;    A = B | D | A C | A E.   ==>   A = ( B | D ) { C | E }*.
  65 ;;
  66 ;;    optional:
  67 ;;    A = B | .                ==>   A = [B].
  68 ;;    A =   | B .              ==>   A = [B].
  69 ;;
  70 ;;    factorization:
  71 ;;    A = B C | B D.           ==>   A = B (C | D).
  72 ;;    A = C B | D B.           ==>   A = (C | D) B.
  73 ;;    A = B C E | B D E.       ==>   A = B (C | D) E.
  74 ;;
  75 ;;    none:
  76 ;;    A = B | C | .            ==>   A = B | C | .
  77 ;;    A = B | C A D.           ==>   A = B | C A D.
  78 ;;
  79 ;;
  80 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  81
  82 ;;; Code:
  83
  84
  85 (require 'ebnf2ps)
  86
  87 \f
  88 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  89
  90
  91 (defvar ebnf-empty-rule-list nil
  92   "List of empty rule name.")
  93
  94
  95 (defun ebnf-add-empty-rule-list (rule)
  96   "Add empty RULE in `ebnf-empty-rule-list'."
  97   (and ebnf-ignore-empty-rule
  98        (eq (ebnf-node-kind (ebnf-node-production rule))
  99            'ebnf-generate-empty)
 100        (setq ebnf-empty-rule-list (cons (ebnf-node-name rule)
 101                                         ebnf-empty-rule-list))))
 102
 103
 104 (defun ebnf-otz-initialize ()
 105   "Initialize optimizer."
 106   (setq ebnf-empty-rule-list nil))
 107
 108 \f
 109 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 110 ;; Eliminate empty rules
 111
 112
 113 (defun ebnf-eliminate-empty-rules (syntax-list)
 114   "Eliminate empty rules."
 115   (while ebnf-empty-rule-list
 116     (let ((ebnf-total (length syntax-list))
 117           (ebnf-nprod 0)
 118           (prod-list syntax-list)
 119           new-list before)
 120       (while prod-list
 121         (ebnf-message-info "Eliminating empty rules")
 122         (let ((rule (car prod-list)))
 123           ;; if any non-terminal pertains to ebnf-empty-rule-list
 124           ;; then eliminate non-terminal from rule
 125           (if (ebnf-eliminate-empty rule)
 126               (setq before prod-list)
 127             ;; eliminate empty rule from syntax-list
 128             (setq new-list (cons (ebnf-node-name rule) new-list))
 129             (if before
 130                 (setcdr before (cdr prod-list))
 131               (setq syntax-list (cdr syntax-list)))))
 132         (setq prod-list (cdr prod-list)))
 133       (setq ebnf-empty-rule-list new-list)))
 134   syntax-list)
 135
 136
 137 ;; [production   width-func entry height width name production action]
 138 ;; [sequence     width-func entry height width list]
 139 ;; [alternative  width-func entry height width list]
 140 ;; [non-terminal width-func entry height width name default]
 141 ;; [empty        width-func entry height width]
 142 ;; [terminal     width-func entry height width name default]
 143 ;; [special      width-func entry height width name default]
 144
 145 (defun ebnf-eliminate-empty (rule)
 146   (let ((kind (ebnf-node-kind rule)))
 147     (cond
 148      ;; non-terminal
 149      ((eq kind 'ebnf-generate-non-terminal)
 150       (if (member (ebnf-node-name rule) ebnf-empty-rule-list)
 151           nil
 152         rule))
 153      ;; sequence
 154      ((eq kind 'ebnf-generate-sequence)
 155       (let ((seq    (ebnf-node-list rule))
 156             (header (ebnf-node-list rule))
 157             before elt)
 158         (while seq
 159           (setq elt (car seq))
 160           (if (ebnf-eliminate-empty elt)
 161               (setq before seq)
 162             (if before
 163                 (setcdr before (cdr seq))
 164               (setq header (cdr header))))
 165           (setq seq (cdr seq)))
 166         (when header
 167           (ebnf-node-list rule header)
 168           rule)))
 169      ;; alternative
 170      ((eq kind 'ebnf-generate-alternative)
 171       (let ((seq    (ebnf-node-list rule))
 172             (header (ebnf-node-list rule))
 173             before elt)
 174         (while seq
 175           (setq elt (car seq))
 176           (if (ebnf-eliminate-empty elt)
 177               (setq before seq)
 178             (if before
 179                 (setcdr before (cdr seq))
 180               (setq header (cdr header))))
 181           (setq seq (cdr seq)))
 182         (when header
 183           (if (= (length header) 1)
 184               (car header)
 185             (ebnf-node-list rule header)
 186             rule))))
 187      ;; production
 188      ((eq kind 'ebnf-generate-production)
 189       (let ((prod (ebnf-eliminate-empty (ebnf-node-production rule))))
 190         (when prod
 191           (ebnf-node-production rule prod)
 192           rule)))
 193      ;; terminal, special and empty
 194      (t
 195       rule)
 196      )))
 197
 198 \f
 199 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 200 ;; Optimizations
 201
 202
 203 ;; *To be implemented*:
 204 ;;    left recursion:
 205 ;;    A = B | A C B | A C D.   ==>   A = B {C (B | D)}*.
 206
 207 ;;    right recursion:
 208 ;;    A = B | C A.             ==>   A = {C}* B.
 209 ;;    A = B | D | C A | E A.   ==>   A = { C | E }* ( B | D ).
 210
 211 ;;    optional:
 212 ;;    A = B | C B.             ==>   A = [C] B.
 213 ;;    A = B | B C.             ==>   A = B [C].
 214 ;;    A = D | B D | B C D.     ==>   A = [B [C]] D.
 215
 216
 217 ;; *Already implemented*:
 218 ;;    left recursion:
 219 ;;    A = B | A C.             ==>   A = B {C}*.
 220 ;;    A = B | A B.             ==>   A = {B}+.
 221 ;;    A =   | A B.             ==>   A = {B}*.
 222 ;;    A = B | A C B.           ==>   A = {B || C}+.
 223 ;;    A = B | D | A C | A E.   ==>   A = ( B | D ) { C | E }*.
 224
 225 ;;    optional:
 226 ;;    A = B | .                ==>   A = [B].
 227 ;;    A =   | B .              ==>   A = [B].
 228
 229 ;;    factorization:
 230 ;;    A = B C | B D.           ==>   A = B (C | D).
 231 ;;    A = C B | D B.           ==>   A = (C | D) B.
 232 ;;    A = B C E | B D E.       ==>   A = B (C | D) E.
 233
 234 ;;    none:
 235 ;;    A = B | C | .            ==>   A = B | C | .
 236 ;;    A = B | C A D.           ==>   A = B | C A D.
 237
 238 (defun ebnf-optimize (syntax-list)
 239   "Syntactic chart optimizer."
 240   (if (not ebnf-optimize)
 241       syntax-list
 242     (let ((ebnf-total (length syntax-list))
 243           (ebnf-nprod 0)
 244           new)
 245       (while syntax-list
 246         (setq new (cons (ebnf-optimize1 (car syntax-list)) new)
 247               syntax-list (cdr syntax-list)))
 248       (nreverse new))))
 249
 250
 251 ;; left recursion:
 252 ;; 1.  A = B | A C.             ==>   A = B {C}*.
 253 ;; 2.  A = B | A B.             ==>   A = {B}+.
 254 ;; 3.  A =   | A B.             ==>   A = {B}*.
 255 ;; 4.  A = B | A C B.           ==>   A = {B || C}+.
 256 ;; 5.  A = B | D | A C | A E.   ==>   A = ( B | D ) { C | E }*.
 257
 258 ;; optional:
 259 ;; 6.  A = B | .                ==>   A = [B].
 260 ;; 7.  A =   | B .              ==>   A = [B].
 261
 262 ;; factorization:
 263 ;; 8.  A = B C | B D.           ==>   A = B (C | D).
 264 ;; 9.  A = C B | D B.           ==>   A = (C | D) B.
 265 ;; 10. A = B C E | B D E.       ==>   A = B (C | D) E.
 266
 267 (defun ebnf-optimize1 (prod)
 268   (ebnf-message-info "Optimizing syntactic chart")
 269   (let ((production (ebnf-node-production prod)))
 270     (and (eq (ebnf-node-kind production) 'ebnf-generate-alternative)
 271          (let* ((hlist (ebnf-split-header-prefix
 272                         (ebnf-node-list production)
 273                         (ebnf-node-name prod)))
 274                 (nlist (car hlist))
 275                 (zlist (cdr hlist))
 276                 (elist (ebnf-split-header-suffix nlist zlist)))
 277            (ebnf-node-production
 278             prod
 279             (cond
 280              ;; cases 2., 4.
 281              (elist
 282               (and (eq elist t)
 283                    (setq elist nil))
 284               (setq elist (or (ebnf-prefix-suffix elist)
 285                               elist))
 286               (let* ((nl (ebnf-extract-empty nlist))
 287                      (el (or (ebnf-prefix-suffix (cdr nl))
 288                              (ebnf-create-alternative (cdr nl)))))
 289                 (if (car nl)
 290                     (ebnf-make-zero-or-more el elist)
 291                   (ebnf-make-one-or-more el elist))))
 292              ;; cases 1., 3., 5.
 293              (zlist
 294               (let* ((xlist (cdr (ebnf-extract-empty zlist)))
 295                      (znode (ebnf-make-zero-or-more
 296                              (or (ebnf-prefix-suffix xlist)
 297                                  (ebnf-create-alternative xlist))))
 298                      (nnode (ebnf-map-list-to-optional nlist)))
 299                 (and nnode
 300                      (setq nlist (list nnode)))
 301                 (if (or (null nlist)
 302                         (and (= (length nlist) 1)
 303                              (eq (ebnf-node-kind (car nlist))
 304                                  'ebnf-generate-empty)))
 305                     znode
 306                   (ebnf-make-sequence
 307                    (list (or (ebnf-prefix-suffix nlist)
 308                              (ebnf-create-alternative nlist))
 309                          znode)))))
 310              ;; cases 6., 7.
 311              ((ebnf-map-node-to-optional production)
 312               )
 313              ;; cases 8., 9., 10.
 314              ((ebnf-prefix-suffix nlist)
 315               )
 316              ;; none
 317              (t
 318               production)
 319              ))))
 320     prod))
 321
 322
 323 (defun ebnf-split-header-prefix (node-list header)
 324   (let* ((hlist (ebnf-split-header-prefix1 node-list header))
 325          (nlist (car hlist))
 326          zlist empty-p)
 327     (while (setq hlist (cdr hlist))
 328       (let ((elt (car hlist)))
 329         (if (eq (ebnf-node-kind elt) 'ebnf-generate-sequence)
 330             (setq zlist (cons
 331                          (let ((seq (cdr (ebnf-node-list elt))))
 332                            (if (= (length seq) 1)
 333                                (car seq)
 334                              (ebnf-node-list elt seq)
 335                              elt))
 336                          zlist))
 337           (setq empty-p t))))
 338     (and empty-p
 339          (setq zlist (cons (ebnf-make-empty)
 340                            zlist)))
 341     (cons nlist (nreverse zlist))))
 342
 343
 344 (defun ebnf-split-header-prefix1 (node-list header)
 345   (let (hlist nlist)
 346     (while node-list
 347       (if (ebnf-node-equal-header (car node-list) header)
 348           (setq hlist (cons (car node-list) hlist))
 349         (setq nlist (cons (car node-list) nlist)))
 350       (setq node-list (cdr node-list)))
 351     (cons (nreverse nlist) (nreverse hlist))))
 352
 353
 354 (defun ebnf-node-equal-header (node header)
 355   (let ((kind (ebnf-node-kind node)))
 356     (cond
 357      ((eq kind 'ebnf-generate-sequence)
 358       (ebnf-node-equal-header (car (ebnf-node-list node)) header))
 359      ((eq kind 'ebnf-generate-non-terminal)
 360       (string= (ebnf-node-name node) header))
 361      (t
 362       nil)
 363      )))
 364
 365
 366 (defun ebnf-map-node-to-optional (node)
 367   (and (eq (ebnf-node-kind node) 'ebnf-generate-alternative)
 368        (ebnf-map-list-to-optional (ebnf-node-list node))))
 369
 370
 371 (defun ebnf-map-list-to-optional (nlist)
 372   (and (= (length nlist) 2)
 373        (let ((first  (nth 0 nlist))
 374              (second (nth 1 nlist)))
 375          (cond
 376           ;; empty second
 377           ((eq (ebnf-node-kind first) 'ebnf-generate-empty)
 378            (ebnf-make-optional second))
 379           ;; first empty
 380           ((eq (ebnf-node-kind second) 'ebnf-generate-empty)
 381            (ebnf-make-optional first))
 382           ;; first second
 383           (t
 384            nil)
 385           ))))
 386
 387
 388 (defun ebnf-extract-empty (elist)
 389   (let ((now elist)
 390         before empty-p)
 391     (while now
 392       (if (not (eq (ebnf-node-kind (car now)) 'ebnf-generate-empty))
 393           (setq before now)
 394         (setq empty-p t)
 395         (if before
 396             (setcdr before (cdr now))
 397           (setq elist (cdr elist))))
 398       (setq now (cdr now)))
 399     (cons empty-p elist)))
 400
 401
 402 (defun ebnf-split-header-suffix (nlist zlist)
 403   (let (new empty-p)
 404     (and (cond
 405           ((= (length nlist) 1)
 406            (let ((ok t)
 407                  (elt (car nlist)))
 408              (while (and ok zlist)
 409                (setq ok    (ebnf-split-header-suffix1 elt (car zlist))
 410                      zlist (cdr zlist))
 411                (if (eq ok t)
 412                    (setq empty-p t)
 413                  (setq new (cons ok new))))
 414              ok))
 415           ((= (length nlist) (length zlist))
 416            (let ((ok t))
 417              (while (and ok zlist)
 418                (setq ok    (ebnf-split-header-suffix1 (car nlist) (car zlist))
 419                      nlist (cdr nlist)
 420                      zlist (cdr zlist))
 421                (if (eq ok t)
 422                    (setq empty-p t)
 423                  (setq new (cons ok new))))
 424              ok))
 425           (t
 426            nil)
 427           )
 428          (let* ((lis (ebnf-unique-list new))
 429                 (len (length lis)))
 430            (cond
 431             ((zerop len)
 432              t)
 433             ((= len 1)
 434              (setq lis (car lis))
 435              (if empty-p
 436                  (ebnf-make-optional lis)
 437                lis))
 438             (t
 439              (and empty-p
 440                   (setq lis (cons (ebnf-make-empty) lis)))
 441              (ebnf-create-alternative (nreverse lis)))
 442             )))))
 443
 444
 445 (defun ebnf-split-header-suffix1 (ne ze)
 446   (cond
 447    ((eq (ebnf-node-kind ne) 'ebnf-generate-sequence)
 448     (and (eq (ebnf-node-kind ze) 'ebnf-generate-sequence)
 449          (let ((nl (ebnf-node-list ne))
 450                (zl (ebnf-node-list ze))
 451                len z)
 452            (and (>= (length zl) (length nl))
 453                 (let ((ok t))
 454                   (setq len (- (length zl) (length nl))
 455                         z   (nthcdr len zl))
 456                   (while (and ok z)
 457                     (setq ok (ebnf-node-equal (car z) (car nl))
 458                           z  (cdr z)
 459                           nl (cdr nl)))
 460                   ok)
 461                 (if (zerop len)
 462                     t
 463                   (setcdr (nthcdr (1- len) zl) nil)
 464                   ze)))))
 465    ((eq (ebnf-node-kind ze) 'ebnf-generate-sequence)
 466     (let* ((zl  (ebnf-node-list ze))
 467            (len (length zl)))
 468       (and (ebnf-node-equal ne (car (nthcdr (1- len) zl)))
 469            (cond
 470             ((= len 1)
 471              t)
 472             ((= len 2)
 473              (car zl))
 474             (t
 475              (setcdr (nthcdr (- len 2) zl) nil)
 476              ze)
 477             ))))
 478    (t
 479     (ebnf-node-equal ne ze))
 480    ))
 481
 482
 483 (defun ebnf-prefix-suffix (lis)
 484   (and lis (listp lis)
 485        (let* ((prefix (ebnf-split-prefix lis))
 486               (suffix (ebnf-split-suffix (cdr prefix)))
 487               (middle (cdr suffix)))
 488          (setq prefix (car prefix)
 489                suffix (car suffix))
 490          (and (or prefix suffix)
 491               (ebnf-make-sequence
 492                (nconc prefix
 493                       (and middle
 494                            (list (or (ebnf-map-list-to-optional middle)
 495                                      (ebnf-create-alternative middle))))
 496                       suffix))))))
 497
 498
 499 (defun ebnf-split-prefix (lis)
 500   (let* ((len  (length lis))
 501          (tail lis)
 502          (head (if (eq (ebnf-node-kind (car lis)) 'ebnf-generate-sequence)
 503                    (ebnf-node-list (car lis))
 504                  (list (car lis))))
 505          (ipre (1+ len)))
 506     ;; determine prefix length
 507     (while (and (> ipre 0) (setq tail (cdr tail)))
 508       (let ((cur head)
 509             (this (if (eq (ebnf-node-kind (car tail)) 'ebnf-generate-sequence)
 510                       (ebnf-node-list (car tail))
 511                     (list (car tail))))
 512             (i 0))
 513         (while (and cur this
 514                     (ebnf-node-equal (car cur) (car this)))
 515           (setq cur  (cdr cur)
 516                 this (cdr this)
 517                 i    (1+ i)))
 518         (setq ipre (min ipre i))))
 519     (if (or (zerop ipre) (> ipre len))
 520         ;; no prefix at all
 521         (cons nil lis)
 522       (let* ((tail   (nthcdr ipre head))
 523              ;; get prefix
 524              (prefix (progn
 525                        (and tail
 526                             (setcdr (nthcdr (1- ipre) head) nil))
 527                        head))
 528              empty-p before)
 529         ;; adjust first element
 530         (if (or (not (eq (ebnf-node-kind (car lis)) 'ebnf-generate-sequence))
 531                 (null tail))
 532             (setq lis     (cdr lis)
 533                   tail    lis
 534                   empty-p t)
 535           (if (= (length tail) 1)
 536               (setcar lis (car tail))
 537             (ebnf-node-list (car lis) tail))
 538           (setq tail (cdr lis)))
 539         ;; eliminate prefix from lis based on ipre
 540         (while tail
 541           (let ((elt (car tail))
 542                 rest)
 543             (if (and (eq (ebnf-node-kind elt) 'ebnf-generate-sequence)
 544                      (setq rest (nthcdr ipre (ebnf-node-list elt))))
 545                 (progn
 546                   (if (= (length rest) 1)
 547                       (setcar tail (car rest))
 548                     (ebnf-node-list elt rest))
 549                   (setq before tail))
 550               (setq empty-p t)
 551               (if before
 552                   (setcdr before (cdr tail))
 553                 (setq lis (cdr lis))))
 554             (setq tail (cdr tail))))
 555         (cons prefix (ebnf-unique-list
 556                       (if empty-p
 557                           (nconc lis (list (ebnf-make-empty)))
 558                         lis)))))))
 559
 560
 561 (defun ebnf-split-suffix (lis)
 562   (let* ((len  (length lis))
 563          (tail lis)
 564          (head (nreverse
 565                 (if (eq (ebnf-node-kind (car lis)) 'ebnf-generate-sequence)
 566                     (ebnf-node-list (car lis))
 567                   (list (car lis)))))
 568          (isuf (1+ len)))
 569     ;; determine suffix length
 570     (while (and (> isuf 0) (setq tail (cdr tail)))
 571       (let* ((cur head)
 572              (tlis (nreverse
 573                     (if (eq (ebnf-node-kind (car tail)) 'ebnf-generate-sequence)
 574                         (ebnf-node-list (car tail))
 575                       (list (car tail)))))
 576              (this tlis)
 577              (i 0))
 578         (while (and cur this
 579                     (ebnf-node-equal (car cur) (car this)))
 580           (setq cur  (cdr cur)
 581                 this (cdr this)
 582                 i    (1+ i)))
 583         (nreverse tlis)
 584         (setq isuf (min isuf i))))
 585     (setq head (nreverse head))
 586     (if (or (zerop isuf) (> isuf len))
 587         ;; no suffix at all
 588         (cons nil lis)
 589       (let* ((n      (- (length head) isuf))
 590              ;; get suffix
 591              (suffix (nthcdr n head))
 592              (tail   (and (> n 0)
 593                           (progn
 594                             (setcdr (nthcdr (1- n) head) nil)
 595                             head)))
 596              before empty-p)
 597         ;; adjust first element
 598         (if (or (not (eq (ebnf-node-kind (car lis)) 'ebnf-generate-sequence))
 599                 (null tail))
 600             (setq lis     (cdr lis)
 601                   tail    lis
 602                   empty-p t)
 603           (if (= (length tail) 1)
 604               (setcar lis (car tail))
 605             (ebnf-node-list (car lis) tail))
 606           (setq tail (cdr lis)))
 607         ;; eliminate suffix from lis based on isuf
 608         (while tail
 609           (let ((elt (car tail))
 610                 rest)
 611             (if (and (eq (ebnf-node-kind elt) 'ebnf-generate-sequence)
 612                      (setq rest (ebnf-node-list elt)
 613                            n    (- (length rest) isuf))
 614                      (> n 0))
 615                 (progn
 616                   (if (= n 1)
 617                       (setcar tail (car rest))
 618                     (setcdr (nthcdr (1- n) rest) nil)
 619                     (ebnf-node-list elt rest))
 620                   (setq before tail))
 621               (setq empty-p t)
 622               (if before
 623                   (setcdr before (cdr tail))
 624                 (setq lis (cdr lis))))
 625             (setq tail (cdr tail))))
 626         (cons suffix (ebnf-unique-list
 627                       (if empty-p
 628                           (nconc lis (list (ebnf-make-empty)))
 629                         lis)))))))
 630
 631
 632 (defun ebnf-unique-list (nlist)
 633   (let ((current nlist)
 634         before)
 635     (while current
 636       (let ((tail (cdr current))
 637             (head (car current))
 638             remove-p)
 639         (while tail
 640           (if (not (ebnf-node-equal head (car tail)))
 641               (setq tail (cdr tail))
 642             (setq remove-p t
 643                   tail     nil)
 644             (if before
 645                 (setcdr before (cdr current))
 646               (setq nlist (cdr nlist)))))
 647         (or remove-p
 648             (setq before current))
 649         (setq current (cdr current))))
 650     nlist))
 651
 652
 653 (defun ebnf-node-equal (A B)
 654   (let ((kindA (ebnf-node-kind A))
 655         (kindB (ebnf-node-kind B)))
 656     (and (eq kindA kindB)
 657          (cond
 658           ;; empty
 659           ((eq kindA 'ebnf-generate-empty)
 660            t)
 661           ;; non-terminal, terminal, special
 662           ((memq kindA '(ebnf-generate-non-terminal
 663                          ebnf-generate-terminal
 664                          ebnf-generate-special))
 665            (string= (ebnf-node-name A) (ebnf-node-name B)))
 666           ;; alternative, sequence
 667           ((memq kindA '(ebnf-generate-alternative ; any order
 668                          ebnf-generate-sequence)) ; order is important
 669            (let ((listA (ebnf-node-list A))
 670                  (listB (ebnf-node-list B)))
 671              (and (= (length listA) (length listB))
 672                   (let ((ok t))
 673                     (while (and ok listA)
 674                       (setq ok    (ebnf-node-equal (car listA) (car listB))
 675                             listA (cdr listA)
 676                             listB (cdr listB)))
 677                     ok))))
 678           ;; production
 679           ((eq kindA 'ebnf-generate-production)
 680            (and (string= (ebnf-node-name A) (ebnf-node-name B))
 681                 (ebnf-node-equal (ebnf-node-production A)
 682                                  (ebnf-node-production B))))
 683           ;; otherwise
 684           (t
 685            nil)
 686           ))))
 687
 688
 689 (defun ebnf-create-alternative (alt)
 690   (if (> (length alt) 1)
 691       (ebnf-make-alternative alt)
 692     (car alt)))
 693
 694 \f
 695 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 696
 697
 698 (provide 'ebnf-otz)
 699
 700
 701 ;;; arch-tag: 7ef2249d-9e8b-4bc1-999f-95d784690636
 702 ;;; ebnf-otz.el ends here