;; -*- Mode: Lisp; -*-

;;;; Modeling language for TGizmo
;;;; File name: mlang.lsp
;;;;  modified: Thursday, February 14, 2008 at 17:56:42 by forbus

;;; Copyright (c) 1991, Kenneth D. Forbus, Northwestern University,
;;;  and Johan de Kleer, the Xerox Corporation.
;;; All Rights Reserved.

;;; See the file legal.txt for a paragraph stating scope of permission
;;; and disclaimer of warranty.  The above copyright notice and that
;;; paragraph must be included in any separate copy of this file.


(in-package :cl-user)

(defun keywordize (stuff)
  (cond ((null stuff) (error "Can't keywordize nothing."))
	((listp stuff) (keywordize (car stuff)))
	(t (intern (format nil "~A" stuff) 'keyword))))

(defmacro defrule (name triggers &rest consequences)
  `(rule , (mapcar #'(lambda (trigger)
		       `(:intern ,trigger)) triggers)
	 (rassert! (:implies (:and ,@ triggers)
			    (:and ,@ consequences))
		  ,(keywordize name))))

(defmacro defPredicate (form &rest consequences)
  `(rule ((:intern ,form))
    (rlet ((?self ,form))
	  ,@ (translate-relations consequences :defpredicate
				  form (keywordize form)))))

(defmacro defentity (form &rest consequences)
  `(rule ((:intern ,form))
    (rlet ((?self ,form))
	  (rassert! (:implies ,form (exists ,(cadr form)))
		    :defentity)
	  ,@ (translate-relations consequences :defentity
				  form (keywordize form)))))

(defmacro defview (form &rest stuff)
  (multiple-value-bind (ispec pcs qcs rels infs)
		       (parse-vp form stuff nil)
		       (debugging-tgizmo :domain-theory
					 "~% Defining view ~A.." form)
		       (make-vp-rules form ispec pcs qcs rels infs nil)))

(defmacro defprocess (form &rest stuff)
  (multiple-value-bind (ispec pcs qcs rels infs)
		       (parse-vp form stuff t)
		       (debugging-tgizmo :domain-theory
					 "~% Defining process ~A.." form)
		       (make-vp-rules form ispec pcs qcs rels infs t)))

;;;; Working with views and processes

(defun parse-vp (form stuff process?)
  ;; Does some extra syntactic checks
  (let ((ispec (cadr (member :individuals stuff)))
	(pcs (cadr (member :preconditions stuff)))
	(qcs (cadr (member :quantity-conditions stuff)))
	(rels (cadr (member :relations stuff)))
	(infs (cadr (member :influences stuff))))
    (unless ispec (error "~A must have :individuals field: ~A"
			 (if process? "defprocess" "defview")
			 form))
    (unless (or pcs qcs)
	    (error "~A must have :preconditions or :quantity-conditions: ~A"
		   (if process? "defprocess" "defview") form))
    (cond (process?
	   (unless infs (error "Physical processes must have influences: ~A" form)))
	  (infs (error "Views cannot have influences: ~A" form)))
    ;;; Make sure no dangling variables
    (let ((*bound-vars* (cons '?self (pattern-free-variables ispec)))
	  (floating nil))
      (when (setq floating (pattern-free-variables pcs))
	    (error "Can't have free variable(s) ~A in preconditions: ~A"
		   floating form))
      (when (setq floating (pattern-free-variables qcs))
	    (error "Can't have free variable(s) ~A in quantity conditions: ~A"
		   floating form))
      (when (setq floating (pattern-free-variables rels))
	    (error "Can't have free variable(s) ~A in relations: ~A"
		   floating form))
      (if process? 
	  (when (setq floating (pattern-free-variables infs))
	    (error "Can't have free variable(s) ~A in influences : ~A"
		   floating form))))
    (values ispec pcs qcs rels infs)))

;;;; Finding and instantiating views and processes

(defun make-vp-rules (form ispec pcs qcs rels infs process?)
  (let ((antes (apply #'append 
		      (mapcar #'cdr ispec)))
	(is (mapcar #'car ispec)))
    `(rule ,(mapcar #'(lambda (ante)
			`(:intern ,ante))
		    antes)
	   (rlet ((?self ,form))
		 (debugging-tgizmo :modeling "~% Found ~A: ~A."
				   ,(if process? "process" "view")
				   ?self)
	   ;; The ispecs imply the process instance
	   (rassert! (:implies (:and ,@ antes)
			       (,(if process? 'process-Instance
				   'view-Instance) ,form))
		    :cdi-implied)
	   ;; The existence of the individuals implies
	   ;; the existence of the process.
	   ,@ (when process? 
		 `((rassert! (:implies (:and ,@ (mapcar #'(lambda (i)
							    `(exists ,i)) is))
				       (exists ,form))
			     :process-existence)
		   (rassert! (:implies (active ,form) (exists ,form)) :no-ghosts)))
	   ;; Active iff pc's and qc's hold
	   (rassert! (:iff (active ,form)
			   (:and ,@ pcs
				 ,@ qcs))
		    :cdi-active-constraint)
	   ;; If active, the relations hold
	   ,@ (when rels
		    (translate-relations rels (if process? :process :view)
					 '(active ?self) (keywordize form)))
	   ;; If active process, influences hold
	   ,@ (when infs
		    (translate-relations infs (if process? :process :view)
					 '(active ?self) (keywordize form)))))))

;;;; Parsing contents of relations fields

;;; In an ``industrial-grade'' QP theory implementation,
;;;  there is typically alot more hair here.  We'll do
;;;  the minimum.

(defun translate-relations (conseqs context antes informant)
  (let ((explicit nil)
	(implicit nil))
    (dolist (c conseqs)
     (multiple-value-bind (e i)
	(translate-relation c context antes informant)
	(setq explicit (nconc e explicit))
	(setq implicit (nconc i implicit))))
    `(,@ (when explicit `((rassert! (:implies ,antes (:and ,@ explicit))
				    ,informant)))
      ,@ implicit)))

(defun translate-relation (form context antes informant)
  (cond ((not (listp form)) (values (list form) nil))
	(t (case (car form)
		 ;; only-during indicates that form holds exactly when cdi does.
		 (only-during
		  (values nil
			  `((rassert! (:iff ,antes ,(cadr form)) ,informant))))
		 ;; quantities local to a cdi only exist when it is active.
		 (quantity (if (member context '(:process :view))
			       (values nil
				       `((rassert! (:iff ,antes ,form) ,informant)))
			     (values (list form) nil)))
		 ((i+ i-) (unless (eq context :process)
				  (error "can't have direct influence in ~a: ~a"
					 context antes))
		  (values nil `((rassert! (:iff ,antes ,(append form (list '?self))
						,informant)))))
		 ((qprop qprop-)
		  (values nil `((rassert! (:iff ,antes ,(append form (list '?self)))
					  ,informant))))
		 (t (values (list form) nil))))))