diff --git a/src/shrdlu/blockl.6 b/src/shrdlu/blockl.6 index 6569c319..78436b5d 100644 --- a/src/shrdlu/blockl.6 +++ b/src/shrdlu/blockl.6 @@ -204,14 +204,13 @@ (declare (*expr fn)) -(DEFUN LOCGREATER (X Y FN) ((LAMBDA (XX YY) - (NOT (LESSP (funcall FN (CADR XX)) - (PLUS (funcall FN (CADR YY)) - (funcall FN (CADDR YY)))))) - (LOCG2 (QUOTE $?YY) X) - (LOCG2 (QUOTE $?ZZ) Y))) - - +(DEFUN LOCGREATER (X Y FN) + ((LAMBDA (XX YY) + (NOT (LESSP (funcall FN (CADR XX)) + (PLUS (funcall FN (CADR YY)) + (funcall FN (CADDR YY)))))) + (LOCG2 (QUOTE $?YY) X) + (LOCG2 (QUOTE $?ZZ) Y))) (DEFUN LOCG2 (X Y) (COND ((EQ $?LOC (QUOTE !LOC)) (ATAB Y)) ((CONS NIL (CONS (EVAL X) (CDDR (ATAB Y))))))) @@ -247,17 +246,16 @@ (CONS (CAR Y) (ORDER X (CDR Y)))) ((CONS X Y)))) -(DEFUN PACKO - (OBJ TYPE) - (PROG (XX) - (MAPC (FUNCTION (LAMBDA (X) - (AND (THVAL (QUOTE (THGOAL (!IS $?X - $E - TYPE))) - (LIST (LIST (QUOTE X) X))) - (SETQ XX (PACKORD X (SIZE X) XX))))) - (listify obj)) - (RETURN (MAPCAR (QUOTE CADR) XX)))) +(DEFUN PACKO (OBJ TYPE) + (PROG (XX) + (MAPC (FUNCTION (LAMBDA (X) + (AND (THVAL (QUOTE (THGOAL (!IS $?X + $E + TYPE))) + (LIST (LIST (QUOTE X) X))) + (SETQ XX (PACKORD X (SIZE X) XX))))) + (listify obj)) + (RETURN (MAPCAR (QUOTE CADR) XX)))) (DEFUN PACKON (SURF LIST) @@ -283,11 +281,13 @@ (GREATERP (CADAAR LIST) (CADR SIZE)))) (CONS (CAR LIST) (PACKORD X SIZE (CDR LIST)))) ((CONS (LIST SIZE X) LIST)))) -(DEFUN SIZE (X) (COND ((EQ X (QUOTE :BOX)) (QUOTE (400 400 300))) - ((EQ X (QUOTE :TABLE)) (QUOTE (1200 1200 1200))) - ((eq x (quote :hand)) (quote (0 0 0))) - ((ATOM X) (CADDR (ATAB X))) - (X))) + +(DEFUN SIZE (X) + (COND ((EQ X (QUOTE :BOX)) (QUOTE (400 400 300))) + ((EQ X (QUOTE :TABLE)) (QUOTE (1200 1200 1200))) + ((eq x (quote :hand)) (quote (0 0 0))) + ((ATOM X) (CADDR (ATAB X))) + (X))) (DEFUN STARTHISTORY NIL diff --git a/src/shrdlu/blockp.5 b/src/shrdlu/blockp.5 index f72a24cd..ff87d044 100644 --- a/src/shrdlu/blockp.5 +++ b/src/shrdlu/blockp.5 @@ -220,12 +220,13 @@ (THGO TAG)) (MEMOREND (!MAKESPACE $?EV $?SURF))) THEOREM) + (DEFPROP TC-MORE - (THCONSE (MEASURE X Y) - (!MORE $?MEASURE $?X $?Y) - (THVSETQ $_MEASURE (GET $?MEASURE (QUOTE MEASFN))) - (GREATERP ($?MEASURE $?X) ($?MEASURE $?Y))) - THEOREM) + (THCONSE (MEASURE X Y) + (!MORE $?MEASURE $?X $?Y) + (THVSETQ $_MEASURE (GET $?MEASURE (QUOTE MEASFN))) + (GREATERP ($?MEASURE $?X) ($?MEASURE $?Y))) + THEOREM) (DEFPROP TC-MOVEHAND (THCONSE @@ -488,6 +489,7 @@ THEOREM) (THAND (THASSERT (!PART $?Z $?X)) (THFINALIZE THAND)))) THEOREM) + (DEFPROP TC-STACKUP (THCONSE (X Y BLOCKS PYR (WHY (EV)) EV) @@ -863,4 +865,4 @@ NIL !UNGRASP)) (QUOTE (PREDICATES ARE: !LOC !SUPPORT !ON !PHYSOB)) -  \ No newline at end of file +  diff --git a/src/shrdlu/loader.20 b/src/shrdlu/loader.20 index fb4bca74..877fc86e 100644 --- a/src/shrdlu/loader.20 +++ b/src/shrdlu/loader.20 @@ -23,15 +23,15 @@ (defun ioc fexpr (x) (cond ((eq (car x) 'c) (setq ^d nil)) - ((eq (car x) 'd) (setq ^d t)) - ((eq (car x) 'q) (setq ^q t)) - ((eq (car x) 's) (setq ^q nil)) + ((eq (car x) 'd) (setq ^d t)) + ((eq (car x) 'q) (setq ^q t)) + ((eq (car x) 's) (setq ^q nil)) ((eq (car x) 't) (setq ^r nil)) ((eq (car x) 'v) (setq ^w nil)) ((eq (car x) 'r) (setq ^r t)) ((eq (car x) 'w) (progn (setq ^w t) (clear-output t))) - ((eq (car x) 'g) (tyo 7)) ; ring the bell - (t (break (eval (car x)))))) + ((eq (car x) 'g) (tyo 7)) ; ring the bell + (t (break (eval (car x)))))) (SETQ *RSET T) @@ -73,10 +73,10 @@ (defun loadplanner () (ALLOC '(LIST 320000 - FIXNUM 15000 - SYMBOL 15000 - array 500 - flonum 4000)) + FIXNUM 15000 + SYMBOL 15000 + array 500 + flonum 4000)) (SETQ PURE NIL) (setq car t) (setq cdr t) @@ -86,12 +86,10 @@ (DEFUN LOADSHRDLU NIL (ALLOC '(LIST 320000 - FIXNUM - 15000 - SYMBOL - 15000 - array 500 - flonum 3000)) + FIXNUM 15000 + SYMBOL 15000 + array 500 + flonum 3000)) (SETQ PURE NIL) (setq car t) (setq cdr t) diff --git a/src/shrdlu/smspec.96 b/src/shrdlu/smspec.96 index 38bc041f..9cefa452 100644 --- a/src/shrdlu/smspec.96 +++ b/src/shrdlu/smspec.96 @@ -292,7 +292,7 @@ ; A NODE LIST OF POSSIBLE (OR DISCOURSE (ERT SMIT: DISCOURSE SWITCH NOT ON)) ;REFERENTS - (AND MVB;IS THIS A "DO IT!" COMMAND? + (AND MVB ;IS THIS A "DO IT!" COMMAND? (ISQ MVB DO) (CQ OBJ1) (boundp 'lastevent) @@ -751,7 +751,7 @@ (DEFUN SMPOSS NIL (PROG (X) (RETURN (AND (SETQ X (SMPOSS2 C (MOVE-PT H PV (POSS)))) - (SMRELATE X))))) + (SMRELATE X))))) (DEFUN SMPOSS2 (HEADNODE MODNODE) (PROG (X SM SMSUB SMOB1 SMOB2 SMOBL SMCOMP RELLIST) diff --git a/src/shrdlu/smutil.150 b/src/shrdlu/smutil.150 index b5bcc64f..6f37f94f 100644 --- a/src/shrdlu/smutil.150 +++ b/src/shrdlu/smutil.150 @@ -162,7 +162,7 @@ (PROG (SMCOMP SMSUB SMOB1 SMOB2 SMOBL MARKERS: RESTRICTIONS: PLAUSIBILITY: REL: PARAPHRASE: RELMARKERS: RSSNAME PROCEDURE: !1 !2 !3 %NEWRSS - %OSSNODE) + %OSSNODE) (SETQ %DEF (ARG 1.) SMSUB @@ -175,7 +175,8 @@ (ARG 5.) SMCOMP (ARG 6.)) - ;AN LEXPR IS USED HERE IN ORDER TO GET AROUND + + ;AN LEXPR IS USED HERE IN ORDER TO GET AROUND ;THE LIMITATION OF FIVE EXPR ARGUMENTS IN ;COMPILED CODE. NOTICE THAT WITHIN THIS LAMBDA ;EXPRESSION THAT SMSUB = ONE OSS FOR SEMANTIC