diff --git a/build/shrdlu.tcl b/build/shrdlu.tcl index 31dabaf45..e0ef4f470 100644 --- a/build/shrdlu.tcl +++ b/build/shrdlu.tcl @@ -4,101 +4,65 @@ respond "*" ":cwd shrdlu\r" # first, compile all the sources that should be compiled -respond "*" ":complr\r" -respond "_" "shrdlu; graphf\r" -respond "_" "\032" -type ":kill\r" - -respond "*" ":complr\r" -respond "_" "shrdlu; macros\r" -respond "_" "\032" -type ":kill\r" - -respond "*" ":complr\r" -respond "_" "shrdlu; proggo\r" -respond "_" "\032" -type ":kill\r" - -respond "*" ":complr\r" -respond "_" "shrdlu; plnr\r" -respond "_" "\032" -type ":kill\r" - -respond "*" ":complr\r" -respond "_" "shrdlu; thtrac\r" -respond "_" "\032" -type ":kill\r" - -respond "*" ":complr\r" -respond "_" "shrdlu; syscom\r" -respond "_" "\032" -type ":kill\r" - -respond "*" ":complr\r" -respond "_" "shrdlu; morpho\r" -respond "_" "\032" -type ":kill\r" - -respond "*" ":complr\r" -respond "_" "shrdlu; show\r" -respond "_" "\032" -type ":kill\r" - -respond "*" ":complr\r" -respond "_" "shrdlu; progmr\r" -respond "_" "\032" -type ":kill\r" - -respond "*" ":complr\r" -respond "_" "shrdlu; ginter\r" -respond "_" "\032" -type ":kill\r" - -respond "*" ":complr\r" -respond "_" "shrdlu; gramar\r" -respond "_" "\032" -type ":kill\r" - -respond "*" ":complr\r" -respond "_" "shrdlu; dictio\r" -respond "_" "\032" -type ":kill\r" - -respond "*" ":complr\r" -respond "_" "shrdlu; smspec\r" -respond "_" "\032" -type ":kill\r" - -respond "*" ":complr\r" -respond "_" "shrdlu; smass\r" -respond "_" "\032" -type ":kill\r" - -respond "*" ":complr\r" -respond "_" "shrdlu; smutil\r" -respond "_" "\032" -type ":kill\r" - -respond "*" ":complr\r" -respond "_" "shrdlu; newans\r" -respond "_" "\032" -type ":kill\r" - -respond "*" ":complr\r" -respond "_" "shrdlu; blockp\r" -respond "_" "\032" -type ":kill\r" - -respond "*" ":complr\r" -respond "_" "shrdlu; blockl\r" -respond "_" "\032" -type ":kill\r" +respond "*" ":complr graphf\r" +respond "Job COMPLR finished" ":kill\r" + +respond "*" ":complr macros\r" +respond "Job COMPLR finished" ":kill\r" + +respond "*" ":complr proggo\r" +respond "Job COMPLR finished" ":kill\r" + +respond "*" ":complr plnr\r" +respond "Job COMPLR finished" ":kill\r" + +respond "*" ":complr thtrac\r" +respond "Job COMPLR finished" ":kill\r" + +respond "*" ":complr syscom\r" +respond "Job COMPLR finished" ":kill\r" + +respond "*" ":complr morpho\r" +respond "Job COMPLR finished" ":kill\r" + +respond "*" ":complr show\r" +respond "Job COMPLR finished" ":kill\r" + +respond "*" ":complr progmr\r" +respond "Job COMPLR finished" ":kill\r" + +respond "*" ":complr ginter\r" +respond "Job COMPLR finished" ":kill\r" + +respond "*" ":complr gramar\r" +respond "Job COMPLR finished" ":kill\r" + +respond "*" ":complr dictio\r" +respond "Job COMPLR finished" ":kill\r" + +respond "*" ":complr smspec\r" +respond "Job COMPLR finished" ":kill\r" + +respond "*" ":complr smass\r" +respond "Job COMPLR finished" ":kill\r" + +respond "*" ":complr smutil\r" +respond "Job COMPLR finished" ":kill\r" + +respond "*" ":complr newans\r" +respond "Job COMPLR finished" ":kill\r" + +respond "*" ":complr blockp\r" +respond "Job COMPLR finished" ":kill\r" + +respond "*" ":complr blockl\r" +respond "Job COMPLR finished" ":kill\r" # now load up a compiled version of SHRDLU respond "*" ":lisp\r" respond "Alloc?" "n" respond "*" "(load 'loader)" -respond "T" "(shrdlu-compiled)" +respond "T" "(load-shrdlu-compiled)" respond "COMPLETED" "(dump-shrdlu)" # dump it as SHRDLU;TS SHRDLU @@ -109,8 +73,7 @@ respond "*" ":kill\r" respond "*" ":lisp\r" respond "Alloc?" "n" respond "*" "(load 'loader)" -respond "T" "(load 'plnrfi)" -respond "T" "(planner-compiled)" +respond "T" "(load-planner-compiled)" respond "(THERT TOP LEVEL))" "(dump-planner)" # dump it as SHRDLU;TS PLNR 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 6525012ef..d8232268c 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 420774f55..2e523d32f 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 7c1f49907..fc7a5d4aa 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 e931676c1..1a4ef13ef 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/newans.82 b/src/shrdlu/newans.83 similarity index 99% rename from src/shrdlu/newans.82 rename to src/shrdlu/newans.83 index 8f9598236..b81e96daa 100644 --- a/src/shrdlu/newans.82 +++ b/src/shrdlu/newans.83 @@ -1073,7 +1073,7 @@ TEST-LOOP (DEFUN NOTELL NIL (GLOBAL-ERR THAT ISN - 'T + /'T THE KIND OF @@ -1093,7 +1093,9 @@ TEST-LOOP ;;SINGLE "SAY" PHRASE. "PHRASE" IS A FREE VARIABLE IN ;;LISTNAMES (PROG (ANS OLD NEW) - (AND (EQUAL PHRASE '(NIL)) + (AND (or + (EQUAL PHRASE '(NIL)) + (equal phrase nil)) (SETQ PHRASE (CAR ITEM)) (RETURN ITEM)) (SETQ OLD (REVERSE PHRASE)) 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 8269b21fc..546198805 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 992323714..4ad0fb107 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/setup.64 b/src/shrdlu/setup.65 similarity index 99% rename from src/shrdlu/setup.64 rename to src/shrdlu/setup.65 index 3768ea22b..e03a6d969 100644 --- a/src/shrdlu/setup.64 +++ b/src/shrdlu/setup.65 @@ -191,7 +191,8 @@ T) (SETQ *RSET NIL) (IOC C) - (SETQ SH-PRINT-TIME T)) + ;(SETQ SH-PRINT-TIME T) + ) (DEFUN DEBUGMODE NIL (QUIETMODE) @@ -285,6 +286,7 @@ (SHRDLU)) (DEBUGMODE) +;(USERMODE) (setq sh-standard-printout nil smnbreak nil smntrace nil makintern t annoyance t) 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 e17f9ce0f..13f1976d5 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))