Function: ebnf-split-suffix

ebnf-split-suffix is a byte-compiled function defined in ebnf-otz.el.gz.

Signature

(ebnf-split-suffix LIS)

Source Code

;; Defined in /usr/src/emacs/lisp/progmodes/ebnf-otz.el.gz
(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)))))))