AAL sources (4 of 8)

[Jonathan Amsterdam]

;;; -*- Mode: LISP; Syntax: Common-lisp; Package: USER; Base: 10 -*-

;;; Copyright 1988 by Jonathan Amsterdam.  All Rights Reserved.

(provide 'initial)

;;; Initial stuff for AAL.  This file should be loaded before the others
;;; (except streams, which doesn't depend on anything).
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Macros.

#-3600
(defmacro defprop (sym value indicator)
  ;; Like putprop, but doesn't evaluate its arguments.  The Symbolics 3600
  ;; already has this defined.
  `(setf (get ',sym ',indicator) ',value))

(defmacro defunp (prop-symbol arglist &body body)
  ;; Allows defining a function to be the value of a property on a symbol.  See
  ;; the deducer, execute-action and keywords in the compiler for usage.
  (let* ((prop (first prop-symbol))
	 (symbol (second prop-symbol))
	 (name (symbol-append prop '- symbol '- 'func)))
    `(progn
       (defun ,name ,arglist , at body)
       (defprop ,symbol ,name ,prop))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Structures.

;;; Changed slightly from the article--instead of a failure string, you can
;;; have any action.
(defstruct requirement
  pattern
  (failure-action				;action to take on failure
    '(lisp (format t "You can't do that.")))
  succeeded?					;used internally by check-reqs
)


(defstruct timer			; used for timers and demons
  before-after				;:before, :after
  turn-tick				;:turn, :tick
  time-to-run				;number indicating when to run
  action				;code to run 
  (renew-time 0)			;if 0, not renewable; else this is
					;added to time-to-run when expired 
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Constants.

(defconstant *initial-lisp-names* 
	     '(eql member cons car cdr + - * / setf incf decf push print eval
	       get null = zerop)
	     "The action and pattern parsers translate these automatically")

(defconstant *initial-global-specs*
	     '(*agent *command *obj *instr *verb *loc (*turn 0) (*tick 0)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Global variables.

(defvar *report* nil "Controls debugging messages")

;;; The following are modified by the compiler.

(defvar *objects* nil "A list of all the objects in the game (including locs)")
(defvar *assertion-rules* nil "Forward rules to run on assertions")
(defvar *retraction-rules* nil "Forward rules to run on retractions")
(defvar *initial-actions* nil "Actions executed when the game starts")
(defvar *initial-rules* nil "Rules asserted when the game starts")
(defvar *initial-timers* nil)

(defvar *lisp-names* nil "Used in parsing actions and patterns")
(defvar *global-specs* nil "Used in declaring globals")
(defvar *backward-predicates* nil "Used in parsing actions and patterns")


;;; The following are modified during the game.

(defvar *tick* nil "The current tick")
(defvar *turn* nil "The current turn")
(defvar *abort-action* nil "Indicates when an action has been aborted in the middle")

(defvar *globals* nil "An alist of the AAL globals")
(defvar *protected-vars* nil "An alist of variables protected from renaming")
(defvar *db*      nil "The database, which holds a list of all the facts")
(defvar *indices* nil "The symbols used as indices by the database indexer")
(defvar *timers*  nil "Lists of the currently active timers")


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Initialization.

(defun play (filename)
  (cold-init)
  (load filename)
  (reverse-lists)
  (replay))

(defun reverse-lists ()
  ;; Reverse the objects, so the ones earlier in the file are first.
  ;; Reverse the initial actions, so that the ones earlier in the file are done
  ;; before those later.
  (setq *objects* (nreverse *objects*))
  (setq *initial-actions* (nreverse *initial-actions*))
  (dolist (obj *objects*)
    (setf (get obj 'initial-actions) (nreverse (get obj 'initial-actions)))))
  
(defun replay ()
  (warm-init)
  (run))

(defun cold-init ()
  ;; Set up stuff necessary to load a new file.
  (setq *objects* nil)
  (setq *assertion-rules* nil)
  (setq *retraction-rules* nil)
  (setq *initial-actions* nil)
  (setq *initial-rules* nil)
  (setq *initial-timers* nil)
  (setq *lisp-names* *initial-lisp-names*)
  (setq *global-specs* *initial-global-specs*)
  (setq *backward-predicates* nil)
)

(defun warm-init ()
  ;; Do things necessary for replaying an already loaded game.
  (setq *tick* 0)
  (setq *turn* 0)
  (setq *abort-action* nil)
  (setq *protected-vars* nil)
  (clear-database)
  (clear-timers)
  (init-vars)
  (init-timers)
  ;; Add the b-rules before the facts, because adding facts might trigger
  ;; rules.  Also, this will put the rules at the end of the database, where
  ;; they should be (so facts can override them).
  (init-rules)
  (init-actions)
)

(defun clear-database ()
  (setq *db* nil)
  (dolist (index *indices*)
    (setf (get index 'database) nil))
  (setq *indices* '(*)))

(defun clear-timers ()
  ;; We need to do a copy-tree because this list is destructively modified.
  (setq *timers* (copy-tree '((:after . ((:tick . nil) (:turn . nil)))
			      (:before . ((:tick . nil) (:turn . nil)))))))

(defun init-vars ()
  (setq *globals* (specs->alist *global-specs*))
  (dolist (obj *objects*)
    (setf (get obj 'vars) (specs->alist (get obj 'var-specs)))))


(defun specs->alist (specs)
  ;; A variable spec is either a variable name, in which case it's bound to
  ;; NIL, or a list (<name> <value>).
  (mapcar #'(lambda (spec) (if (symbolp spec)
			       (cons spec nil) 
			       (cons (first spec) (second spec))))
	  specs))
  
(defun init-rules ()
  (dolist (rule *initial-rules*)
    (assert rule)))

(defun init-timers ()
  (mapc #'add-timer (mapcar #'eval *initial-timers*)))

(defun init-actions ()
  ;; First do all the actions local to objects.  Then do the global actions.
  (dolist (obj *objects*)
    (dolist (action (get obj 'initial-actions))
      (execute-action-in-object obj action)))
  (dolist (action *initial-actions*)
    (execute-action action *globals*)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Utilities.

(defun symbol-append (&rest symbols)
  (intern (apply #'string-append symbols)))

(defun report (&rest args)
  (if *report*
      (apply #'format t args)))


;;; End initial.lisp.