;;; -*- Mode:Lisp; Package:DYPAR; Base:10; -*-


;;; ----------------------------------------------------------------
;;;
;;; 		(c) Copyright, 1989
;;; 			by Mark Boggs and Jesus Gonzalez Boticario
;;; 			All rights reserved
;;;
;;; ----------------------------------------------------------------

;;; STRUC.LSP

;;; HISTORY
; 23-Oct-89  Jesus Gonzalez Boticario para Rank Xerox, Espa¤a
;       Reducci¢n del c¢digo para la versi¢n "runtime".
; 24-Apr-89  Mark Boggs (boggs) at Rank Xerox, Spain
;	Added constants, required, consumes, and forced fields to the
;	general rule structure.
;	Added structure printing functions.
;
; 09-Apr-89  Mark Boggs (boggs) at Rank Xerox, Spain
;	Added functions for removing rules and terminals.
;	Added functions to delete individual elements from where and lwhere
;	Added generic parent macro.
;	Added selective delete macros for all fields containing lists.
;
; 15-Dec-88  Mark Boggs (boggs) at Rank Xerox, Spain
;	Created.
;	Contains macros for manipulating rule and terminal structures.

(in-package "DYPAR")

;;; Make sure our macro package is here for compilation.
(eval-when (compile)
  (if (not (boundp '*macros-loaded*)) (load "macros")))

;;; For efficient look-up, as well as avoiding symbol conflicts, we store
;;; our structures in a hash table.

(defvar *dypar-structure-hash*
  (make-hash-table :size 453 :rehash-size 1.4))

;;; To add a new rule structure to the hash table.
(defmacro put-rule-hash (key struc)
  `(setf (gethash ,key *dypar-structure-hash*) ,struc))

;;; Access a rule structure
(defmacro get-rule-hash (key)
  `(gethash ,key *dypar-structure-hash*))

(defmacro rule (key)
  `(gethash ,key *dypar-structure-hash*))

;;; Delete a rule structure.
(defmacro remove-rule-hash (key)
  `(remhash ,key *dypar-structure-hash*))

(defvar *dypar-terminal-hash*
  (make-hash-table :size 453 :rehash-size 1.4))

;;; To add a new terminal structure to the hash table.
(defmacro put-terminal-hash (key struc)
  `(setf (gethash ,key *dypar-terminal-hash*) ,struc))

;;; Access a terminal structure.
(defmacro get-terminal-hash (key)
  `(gethash ,key *dypar-terminal-hash*))

(defmacro term (key)
  `(gethash ,key *dypar-terminal-hash*))

;;; Delete a structure.
(defmacro remove-terminal (key)
  `(remhash ,key *dypar-terminal-hash*))

;;; Add a terminal to the hash table while creating the associated
;;; structure.
(defmacro new-terminal-hash (term &rest struc-args)
  `(put-terminal-hash
     ,term
     (make-terminal :name ,term ,@struc-args)))

;;; DyparI includes three types of grammar rules (top-level, transformation
;;; and non-terminal).  The Xreference operation generates some information
;;; which is common to all dypar rule types.  Thus we define a common
;;; structure to contain those common elements.  This makes retreiving
;;; data depend on exactly the same function name for each rule type.

(defstruct (dypar-xref-values (:conc-name dxv-))
  (name nil :type symbol) 		; the name of the rule
  (pattern nil :type list) 		; its pattern
  (first nil :type list) 		; those words which can iniciate
 					; a pattern.
  (last nil :type list) 		; those words which can terminate
 					; a pattern
  (fwild nil :type symbol) 		; a flag indicating if a wildcard
 					; match is possible at the start
  (lwild nil :type symbol) 		; a flag indicating if a wildcard
 					; match is possible at the end
  (opt nil :type symbol) 		; is the pattern completely optional
  (variables nil :type list) 		; names of variables used in pattern
  (terminals nil :type list) 		; terminals referenced in pattern
  )

;;; We want to be able to update these structure fields relatively painlessly
;;; The following macros, given a structure and a value will update or access
;;; appropriate field.  Those structure fields which contain lists also
;;; have a function for selective deletion of information.
;;; ACCESS & UPDATE FUNCTIONS:
;;;	(set-FIELD rule value)
;;;	(get-FIELD rule)
;;;	(delete-SINGULAR_FIELD rule value)
;;;		only in first, last, fchildren (fchild), lchildren (lchild),
;;;			 variables (variable), terminals (terminal)
;;;			 and constants (constant).

(defmacro set-pattern (rname pattern)
  `(setf (dxv-pattern (get-rule-hash ,rname)) ,pattern))

(defmacro get-pattern (rname)
  `(dxv-pattern (get-rule-hash ,rname)))

(defmacro set-first (struc first-list)
  `(setf (dxv-first (get-rule-hash ,struc)) ,first-list))

(defmacro get-first (struc)
  `(dxv-first (get-rule-hash ,struc)))

(defmacro delete-first (struc first)
  `(setf (dxv-first (get-rule-hash ,struc))
	 (delete ,first (get-first ,struc))))

(defmacro set-last (struc last-list)
  `(setf (dxv-last (get-rule-hash ,struc)) ,last-list))

(defmacro get-last (struc)
  `(dxv-last (get-rule-hash ,struc)))

(defmacro delete-last (struc last)
  `(setf (dxv-last (get-rule-hash ,struc))
	 (delete ,last (get-last ,struc))))

(defmacro set-terminals (struc terminals)
  `(setf (dxv-terminals (get-rule-hash ,struc)) ,terminals))

(defmacro get-terminals (struc)
  `(dxv-terminals (get-rule-hash ,struc)))

(defmacro delete-terminal (struc terminal)
  `(setf (dxv-terminals (get-rule-hash ,struc))
	 (delete ,terminal (get-terminals ,struc))))

(defmacro set-variables (struc variables)
  `(setf (dxv-variables (get-rule-hash ,struc)) ,variables))

(defmacro get-variables (struc)
  `(dxv-variables (get-rule-hash ,struc)))

(defmacro delete-variable (struc variable)
  `(setf (dxv-variables (get-rule-hash ,struc))
	 (delete ,variable (get-variables ,struc))))

(defmacro set-fwild (struc fwild)
  `(setf (dxv-fwild (get-rule-hash ,struc)) ,fwild))

(defmacro get-fwild (struc)
  `(dxv-fwild (get-rule-hash ,struc)))

(defmacro set-lwild (struc lwild)
  `(setf (dxv-lwild (get-rule-hash ,struc)) ,lwild))

(defmacro get-lwild (struc)
  `(dxv-lwild (get-rule-hash ,struc)))

(defmacro set-opt (struc opt)
  `(setf (dxv-opt (get-rule-hash ,struc)) ,opt))

(defmacro get-opt (struc)
  `(dxv-opt (get-rule-hash ,struc)))


;;; For each real dypar rule type we define a structure which includes the
;;; common information fields as well as rule-type specific fields.

(defstruct (non-terminal (:conc-name nt-)
			 (:constructor make-nt)
			 (:include dypar-xref-values)
			 (:print-function non-terminal-print-function))
  (parents nil :type list)
  )

(defmacro set-nt-parents (struc parent)
  `(setf (nt-parents (get-rule-hash ,struc)) ,parent))

(defmacro add-nt-parent (term parent)
  `(setf (nt-parents (get-rule-hash ,term))
	 (dy-insert ,parent (get-nt-parents ,term))))

(defmacro get-nt-parents (struc)
  `(nt-parents (get-rule-hash ,struc)))

(defmacro delete-nt-parent (struc parent)
  `(setf (nt-parents (get-rule-hash ,struc))
	 (delete ,parent (get-nt-parents ,struc))))

(defstruct (top-level-rule
	     (:conc-name tl-rule-)
	     (:constructor make-tl-rule)
	     (:include dypar-xref-values)
	     (:print-function top-level-rule-print-function))
  (action nil :type t)
  (internal-strategy nil :type list)
  (external-strategy nil :type list)
  )

(defmacro set-action (rname action)
  `(setf (tl-rule-action (get-rule-hash ,rname)) ,action))

(defmacro get-action (rname)
  `(tl-rule-action (get-rule-hash ,rname)))

(defmacro set-in-strat (rname strat)
  `(setf (tl-rule-internal-strategy (get-rule-hash ,rname)) ,strat))

(defmacro get-in-strat (rname)
  `(tl-rule-internal-strategy (get-rule-hash ,rname)))

(defmacro set-ex-strat (rname strat)
  `(setf (tl-rule-external-strategy (get-rule-hash ,rname)) ,strat))

(defmacro get-ex-strat (rname)
  `(tl-rule-external-strategy (get-rule-hash ,rname)))

(defstruct (terminal (:print-function terminal-print-function))
  (name nil :type symbol)
  (where nil :type list)
  (lwhere nil :type list)
  (parents nil :type list)
  )

(defmacro set-terminal-parents (struc parent)
  `(setf (terminal-parents (get-terminal-hash ,struc)) ,parent))

(defmacro add-terminal-parent (term parent)
  `(setf (terminal-parents (get-terminal-hash ,term))
	 (dy-insert ,parent (get-terminal-parents ,term))))

(defmacro get-terminal-parents (struc)
  `(terminal-parents (get-terminal-hash ,struc)))

(defmacro delete-terminal-parent (term parent)
  `(setf (terminal-parents (get-terminal-hash ,term))
	 (delete ,parent (get-terminal-parents ,term))))

(defmacro set-where (term where)
  `(setf (terminal-where (get-terminal-hash ,term)) ,where))

(defmacro add-where (term where)
  `(setf (terminal-where (get-terminal-hash ,term))
	 (dy-insert ,where (get-where ,term))))

(defmacro get-where (term)
  `(and (get-terminal-hash ,term)
	(terminal-where (get-terminal-hash ,term))))

(defmacro delete-where (term where)
  `(setf (terminal-where ,term) (delete ,where (get-where ,term))))

(defmacro set-lwhere (term where)
  `(setf (terminal-lwhere (get-terminal-hash ,term)) ,where))

(defmacro add-lwhere (term where)
  `(setf (terminal-lwhere (get-terminal-hash ,term))
	 (dy-insert ,where (get-lwhere ,term))))

(defmacro get-lwhere (term)
  `(and (get-terminal-hash ,term)
	(terminal-lwhere (get-terminal-hash ,term))))

(defmacro delete-lwhere (term lwhere)
  `(setf (terminal-lwhere ,term) (delete ,lwhere (get-lwhere ,term))))

;;; Because there are two distinct structure types for non-terminals
;;; and terminals we provide this function to make the choice as to
;;; which of the two is being modified.

(defmacro add-parent (term parent)
  `(if (non-terminal-p (get-rule-hash ,term))
       (add-nt-parent ,term ,parent)
       (add-terminal-parent ,term ,parent)))

(defmacro get-parents (term)
  `(if (non-terminal-p (get-rule-hash ,term))
       (get-nt-parents ,term)
       (get-terminal-parent ,term)))

(defun non-terminal-print-function (struc stream depth)
  (declare (ignore depth))
  (format stream "~&Rule-name: ~S~&" (dxv-name struc))
  (format stream "   Pattern: ~S~&" (dxv-pattern struc))
  (format stream "   First Wild: ~S  Last Wild:  ~S  Optional: ~S"
	  (dxv-fwild struc) (dxv-lwild struc) (dxv-opt struc))
  (format stream "   First: ")
  (pprint (dxv-first struc) stream)
  (format stream "   Last: ")
  (pprint (dxv-last struc) stream)
  (format stream "   Terminals: ")
  (pprint (dxv-terminals struc) stream)
  (format stream "   Variables: ~S~&" (dxv-variables struc))
  (format stream "   Parents: ~S~&" (nt-parents struc))
  t)

(defun top-level-rule-print-function (struc stream depth)
  (declare (ignore depth))
  (format stream "~&Rule-name: ~S~&" (dxv-name struc))
  (format stream "   Pattern: ~S~&" (dxv-pattern struc))
  (format stream "   Action: ~S~&" (tl-rule-action struc))
  (format stream "   First Wild: ~S  Last Wild:  ~S  Optional: ~S"
	  (dxv-fwild struc) (dxv-lwild struc) (dxv-opt struc))
  (format stream "   First: ")
  (pprint (dxv-first struc) stream)
  (format stream "   Last: ")
  (pprint (dxv-last struc) stream)
  (format stream "   Terminals: ")
  (pprint (dxv-terminals struc) stream)
  (format stream "   Variables: ~S~&" (dxv-variables struc))
  (format stream "   Internal Strategy: ~S~&"
	  (tl-rule-internal-strategy struc))
  (format stream "   External Strategy: ~S~&"
	  (tl-rule-external-strategy struc))
  t)
  
(defun terminal-print-function (struc stream depth)
  (declare (ignore depth))
  (format stream "~&Terminal: ~S~&" (terminal-name struc))
  (format stream "  Parents: ~S~&" (terminal-parents struc))
  (format stream "  First Where: ~S~&" (terminal-where struc))
  (format stream "  Last Where: ~S~&" (terminal-lwhere struc))
  t)

;;; To prove that a file has been loaded at least once we set a variable
;;; which can be used by other files to check for this fact.

(defvar *struc-loaded* t)