From b26050f9d2d93c3eb9ec82ffefb28d5d8953217f Mon Sep 17 00:00:00 2001 From: Eric Swenson Date: Thu, 22 Aug 2024 17:43:00 -0700 Subject: [PATCH] Got rid of hack of setting CAR and CDR values to T. The old Maclisp used when SHRDLU was created allowed one to take the CAR and CDR of atoms. The former returned internal bits associated wih the symbol, and the latter returned the property list of the symbol. This was disabled in later verisons of MacLISP, but allowed to be enabled by setting the value of CAR to T (and the value of CDR to T). However, doing this masked coding errors that resulted from unintentionally taking the CAR or CDR of a symbol, when a list or NUL was actually expected. This commit removes the hack of setting CAR and CDR to T, and adds macros to replace the use of CAR and CDR in this cases in PLNR and associated PLNR logic. These macros are found in the MACROS module. Making this change, and removing the duplicated $ reader macro from PLNR (it is already in MACROS for the benefit of other files), required making changes to the loader of SHRDLU and PLNR. I removed the obsolete use of UREAD to load interpreted files, and replaced with a new NEW-LOAD function. UREAD was unable to handle the (status macro $ 'thread) code that needed to be included. --- src/shrdlu/{blockp.6 => blockp.7} | 16 +- src/shrdlu/{gramar.29 => gramar.30} | 4 +- src/shrdlu/{loader.21 => loader.22} | 122 ++++---- src/shrdlu/{macros.1 => macros.2} | 29 +- src/shrdlu/{plnr.184 => plnr.185} | 403 ++++++++++++-------------- src/shrdlu/{plnrfi.1 => plnrfi.2} | 3 - src/shrdlu/{smutil.151 => smutil.152} | 4 +- 7 files changed, 282 insertions(+), 299 deletions(-) rename src/shrdlu/{blockp.6 => blockp.7} (98%) rename src/shrdlu/{gramar.29 => gramar.30} (99%) rename src/shrdlu/{loader.21 => loader.22} (61%) rename src/shrdlu/{macros.1 => macros.2} (51%) rename src/shrdlu/{plnr.184 => plnr.185} (87%) rename src/shrdlu/{plnrfi.1 => plnrfi.2} (89%) rename src/shrdlu/{smutil.151 => smutil.152} (99%) diff --git a/src/shrdlu/blockp.6 b/src/shrdlu/blockp.7 similarity index 98% rename from src/shrdlu/blockp.6 rename to src/shrdlu/blockp.7 index 6525012e..d8232268 100644 --- a/src/shrdlu/blockp.6 +++ b/src/shrdlu/blockp.7 @@ -288,7 +288,6 @@ ((THSETQ PLAN (CONS (CONS (QUOTE MOVETO) $?Y) PLAN))))) THEOREM) - (DEFPROP TC-NAME (THCONSE (X) (!NAME $?X) @@ -434,7 +433,9 @@ THEOREM) (THCONSE (X Y Z (WHY (EV)) EV) (!PUTON $?X $?Y) (ATOM $?Y) - (OR (CDR $?X) (THSETQ $_X (CAR $?X))) + (OR (cond ((listp $?x) (cdr $?x)) + (t (plist $?x))) + (THSETQ $_X (and (listp $?x) (CAR $?X)))) (NOT (COND ((ATOM $?X) (EQ $?X $?Y)) ((MEMQ $?Y $?X)))) (MEMORY) (THCOND ((ATOM $?X) @@ -623,12 +624,11 @@ THEOREM) (THGOAL (!AT $?Y $?Z)) (THSUCCEED THEOREM))) (THSETQ $_X(TFIND $?Y $?TIME)) -(THOR(THSETQ $_W(CAR $?X)) -(THAND(THAMONG $?W (CDR $?X)) -(OR (NOT (LESSP (CAR $?W) (OR (START? $?TIME) -1))) -(THFAIL THAND)) -)) - + (THOR (THSETQ $_W (CAR $?X)) + (THAND (THAMONG $?W (CDR $?X)) + (OR (NOT (LESSP (CAR $?W) (OR (START? $?TIME) -1))) + (THFAIL THAND)) + )) (THSETQ $?Z (CADR $?W))) THEOREM) diff --git a/src/shrdlu/gramar.29 b/src/shrdlu/gramar.30 similarity index 99% rename from src/shrdlu/gramar.29 rename to src/shrdlu/gramar.30 index 420774f5..2e523d32 100644 --- a/src/shrdlu/gramar.29 +++ b/src/shrdlu/gramar.30 @@ -1112,7 +1112,7 @@ FDEC (FQ DECLAR) ;; CHECK FOR DISGUISED RSQ CLAUSES BY READING THE FAILURE ;;MESSAGES SENT UP FROM PREPG. - (: (EQ (CAR MES) 'PREP-WHICH) NIL RSQ) + (: (and (listp mes) (EQ (CAR MES) 'PREP-WHICH)) NIL RSQ) (SETQ MES (CDR MES)) (: (PARSE CLAUSE RSQ PREPREL) PREPNG (RSQ-PREPREL) RETSM) @@ -1929,7 +1929,7 @@ possdef ;the placement of this tag is a (AND (ATOM PREV) (MOVE-PTW N NW (EQ (WORD PTW) PREV)) (CUT PTW)) - (AND (OR (EQ PREV 'BUT) (EQ (CADR PREV) 'BUT)) + (AND (OR (EQ PREV 'BUT) (and (listp prev) (EQ (CADR PREV) 'BUT))) (NEXTWORD? 'NOT) ;CHECK FOR BUT-NOT COMBINATION (OR (FLUSHME) (*GO LOSE2)) (FQ NEGBUT)) diff --git a/src/shrdlu/loader.21 b/src/shrdlu/loader.22 similarity index 61% rename from src/shrdlu/loader.21 rename to src/shrdlu/loader.22 index 7c1f4990..fc7a5d4a 100644 --- a/src/shrdlu/loader.21 +++ b/src/shrdlu/loader.22 @@ -1,19 +1,23 @@ -;;; THIS IS A PACKAGE FOR LOADING SHRDLU'S INTO CORE FROM THE DISK FILES. -;;; THE PROCEDURE IS TO FIRST LOAD A BLISP (IGNORE ALLOCATIONS, THE -;;; PROGRAMS DO THEIR OWN). AND UREAD THIS FILE. EXECUTING "LOADSHRDLU" -;;; WILL GENERATE (AFTER SOME TIME) A FULLY INTERPRETED VERSION. -;;; PARTIALLY COMPILED MIXES ARE AVAILLABLE, AS SEEN BELOW. +;;; THIS IS A PACKAGE FOR LOADING SHRDLUS INTO CORE FROM THE DISK FILES. +;;; THE PROCEDURE IS TO FIRST LOAD A LISP (IGNORE ALLOCATIONS, THE +;;; PROGRAMS DO THEIR OWN), THEN TO LOAD THIS FILE. EXECUTING +;;; (load-shrdlu-interpreted) WILL GENERATE (AFTER SOME TIME) A FULLY +;;; INTERPRETED VERSION. Once SHRDLU is loaded, invoking +;;; (dump-shrdlu) will generate a PDUMPable image. +;;; +;;; (load-shrdlu-compiled) can be used instead of +;;; (load-shrdlu-interpreted) to load a compiled version of PLNR and +;;; SHRDLU. (dump-shrdlu) can then be used to generate a PDUMPable +;;; image. +;;; ;;; THE VARIABLE "VERSION-FILES" KEEPS A RUNNING TAB OF THE FILES -;;; LOADER VIA "LOADER". IF ANY ERRORS OCCUR DURING READIN THEY +;;; LOADER VIA "new-loader". IF ANY ERRORS OCCUR DURING READIN THEY ;;; ARE PROTECTED BY AN "ERRSET" AND LOADING CONTINUES. (NOTE !! IF AN ;;; UNBOUND PAREN CAUSES THE FILE TO BE TERMINATED TOO SOON, YOU'LL ;;; NEVER NOTICE) ;;; -;(setsyntax 34. 'single 34.) - (SETQ GC-OVERFLOW '(LAMBDA (X) T)) - (defun makoblist (x) (cond ((null x) (listarray obarray (- (cadr (arraydims 'obarray)) 129.))) @@ -35,29 +39,23 @@ (SETQ *RSET T) -(DEFUN LOADER (*!?KEY) - (OR (ERRSET (EVAL (LIST 'UREAD - *!?KEY - '> - 'DSK - 'SHRDLU)) - NIL) - (AND (PRINT *!?KEY) - (PRINC 'NOT-FOUND) - (RETURN NIL))) - (LOADX)) - -(DEFUN LOADX () - (PROG (*!?H *!?F *!?EOF) - (SETQ *!?EOF (GENSYM)) - (PRINT 'READING) - (PRINC *!?KEY) - (SETQ VERSION-FILES (CONS (STATUS UREAD) VERSION-FILES)) - LOOP ((LAMBDA (^Q) (SETQ *!?H (READ *!?EOF))) T) - (AND (EQ *!?H *!?EOF) (RETURN T)) - (OR (ERRSET ((LAMBDA (^W ^Q) (EVAL *!?H)) T T)) - (PROG2 (PRINT 'ERROR-IN-FILE) (PRINT *!?H))) - (GO LOOP))) +(defun new-loader (filename) + (let ((file (probef `(,filename > dsk shrdlu)))) + (if file + (progn + (print 'reading) + (princ filename) + (setq version-files (cons file version-files)) + (or + (errset (progn (load file) t)) + (progn + (print filename) + (princ 'error-in-file) + nil))) + (progn + (print filename) + (princ 'not-found) + nil)))) (defun fload2 (x) (fload (cons x '(fasl dsk shrdlu)))) @@ -71,75 +69,69 @@ (ERT lossage in loading - try again ?)) ) - (SETQ VERSION-FILES NIL) -(defun loadplanner () +(defun load-planner-interpreted () (ALLOC '(LIST 320000 FIXNUM 15000 SYMBOL 15000 array 500 flonum 4000)) (SETQ PURE NIL) - (setq car t) - (setq cdr t) (SETQ THINF NIL THTREE NIL THLEVEL NIL) - (MAPC 'LOADER '(PLNR THTRAC)) + (new-loader 'plnrfi) + (MAPC 'new-LOADER '(PLNR THTRAC)) (THINIT)) -(defun planner-compiled () +(defun load-planner-compiled () (ALLOC '(LIST 320000 FIXNUM 15000 SYMBOL 15000 array 500 flonum 4000)) (SETQ PURE NIL) - (setq car t) - (setq cdr t) (SETQ THINF NIL THTREE NIL THLEVEL NIL) + (new-loader 'plnrfi) (MAPC 'fload2 '(PLNR THTRAC)) (THINIT)) -(DEFUN LOADSHRDLU () +(DEFUN load-shrdlu-interpreted () (ALLOC '(LIST 320000 FIXNUM 15000 SYMBOL 15000 array 500 flonum 3000)) (SETQ PURE NIL) - (setq car t) - (setq cdr t) (SETQ THINF NIL THTREE NIL THLEVEL NIL NOSTOP NIL) (load '((lisp) slave fasl)) (load '((lisp) format fasl)) (load '((lisp) umlmac fasl)) - (MAPC 'LOADER '(PLNR THTRAC)) + (load '(macros >)) + (MAPC 'new-LOADER '(PLNR THTRAC)) (thinit) (setq errlist nil) ;removes micro-planner's fangs - (MAPC 'LOADER '(SYSCOM MORPHO SHOW)) - (MAPC 'LOADER '(PROGMR PROGGO GINTER GRAMAR DICTIO)) - (MAPC 'LOADER '(SMSPEC SMASS SMUTIL)) - (LOADER 'NEWANS) - (load 'blockp) - (load 'data2) - (load 'blockl) - (LOADER 'SETUP) - (load 'data) + (MAPC 'new-LOADER '(SYSCOM MORPHO SHOW)) + (MAPC 'new-LOADER '(PROGMR PROGGO GINTER GRAMAR DICTIO)) + (MAPC 'new-LOADER '(SMSPEC SMASS SMUTIL)) + (new-loader 'NEWANS) + (new-loader 'blockp) + (new-loader 'data2) + (new-loader 'blockl) + (new-loader 'SETUP) + (new-loader 'data) (load '((lisp) trace fasl)) - (let ((x nil)) nil) ; forces let to get loaded +; (let ((x nil)) nil) ; forces let to get loaded (load '((shrdlu) graphf fasl)) (load '((lisp) grinde fasl)) 'CONSTRUCTION/ COMPLETED) -(DEFUN SHRDLU-COMPILED () +(DEFUN load-shrdlu-compiled () (ALLOC '(LIST 320000 FIXNUM 15000 SYMBOL 15000 array 500 flonum 3000)) (SETQ PURE NIL) - (setq car t) - (setq cdr t) (SETQ THINF NIL THTREE NIL THLEVEL NIL NOSTOP NIL) (load '((lisp) slave fasl)) (mapc 'fload2 '(plnr thtrac)) @@ -151,27 +143,27 @@ (mapc 'fload2 '(newans blockp)) (load 'data2) (fload2 'blockl) - (LOADER 'SETUP) + (new-LOADER 'SETUP) (load 'data) (load '((lisp) trace fasl)) (let ((x nil)) nil) ; forces let to get loaded (load '((shrdlu) graphf fasl)) (load '((lisp) grinde fasl)) - (load '((lisp) mlmac fasl)) + (load '((lisp) mlsub fasl)) 'COMPLETED) -(defun loadparser () +(defun load-parser-interpreted () (mapc 'loader '(syscom morpho show)) (mapc 'loader '(progmr proggo ginter gramar dictio)) - (loader 'setup) - (loader 'parser) + (new-loader 'setup) + (new-loader 'parser) 'complete-call-setup-num-date) -(DEFUN PARSER-compiled () +(DEFUN load-parser-compiled () (SETQ PURE NIL) (mapc 'fload2 '(syscom morpho show)) (mapc 'fload2 '(progmr proggo ginter gramar dictio)) (load '((lisp) trace fasl)) - (loader 'setup) - (loader 'parser) + (new-loader 'setup) + (new-loader 'parser) 'PARSER-LOADED) diff --git a/src/shrdlu/macros.1 b/src/shrdlu/macros.2 similarity index 51% rename from src/shrdlu/macros.1 rename to src/shrdlu/macros.2 index e931676c..1a4ef13e 100644 --- a/src/shrdlu/macros.1 +++ b/src/shrdlu/macros.2 @@ -1,6 +1,4 @@ - (SSTATUS MACRO $ (QUOTE THREAD)) - (DEFUN THREAD ;FUNCTION FOR THE /$ READ MACRO - +(DEFUN THREAD ;FUNCTION FOR THE /$ READ MACRO ;;EXPANDS _ TO (THNV (READ)) EXPANDS A TO ASSERT ;EXPANDS G TO GOAL EXPANDS T TO THTBF THTRUE NIL ;EXPANDS ? TO (THV (READ)) EXPANDS E TO (THEV ;(READ)) @@ -29,3 +27,28 @@ (PRINC CHAR) (PRINC (READ)) (ERR NIL)))))) + +(sstatus macro $ 'thread) + +; this macro handles the case where the value passed to it is an atom +; the old MacLISP used to support this, and this returned some implementation +; specific flags from a symbol flag word. The current MacLISP CAR doesn't +; allow this, and causes an error to be signalled. Rather than SETQ the value +; CAR to T, which re-enables the old behavior, this macro handles the ATOM +; case by returning a GENSYM (*car-of-atom*), which is guaranteed not to match +; any other value. In the original code, any comparison with the value returned +; from (CAR ) would fail, and so too does this rewrite. + +(defvar *car-of-atom* (gensym)) + +(defmacro carx (x) + `(let ((xx ,x)) + (cond ((null xx) nil) + ((atom xx) *car-of-atom*) + (t (car xx))))) + +(defmacro cdrx (x) + `(let ((xx ,x)) + (cond ((null xx) nil) + ((atom xx) (error "CDRX of a symbol")) + (t (cdr xx))))) diff --git a/src/shrdlu/plnr.184 b/src/shrdlu/plnr.185 similarity index 87% rename from src/shrdlu/plnr.184 rename to src/shrdlu/plnr.185 index 8269b21f..54619880 100644 --- a/src/shrdlu/plnr.184 +++ b/src/shrdlu/plnr.185 @@ -1,5 +1,3 @@ -(declare (genprefix plnr)) - (COMMENT DO NOT GRIND THIS FILE WITH THE STANDARD GRIND) (SETQ THVERSION (CADR (STATUS UREAD))) @@ -7,7 +5,6 @@ (DECLARE (PRINT (LIST 'SETQ 'THVERSION (LIST 'QUOTE (CADR (STATUS UREAD)))))) - (DECLARE (*FEXPR THAPPLY THGENAME THSTATE @@ -54,6 +51,9 @@ (DECLARE (MACROS T) (GENPREFIX TH)) +(eval-when (compile) + (load 'macros)) + ;ejs causes DDTBUG when FORMAT and other FASLs are loaded ; don't think this is really required ;(SETQ SYMBOLS T) @@ -61,37 +61,6 @@ (COND ((ERRSET (AND PURE (SETQ LOW (PAGEBPORG))))) (' (NOT PURIFIED))) -(DEFUN THREAD ;FUNCTION FOR THE /$ READ MACRO - - ;;EXPANDS _ TO (THNV (READ)) EXPANDS A TO ASSERT ;EXPANDS G TO GOAL EXPANDS T TO THTBF THTRUE - NIL ;EXPANDS ? TO (THV (READ)) EXPANDS E TO (THEV - ;(READ)) - (PROG (CHAR) ;EXPANDS R TO THRESTRICT - - ;;TREATS & - - & AS A COMMENT - (RETURN (COND ((EQ (SETQ CHAR (READCH)) (QUOTE ?)) - (LIST (QUOTE THV) (READ))) - ((EQ CHAR (QUOTE E)) - (LIST (QUOTE THEV) (READ))) - ((EQ CHAR (QUOTE _)) - (LIST (QUOTE THNV) (READ))) - ((EQ CHAR (QUOTE &)) - (PROG NIL - CHLP (COND ((EQ (QUOTE &) (READCH)) - (RETURN (QUOTE (COMMENT))))) - (GO CHLP))) - ((EQ CHAR (QUOTE T)) - (QUOTE (THTBF THTRUE))) - ((EQ CHAR (QUOTE R)) (QUOTE THRESTRICT)) - ((EQ CHAR (QUOTE G)) (QUOTE THGOAL)) - ((EQ CHAR (QUOTE A)) (QUOTE THASSERT)) - ((EQ CHAR 'N) (LIST 'THANUM (READ))) - ((PRINT (QUOTE ILLEGAL-PREFIX)) - (PRINC (QUOTE $)) - (PRINC CHAR) - (PRINC (READ)) - (ERR NIL)))))) - (DEFUN THPUSH MACRO (A) ;(THPUSH THTREE NEWINFO) CONSES NEWINFO ONTO @@ -120,13 +89,13 @@ (OR (SETQ THT1 (GET THTT (QUOTE THEOREM))) ;;IF NO THEOREM PROPERTY THE GUY MADE A MISTAKE - (PROG2 (PRINT THTT) (THERT CANT + (PROG2 (PRINT THTT) (THERT CAN/'T THASSERT/, NO THEOREM - THADD))) - (SETQ THWH (CAR THT1)) + (SETQ THWH (CARX THT1)) ;;THWH NOW SET TO KIND OF THEOREM, LIKE THERASING (SETQ THTTL THTT) @@ -141,7 +110,7 @@ ;;GO THROUGH ITEMS ON PL ONE BY ONE LP (THPUTPROP THTT (CADR THPL) - (CAR THPL)) + (CARX THPL)) (COND ((SETQ THPL (CDDR THPL)) (GO LP))))) (CADDR THT1)) @@ -183,7 +152,7 @@ ;;BEING IN DATA BASE, BUT NOW USE VARIABLES FOR EQ CHECK (SETQ THFSTP T) (GO THP1)) - ((NULL (SETQ THT1 (THIP (CAR THCK)))) (RETURN NIL)) + ((NULL (SETQ THT1 (THIP (CARX THCK)))) (RETURN NIL)) ;;THIP IS THE WORKHORSE FOR THADD IF IT RETURNS NIL ;;IT MEANS THE ASSERTEE IS ALREADY IN, SO FAIL @@ -197,11 +166,11 @@ ;;VARIABLE ITEM TO DO THE EQ CHECK (NCONC THFOO (LIST (COND ((EQ THT1 (QUOTE THVRB)) - (CAR THCK)))))) - (SETQ THCK (CDR THCK)) + (CARX THCK)))))) + (SETQ THCK (CDRX THCK)) (GO THP1))) (SETQ THFST NIL) - (MAPC (FUNCTION THIP) (CDR THCK)) + (MAPC (FUNCTION THIP) (CDRX THCK)) (SETQ THNF 0.) (MAPC (FUNCTION THIP) THFOO) (RETURN THTTL))) @@ -210,14 +179,14 @@ FEXPR (THA) ;EXAMPLE - (THAMONG $?X (THFIND ... )) (COND ;$E - (THAMONG $E$?X (THFIND ... )) CAUSES THE - ;THVALUE OF ;$?X ;TO BE THE FIRST INPUT TO THAMONG. THXX SET ;TO + ;THVALUE OF $?X TO BE THE FIRST INPUT TO THAMONG. + ;THXX SET TO ((EQ (CADR (SETQ THXX (THGAL (COND ((EQ (CAAR THA) ;OLD BINDING CELL OF $?X (OR $E$?X) IF $?X - - ;;VALUES PUSHED ONTO THTREE AND THAMONG FAILS TO + ;VALUES PUSHED ONTO THTREE AND THAMONG FAILS TO (QUOTE THEV)) ;THUNASSIGNED, OLD VALUE AND LIST OF NEW (THVAL (CADAR THA) ;THAMONGF. THALIST)) - (T (CAR THA))) + (T (CARX THA))) THALIST))) (QUOTE THUNASSIGNED)) (THPUSH THTREE (LIST (QUOTE THAMONG) @@ -230,8 +199,8 @@ NIL ;VALUES)) (COND (THMESSAGE (THPOPT) NIL) ((CADDAR THTREE) ;LIST OF NEW VALUES NON NIL - (RPLACA (CDADAR THTREE) (CAADDR (CAR THTREE))) ;REPLACE OLD VALUE WITH NEW VALUE - (RPLACA (CDDAR THTREE) (CDADDR (CAR THTREE))) ;POP NEW VALUES + (RPLACA (CDADAR THTREE) (CAADDR (CARX THTREE))) ;REPLACE OLD VALUE WITH NEW VALUE + (RPLACA (CDDAR THTREE) (CDADDR (CARX THTREE))) ;POP NEW VALUES (SETQ THBRANCH THTREE) ;STORE AWAY TREE FOR POSSIBLE BACKTRACKING (SETQ THABRANCH THALIST) ;STORE AWAY THALIST FOR POSSIBLE BACKTRACKING (THPOPT) ;POP TREE @@ -243,7 +212,7 @@ (DEFUN THAND FEXPR (A) (OR (NOT A) (PROG2 (THPUSH THTREE (LIST (QUOTE THAND) A NIL)) - (SETQ THEXP (CAR A))))) + (SETQ THEXP (CARX A))))) (DEFUN THANDF NIL (THBRANCHUN) NIL) @@ -259,11 +228,11 @@ (THX) ;DEFINES AND OPTIONALLY ASSERTS ANTECEDENT (THDEF (QUOTE THANTE) THX)) ;THEOREMS) -(DEFUN THAPPLY FEXPR (L) (THAPPLY1 (CAR L) +(DEFUN THAPPLY FEXPR (L) (THAPPLY1 (CARX L) ;;THAPPLY1 DOES THE REAL WORK, ALL WE DO IS GET THE THEOREM OFF THE ;;PROPERTY LIST - (GET (CAR L) (QUOTE THEOREM)) + (GET (CARX L) (QUOTE THEOREM)) (CADR L))) (DEFUN THAPPLY1 @@ -288,13 +257,13 @@ (DEFUN THASS1 (THA P) (PROG (THX THY TYPE PSEUDO) - (AND (CDR THA) (EQ (CAADR THA) (QUOTE THPSEUDO)) (SETQ PSEUDO + (AND (CDRX THA) (EQ (CAADR THA) (QUOTE THPSEUDO)) (SETQ PSEUDO T)) ;;IF YOU SEE "THPSEUDO" SET FLAG "PSEUDO" TO T - (OR (ATOM (SETQ THX (CAR THA))) + (OR (ATOM (SETQ THX (CARX THA))) - ;;IF (CAR THA) IS AN ATOM WE ARE ASSERTING (ERRASING) A THEOREM + ;;IF (CARX THA) IS AN ATOM WE ARE ASSERTING (ERRASING) A THEOREM (THPURE (SETQ THX (THVARSUBST THX NIL))) ;;THVARSUBST SUBSTITUTES THE ASSIGNMENTS FOR ALL ASSIGNED VARIABLES @@ -307,7 +276,7 @@ (AND THTRACE (NOT PSEUDO) (THTRACES (COND (P (QUOTE THASSERT)) ((QUOTE THERASE))) THX)) - (SETQ THA (COND (PSEUDO (CDDR THA)) ((CDR THA)))) + (SETQ THA (COND (PSEUDO (CDDR THA)) ((CDRX THA)))) ;;THX IS NOW WHAT WE ARE ASSERTING, AND THA IS THE RECOMMENDATION LIST (OR @@ -333,7 +302,7 @@ ;;AND REMOVE THPROP FROM THE RECOMENDATION LIST (SETQ THA - (CDR THA)))))))) + (CDRX THA)))))))) ;;OTHERWISE WE ARE ERASING, SO USE THREMOVE (T (THREMOVE THX)))) @@ -381,7 +350,7 @@ FEXPR (X) ((LAMBDA (X) (AND X (NOT (EQ (CADR X) (QUOTE THUNASSIGNED))))) - (THGAL (CAR X) THALIST))) + (THGAL (CARX X) THALIST))) (DEFUN THBA @@ -393,7 +362,7 @@ (SETQ THP TH2) THP1 (AND (EQ (COND (THPC (CADR THP)) (T (CAADR THP))) TH1) (RETURN THP)) - (OR (CDR (SETQ THP (CDR THP))) (RETURN NIL)) + (OR (CDRX (SETQ THP (CDRX THP))) (RETURN NIL)) (GO THP1))) (DEFUN THBAP @@ -404,7 +373,7 @@ (SETQ THP TH2) THP1 (AND (EQUAL (COND (THPC (CADR THP)) (T (CAADR THP))) TH1) (RETURN THP)) - (OR (CDR (SETQ THP (CDR THP))) (RETURN NIL)) + (OR (CDRX (SETQ THP (CDRX THP))) (RETURN NIL)) (GO THP1))) (DEFUN THBIND @@ -430,13 +399,13 @@ ;;OTHERWISE ADD TO THE ALIST THE NEW BINDING CELL (THPUSH THALIST - (COND ((ATOM (CAR A)) + (COND ((ATOM (CARX A)) ;;THE FIRST ELEMENT IS THE NAME OF THE VARIABLE ;;IF THE ENTRY IS AN ATOM, THEN WE ARE JUST GIVEN THE ;;VARIABLE AND ITS INITIAL ASSIGNMENT IS "THUNASSIGNED" ;;I.E., NO INITIAL ASSIGNMENT - (LIST (CAR A) (QUOTE THUNASSIGNED))) + (LIST (CARX A) (QUOTE THUNASSIGNED))) ;;OTHERWISE OUR ENTRY IS A LIST ;;IF THE FIRST ELEMENT OF THE LIST IS $R OR THRESTRICT @@ -449,13 +418,13 @@ ;;INITIAL ASSIGNMENT, SO MAKE THE SECOND ELEMENT OF THE ;;BINDING CELL A POINTER TO THE INITIAL ASSIGNMENT (T (LIST (CAAR A) (EVAL (CADAR A)))))) - (SETQ A (CDR A)) + (SETQ A (CDRX A)) ;;REPEAT FOR THE NEXT VARIABLE IN THE LIST (GO GO)))) (DEFUN THBI1 (X) (COND ((ATOM X) (LIST X (QUOTE THUNASSIGNED))) - (T (LIST (CAR X) (EVAL (CADR X)))))) + (T (LIST (CARX X) (EVAL (CADR X)))))) (DEFUN THBKPT FEXPR (L) (OR (AND THTRACE (THTRACES (QUOTE THBKPT) L)) THVALUE)) @@ -465,7 +434,7 @@ ;;THBRANCH IS CALLED BY THPROGT ;;AND WE ARE SUCCEEDING BACKWARDS - ;;CAR THTREE IS THE THPROG MARKING + ;;CARX THTREE IS THE THPROG MARKING (COND ;;THERE ARE NO MORE EXPRESSIONS TO EXECUTE IN THE THPROG ((NOT (CDADAR THTREE))) ((EQ THBRANCH THTREE) (SETQ THBRANCH NIL)) @@ -502,7 +471,7 @@ ;;WILL REVEAL THAT ALL WE ARE DOING HERE IS RESTORING ;;THE PROG MARK TO IS STATE BEFORE THE LAST SUCCESS (RPLACA (CDAR THTREE) (CADDAR X)) - (RPLACA (CDDAR THTREE) (CDR X)) + (RPLACA (CDDAR THTREE) (CDRX X)) ;;RESET THALIST AND THTREE (SETQ THALIST (CADAR X)) @@ -523,7 +492,7 @@ (DEFUN THCONDT NIL - (RPLACA (CAR THTREE) (QUOTE THAND)) + (RPLACA (CARX THTREE) (QUOTE THAND)) (RPLACA (CDAR THTREE) (CAADAR THTREE)) THVALUE) @@ -534,14 +503,14 @@ (DEFUN THDATA NIL (PROG (X) GO (TERPRI) (COND ((NULL (SETQ X (READ NIL))) (RETURN T)) - ((PRINT (THADD (CAR X) (CDR X))))) + ((PRINT (THADD (CARX X) (CDRX X))))) (GO GO))) (COMMENT THDEF DEFINES AND OPTIONALLY ASSERTS THEOREMS) (DEFUN THDEF (THMTYPE THX) (PROG (THNOASSERT? THMNAME THMBODY) - (COND ((NOT (ATOM (CAR THX))) + (COND ((NOT (ATOM (CARX THX))) (SETQ THMBODY THX) (COND ((EQ THMTYPE (QUOTE THCONSE)) (SETQ THMNAME (THGENAME TC-G))) @@ -549,10 +518,10 @@ (SETQ THMNAME (THGENAME TA-G))) ((EQ THMTYPE (QUOTE THERASING)) (SETQ THMNAME (THGENAME TE-G))))) - ((SETQ THMNAME (CAR THX)) (SETQ THMBODY (CDR THX)))) ;THNOOASSERT FEATURE - (COND ((EQ (CAR THMBODY) (QUOTE THNOASSERT)) + ((SETQ THMNAME (CARX THX)) (SETQ THMBODY (CDRX THX)))) ;THNOOASSERT FEATURE + (COND ((EQ (CARX THMBODY) (QUOTE THNOASSERT)) (SETQ THNOASSERT? T) - (SETQ THMBODY (CDR THMBODY)))) + (SETQ THMBODY (CDRX THMBODY)))) (THPUTPROP THMNAME (CONS THMTYPE THMBODY) (QUOTE THEOREM)) (COND (THNOASSERT? @@ -567,7 +536,7 @@ (A) (OR (NOT A) (PROG2 (THPUSH THTREE (LIST (QUOTE THDO) A NIL NIL)) - (SETQ THEXP (CAR A))))) + (SETQ THEXP (CARX A))))) (DEFUN THDO1 NIL @@ -578,10 +547,10 @@ (SETQ THBRANCH NIL) (RPLACA (CDDDAR THTREE) (CONS THABRANCH - (CAR (CDDDAR THTREE))))))) + (CARX (CDDDAR THTREE))))))) (DEFUN THDOB NIL (COND ((OR THMESSAGE (NULL (CDADAR THTREE))) - (RPLACA (CAR THTREE) (QUOTE THUNDO)) + (RPLACA (CARX THTREE) (QUOTE THUNDO)) T) ((THDO1)))) @@ -615,17 +584,17 @@ (THA) (AND THA (PROG (THTREE1 THA1 THX) - F (SETQ THA1 (COND ((EQ (CAR THA) (QUOTE THEOREM)) + F (SETQ THA1 (COND ((EQ (CARX THA) (QUOTE THEOREM)) (QUOTE THPROG)) - ((EQ (CAR THA) (QUOTE THTAG)) + ((EQ (CARX THA) (QUOTE THTAG)) (QUOTE THPROG)) - ((EQ (CAR THA) (QUOTE THINF)) + ((EQ (CARX THA) (QUOTE THINF)) (SETQ THINF T) (RETURN NIL)) - ((EQ (CAR THA) (QUOTE THMESSAGE)) + ((EQ (CARX THA) (QUOTE THMESSAGE)) (SETQ THMESSAGE (CADR THA)) (RETURN NIL)) - (T (CAR THA)))) + (T (CARX THA)))) (SETQ THTREE1 THTREE) LP1 (COND ((NULL THTREE1) (PRINT THA) @@ -636,24 +605,24 @@ (RETURN THA)) (T (GO F)))) ((EQ (CAAR THTREE1) THA1) (GO ELP1))) - ALP1 (SETQ THTREE1 (CDR THTREE1)) + ALP1 (SETQ THTREE1 (CDRX THTREE1)) (GO LP1) - ELP1 (COND ((EQ (CAR THA) (QUOTE THTAG)) + ELP1 (COND ((EQ (CARX THA) (QUOTE THTAG)) (COND ((MEMQ (CADR THA) - (CADDDR (CAR THTREE1))) + (CADDDR (CARX THTREE1))) (GO TAGS)) (T (GO ALP1))))) - (SETQ THMESSAGE (LIST (CDR THTREE1) - (AND (CDR THA) (CADR THA)))) + (SETQ THMESSAGE (LIST (CDRX THTREE1) + (AND (CDRX THA) (CADR THA)))) (RETURN NIL) TAGS (SETQ THX (CADDAR THTREE1)) LP2 (COND ((NULL THX) (GO ALP1)) - ((EQ (CAADDR (CAR THX)) (CADR THA)) + ((EQ (CAADDR (CARX THX)) (CADR THA)) (SETQ THMESSAGE (LIST (CAAR THX) (AND (CDDR THA) (CADDR THA)))) (RETURN NIL))) - (SETQ THX (CDR THX)) + (SETQ THX (CDRX THX)) (GO LP2)))) (DEFUN THFAIL? @@ -676,34 +645,34 @@ (COND ((NULL THA) (SETQ THA (THERT BAD CALL - THFINALIZE)))) (COND ((ATOM THA) (RETURN THA)) - ((EQ (CAR THA) (QUOTE THTAG)) + ((EQ (CARX THA) (QUOTE THTAG)) (SETQ THT (CADR THA))) - ((EQ (CAR THA) (QUOTE THEOREM)) + ((EQ (CARX THA) (QUOTE THEOREM)) (SETQ THA (LIST (QUOTE THPROG))))) (SETQ THTREE (SETQ THTREE1 (CONS NIL THTREE))) PLUP (SETQ THX (CADR THTREE1)) - (COND ((NULL (CDR THTREE1)) (PRINT THA) + (COND ((NULL (CDRX THTREE1)) (PRINT THA) (THERT OVERPOP - THFINALIZE)) ((AND THT - (EQ (CAR THX) (QUOTE THPROG)) + (EQ (CARX THX) (QUOTE THPROG)) (MEMQ THT (CADDDR THX))) (GO RTLEV)) - ((OR (EQ (CAR THX) (QUOTE THPROG)) - (EQ (CAR THX) (QUOTE THAND))) + ((OR (EQ (CARX THX) (QUOTE THPROG)) + (EQ (CARX THX) (QUOTE THAND))) (RPLACA (CDDR THX) NIL) - (SETQ THTREE1 (CDR THTREE1))) - ((EQ (CAR THX) (QUOTE THREMBIND)) - (SETQ THTREE1 (CDR THTREE1))) + (SETQ THTREE1 (CDRX THTREE1))) + ((EQ (CARX THX) (QUOTE THREMBIND)) + (SETQ THTREE1 (CDRX THTREE1))) ((RPLACD THTREE1 (CDDR THTREE1)))) - (COND ((EQ (CAR THX) (CAR THA)) (GO DONE))) + (COND ((EQ (CARX THX) (CARX THA)) (GO DONE))) (GO PLUP) RTLEV(SETQ THX (CDDR THX)) - LEVLP(COND ((NULL (CAR THX)) (SETQ THTREE1 (CDR THTREE1)) + LEVLP(COND ((NULL (CARX THX)) (SETQ THTREE1 (CDRX THTREE1)) (GO PLUP)) ((EQ (CAADDR (CAAR THX)) THT) (GO DONE))) (RPLACA THX (CDAR THX)) (GO LEVLP) - DONE (SETQ THTREE (CDR THTREE)) + DONE (SETQ THTREE (CDRX THTREE)) (RETURN T))) (DEFUN THFIND @@ -712,10 +681,10 @@ (THBIND (CADDR THA)) (THPUSH THTREE (LIST (QUOTE THFIND) - (COND ((EQ (CAR THA) 'ALL) ' (1. NIL NIL)) ;STANDARD ALL - ((NUMBERP (CAR THA)) - (LIST (CAR THA) (CAR THA) T)) ;SINGLE NUMBER - ((NUMBERP (CAAR THA)) (CAR THA)) ;WINOGRAD CROCK FORMAT + (COND ((EQ (CARX THA) 'ALL) ' (1. NIL NIL)) ;STANDARD ALL + ((NUMBERP (CARX THA)) + (LIST (CARX THA) (CARX THA) T)) ;SINGLE NUMBER + ((NUMBERP (CAAR THA)) (CARX THA)) ;WINOGRAD CROCK FORMAT ((EQ (CAAR THA) 'EXACTLY) (LIST (CADAR THA) (ADD1 (CADAR THA)) NIL)) ((EQ (CAAR THA) 'AT-MOST) @@ -725,9 +694,9 @@ (T (CONS (CADAR THA) ;ONLY THING LEFT IS AT-LEAST (COND ((NULL (CDDAR THA)) (LIST NIL T)) ;NO AT-MOST ((EQ (CADDAR THA) 'AT-MOST) - (LIST (ADD1 (CAR (CDDDAR THA))) + (LIST (ADD1 (CARX (CDDDAR THA))) NIL)) - (T (LIST (CAR (CDDDAR THA)) + (T (LIST (CARX (CDDDAR THA)) T)))))) (CONS 0. NIL) (CADR THA))) @@ -786,7 +755,7 @@ (DEFUN THGENAME FEXPR ;GENERATES UNIQUE NAME WITH ARG AS PREFIX (X) - (READLIST (NCONC (EXPLODE (CAR X)) + (READLIST (NCONC (EXPLODE (CARX X)) (EXPLODE (SETQ THGENAME (ADD1 THGENAME)))))) (DEFUN THGO FEXPR (X) (APPLY (QUOTE THSUCCEED) @@ -796,8 +765,8 @@ FEXPR (THA) ;THA = (PATTERN RECOMMENDATION) (PROG (THY THY1 THZ THZ1 THA1 THA2) ;PATTERN IS EITHER EXPLICIT, THE VALUE OF A - (SETQ THA2 (THVARSUBST (CAR THA) T)) ;PLANNER VARIABLE OR THVAL OF $E... THA2 = - (SETQ THA1 (CDR THA)) ;INSTANTIATED PATTERN THA1 = RECOMMENDATIONS + (SETQ THA2 (THVARSUBST (CARX THA) T)) ;PLANNER VARIABLE OR THVAL OF $E... THA2 = + (SETQ THA1 (CDRX THA)) ;INSTANTIATED PATTERN THA1 = RECOMMENDATIONS (COND ((OR (NULL THA1) ;SHOULD DATA BASE BE SEARCHED TRYED IF NO RECS (AND (NOT (AND (EQ (CAAR THA1) 'THANUM) (SETQ THA1 @@ -805,9 +774,9 @@ (CADAR THA1)) (CONS (LIST 'THDBF 'THTRUE) - (CDR THA1)))))) + (CDRX THA1)))))) (NOT (AND (EQ (CAAR THA1) (QUOTE THNODB)) ;TRIED IF REC NOT THNODB OR (THDBF PRED) - (PROG2 (SETQ THA1 (CDR THA1)) T))) + (PROG2 (SETQ THA1 (CDRX THA1)) T))) (NOT (EQ (CAAR THA1) (QUOTE THDBF))))) (SETQ THA1 (CONS (LIST (QUOTE THDBF) (QUOTE THTRUE)) THA1)))) @@ -882,7 +851,7 @@ ;;IF THE PROPERTY IS "THNOHASH" IT MEANS THAT WE ;;SHOULD NOT BOTHER TO INDEX UNDER THIS ATOM, SO ;;JUST RETURN TO THADD - ((NOT (SETQ THT2 (ASSQ THNF (CDR THT1)))) + ((NOT (SETQ THT2 (ASSQ THNF (CDRX THT1)))) ;;LOOK ON THE PROPERTY LIST ENTRY TO SEE ;;IF THERE IS A SUB-ENTRY FOR PATTERNS WITH THIS ATOM ;;IN THE THNF'TH POSITION @@ -891,7 +860,7 @@ ;;BEEN ASSERTED BEFORE (NCONC THT1 (LIST (LIST THNF (LIST THLAS 1. THTTL))))) - ((NOT (SETQ THT3 (ASSQ THLAS (CDR THT2)))) + ((NOT (SETQ THT3 (ASSQ THLAS (CDRX THT2)))) ;;NOW LOOK WITHIN THE SUB-ENTRY FOR A SUB-SUB-ENTRY. ;;I.E. THOSE PATTERNS WHICH ARE ALSO OF THE CORRECT @@ -922,8 +891,8 @@ ((SETQ THSV (CDDR THT3)) ;;HACK IN THE LATEST ENTRY INTO THE SUB-SUB-BUCKET - (RPLACA (CDR THT3) (ADD1 (CADR THT3))) - (RPLACD (CDR THT3) (NCONC (LIST THTTL) THSV)))) + (RPLACA (CDRX THT3) (ADD1 (CADR THT3))) + (RPLACD (CDRX THT3) (NCONC (LIST THTTL) THSV)))) ;;IF WE GET TO THIS POINT EVERYTHING ;;IS OK SO TELL THADD SO @@ -939,9 +908,9 @@ ;;THOLIST IS THE "THALIST" WHICH WAS IN EXISTANCE BEFORE ;;WE STARTED WORKING ON THE CURRENT LINE OF PLANNER CODE ;;STANDARD CHECK FOR $E - (AND (EQ (CAR THX) (QUOTE THEV)) + (AND (listp thx) (EQ (CAR THX) (QUOTE THEV)) (SETQ THX (THVAL (CADR THX) THOLIST))) - (AND (EQ (CAR THY) (QUOTE THEV)) + (AND (listp thy) (EQ (CAR THY) (QUOTE THEV)) (SETQ THY (THVAL (CADR THY) THALIST))) (COND @@ -952,8 +921,8 @@ ;;IF EITHER IS A VARIABLE THINGS GET MESSY. ;; EVERYTHING DOWN TO ***** IS ;;CONCERNED WITH THIS CASE - ((OR (MEMQ (CAR THX) (QUOTE (THV THNV THRESTRICT))) - (MEMQ (CAR THY) (QUOTE (THV THNV THRESTRICT)))) + ((OR (and (listp thx) (MEMQ (CAR THX) (QUOTE (THV THNV THRESTRICT)))) + (and (listp thy) (MEMQ (CAR THY) (QUOTE (THV THNV THRESTRICT))))) ((LAMBDA (XPAIR YPAIR) ;;X AND Y PAIR ARE THE RESPECTIVE BINDING CELLS WHICH @@ -964,8 +933,8 @@ ;;THX IS A VARIABLE ;;THIS SEES IF THX IS UNASSIGNED - (OR (EQ (CAR THX) (QUOTE THNV)) - (AND (EQ (CAR THX) (QUOTE THV)) + (OR (and (listp thx) (EQ (CAR THX) (QUOTE THNV))) + (AND (listp thx) (EQ (CAR THX) (QUOTE THV)) (EQ (CADR XPAIR) (QUOTE THUNASSIGNED)))) ;;THCHECK MACKES SURE THE RESTRICTIONS (IF ANY) ON @@ -975,27 +944,27 @@ ;;FURTHERMORE, THY IS ALSO A VARIABLE ;;THIS MEANS WE MUST DO THE MYSTERIOUS VARIABLE LINKING - (COND (YPAIR (THRPLACAS (CDR XPAIR) (CADR YPAIR)) + (COND (YPAIR (THRPLACAS (CDRX XPAIR) (CADR YPAIR)) ;;IF THY ALSO HAS RESTRICTIONS, WHEN WE ;;LINK VARIABLES WE COMBINE RESTRICTIONS (AND (CDDR YPAIR) - (THRPLACDS (CDR XPAIR) + (THRPLACDS (CDRX XPAIR) (THUNION (CDDR XPAIR) (CDDR YPAIR)))) - (THRPLACDS YPAIR (CDR XPAIR))) + (THRPLACDS YPAIR (CDRX XPAIR))) ;;IF THY IS NOT A VARIALBE, JUST ASSIGN THX TO THY ;;THRPLACAS WILL HACK THML THE FREE VARIABLE FROM THMATCH1 - (T (THRPLACAS (CDR XPAIR) THY)))) + (T (THRPLACAS (CDRX XPAIR) THY)))) ;;IN THIS COND PAIR THY IS A VARIABLE AND THX IS EITHER ;;A CONSTANT OR A PREVIOUSLY ASSIGNED VARIALBE ((AND YPAIR - (OR (EQ (CAR THY) (QUOTE THNV)) + (OR (and (listp thy) (EQ (CAR THY) (QUOTE THNV))) ;;FURTHERMORE THY IS UNASSIGNED - (AND (EQ (CAR THY) (QUOTE THV)) + (AND (listp thy) (EQ (CAR THY) (QUOTE THV)) (EQ (CADR YPAIR) (QUOTE THUNASSIGNED)))) ;;MAKE SURE RESTRICTIONS ARE OK @@ -1003,10 +972,10 @@ (COND (XPAIR (CADR XPAIR)) (T THX)))) ;;IF THX IS A VARIABLE, LINK - (COND (XPAIR (THRPLACAS (CDR YPAIR) (CADR XPAIR))) + (COND (XPAIR (THRPLACAS (CDRX YPAIR) (CADR XPAIR))) ;;OTHERWISE JUST ASSIGN THY TO THX - (T (THRPLACAS (CDR YPAIR) THX)))) + (T (THRPLACAS (CDRX YPAIR) THX)))) ;;THX IS AN ASSIGED VARIABLE, SO JUST MAKE ;;SURE ITS ASSIGNEMENT IS EQUAL TO THY @@ -1029,7 +998,7 @@ ;;WE MUST HACK A NEW RESTRICTION ONTO THE ;;BINDING LIST - ((EQ (CAR THX) (QUOTE THRESTRICT)) + ((and (listp thx) (EQ (CAR THX) (QUOTE THRESTRICT))) ;;WE ARE "RESTRICTING" A ?. SINCE ? HAS NO ;;BINDING LIST, WE MAKE UP A PSEUDO BINDING LIST @@ -1043,7 +1012,7 @@ ;;WE ARE RESTRICTING A VARIABLE. THIS MEANS THAT ;;WE MUST PUT IN ON THE BINDING LIST (T ((LAMBDA (U) - (THRPLACDS (CDR U) + (THRPLACDS (CDRX U) ;;THUNION MAKES SURE WE DON'T PUT THE SAME RESTRICTION ON TWICE (THUNION (CDDR U) (CDDR THX))) @@ -1056,7 +1025,7 @@ ;;WE DO THE EXACT SAME THING FOR THY AS WE JUST DID FOR THX ;; (COND ((THVAR THY) (THGAL THY THALIST)) - ((EQ (CAR THY) (QUOTE THRESTRICT)) + ((and (listp thy) (EQ (CAR THY) (QUOTE THRESTRICT))) (COND ((EQ (CADR THY) (QUOTE ?)) (PROG2 0. (CONS (QUOTE ?) @@ -1064,7 +1033,7 @@ (APPEND (CDDR THY) NIL))) (SETQ THY (QUOTE (THNV ?))))) (T ((LAMBDA (U) - (THRPLACDS (CDR U) + (THRPLACDS (CDRX U) (THUNION (CDDR U) (CDDR THY))) (SETQ THY (CADR THY)) U) @@ -1115,7 +1084,7 @@ ;;WE HAVE TO CHECK THAT THE PATTERN AND CANDIDATE ;;ARE OF THE SAME LENGTH SINCE THE USER MAY HAVE ;;SPECIFIED THE CANDIDATE WITH A "THUSE" RECOMMENDATION - (COND ((AND (= (LENGTH (COND ((EQ (CAR THX) + (COND ((AND (= (LENGTH (COND ((EQ (CARX THX) (QUOTE THEV)) (SETQ THX (THVAL (CADR THX) @@ -1176,10 +1145,10 @@ (SETQ THNF (ADD1 THNF)) ;;THB2 IS THE ITEM WE ARE WORKING ON IN THIS PASS - (SETQ THB2 (CAR THB1)) + (SETQ THB2 (CARX THB1)) ;;UPDATE THB1 - (SETQ THB1 (CDR THB1)) + (SETQ THB1 (CDRX THB1)) THP3 (COND ((OR (NULL (ATOM THB2)) ;;IF THE ITEM IS NOT A NORMAL ATOM, SKIP IT AND @@ -1206,11 +1175,11 @@ ;;SAME IF THERE IS NO SUB-BUCKET FOR THE ATOM ;;IN THE CORRECT POSITION - ((NOT (SETQ THA1 (ASSQ THNF (CDR THA1)))) + ((NOT (SETQ THA1 (ASSQ THNF (CDRX THA1)))) (SETQ THA1 (QUOTE (0. 0.)))) ;;SAME FOR SUB-SUB-BUCKET (PATTERN LENGTH) - ((NOT (SETQ THA1 (ASSQ THAL (CDR THA1)))) + ((NOT (SETQ THA1 (ASSQ THAL (CDRX THA1)))) (SETQ THA1 (QUOTE (0. 0.))))) (SETQ THRN (CADR THA1)) (SETQ THA1 (CDDR THA1)) @@ -1223,9 +1192,9 @@ ;;HAVE A VARIABLE IN THE CORRECT POSSITION (COND ((NOT (SETQ THA2 (GET (QUOTE THVRB) THWH))) (SETQ THA2 (QUOTE (0. 0.)))) - ((NOT (SETQ THA2 (ASSQ THNF (CDR THA2)))) + ((NOT (SETQ THA2 (ASSQ THNF (CDRX THA2)))) (SETQ THA2 (QUOTE (0. 0.)))) - ((NOT (SETQ THA2 (ASSQ THAL (CDR THA2)))) + ((NOT (SETQ THA2 (ASSQ THAL (CDRX THA2)))) (SETQ THA2 (QUOTE (0. 0.))))) (SETQ THRVC (CADR THA2)) (SETQ THA2 (CDDR THA2)) @@ -1265,7 +1234,7 @@ THVALUE) (DEFUN THMESSAGEF NIL (PROG (BOD) - (SETQ BOD (CAR THTREE)) + (SETQ BOD (CARX THTREE)) (THPOPT) (COND ((AND (THBIND (CADR BOD)) (THMATCH1 (CADDR BOD) @@ -1291,23 +1260,23 @@ (DEFUN THNOHASH FEXPR (THA) - (MAPC (FUNCTION (LAMBDA (X) (PUTPROP (CAR THA) + (MAPC (FUNCTION (LAMBDA (X) (PUTPROP (CARX THA) (QUOTE THNOHASH) X))) - (OR (CDR THA) + (OR (CDRX THA) (QUOTE (THASSERTION THCONSE THANTE THERASING))))) (DEFUN THNOT FEXPR (THA) (SETQ THEXP (LIST (QUOTE THCOND) - (LIST (CAR THA) + (LIST (CARX THA) (QUOTE (THFAIL THAND))) (QUOTE ((THSUCCEED)))))) -(DEFUN THNV FEXPR (X) (THV1 (CAR X))) +(DEFUN THNV FEXPR (X) (THV1 (CARX X))) (DEFUN THOR FEXPR (THA) (AND THA (THPUSH THTREE (LIST (QUOTE THOR) THA)) - (SETQ THEXP (CAR THA)))) + (SETQ THEXP (CARX THA)))) (DEFUN THOR2 (P) (COND (THMESSAGE (THPOPT) NIL) ((AND (CADAR THTREE) (CDADAR THTREE)) @@ -1316,14 +1285,14 @@ (CAADAR THTREE) (OR (CADAR THTREE) (THPOPT)))) - ((CAR (CAADAR THTREE)))))) + ((CARX (CAADAR THTREE)))))) (T (THPOPT) NIL))) (DEFUN THORF NIL (THOR2 T)) (DEFUN THORT NIL (THPOPT) THVALUE) -(DEFUN THPOPT NIL (SETQ THTREE (CDR THTREE))) +(DEFUN THPOPT NIL (SETQ THTREE (CDRX THTREE))) (DEFUN THPROG FEXPR @@ -1331,7 +1300,7 @@ ;;THBIND HACKS THALIST TO BIND THE VARIABLES ;;IT ALSO HACKS THTREE SO WE CAN UNDO IT IF NEEDED - (THBIND (CAR THA)) + (THBIND (CARX THA)) ;;PUT THPROG MARK ON THTREE ;;THE FIRST THA IS A POINTER ONE BEFORE @@ -1425,7 +1394,7 @@ (NOT (NUMBERP THB))) (SETQ THA THB)) ((OR (EQ THB (QUOTE ?)) - (MEMQ (CAR THB) (QUOTE (THV THNV)))) + (and (listp thb) (MEMQ (CAR THB) (QUOTE (THV THNV))))) (COND (THFST (RETURN (QUOTE THVRB))) ((SETQ THA (QUOTE THVRB))))) ((RETURN (QUOTE THVRB)))) @@ -1445,22 +1414,22 @@ (SETQ THA4 (CADR THA3)) (SETQ THPC (NOT (EQ THWH (QUOTE THASSERTION)))) (SETQ THA5 - (COND ((OR THFST THFSTP) (THBAP THBS (CDR THA4))) - ((THBA (COND (THPC THON) (T (CAR THON))) - (CDR THA4))))) + (COND ((OR THFST THFSTP) (THBAP THBS (CDRX THA4))) + ((THBA (COND (THPC THON) (T (CARX THON))) + (CDRX THA4))))) (OR THA5 (RETURN NIL)) (SETQ THONE (CADR THA5)) (RPLACD THA5 (CDDR THA5)) (AND (NOT (= (CADR THA4) 1.)) (OR (SETQ THSV (CDDR THA4)) T) - (RPLACA (CDR THA4) (SUB1 (CADR THA4))) + (RPLACA (CDRX THA4) (SUB1 (CADR THA4))) (RETURN THONE)) (SETQ THSV (CDDR THA3)) (RPLACD THA3 THSV) (AND (CDADR THA2) (RETURN THONE)) (SETQ THSV (CDDR THA2)) (RPLACD THA2 THSV) - (AND (CDR THA1) (RETURN THONE)) + (AND (CDRX THA1) (RETURN THONE)) (REMPROP THA THWH) (RETURN THONE))) @@ -1491,7 +1460,7 @@ (COND ((ATOM THB) (SETQ THBS THB) (SETQ THWH - (CAR (SETQ THB1 + (CARX (SETQ THB1 (GET THB (QUOTE THEOREM))))) (CADDR THB1)) @@ -1504,17 +1473,17 @@ (SETQ THFST (SETQ THFOO NIL)) (SETQ THFSTP T) (GO THP1)) - ((NULL (SETQ THON (THREM1 (CAR THB1)))) + ((NULL (SETQ THON (THREM1 (CARX THB1)))) (RETURN NIL)) ((MEMQ THON (QUOTE (THBQF THVRB))) (SETQ THFOO (NCONC THFOO (LIST (COND ((EQ THON (QUOTE THVRB)) - (CAR THB1)))))) - (SETQ THB1 (CDR THB1)) + (CARX THB1)))))) + (SETQ THB1 (CDRX THB1)) (GO THP1))) (SETQ THFST NIL) - (MAPC (FUNCTION THREM1) (CDR THB1)) + (MAPC (FUNCTION THREM1) (CDRX THB1)) (SETQ THNF 0.) (MAPC (FUNCTION THREM1) THFOO) (RETURN THON))) @@ -1533,9 +1502,9 @@ FEXPR (THB) (PROG (X) - (COND ((ATOM (SETQ X (THGAL (CAR THB) THALIST))) + (COND ((ATOM (SETQ X (THGAL (CARX THB) THALIST))) (THPRINTC 'THRESTRICT/ IGNORED/ -/ CONTINUING)) - ((THRPLACD (CDR X) (THUNION (CDDR X) (CDR THB))))) + ((THRPLACD (CDRX X) (THUNION (CDDR X) (CDRX THB))))) (RETURN X))) (DEFUN THRETURN FEXPR (X) (APPLY (QUOTE THSUCCEED) @@ -1548,10 +1517,10 @@ (DEFUN THRPLACAS (X Y) - (THPUSH THML (LIST (QUOTE THURPLACA) X (CAR X))) + (THPUSH THML (LIST (QUOTE THURPLACA) X (CARX X))) (RPLACA X Y)) -(DEFUN THURPLACA FEXPR (L) (RPLACA (CAR L) (CADR L))) +(DEFUN THURPLACA FEXPR (L) (RPLACA (CARX L) (CADR L))) (DEFUN THRPLACD (X Y) (PROG (THML) (THRPLACDS X Y) @@ -1560,10 +1529,10 @@ (DEFUN THRPLACDS (X Y) - (THPUSH THML (LIST (QUOTE THURPLACD) X (CDR X))) + (THPUSH THML (LIST (QUOTE THURPLACD) X (CDRX X))) (RPLACD X Y)) -(DEFUN THURPLACD FEXPR (L) (RPLACD (CAR L) (CADR L))) +(DEFUN THURPLACD FEXPR (L) (RPLACD (CARX L) (CADR L))) (DEFUN THSETQ FEXPR @@ -1573,16 +1542,16 @@ LOOP (COND ((NULL THL) (THPUSH THTREE (LIST (QUOTE THMUNG) THML)) (RETURN THVALUE)) - ((NULL (CDR THL)) + ((NULL (CDRX THL)) (PRINT THL1) (THERT ODD NUMBER OF GOODIES - THSETQ)) - ((ATOM (CAR THL)) + ((ATOM (CARX THL)) (THPUSH THML (LIST (QUOTE SETQ) - (CAR THL) + (CARX THL) (LIST (QUOTE QUOTE) - (EVAL (CAR THL))))) - (SET (CAR THL) (SETQ THVALUE (EVAL (CADR THL))))) - (T (THRPLACAS (CDR (THSGAL (CAR THL))) + (EVAL (CARX THL))))) + (SET (CARX THL) (SETQ THVALUE (EVAL (CADR THL))))) + (T (THRPLACAS (CDRX (THSGAL (CARX THL))) (SETQ THVALUE (THVAL (CADR THL) THALIST))))) (SETQ THL (CDDR THL)) @@ -1619,7 +1588,7 @@ (LAMBDA (THWH) (AND (SETQ THP (GET THATOM THWH)) - (SETQ THP (ASSOC 1. (CDR THP))) + (SETQ THP (ASSOC 1. (CDRX THP))) (MAPC (FUNCTION (LAMBDA (LENGTH-BUCKET) @@ -1630,7 +1599,7 @@ (PRINT ASRT)) ((PRINT (LIST ASRT)))))) (CDDR LENGTH-BUCKET)))) - (CDR THP))))) + (CDRX THP))))) (COND (THINDICATORS) (' (THASSERTION THANTE THCONSE THERASING)))))) BUCKET))) @@ -1642,8 +1611,8 @@ (THA) (OR (NOT THA) (PROG (THX) - (AND (EQ (CAR THA) (QUOTE THEOREM)) - (SETQ THA (CONS (QUOTE THPROG) (CDR THA)))) + (AND (EQ (CARX THA) (QUOTE THEOREM)) + (SETQ THA (CONS (QUOTE THPROG) (CDRX THA)))) (SETQ THBRANCH THTREE) (SETQ THABRANCH THALIST) LOOP (COND ((NULL THTREE) (PRINT THA) @@ -1652,14 +1621,14 @@ (SETQ THALIST (CADAR THTREE)) (THPOPT) (GO LOOP)) - ((EQ (CAAR THTREE) (CAR THA)) + ((EQ (CAAR THTREE) (CARX THA)) (THPOPT) - (RETURN (COND ((CDR THA) (EVAL (CADR THA))) + (RETURN (COND ((CDRX THA) (EVAL (CADR THA))) ((QUOTE THNOVAL))))) - ((AND (EQ (CAR THA) (QUOTE THTAG)) + ((AND (EQ (CARX THA) (QUOTE THTAG)) (EQ (CAAR THTREE) (QUOTE THPROG)) (SETQ THX (MEMQ (CADR THA) - (CADDDR (CAR THTREE))))) + (CADDDR (CARX THTREE))))) (RPLACA (CDAR THTREE) (CONS NIL THX)) (RETURN (THPROGT))) (T (THPOPT) (GO LOOP)))))) @@ -1668,30 +1637,30 @@ (XX) (COND ((ATOM XX) NIL) - ((EQ (CAR XX) (QUOTE THUSE)) + ((EQ (CARX XX) (QUOTE THUSE)) (MAPCAR (FUNCTION (LAMBDA (X) (COND ((NOT (AND (SETQ THXX (GET X (QUOTE THEOREM))) - (EQ (CAR THXX) TYPE))) + (EQ (CARX THXX) TYPE))) (PRINT X) (LIST 'THAPPLY (THERT BAD THEOREM /-THTAE) - (CAR THX))) - (T (LIST (QUOTE THAPPLY) X (CAR THX)))))) - (CDR XX))) - ((EQ (CAR XX) (QUOTE THTBF)) + (CARX THX))) + (T (LIST (QUOTE THAPPLY) X (CARX THX)))))) + (CDRX XX))) + ((EQ (CARX XX) (QUOTE THTBF)) (MAPCAN (FUNCTION (LAMBDA (Y) (COND ((funcall (CADR XX) Y) (LIST (LIST (QUOTE THAPPLY) Y - (CAR THX))))))) + (CARX THX))))))) (COND (THY1 THY) ((SETQ THY1 T) - (SETQ THY (THMATCHLIST (CAR THX) TYPE)))))) + (SETQ THY (THMATCHLIST (CARX THX) TYPE)))))) (T (PRINT XX) (THTAE (THERT UNCLEAR RECCOMMENDATION /-THTAE))))) -(DEFUN THTAG FEXPR (L) (AND (CAR L) +(DEFUN THTAG FEXPR (L) (AND (CARX L) (THPUSH THTREE - (LIST (QUOTE THTAG) (CAR L))))) + (LIST (QUOTE THTAG) (CARX L))))) (DEFUN THTAGF NIL (THPOPT) NIL) @@ -1702,14 +1671,14 @@ (DEFUN THTRY1 ;TRIES NEXT RECOMMENDATION ON TREE FOR THGOAL NIL (PROG (THX THY THZ THW THEOREM) - (SETQ THZ (CAR THTREE)) ;= (THGOAL PATTERN EXPANDED-RECOMMENDATIONS) + (SETQ THZ (CARX THTREE)) ;= (THGOAL PATTERN EXPANDED-RECOMMENDATIONS) (SETQ THY (CDDR THZ)) ;= RECOMMENDATIONS - (RPLACD THY (SUB1 (CDR THY))) + (RPLACD THY (SUB1 (CDRX THY))) NXTREC - (COND ((OR (NULL (CAR THY)) (ZEROP (CDR THY))) + (COND ((OR (NULL (CARX THY)) (ZEROP (CDRX THY))) (RETURN NIL))) ;RECOMMENDATIONS EXHAUSTED. FAIL (SETQ THX (CAAR THY)) - (GO (CAR THX)) + (GO (CARX THX)) THNUM(RPLACD THY (CADR THX)) (RPLACA THY (CDAR THY)) (GO NXTREC) @@ -1718,7 +1687,7 @@ (GO NXTREC)) ;NO MORE CANDIDATES SATISFYING THIS REC. ((PROG2 0. ;TRY NEXT REC (AND (funcall (CADR THX) (SETQ THW (CAADDR THX))) - (THMATCH1 (CADR THZ) (CAR THW))) + (THMATCH1 (CADR THZ) (CARX THW))) (RPLACA (CDDR THX) (CDADDR THX))) (RETURN THW)) (T (GO THDBF))) @@ -1728,7 +1697,7 @@ THTBF1 (COND ((NOT (AND (SETQ THW ;TRY NEXT REC (GET THEOREM (QUOTE THEOREM))) - (EQ (CAR THW) (QUOTE THCONSE)))) + (EQ (CARX THW) (QUOTE THCONSE)))) (PRINT THEOREM) (COND ((EQ (SETQ THEOREM (THERT BAD THEOREM - THTRY1)) @@ -1755,7 +1724,7 @@ ((ATOM X) NIL) ;;HAVE A THEOREM BASE FILTER - ((EQ (CAR X) (QUOTE THTBF)) + ((EQ (CARX X) (QUOTE THTBF)) ;;MAKE UP A LIST WHICH GIVES, 1 - THE INDICATOR "THTBF" ;; 2 - THE ACTUAL FILTER (THTRUE IS THE MOST COMMON) @@ -1764,15 +1733,15 @@ (COND (THZ (LIST (LIST 'THTBF (CADR X) THZ))) (T NIL))) ;;DO THE SAME THING, ONLY FOR DATA BASE FILTERS - ((EQ (CAR X) (QUOTE THDBF)) + ((EQ (CARX X) (QUOTE THDBF)) (COND ((NOT THY1) (SETQ THY1 T) (SETQ THY (THMATCHLIST THA2 'THASSERTION)))) (COND (THY (LIST (LIST 'THDBF (CADR X) THY))) (T NIL))) ;;THUSE STATEMENTS ARE TRANSLATED INTO THTBF THTRUE ;;STATEMENTS, WHICH THE "BUCKET" IS THE LIST GIVEN IN THE THUSE - ((EQ (CAR X) (QUOTE THUSE)) - (LIST (LIST (QUOTE THTBF) (QUOTE THTRUE) (CDR X)))) - ((EQ (CAR X) 'THNUM) (LIST X)) + ((EQ (CARX X) (QUOTE THUSE)) + (LIST (LIST (QUOTE THTBF) (QUOTE THTRUE) (CDRX X)))) + ((EQ (CARX X) 'THNUM) (LIST X)) (T (PRINT X) (THTRY (THERT UNCLEAR RECOMMENDATION - THTRY))))) (DEFUN THUNDOF @@ -1780,7 +1749,7 @@ (COND ((NULL (CADDAR THTREE)) (THPOPT)) (T (SETQ THXX (CDDAR THTREE)) (SETQ THALIST (CAADR THXX)) - (RPLACA (CDR THXX) (CDADR THXX)) + (RPLACA (CDRX THXX) (CDADR THXX)) (SETQ THTREE (CAAR THXX)) (RPLACA THXX (CDAR THXX)))) NIL) @@ -1795,8 +1764,8 @@ (SETQ X THALIST) LP (COND ((NULL X) (THPUSH THALIST THA) (RETURN T)) ((EQ (CAAR X) (QUOTE THUNIQUE)) - (COND ((EQUAL (CAR X) THA) (RETURN NIL))))) - (SETQ X (CDR X)) + (COND ((EQUAL (CARX X) THA) (RETURN NIL))))) + (SETQ X (CDRX X)) (GO LP))) (DEFUN THV1 @@ -1817,7 +1786,7 @@ (DEFUN THV FEXPR (X) ;(THV X) IS THE VALUE OF THE PLANNER VARIABLE - (THV1 (CAR X))) ;$?X + (THV1 (CARX X))) ;$?X (DEFUN THVAL @@ -1857,8 +1826,8 @@ ;;THAT EACH PLANNER FUNCTION CORESPONDS TO THREE LISP FUNCTIONS ;;ONE TO SET THINGS UP (THIS IS WHAT IS GETTING EVALED AT THIS POINT ;;ONE TO HANDLE SUCCESS AND ONE FOR FAILURE - (COND ((ERRSET (SETQ THVALUE (EVAL THE)))) - + (COND ;((ERRSET (SETQ THVALUE (EVAL THE)))) + ((progn (setq thvalue (eval the)) t)) ;;IF THERE WAS A LISP ERROR, REPORT IT TO THE USER (T (PRINT THE) (SETQ THVALUE (THERT LISPERROR - THVAL)))) @@ -1892,7 +1861,7 @@ ;;ALL THEOREMS ACT LIKE A THPROG, INCLUDING PUTTING ;;ITS MARK ON THTREE SEE THAPPLY ;;HENCE NO NEED TO GROW MORE BRANCHES ON THTREE - (COND ((NULL THTREE) (SETQ THLEVEL (CDR THLEVEL)) + (COND ((NULL THTREE) (SETQ THLEVEL (CDRX THLEVEL)) (RETURN THVALUE)) ;;THIS IS THE NORMAL CASE. WE EVAL THE SUCCEED-FUNCTION @@ -1905,14 +1874,14 @@ ((GO FAIL))) ;;HAS TO DO WITH FAILURE + MESSAGE - MFAIL(COND ((EQ (CAR THMESSAGE) THTREE) + MFAIL(COND ((EQ (CARX THMESSAGE) THTREE) (SETQ THEXP (CADR THMESSAGE)) (SETQ THMESSAGE NIL) (GO GO))) FAIL (COND (THSTEPF (EVAL THSTEPF))) ;;IF THTREE IS NIL WE HAVE FAILED THE ENTIRE EXPRESSION - (COND ((NULL THTREE) (SETQ THLEVEL (CDR THLEVEL)) + (COND ((NULL THTREE) (SETQ THLEVEL (CDRX THLEVEL)) (RETURN NIL)) ;;NORMAL CASE, EVAL THE FAILURE FUNCTION ASSOCIATED @@ -1936,7 +1905,7 @@ (DEFUN THVAR (X) ;PREDICATE - IS ITS INPUT A PLANNER VARIABLE - (MEMQ (CAR X) (QUOTE (THV THNV)))) + (and (listp x) (MEMQ (CARX X) (QUOTE (THV THNV))))) (DEFUN THVARS2 @@ -1948,7 +1917,7 @@ (AND (ATOM X) (RETURN X)) ;;IF ITS AN ATOM NOTHING NEED BE DONE - (AND (EQ (CAR X) (QUOTE THEV)) + (AND (EQ (CARX X) (QUOTE THEV)) (SETQ X (THVAL (CADR X) THALIST))) ;;IF THE EXPRESSION HAS A $E BEFORE IT, THVAL BEFORE GOING ON @@ -1965,7 +1934,7 @@ ;;IF THE VARIABLE IS UNASSIGNED ;;THEN RETURN THE ACTUAL VARIABLE - ((AND THY (EQ (CAR X) 'THNV)) + ((AND THY (EQ (CARX X) 'THNV)) ;;THY WILL BE T JUST IN THE CASES ;;WHERE THVARSUBST WAS CALLED BY A THGOAL SITUATION @@ -1973,7 +1942,7 @@ ;;THUNASSIGNED SO THAT IF THE SAME VARIABLE IS USED ;;TWICE IN THE SAME PATTERN WE WON'T PUT ;;IN ITS OLD VALUE THE SECOND TIME IT IS ENCOUNTERED - (THRPLACA (CDR A) 'THUNASSIGNED) + (THRPLACA (CDRX A) 'THUNASSIGNED) X) ;;OTHERWISE THE ASSIGNMENT IS THE SECOND ELEMENT @@ -1987,9 +1956,9 @@ ;;THIS FUNCTION RETURNS THE SAME PATTERN, EXCEPT ;;IN PLACE OF ALL ASSIGNED VARIABLES WILL BE THE ;;VALUES THEY ARE ASSIGNED TO - (COND ((EQ (CAR THX) (QUOTE THEV)) + (COND ((EQ (CARX THX) (QUOTE THEV)) - ;;IF THE CAR IS THEV IT MEANS THAT THERE WAS + ;;IF THE CARX IS THEV IT MEANS THAT THERE WAS ;;A $E BEFORE THE PATTERN, IN WHICH CASE WE ;;ARE TO GET THE REAL PATTERN BY THVALUATING WHAT ;;IS THERE @@ -2009,11 +1978,11 @@ (PROG (A) (SETQ A THA) LOOP (COND ((NULL A) (RETURN THVALUE)) - ((NULL (CDR A)) + ((NULL (CDRX A)) (PRINT THA) (THERT ODD NUMBER OF GOODIES-THSETQ)) (T (SETQ THVALUE - (CAR (RPLACA (CDR (THSGAL (CAR A))) + (CARX (RPLACA (CDRX (THSGAL (CARX A))) (THVAL (CADR A) THALIST)))))) (SETQ A (CDDR A)) (GO LOOP))) @@ -2121,7 +2090,7 @@ (RETURN (EVAL (CADR /0LISTEN)))) (THLEVEL (PRINT (EVAL /0LISTEN))) ;EVAL LISTENING IF NOT AT TOP LEVEL (T (PRINT (THVAL /0LISTEN THALIST))))) ;THVAL LISTENING AT TOP LEVEL - (GO /0LISTEN))) + (GO /0LISTEN))) (DEFUN THINIT FEXPR @@ -2136,7 +2105,6 @@ (SETQ THXX NIL) (SETQ THTRACE NIL) (SETQ THALIST (QUOTE ((NIL NIL)))) - (SSTATUS MACRO $ (QUOTE THREAD)) (SETQ ERRLIST (QUOTE ((PRINT (QUOTE MICRO-PLANNER)) (PRINC THVERSION) @@ -2154,3 +2122,4 @@ (SETQ THTREE NIL) (SETQ THLEVEL NIL) (THERT TOP LEVEL))))) + diff --git a/src/shrdlu/plnrfi.1 b/src/shrdlu/plnrfi.2 similarity index 89% rename from src/shrdlu/plnrfi.1 rename to src/shrdlu/plnrfi.2 index 99232371..4ad0fb10 100644 --- a/src/shrdlu/plnrfi.1 +++ b/src/shrdlu/plnrfi.2 @@ -4,9 +4,6 @@ (t (*ARRAY x 'OBARRAY)))) -(setq car t) -(setq cdr t) - (defun dump-planner () (suspend) (thinit) diff --git a/src/shrdlu/smutil.151 b/src/shrdlu/smutil.152 similarity index 99% rename from src/shrdlu/smutil.151 rename to src/shrdlu/smutil.152 index e17f9ce0..13f1976d 100644 --- a/src/shrdlu/smutil.151 +++ b/src/shrdlu/smutil.152 @@ -120,7 +120,7 @@ (DEFUN NEWCOPY (OSS) (PROG (OLD NEW) (SETQ NEW (MAKESYM 'OSS)) - (SETQ OLD (CDR OSS)) + (SETQ OLD (plist OSS)) ;WATCH OUT -- THIS IS IMPLEMENTATION DEPENDENT, UP (COND ((NULL OLD) ;AND GETS THE ENTIRE PROPERTY LIST IN OUR LISP. @@ -1282,6 +1282,8 @@ (PROG NIL LOOP (COND ((NULL NEW-MARKERS) (RETURN (LIST MARKERS SYSTEMS))) + ((not (listp new-markers)) + (return nil)) ((CHECKAMARKER (CAR NEW-MARKERS)) (SETQ NEW-MARKERS (CDR NEW-MARKERS)) (GO LOOP))