;;; -*- Package: PENMAN; Mode: LISP -*-
(in-package "PENMAN")

;;;======================================================================
;;; Here we define the realization statements for traversal of
;;; the register network. 
;;;======================================================================

(defvar *show-register-realizations* nil)


(define-realization-operators 
  register-insert
  register-preselect
  grow-semantics
  prune-semantics
  isa-semantics
  thematic-development
  macro-theme
  inter-preselect-function
  inter-preselect-ff
  inter-preselect-canned
  register-constrain)


(defvar *semantic-image* nil)
(defvar *stage-constraints* nil)

(defun grow-semantics (concept1 concept2)
  (format *show-register-realizations* "~% !! In the semantic image being constructed for this register,
 ~A is a subconcept of ~A ~%"
	  concept2 concept1)
  (pushnew (list concept2 concept1) *semantic-image* :test #'equal))


(defun thematic-development (type)
  (format *show-register-realizations* "~% !! This generic stage must be realized using a thematic development,
       of type: ~A ~%"
	  type)
  (pushnew (cons 'thematic-development type)
	   *stage-constraints*
	   :test #'equal))
	

(defun register-insert (register-micro-function)
  (generalized-insert register-micro-function))

(defun register-preselect (register-micro-function register-feature)
  (generalized-preselect register-micro-function register-feature))

;;; following modelled on GSP-INTER-PRESELECT in gsp-realizations.lisp.
;;;
(defun inter-preselect-function (upper-role lower-role)
  (format *show-register-realizations* "~% Inter-stratally role preselecting role ~A for role: ~A"
	  upper-role lower-role)
  (let ((stage-exist? (force-function-to-exist upper-role)))
    (pushnew (cons 'role-preselect lower-role)
	     (syntagmatic-unit-inter-stratal-constraints-below (micro-fn upper-role))
	     :test #'equal)))

;;; Some information is stored textually without semantics in the domain.
;;; This needs to be passed on untouched and unprocessed. NOT IN USE.

(defun inter-preselect-canned (micro-function)
    (format *show-register-realizations* "~% Passing on information stored without semantics for role: ~A" micro-function)
  (let ((stage-exist? (force-function-to-exist micro-function)))
    (print (micro-fn micro-function))
    (pushnew (cons 'canned-preselect '****)
	     (syntagmatic-unit-inter-stratal-constraints-below (micro-fn 
								micro-function))
	     :test #'equal)))


;;; General slot-filler, or function-feature, constraints...

(defun inter-preselect-ff (upper-micro-function lower-micro-function feature)
    (format *show-register-realizations* "~% Constraining feature-function interstratally for: ~A" upper-micro-function)
  (let ((stage-exist? (force-function-to-exist upper-micro-function)))
    (pushnew (cons 'function-feature `(,lower-micro-function ,feature))
	     (syntagmatic-unit-inter-stratal-constraints-below (micro-fn 
								upper-micro-function))
	     :test #'equal)))





;;; Following is a beginning of generally constraining the lexicogrammar
;;; according to its context of use... 

(defun register-constrain (constraint)
-  "add general lexicogrammatical constraints for the stage"
  (format *show-register-realizations* 
	  "~% !! This generic stage must be realized with the lexicogrammar
       constrained by: ~A" constraint)
  (pushnew (cons 'lexicogrammar constraint)
	   *stage-constraints*
	   :test #'equal))


;;; should be able to select generic types of macro-themes...
(defun MACRO-THEME (role)
  (format *show-register-realizations* 
	  "~% !! This generic stage has ~A as a macro-theme" role)
  (pushnew (cons 'macro-theme 
		 (micro-fn-label role *current-cycle*))
	   *stage-constraints*
	   :test #'equal))



