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