; -*- Mode: Lisp; Package: GPSG; Base: 10; Syntax: Common-Lisp -*-
; (in-package 'gpsg :use '(lisp))

(defun check-syntax-of-rtn-rule (state)
  (cond ((or (not (listp state)) (not (= (length state) 2)))
	 "This RTN state is not a list of length two."
	 t)
	((not (listp (second state)))
	 "This RTN state does not have a list for its arcs."
	 t)
	(t (mapcan #'(lambda (arc)
		       (if (or (not (listp arc))
			       (null arc)
			       (and (eq (first arc) 'word)
				    (not (= (length arc) 3)))
			       (and (eq (first arc) 'category)
				    (not (= (length arc) 3)))
			       (and (eq (first arc) 'push)
				    (not (= (length arc) 3)))
			       (and (eq (first arc) 'pop)
				    (not (= (length arc) 1))))
			   '(t) nil))
		   (second state)))))

; This routine makes grammars from RTNs.

(defun make-grammar-from-rtn (firsts rtn &optional (cfg-special? nil)
				     (transitive-closure? t))
  (let* ((temp (get-state-name-array-and-table rtn))
	 (state-name-array (first temp))
	 (state-name-table (second temp))
	 (temp (get-category-name-array-and-table rtn))
	 (category-name-array (first temp))
	 (category-name-table (second temp))
	 (firsts firsts)
	 (delta-category (build-delta-category
			  rtn state-name-array state-name-table
			  category-name-array category-name-table))
	 (delta-push (build-delta-push rtn state-name-table)))

     (list state-name-array
	   state-name-table
	   delta-category
	   delta-push
	   (if cfg-special?
	       (build-h-cfg-special rtn state-name-table)
	       (build-h delta-category delta-push state-name-array))
	   (build-l* rtn state-name-array state-name-table transitive-closure?)
	   (build-final? rtn state-name-array state-name-table)
	   firsts
	   category-name-array
	   category-name-table)))