From 061a3f8002a0b96d0c72aa2e5a1440a1912e2fbf Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" Date: Mon, 12 Feb 2024 13:15:35 -0600 Subject: [PATCH 1/2] Fix case issue for Allegro modern lisp. There were some uses of "NIL" (all caps) which broke compatibility with Allegro's modern, case-sensitive Lisp, because it wasn't the default case ("nil"). --- shop3/common/state-utils.lisp | 42 +++++++++---------- shop3/decls.lisp | 2 +- shop3/explicit-stack-search/decls.lisp | 2 +- .../explicit-search.lisp | 4 +- shop3/explicit-stack-search/plan-tree.lisp | 10 ++--- shop3/io/input.lisp | 2 +- shop3/theorem-prover/decls.lisp | 10 ++--- 7 files changed, 35 insertions(+), 37 deletions(-) diff --git a/shop3/common/state-utils.lisp b/shop3/common/state-utils.lisp index 3a095d13..a310935e 100644 --- a/shop3/common/state-utils.lisp +++ b/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)) @@ -329,7 +329,7 @@ using MAKE-INITIAL-STATE.") (let* ((statebody (state-body st)) (subtable (gethash (first atom) statebody)) ; hash-table (sub-key (if (> (length atom) 1) - (second atom) + (second atom) +SINGLETON-TERM+)) (subtable-entry (when subtable (gethash sub-key subtable)))) ; list @@ -345,7 +345,7 @@ 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+) @@ -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))) diff --git a/shop3/decls.lisp b/shop3/decls.lisp index 27082055..71922e28 100644 --- a/shop3/decls.lisp +++ b/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 diff --git a/shop3/explicit-stack-search/decls.lisp b/shop3/explicit-stack-search/decls.lisp index 963cba4d..86034158 100644 --- a/shop3/explicit-stack-search/decls.lisp +++ b/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." ) diff --git a/shop3/explicit-stack-search/explicit-search.lisp b/shop3/explicit-stack-search/explicit-search.lisp index 95de9fba..46da8a28 100644 --- a/shop3/explicit-stack-search/explicit-search.lisp +++ b/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 diff --git a/shop3/explicit-stack-search/plan-tree.lisp b/shop3/explicit-stack-search/plan-tree.lisp index 71118ba0..63c9b283 100644 --- a/shop3/explicit-stack-search/plan-tree.lisp +++ b/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) diff --git a/shop3/io/input.lisp b/shop3/io/input.lisp index 66cd3d12..a0cc569a 100644 --- a/shop3/io/input.lisp +++ b/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)) diff --git a/shop3/theorem-prover/decls.lisp b/shop3/theorem-prover/decls.lisp index b3999ce4..3cb0855e 100644 --- a/shop3/theorem-prover/decls.lisp +++ b/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)) - - From ab3fc0380207f33a10563b5646aca41eb0c34137 Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" Date: Mon, 12 Feb 2024 13:37:01 -0600 Subject: [PATCH 2/2] Another case issue. --- shop3/common/state-utils.lisp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/shop3/common/state-utils.lisp b/shop3/common/state-utils.lisp index a310935e..0845740e 100644 --- a/shop3/common/state-utils.lisp +++ b/shop3/common/state-utils.lisp @@ -322,7 +322,7 @@ 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)) @@ -330,12 +330,12 @@ using MAKE-INITIAL-STATE.") (subtable (gethash (first atom) statebody)) ; hash-table (sub-key (if (> (length atom) 1) (second atom) - +SINGLETON-TERM+)) + +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 @@ -348,7 +348,7 @@ using MAKE-INITIAL-STATE.") (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)