Fix for allegromodern

shop3/common/state-utils.lisp

@@ -1,18 +1,18 @@
 ;;;
 ;;; Version: MPL 1.1/GPL 2.0/LGPL 2.1
-;;; 
+;;;
 ;;; The contents of this file are subject to the Mozilla Public License
 ;;; Version 1.1 (the "License"); you may not use this file except in
 ;;; compliance with the License. You may obtain a copy of the License at
 ;;; http://www.mozilla.org/MPL/
-;;; 
+;;;
 ;;; Software distributed under the License is distributed on an "AS IS"
 ;;; basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
 ;;; License for the specific language governing rights and limitations under
 ;;; the License.
-;;; 
-;;; The Original Code is SHOP2.  
-;;; 
+;;;
+;;; The Original Code is SHOP2.
+;;;
 ;;; The Initial Developer of the Original Code is the University of
 ;;; Maryland. Portions created by the Initial Developer are Copyright (C)
 ;;; 2002,2003 the Initial Developer. All Rights Reserved.
@@ -21,8 +21,8 @@
 ;;; Portions created by Drs. Goldman and Maraist are Copyright (C)
 ;;; 2004-2007 SIFT, LLC.  These additions and modifications are also
 ;;; available under the MPL/GPL/LGPL licensing terms.
-;;; 
-;;; 
+;;;
+;;;
 ;;; Alternatively, the contents of this file may be used under the terms of
 ;;; either of the GNU General Public License Version 2 or later (the "GPL"),
 ;;; or the GNU Lesser General Public License Version 2.1 or later (the
@@ -38,16 +38,16 @@
 ;;; ----------------------------------------------------------------------
 
 ;;; Smart Information Flow Technologies Copyright 2006-2007 Unpublished work
-;;; 
+;;;
 ;;; GOVERNMENT PURPOSE RIGHTS
-;;; 
-;;; Contract No.         FA8650-06-C-7606, 
+;;;
+;;; Contract No.         FA8650-06-C-7606,
 ;;; Contractor Name      Smart Information Flow Technologies, LLC
 ;;;                      d/b/a SIFT, LLC
 ;;; Contractor Address   211 N 1st Street, Suite 300
 ;;;                      Minneapolis, MN 55401
 ;;; Expiration Date      5/2/2011
-;;; 
+;;;
 ;;; The Government's rights to use, modify, reproduce, release,
 ;;; perform, display, or disclose this software are restricted by
 ;;; paragraph (b)(2) of the Rights in Noncommercial Computer Software
@@ -116,7 +116,7 @@ using MAKE-INITIAL-STATE.")
   (rest (assoc pred (state-body st))))
 
 (defmethod state-candidate-atoms-for-goal ((st list-state) goal)
-  
+
   (state-all-atoms-for-predicate st (first goal)))
 
 (defmethod copy-state ((st list-state))
@@ -136,7 +136,7 @@ using MAKE-INITIAL-STATE.")
 ;;; I think this code is going to be pretty inefficient, since it's not properly tail-recursive.  I don't think it would be terribly difficult to replace this with a properly tail-recursive program.  Alternatively, a simple destructive update using (setf (getf statebody (car atom)) ....) might work, but I don't know whether a destructive version of this operation would be acceptable. [2008-02-06: rpg
 (defun LIST-insert-atom-into-statebody (atom statebody)
   ;; the statebody here is evidently implemented as an associative structure, indexed on the predicate, of cells whose cdr is a LIST of atoms
-  (cond 
+  (cond
    ((null statebody)
     (list (list (car atom) atom)))
    ((string< (car atom) (caar statebody))
@@ -255,7 +255,7 @@ using MAKE-INITIAL-STATE.")
 
 (defmethod state-atoms ((st mixed-state))
   (let ((statebody (state-body st)))
-    (let ((acc nil)) 
+    (let ((acc nil))
       (maphash #'(lambda (pred lis)
                    (setf acc
                          (append (mapcar #'(lambda (entry) (cons pred entry)) lis)
@@ -300,8 +300,8 @@ using MAKE-INITIAL-STATE.")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; The "doubly-hashed-state" class
-(defconstant +VARIABLE-TERM+ (uiop:find-symbol* '#:%variable% (find-package (symbol-name '%shop3-common-private%))))
-(defconstant +SINGLETON-TERM+ (uiop:find-symbol* '#:%singleton% (find-package (symbol-name '%shop3-common-private%))))
+(defconstant +variable-term+ (uiop:find-symbol* '#:%variable% (find-package (symbol-name '%shop3-common-private%))))
+(defconstant +singleton-term+ (uiop:find-symbol* '#:%singleton% (find-package (symbol-name '%shop3-common-private%))))
 (defmethod make-initial-state (domain (state-encoding (eql :doubly-hashed)) atoms &key)
   (declare (ignore domain))
    (make-doubly-hashed-state atoms))
@@ -322,20 +322,20 @@ using MAKE-INITIAL-STATE.")
       (setf subtable (make-hash-table :test #'equal))
       (setf (gethash (first atom) (state-body st)) subtable))
     (if (= (length atom) 1)
-        (pushnew t (gethash +SINGLETON-TERM+ subtable))
+        (pushnew t (gethash +singleton-term+ subtable))
         (pushnew (rest atom) (gethash (second atom) subtable) :test 'equal))))
 
 (defmethod remove-atom (atom (st doubly-hashed-state))
   (let* ((statebody (state-body st))
          (subtable (gethash (first atom) statebody)) ; hash-table
          (sub-key (if (> (length atom) 1)
-                      (second atom) 
-                      +SINGLETON-TERM+))
+                      (second atom)
+                      +singleton-term+))
          (subtable-entry (when subtable
                            (gethash sub-key subtable)))) ; list
     (cond ((null subtable) (values)) ;no-op
           ((null subtable-entry) (values))
-          ((eq sub-key +SINGLETON-TERM+) (remhash sub-key subtable))
+          ((eq sub-key +singleton-term+) (remhash sub-key subtable))
           (t
            (setf (gethash sub-key subtable)
                  (delete
@@ -345,10 +345,10 @@ using MAKE-INITIAL-STATE.")
 
 (defmethod state-atoms ((st doubly-hashed-state))
   (let ((statebody (state-body st))     ; this is a hash-table of hash-tables
-        (acc nil)) 
+        (acc nil))
     (maphash #'(lambda (pred subtable)
                  (maphash #'(lambda (first-arg lis)
-                              (if (eq first-arg +SINGLETON-TERM+)
+                              (if (eq first-arg +singleton-term+)
                                   (push `(,pred) acc)
                                   (setf acc
                                         (append (mapcar #'(lambda (entry) (cons pred entry)) lis)
@@ -478,7 +478,7 @@ using MAKE-INITIAL-STATE.")
                        acc)))
              (first (state-body st)))
     (remove-duplicates (append
-                        acc 
+                        acc
                         (mapcan #'(lambda (entry) (copy-list (cdr entry)))
                                 (fourth (state-body st)))))))
 
@@ -608,7 +608,7 @@ using MAKE-INITIAL-STATE.")
       nil))
    (t
     (incf (second (first position)))
-    (cond 
+    (cond
      ((< (second (first position)) (first pred-type-counts))
       position)
      ((null (rest position))
@@ -640,7 +640,7 @@ for easier human inspection."
                   nil)
                  ((symbolp p1)
                   (if (symbolp p2)
-                      (cond 
+                      (cond
                         ((string-lessp p1 p2) t)
                         ((string-lessp p2 p1) (values nil t))
                         (t (values nil nil)))

shop3/decls.lisp

@@ -727,7 +727,7 @@ which should be the default)."))
 
 ;;; ERRORP defaults to NIL only for backwards compatibility.  It might be better
 ;;; to make T be the default. [2015/01/01:rpg]
-(defun find-problem (name-or-problem &optional (errorp NIL))
+(defun find-problem (name-or-problem &optional (errorp nil))
   (if (typep name-or-problem 'problem)
       ;; make FIND-PROBLEM idempotent...
       name-or-problem

shop3/explicit-stack-search/decls.lisp

@@ -31,7 +31,7 @@ in this search MODE."
    (protections
     :initarg :protections
     :accessor protections
-    :initform NIL
+    :initform nil
     :documentation "Set of protections in the current
 state."
     )

shop3/explicit-stack-search/explicit-search.lisp

@@ -5,7 +5,7 @@
   nil
   "Do we build a dependency-enhanced plan tree?")
 (defvar *no-dependencies*
-  NIL
+  nil
   "When building an ENHANCED-PLAN-TREE, do not record  causal links.  Defaults to NIL.")
 
 (defvar *include-rationale* nil)
@@ -703,7 +703,7 @@ trigger backtracking."
 ;;; are no top-tasks.  I just copied this over from mainstream SHOP2.
 (defun EMPTY-P (state)
   (with-slots (top-tasks) state
-    (or (null top-tasks) (equal top-tasks '(NIL)))))
+    (or (null top-tasks) (equal top-tasks '(nil)))))
 
 (defun test-plan-found (state &key repairable)
   "If there is a plan in STATE (a SEARCH-STATE), then

shop3/explicit-stack-search/plan-tree.lisp

@@ -72,9 +72,9 @@ cross-links for VAL using information in TABLE."))
   )
 
 (defun slot-value-translator (val &optional (table *table-for-load-form*))
-  (cond ((null val) NIL)
+  (cond ((null val) nil)
         ((and (symbolp val)
-              (or (eq val :INIT) (equalp (symbol-name val) (symbol-name '#:top))))
+              (or (eq val :init) (equalp (symbol-name val) (symbol-name '#:top))))
          val)
         (t (or (gethash val table)
                (error "No table entry for value ~s" val)))))
@@ -88,7 +88,7 @@ cross-links for VAL using information in TABLE."))
 (defun make-cross-links (&optional (table *table-for-load-form*))
   (iter (for (val var) in-hashtable table)
     (unless (listp val)
-     (appending 
+     (appending
       (cross-links-for var val table)))))
 
 (defmethod make-instantiator ((obj primitive-tree-node))
@@ -104,7 +104,7 @@ cross-links for VAL using information in TABLE."))
 (defmethod cross-links-for ((var-name symbol) (obj complex-tree-node) (table hash-table))
   (append (call-next-method)
           `((setf (complex-tree-node-children ,var-name)
-                  (list 
+                  (list
                    ,@(mapcar #'(lambda (x) (slot-value-translator x table))
                            (complex-tree-node-children obj)))))))
 
@@ -138,7 +138,7 @@ and building a toplogically sorted list of nodes."))
 
 (defun obj-bindings (hash-table)
   "Return an ordered list of variable-name instantiator pairs for use in a LET form."
-  (append 
+  (append
    (iter (for (item var-name) in-hashtable hash-table)
      ;; proposition or task
      (when (listp item)

shop3/io/input.lisp

@@ -731,7 +731,7 @@ breaks usage of *load-truename* by moving the FASLs.")
                 (parse-domain-items domain items))
               (when warnings
                 (let ((*print-pprint-dispatch* *shop-pprint-table*))
-                  (format T "Warnings:~{~&~a~%~%~}" (nreverse warnings)))))
+                  (format t "Warnings:~{~&~a~%~%~}" (nreverse warnings)))))
             (install-domain domain redefine-ok)
             (unless noset
               (setf *domain* domain))

shop3/theorem-prover/decls.lisp

@@ -62,11 +62,11 @@
 (defvar *domain* nil
   "Default domain to use when planning.")
 
-(defvar *record-dependencies-p* NIL
+(defvar *record-dependencies-p* nil
   "Do we record dependencies when we find literals in the theorem
 prover.  If so, see *LITERALS* and *ESTABLISHERS*.")
 
-(defvar *optimize-first-retrieval* NIL
+(defvar *optimize-first-retrieval* nil
   "In some cases we can optimize solutions to :FIRST to find only
 the first match.")
 
@@ -154,7 +154,7 @@ function!  Instead, please use the def-logical-keyword macro.")
     :reader static-preds
     :initform nil
     ))
-  (:documentation "Add this to domain classes that should have 
+  (:documentation "Add this to domain classes that should have
 static predicates defined."))
 
 
@@ -250,7 +250,7 @@ warnings, errors, etc.")
   (:report (lambda (condition stream)
              (format stream "We do not have correct logic for computing dependencies for expression ~a. Simply return no new dependencies."
                      (expression condition)))))
-    
+
 
 ;;; used for the internals of IF-THEN-ELSE in the theorem-prover
 (define-condition cut-commit (condition)
@@ -284,5 +284,3 @@ using it to build dependency records in the enhanced plan trees."
     nil)
   (:method ((domain static-predicates-mixin))
     t))
-
-