Skip to content

Commit

Permalink
Fix case issue for Allegro modern lisp.
Browse files Browse the repository at this point in the history
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").
  • Loading branch information
rpgoldman committed Feb 12, 2024
1 parent 2f88320 commit 061a3f8
Show file tree
Hide file tree
Showing 7 changed files with 35 additions and 37 deletions.
42 changes: 21 additions & 21 deletions shop3/common/state-utils.lisp
Original file line number Diff line number Diff line change
@@ -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.
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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))
Expand All @@ -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))
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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))
Expand Down Expand Up @@ -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
Expand All @@ -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+)
Expand Down Expand Up @@ -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)))))))

Expand Down Expand Up @@ -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))
Expand Down Expand Up @@ -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)))
Expand Down
2 changes: 1 addition & 1 deletion shop3/decls.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion shop3/explicit-stack-search/decls.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -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."
)
Expand Down
4 changes: 2 additions & 2 deletions shop3/explicit-stack-search/explicit-search.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
10 changes: 5 additions & 5 deletions shop3/explicit-stack-search/plan-tree.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -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)))))
Expand All @@ -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))
Expand All @@ -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)))))))

Expand Down Expand Up @@ -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)
Expand Down
2 changes: 1 addition & 1 deletion shop3/io/input.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down
10 changes: 4 additions & 6 deletions shop3/theorem-prover/decls.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -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.")

Expand Down Expand Up @@ -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."))


Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -284,5 +284,3 @@ using it to build dependency records in the enhanced plan trees."
nil)
(:method ((domain static-predicates-mixin))
t))


0 comments on commit 061a3f8

Please sign in to comment.