diff -urN cl-aima-1.0.4.orig/aima.asd cl-aima-1.0.4/aima.asd --- cl-aima-1.0.4.orig/aima.asd 1969-12-31 18:00:00.000000000 -0600 +++ cl-aima-1.0.4/aima.asd 2005-02-05 18:10:50.000000000 -0600 @@ -0,0 +1,107 @@ +;;;; -*- mode: lisp; package: common-lisp -*- + +(defpackage #:aima-system + (:use #:common-lisp + #:asdf)) + +(in-package #:aima-system) + +(defsystem #:aima + :components ((:file "aima") + (:module :utilities + :serial t + :components ((:file "utilities") + (:file "binary-tree") + (:file "queue") + (:file "cltl2"))) + (:module :agents + :serial t + :components ((:module :environments + :serial t + :components ((:file "basic-env") + (:file "grid-env") + (:file "vacuum") + (:file "wumpus"))) + (:module :agents + :serial t + :components ((:file "agent") + (:file "vacuum") + (:file "wumpus"))) + (:module :algorithms + :serial t + :components ((:file "grid")))) + :depends-on (:utilities)) + (:module :logic + :serial t + :components ((:module :algorithms + :serial t + :components ((:file "tell-ask") + (:file "unify") + (:file "normal") + (:file "prop") + (:file "horn") + (:file "fol") + (:file "infix")))) + :depends-on (:agents)) + (:module :planning + :serial t + :components ()) + (:module :uncertainty + :serial t + :components ((:module :agents + :serial t + :components ((:file "mdp-agent"))) + (:module :domains + :serial t + :components ((:file "mdp") + (:file "4x3-mdp"))) + (:module :environments + :serial t + :components ((:file "mdp"))) + (:module :algorithms + :serial t + :components ((:file "dp") + (:file "stats")))) + :depends-on (:agents)) + (:module :learning + :serial t + :components ((:module :algorithms + :serial t + :components ((:file "inductive-learning") + (:file "learning-curves") + (:file "dtl") + (:file "dll") + (:file "nn") + (:file "perceptron") + (:file "multilayer") + (:file "q-iteration"))) + (:module :domains + :serial t + :components ((:file "restaurant-multivalued") + (:file "restaurant-real") + (:file "restaurant-boolean") + (:file "majority-boolean") + (:file "ex-19-4-boolean") + (:file "and-boolean") + (:file "xor-boolean") + (:file "4x3-passive-mdp"))) + (:module :agents + :serial t + :components ((:file "passive-lms-learner") + (:file "passive-adp-learner") + (:file "passive-td-learner") + (:file "active-adp-learner") + (:file "active-qi-learner") + (:file "exploring-adp-learner") + (:file "exploring-tdq-learner")))) + :depends-on (:uncertainty)) + (:module :language + :serial t + :components ((:module :algorithms + :serial t + :components ((:file "chart-parse"))) + (:module :domains + :serial t + :components ((:file "grammars"))))))) + +;;;; aima.asd ends here diff -urN cl-aima-1.0.4.orig/aima.lisp cl-aima-1.0.4/aima.lisp --- cl-aima-1.0.4.orig/aima.lisp 2005-02-05 17:06:50.000000000 -0600 +++ cl-aima-1.0.4/aima.lisp 2005-02-05 17:35:46.000000000 -0600 @@ -1,234 +1,5 @@ ;;; -*- Mode: Lisp; Syntax: Common-Lisp -*- File: aima.lisp -;;;; Vendor-Specific Customizations - -#+Lucid (setq *warn-if-no-in-package* nil) - -;;;; A minimal facility for defining systems of files - -(defparameter *aima-root* (truename "/usr/share/common-lisp/source/aima/") - "The root directory where the code is stored.") - -(defparameter *aima-binary-type* - (pathname-type (compile-file-pathname "foo.lisp")) - "If calling aima-load loads your source files and not your compiled - binary files, insert the file type for your binaries before the <<<< - and load systems with (aima-load-binary NAME).") - -(defvar *aima-version* - "0.99 AIMA Code, Appomattox Version, 09-Apr-2002") - -(defparameter *aima-system-names* nil - "A list of names of the systems that have been defined.") - -(defstruct aima-system - name (requires nil) (doc "") (parts nil) (examples nil) (loaded? nil)) - -;;;; The Top-Level Functions: - -(defmacro def-aima-system (name requires doc &body parts) - "Define a system as a list of parts. A part can be a string, which denotes - a file name; or a symbol, which denotes a (sub)system name; or a list of the - form (subdirectory / part...), which means the parts are in a subdirectory. - The REQUIRES argument is a list of systems that must be loaded before this - one. Note that a documentation string is mandatory." - `(add-aima-system :name ',name - :requires ',requires :doc ',doc :parts ',parts)) - -(defun aima-load (&optional (name 'all)) - "Load file(s), trying the system-dependent method first." - (operate-on-aima-system name 'load-something)) - -(defun aima-load-binary (&optional (name 'all)) - "Load file(s), prefering binaries to source." - (operate-on-aima-system name 'load-binary)) - -(defun aima-compile (&optional (name 'everything)) - "Compile (and load) the file or files that make up an AIMA system." - (operate-on-aima-system name 'compile-load)) - -(defun aima-load-if-unloaded (name) - (let ((system (get-aima-system name))) - (unless (and system (aima-system-loaded? system)) - (aima-load system)) - system)) - -;;;; Support Functions - -(defun add-aima-system (&key name requires doc parts examples) - (pushnew name *aima-system-names*) - (setf (get 'aima-system name) - (make-aima-system :name name :examples examples - :requires requires :doc doc :parts parts))) - -(defun get-aima-system (name) - "Return the system with this name. (If argument is a system, return it.)" - (cond ((aima-system-p name) name) - ((symbolp name) (get 'aima-system name)) - (t nil))) - -(defun operate-on-aima-system (part operation &key (path nil) (load t) - (directory-operation #'identity)) - "Perform the operation on the part (or system) and its subparts (if any). - Reasonable operations are load, load-binary, compile-load, and echo. - If LOAD is true, then load any required systems that are unloaded." - (let (system) - (cond - ((stringp part) (funcall operation (aima-file part :path path))) - ((and (consp part) (eq (second part) '/)) - (let* ((subdirectory (mklist (first part))) - (new-path (append path subdirectory))) - (funcall directory-operation new-path) - (dolist (subpart (nthcdr 2 part)) - (operate-on-aima-system subpart operation :load load - :path new-path - :directory-operation directory-operation)))) - ((consp part) - (dolist (subpart part) - (operate-on-aima-system subpart operation :load load :path path - :directory-operation directory-operation))) - ((setf system (get-aima-system part)) - ;; Load the required systems, then operate on the parts - (when load (mapc #'aima-load-if-unloaded (aima-system-requires system))) - (operate-on-aima-system (aima-system-parts system) operation - :load load :path path - :directory-operation directory-operation) - (setf (aima-system-loaded? system) t)) - (t (warn "Unrecognized part: ~S in path ~A" part path))))) - -(defun aima-file (name &key (type nil) (path nil)) - "Given a file name and maybe a file type and a relative path from the - AIMA directory, return the right complete pathname." - (make-pathname :name name :type type :defaults *aima-root* - :directory (append (pathname-directory *aima-root*) - (mklist path)))) - -(defun >-num (x y) - "Return if x and y are numbers, and x > y" - (and (numberp x) (numberp y) (> x y))) - -(defun newer-file-p (file1 file2) - "Is file1 newer (written later than) file2?" - (>-num (if (probe-file file1) (file-write-date file1)) - (if (probe-file file2) (file-write-date file2)))) - -(defun compile-load (file) - "Compile file and then load it." - ;; This could be made more sophisticated, to compile only when out of date. - (let ((source (file-with-type file "lisp")) - (binary (file-with-type file 'binary))) - (when (or (not (probe-file binary)) - (newer-file-p source binary)) - (ensure-directories-exist binary) - (compile-file source :output-file binary)) - (load-binary file))) - -(defun load-binary (file) - "Load file, trying the binary first, but loading the source if necessary." - (load-something file '(binary nil "lisp"))) - -(defun load-something (file &optional (types '(nil binary "lisp"))) - "Try each of the types in turn until we get a file that loads. - Complain if we can't find anything. By default, try the system-dependent - method first, then the binary, and finally the source (lisp) file." - (dolist (type types (warn "Can't find file: ~A" file)) - (when (load (file-with-type file type) :if-does-not-exist nil) - (return t)))) - -(defun file-with-type (file type) - "Return a pathname with the given type." - (cond - ((null type) - file) - ((eq type 'binary) - (merge-pathnames - (make-pathname :type *aima-binary-type* - #+common-lisp-controller :directory - #+common-lisp-controller - (pathname-directory - (c-l-c:source-root-path-to-fasl-path - (namestring - (asdf::resolve-symlinks - (make-pathname :defaults file :type "lisp")))))) - file)) - (t - (make-pathname :defaults file :type type)))) - (defun mklist (x) "If x is a list, return it; otherwise return a singleton list, (x)." (if (listp x) x (list x))) - -;;; ---------------------------------------------------------------------- -;;;; Definitions of Systems -;;; ---------------------------------------------------------------------- - -(def-aima-system utilities () - "Basic functions that are loaded every time, and used by many other systems." - ("utilities" / "utilities" "binary-tree" "queue" "cltl2" "test-utilities")) - -(def-aima-system agents (utilities) - "Code from Part I: Agents and Environments" - ("agents" / "test-agents" - ("environments" / "basic-env" "grid-env" "vacuum" "wumpus") - ("agents" / "agent" "vacuum" "wumpus") - ("algorithms" / "grid"))) - -(def-aima-system search (agents) - "Code from Part II: Problem Solving and Search" - ("search" / "test-search" - ("algorithms" / "problems" "simple" "repeated" - "csp" "ida" "iterative" "sma" "minimax") - ("environments" / "games" "prob-solve") - ("domains" / "cannibals" "ttt" "cognac" "nqueens" "path-planning" - "puzzle8" "route-finding" "tsp" "vacuum") - ("agents" / "ps-agents" "ttt-agent"))) - -(def-aima-system logic (agents) - "Code from Part III: Logic, Inference, and Knowledge Representation" - ("logic" / "test-logic" - ("algorithms" / "tell-ask" "unify" "normal" "prop" "horn" "fol" "infix") - ("environments" / "shopping"))) - -(def-aima-system planning () - "Code from Part IV: Planning and Acting" - ("planning" / )) - -(def-aima-system uncertainty (agents) - "Code from Part V: Uncertain Knowledge and Reasoning" - ("uncertainty" / "test-uncertainty" - ("agents" / "mdp-agent") - ("domains" / "mdp" "4x3-mdp") - ("environments" / "mdp") - ("algorithms" / "dp" "stats"))) - -(def-aima-system learning (uncertainty) - "Code from Part VI: Learning" - ("learning" / "test-learning" - ("algorithms" / "inductive-learning" "learning-curves" "dtl" "dll" - "nn" "perceptron" "multilayer" "q-iteration") - ("domains" / "restaurant-multivalued" "restaurant-real" - "restaurant-boolean" "majority-boolean" "ex-19-4-boolean" - "and-boolean" "xor-boolean" "4x3-passive-mdp") - ("agents" / "passive-lms-learner" "passive-adp-learner" - "passive-td-learner" "active-adp-learner" "active-qi-learner" - "exploring-adp-learner" "exploring-tdq-learner"))) - -(def-aima-system language (logic) - "Code from Part VII, Chapters 22-23: Natural Language and Communication" - ("language" / "test-language" - ("algorithms" / "chart-parse") - ("domains" / "grammars" ))) - -(def-aima-system all () - "All systems except the utilities system, which is always already loaded" - agents search logic planning uncertainty learning language) - -(def-aima-system everything () - "All the code, including the utilities" - utilities all) - -(setf *aima-system-names* (nreverse *aima-system-names*)) - -;;;; Always load the utilities - -(aima-load 'utilities) diff -urN cl-aima-1.0.4.orig/utilities/utilities.lisp cl-aima-1.0.4/utilities/utilities.lisp --- cl-aima-1.0.4.orig/utilities/utilities.lisp 2005-02-05 17:06:50.000000000 -0600 +++ cl-aima-1.0.4/utilities/utilities.lisp 2005-02-05 18:18:33.000000000 -0600 @@ -15,7 +15,11 @@ #+clisp (dolist (pkg '(excl common-lisp common-lisp-user)) (setf (ext:package-lock (find-package pkg)) nil)) - ) + #+cmu + (let ((package (find-package "EXTENSIONS"))) + (when package + (setf (ext:package-lock package) nil) + (setf (ext:package-definition-lock package) nil)))) ;;;; Control Flow Macros @@ -451,74 +455,3 @@ "Echo all the args when *debugging* is true. Return the first one." (when *debugging* (format t "~&~{~S ~}~%" args)) (first args)) - -;;;; Testing Tool: deftest and test - -(defmacro deftest (name &rest examples) - "Define a set of test examples. Each example is of the form (exp test) - or (exp). Evaluate exp and see if the result passes the test. Within the - test, the result is bound to *. The example ((f 2))) has no test to - fail, so it alweays passes the test. But ((+ 2 2) (= * 3)) has the test - (= * 3), which fails because * will be bound to the result 4, so the test - fails. Call (TEST name) to count how many tests are failed within the - named test. NAME is the name of an aima-system." - `(add-test ',name ',examples)) - -(defun add-test (name examples) - "The functional interface for deftest: adds test examples to a system." - (let ((system (or (get-aima-system name) - (add-aima-system :name name :examples examples)))) - (setf (aima-system-examples system) examples)) - name) - -(defun test (&optional (name 'all) (print? 't)) - "Run a test suite and sum the number of errors. If all is well, this - should return 0. The second argument says what to print: nil for - nothing, t for everything, or FAIL for just those examples that fail. - If there are no test examples in the named system, put the system has - other systems as parts, run the tests for all those and sum the result." - (let ((*print-pretty* t) - (*standard-output* (if print? *standard-output* - (make-broadcast-stream))) - (system (aima-load-if-unloaded name))) - (cond ((null system) (warn "No such system as ~A." name)) - ((and (null (aima-system-examples system)) - (every #'symbolp (aima-system-parts system))) - (sum (aima-system-parts system) - #'(lambda (part) (test part print?)))) - (t (when print? (format t "Testing System ~A~%" name)) - (let ((errors (count-if-not #'(lambda (example) - (test-example example print?)) - (aima-system-examples system)))) - (format *debug-io* "~%~2D error~P on system ~A~%" - errors errors name) - errors))))) - -(defun test-example (example &optional (print? t)) - "Does the EXP part of this example pass the TEST?" - (if (stringp example) - (progn - (when (eq print? t) - (format t "~&;;; ~A~%" example)) - t) - (let* ((exp (first example)) - (* nil) - (test (cond ((null (second example)) t) - ((constantp (second example)) - `(equal * ,(second example))) - (t (second example)))) - test-result) - (when (eq print? t) - (format t "~&> ~S~%" exp)) - (setf * (eval exp)) - (when (eq print? t) - (format t "~&~S~%" *)) - (setf test-result (eval test)) - (when (null test-result) - (case print? - ((FAIL) (format t "~&;;; FAILURE on ~S; expected ~S, got:~%;;; ~S~%" - exp test *)) - ((T) (format t "~&;;; FAILURE: expected ~S" test)) - (otherwise))) - test-result))) -