(CDEFUN WHATS-IN (THING)

   "AUX" (LIST X THINGS)

     (CSETQ LIST (FETCH '(?X IN THING)))

     (CSETQ THINGS NIL)

   :LOOP

     (TRY-NEXT LIST '(GO 'END))

     (CSETQ THINGS (CONS THINGS (CONS X NIL)))

     (GO 'LOOP)

   :END 

     (RETURN THINGS))








(CDEFUN FULL (CONTAINER)

   "AUX" (COUNT MAX)

     (TRY-NEXT (FETCH '(,CONTAINER ?COUNT)))

     (TRY-NEXT (FETCH '(CONTAINER ,CONTAINER ?MAX)))

     (COND ((LESSP COUNT MAX)

            (RETURN 'NIL)))

     (RETURN 'IT-IS))






(ADD '(IF-ADDED CHECK6 (?X IN ?Y)

   "AUX" (X Y COUNT)

     (REMOVE (TRY-NEXT (FETCH '(,Y ?COUNT))))

     (ADD1 COUNT)
     (ADD '(,Y ,COUNT))))






(ADD '(IF-REMOVED CHECK7 (?X IN ?Y)

   "AUX" (X Y COUNT)

     (REMOVE (TRY-NEXT (FETCH '(,Y ?COUNT))))

     (SUB1 COUNT)

     (ADD '(,Y ,COUNT))))






(CDEFUN PUT-DOWN (THING)

   "AUX" (PLACE LIST ANYTHING X)

     (COND ((PRESENT '(,THING IN HAND))

            (CSETQ PLACE (FIND 'ROBOT))

            (REMOVE '(,THING IN HAND))

            (COND ((CSETQ LIST (FETCH '(?ANYTHING AT ,PLACE)))

                   :LOOP

                   (TRY-NEXT LIST '(GO 'END))

                   (COND ((AND (PRESENT '(CONTAINER ,ANYTHING ?X))

                               (NOT (PRESENT '(CONTAINER ,THING)))

                               (NOT (FULL ANYTHING)))

                          (ADD '(THING IN ,ANYTHING))

                          (RETURN 'DONE))

                         (T (GO 'LOOP)))))

            :END

            (ADD '(,THING AT ,PLACE))

            (RETURN 'DONE))

           (T (PRINT (CONS THING '(CANNOT-BE-PUT-DOWN-SINCE-
                                    IT-IS-NOT-IN-MY-HAND)))

              (RETURN NIL))))







(CDEFUN SUPERVISOR (INFO)

     (PRINT (CONS 'TO-SUPERVISOR------- INFO))

     (RETURN (READ)))









(CDEFUN ADD-LIST-OF-ITEMS (LIST)

     (COND ((OR (NULL LIST)

                (NULL (CAR LIST)))

            (RETURN NIL)))

   :LOOP

     (ADD (CAR LIST))

     (CSETQ LIST (CDR LIST))

     (COND ((NULL LIST) (RETURN 'DONE))

           (T (GO 'LOOP))))




(CDEFUN VISUALLY-ANALYZE (THING)

     (COND ((ADD-LIST-OF-ITEMS (SUPERVISOR

                                 (CONS 'VISUALLY-ANALYZE 

                                 (CONS THING NIL))))

     (RETURN 'DONE))))










(CDEFUN SCENE-ANALYSIS NIL

     (COND ((ADD-LIST-OF-ITEMS (SUPERVISOR

                                 '(PLEASE-ANALYZE-THE-SCENERY)))

     (RETURN 'DONE))))






(CDEFUN MOVE-TO (PLACE)

   "AUX" (X)

     (COND ((EQUAL PLACE (CSETQ X (FIND 'ROBOT)))

            (RETURN 'I-AM-ALREADY-THERE))

           ((PATH-TO PLACE)

            (REMOVE '(ROBOT AT ,X))

            (ADD '(ROBOT AT ,PLACE))
            
(RETURN 'DONE))

           (T (RETURN NIL))))







(CDEFUN PATH-TO (PLACE)

   "AUX" (PLACEX)

     (CSETQ PLACEX (FIND 'ROBOT))

     (COND ((OR (EQUAL PLACE PLACEX)

                (PRESENT '(PATH ,PLACEX ,PLACE))

                (AND (PRESENT '(PLACE ,PLACEX))

                     (FIXP (CAR PLACE))

                     (FIXP (CADR PLACE)))

                (AND (PRESENT '(PLACE ,PLACE))

                     (FIXP (CAR PLACEX))

                     (FIXP (CADR PLACEX)))

                (AND (FIXP (CAR PLACEX))

                     (FIXP (CADR PLACEX))

                     (FIXP (CAR PLACE))

                     (FIXP (CADR PLACE))))

            (RETURN 'THERE-IS))))






(CDEFUN MOVE-IT (THING PLACE)

     (COND ((PICK-UP THING)

            (COND ((MOVE-TO PLACE)

                   (PUT-DOWN THING))

                  (T (PRINT (CONS 'I-CANNOT-GET-TO

                            (CONS PLACE

                            (CONS 'THUS-I-CANNOT-MOVE

                            (CONS THING '(THERE))))))

                     (RETURN NIL))))

            (T (RETURN NIL)))

     (RETURN 'DONE))

     



(CDEFUN PICK-UP (THING)

   "AUX" (PLACE MESSAGE SOMETHING CONTAINER)

     (COND ((PRESENT '(,THING IN HAND))

            (RETURN 'I-AM-ALREADY-HOLDING-IT)))

     (COND ((PRESENT '(,THING CAN-NOT-BE-PICKED-UP))

            (RETURN NIL)))

     (CSETQ MESSAGE 'I-CANNOT-PICK-UP)

     (COND ((NULL (CSETQ PLACE (FIND THING)))

            (PRINT (CONS MESSAGE

                   (CONS THING 

                    '(BECAUSE-IT-CANNOT-BE-FOUND))))

            (RETURN NIL)))

     (COND ((NULL (PATH-TO PLACE))

            (PRINT (CONS MESSAGE

                   (CONS THING '(BECAUSE-THERE-IS-NO-PATH-TO-IT))))

            (RETURN NIL)))


     (COND ((FULL ?HAND) (PUT-DOWN SOMETHING)))

     (MOVE-TO PLACE)

     (COND ((TRY-NEXT (FETCH '(,THING IN ?CONTAINER)))

            (REMOVE '(,THING IN ,CONTAINER))))

     (COND ((PRESENT '(,THING AT ,PLACE))

            (REMOVE '(,THING AT ,PLACE))))

     (ADD '(,THING IN HAND))

     (RETURN 'DONE))





(CDEFUN FIND (THING)

   "AUX" (PLACE)

     (COND ((CSETQ PLACE (WHERE-AT THING))

            (RETURN PLACE))

           (T (CSETQ PLACE (SUPERVISOR

                            (CONS 'WHERE-IS

                            (CONS THING NIL))))

              (COND ((OR (NULL PLACE) (NULL (CAR PLACE)))

                     (RETURN NIL))

                    (T (CSETQ PLACE (CAR PLACE))

                       (ADD '(,THING AT ,PLACE))

                  
     (RETURN PLACE))))))





(ADD (IF-ADDED CHECK1 (ROBOT AT ?PLACE)

   "AUX" (THINGS Y OLDPLACE PLACE)

     (CSETQ THINGS (FETCH '(?Y ON ROBOT)))

   :LOOP

     (TRY-NEXT THINGS '(RETURN NIL))

     (COND ((TRY-NEXT (FETCH '(,Y AT ?OLDPLACE)))

            (REMOVE '(,Y AT ,OLDPLACE))

            (ADD '(,Y AT ,PLACE))))

     (GO 'LOOP)))







(ADD (IF-REMOVED CHECK2 (?X ON ?Y)

   "AUX" (X Y)

     (PRINT (CONS 'GRAVE-ERROR---------

            (CONS X (CONS '(WAS-REMOVED-FROM (CONS Y NIL))))))))







(ADD (IF-ADDED CHECK3 (PLACE ?X)

   "AUX" (X)

     (ADD '(,X CAN-NOT-BE-PICKED-UP))))






(ADD (IF-REMOVED CHECK4 (PLACE ?X)

   "AUX" (X)

     (REMOVE '(,X CAN-NOT-BE-PICKED-UP))))






(ADD (IF-ADDED CHECK5 (?X ON ROBOT)

   "AUX" (X)

     (ADD '(,X CAN-NOT-BE-PICKED-UP))))






(ADD '(ROBOT CAN-NOT-BE-PICKED-UP))


(ADD '(HAND ON ROBOT))


(ADD '(HAND ON ARM))


(ADD '(CONTAINER HAND 1))


(ADD '(ARM ON ROBOT))


(ADD '(CONTAINER BAG 3))


(ADD '(HAND 0))


(ADD '(BAG 0))








(CDEFUN WHERE-IS (THING)

   "AUX" (PLACE)

     (COND ((TRY-NEXT (FETCH '(,THING AT ?PLACE)))

            (RETURN (CONS 'AT (CONS PLACE NIL))))

           ((TRY-NEXT (FETCH '(,THING ON ?PLACE)))

            (RETURN (CONS 'ON (CONS PLACE NIL))))

           ((TRY-NEXT (FETCH '(,THING IN ?PLACE)))

            (RETURN (CONS 'IN (CONS PLACE NIL))))))







(CDEFUN WHERE-AT (THING)

   "AUX" (PLACE)

   :LOOP

     (COND ((CSETQ PLACE (WHERE-IS THING))

            (COND ((EQUAL 'AT (CAR PLACE))

                   (RETURN (CADR PLACE)))

                  (T (CSETQ THING (CADR PLACE))

                     (GO 'LOOP))))))






(CDEFUN REMOVE-POSSIBILITIES-LIST (LIST)

   :LOOP

     (REMOVE (TRY-NEXT LIST '(GO 'FIN)))

     (GO 'LOOP)

   :FIN

     (RETURN 'DONE))






(CDEFUN PROVE-POSSIBLE (GOALIST)

   "AUX" (LIST PLACE XPLACE THING ANYTHING COUNT MAX X

         (CONTEXT (PUSH-CONTEXT CONTEXT)))

     (REMOVE-POSSIBILITIES-LIST (FETCH '(?THING AT ?PLACE)))

     (REMOVE-POSSIBILITIES-LIST (FETCH '(?THING IN ?ANYTHING)))

     (ADD-LIST-OF-ITEMS GOALIST)

     (CSETQ LIST (FETCH '(?THING AT ?PLACE)))

:AT

     (TRY-NEXT LIST '(GO 'IN))

     (REMOVE '(,THING AT ,PLACE))

     (COND ((OR (CDR (FETCH '(,THING AT ?XPLACE)))

                (PRESENT'(PLACE ,THING))

                (CDR (FETCH '(,PLACE AT ?XPLACE)))

                (CDR (FETCH '(?PLACE AT ,THING))))

            (RETURN NIL))

           (T (GO 'AT)))

:IN

     (ADD-LIST-OF-ITEMS GOALIST)

     (CSETQ LIST (FETCH '(?THING IN ?ANYTHING)))

:UP

     (TRY-NEXT LIST '(GO 'CHECK))

     (COND ((TRY-NEXT (FETCH '(CONTAINER ,ANYTHING ?MAX)))

            (COND ((OR (TRY-NEXT (FETCH '(,ANYTHING ?COUNT)))

                       (LESSP MAX COUNT)

                       (PRESENT '(,THING 'CAN-NOT-BE-PICKED-UP))

                       (CDR (FETCH '(CONTAINER ,THING ?MAX))))

                   (RETURN NIL)))

          (T (RETURN NIL)))

     (COND ((AND (CSETQ PLACE (WHERE-AT THING))

                 (CSETQ XPLACE (WHERE-AT ANYTHING))

                 (NOT (EQUAL PLACE XPLACE)))

            (RETURN NIL))

           (T (GO 'UP)))

   :CHECK

     (CSETQ LIST (CAR GOALIST))

     (CSETQ GOALIST (CDR GOALIST))

     (COND ((NOT (AND (NOT (ATOM LIST))

                      (CDR LIST)

                      (CDDR LIST)

                      (NULL (CDDDR LIST))

                      (OR (EQUAL 'AT (CADR LIST))

                          (EQUAL 'IN (CADR LIST)))))

            (RETURN NIL))

           (GOALIST (GO 'CHECK)))

     (RETURN T))