@comment(Hey, EMACS, this is -*- SCRIBE -*- input)
@device(dover)
@make(6001)

@modify(excounter, numbered [Exercise @1], referenced [@1])

@PageHeading(left "6.001 -- Hewlett-Packard Summer 1985",
             center "@Value(Page)",
             right "Problem set 6")

@begin(center)
HEWLETT-PACKARD
Summer 1985

Problem Set 6

Originally Prepared As

MASSACHUSETTS INSTITUTE OF TECHNOLOGY
Department of Electrical Engineering and Computer Science
6.001 Structure and Interpretation of Computer Programs
Spring Semester, 1985; Problem Set 6
@end(center)
@blankspace(0.25 in)

@begin(center)
@b[Exercises]
@end(center)

Write up and turn in the following exercises from the text:

@begin(itemize)
Exercise 3-2

Exercise 3-10

Exercise 3-12

Exercise 3-13

@end(itemize)

@blankspace(0.25 in)

@begin(center)
@b[LABORATORY ASSIGNMENT: The Adventure Game]
@end(center)

In this laboratory assignment, we will be exploring two key ideas, the
simulation of a world in which objects are characterized by a set of
state variables, and the use of message passing as a programming
technique for modularizing worlds in which objects interact.  We will
do this in the context of a simplified version of the "Adventure" game, a
"Dungeons & Dragons" style game that is available on many computers
and has provided an interesting waste of time for many computer lovers.


The basic idea of such games is that the user is placed, as a
character, in an imaginary world inhabited by other (usually
imaginary) characters. The user plays the game by 
issuing commands to the computer that have the effect of
moving him around in the imaginary world and that perform acts in the
imaginary world, like picking up an object. The computer simulates his moves
and responds, allowing him to make legal moves and rejecting illegal ones.
For example, it is illegal to move between places that are not connected
(unless you have a magic wand). If a move is legal, the computer
updates its model of the world and allows the next move to be considered.

@paragraph(The essential  system -- places and persons)
In order to get going, we need to establish the structure of our imaginary
world -- the objects that exist and the ways they relate
to each other. The simulator for the world is contained in two files, which can
be found at the end of the problem set. The first file, @a[ps6-adv.scm], contains
procedures to create places and things, and various other useful procedures
that you will not need to modify. The second file, @a[ps6.scm], contains a
procedure to create people, which you may need to modify, as well as
an initial data base defining a particular world with various familiar
and unfamilar places represented, and with two people, ERIC and HAL,
as well as procedures for creating a TROLL and a DEAN. (The
procedures defining the last two are incomplete and will be finished as part
of this laboratory.) Both files will be loaded with the @a[load-problem-set]
command.

Initially, the three procedures for creating objects in our world
are:
@begin(programexample)
	(make-place name)
	(make-thing name)
	(make-person name place threshold-for-moving)
@end(programexample)
For example, the procedure MAKE-PERSON is used to create the two
people, ERIC and HAL.  All of these procedures are standard message-passing
procedures, similar to what we have already seen in section
2.3.3 of the text and in the bank account example of Chapter 3.  For
example, MAKE-PERSON  creates and returns a dispatch function with a
set of procedures and local state attached to it.  Thus
ERIC is represented as a dispatch procedure, and
to perform some action on ERIC, we simply send him an appropriate message
by calling that procedure with the message as argument. 

For example, once these files are loaded, we will be able to find out
where ERIC and HAL are and to walk them around in the world:
@begin(programexample)
==> (eric 'current-position)
ERIC-OFFICE

==> (hal 'current-position)
HAL-OFFICE

==> (hal 'exits)
(UP DOWN)

==> ((hal 'go) 'down)
HAL moved from HAL-OFFICE to TECH-SQUARE
()

==> (hal 'exits)
(UP SOUTH)

==> ((hal 'go) 'south)
HAL moved from TECH-SQUARE to BLDG-36
()

==> (hal 'exits)
(WEST NORTH UP)

==> ((hal 'go) 'up)
HAL moved from BLDG-36 to COMPUTER-LAB
()

==> ((eric 'go) 'down)
ERIC moved from ERIC-OFFICE to HAL-OFFICE
()

==> ((eric 'go) 'down)
ERIC moved from HAL-OFFICE to TECH-SQUARE
()

==> ((eric 'go) 'south)
ERIC moved from TECH-SQUARE to BLDG-36
()

==> ((eric 'go) 'up)
ERIC moved from BLDG-36 to COMPUTER-LAB
ERIC says - Hi, HAL
()

==> (eric 'look-around)
HAL
()

==> (hal 'look-around)
ERIC
()

@end(programexample)

Note that some messages return a procedure that must then be applied to another
message.  For instance, (ERIC 'GO) returned a procedure that 
accepted the direction in which we wanted ERIC to go.

In principle, we could run the ADVENTURE system by simply issuing
commands to each of the creatures in the world, as we did above.
This, however,
defeats the notion of the game, since the user
has control over all the creatures.  Instead, we will
structure our system so that all the characters, with the possible
exception of ourselves, are manipulated in some fashion by the
computer, while we are able only to control our own actions.  We will
do this by creating a queue, consisting of all the creatures currently
active in our world, and using a clock to simulate the passage of time
in the world.  A special procedure, CLOCK, is provided, that upon
invocation sends a MOVE message to each of the creatures on the queue.
A MOVE message does not automatically imply that the creature
receiving it will change location.  Rather, like all of us, a creature
will tend to stay in one place until he or she (or it) gets bored
enough and moves on to a new place.  To account for this, the third
argument to MAKE-PERSON specifies the number of clock intervals that
the person will remain in his or her current place before moving.
Since different people get bored at different rates, this argument
obviously can be different for each creature in the world.

Before we trigger the clock to simulate a game, let's explore the
properties of our world a bit more.
First, let's create a COMPUTER-MANUAL and place it in the COMPUTER-LAB
(where HAL and ERIC now are).
@begin(programexample)
==> (define computer-manual (make-thing 'computer-manual))
COMPUTER-MANUAL

==> ((computer-lab 'appear) computer-manual)
APPEARED
@end(programexample)
Next, we'll have HAL look around.
@begin(programexample)
==> (hal 'look-around)
COMPUTER-MANUAL
ERIC
()
@end(programexample)
The manual looks useful, so HAL picks it up and adds it to his possessions.
@begin(programexample)
==> ((hal 'take) computer-manual)
HAL took COMPUTER-MANUAL
TAKEN
@end(programexample)
If HAL leaves, the manual goes with him.
@begin(programexample)
==> ((hal 'go) 'down)
HAL moved from COMPUTER-LAB to BLDG-36
()

==> (hal 'list-possessions)
COMPUTER-MANUAL
()
@end(programexample)
ERIC had also noticed the COMPUTER-MANUAL; he follows HAL and snatches the
manual away.
@begin(programexample)
==> ((eric 'go) 'down)
ERIC moved from COMPUTER-LAB TO BLDG-36
ERIC says - Hi, HAL
()

==> ((eric 'take) computer-manual)
ERIC took COMPUTER-MANUAL
Yaaaah! HAL is upset!
TAKEN

==> (eric 'list-possessions)
COMPUTER-MANUAL
()

==> (hal 'list-possessions)
()
@end(programexample)
The people, places, and things in our world have many other features built in.
and it is recommended that you look carefully at the code to see some
of them.  Still other features could
readily be added; building such programs is often a good deal of fun. For
the rest of this laboratory, we'll concentrate on a few aspects of the world
we have built.

For many of these problems, you can use the editor to enter
your definitions in your modifiable file. Notice 
that because the Adventure model works by mutation of data, it is possible
to get your SCHEME into an inconsistent state while debugging. If this
happens and if you have been careful about the order in which you  have
entered your definitions in the file @a[ps6.scm], you can re-initialize
by reloading this file.

Many of the problems in this assignment are concerned with incremental
changes to the procedures MAKE-PERSON, MAKE-DEAN and MAKE-TROLL.  As a
consequence, rather than turning in several different versions of the
same procedures, we suggest that after having finished all nine
problems, you turn in one version of each of the modified procedures,
clearly marking all of your changes, and indicating for each change,
what problem the change was made in response to.  

@paragraph(Problem 1)
Make HAL and ERIC move around by repeatedly calling CLOCK (with no
arguments).  Which person is more restless?  How often do both of
them move at the same time?

@paragraph(Problem 2)
Define a new character -- yourself --
with a high enough threshold (say, 100) so that you have "free will" and will
not be moved by the clock.  Place yourself initially in the DORMITORY.
Create a new thing, LATE-HOMEWORK, and
also place it in the DORMITORY. Pick up the LATE-HOMEWORK, find out
where HAL is using the message CURRENT-POSITION, and move yourself to
HAL's location. Try to get HAL to TAKE the homework even though it's
late. Can you find a way to do this that does not leave @a[you] upset?
Turn in  a list of your definitions and actions.

@paragraph(Problem 3)
Draw an environment diagram (see section 3.2 of the text) for the procedure
object that was created when you defined your new character in Problem 2.
Don't draw the complete environment diagram for DORMITORY.

@paragraph(Problem 4)
Our system so far contains three types of objects, PLACE,
PERSON, and THING.  Note that objects of the same type may
be created by different procedures.  For instance, a DEAN, while a
PERSON, differs in some ways from ordinary people, and
hence is created by the procedure MAKE-DEAN rather than the general
procedure MAKE_PERSON.  PLACE, PERSON, and THING objects have one
thing in common -- they all accept the messages TYPE and NAME. In
addition to these two basic messages, however, each
object also supports a set of specialized messages. For example, a PLACE object
supports the message APPEAR.  Suppose we were going to design a new
procedure to create a new variation of some type of object, for example, we
might want to have a procedure that created a PROFESSOR object, which
is a kind of person (contrary to popular belief!).  In order for this
new type of object to interact properly with the other objects in the
world, it is important that it support the right messages.
The messages supported by an object can be separated into
mandatory and optional messages, depending on whether other objects
depend on that message.
For example, PLACE must support APPEAR, because
PERSON objects depend on APPEAR. However, a PERSON object does not have to
support LOOK-AROUND, because no other type of object depends on
LOOK-AROUND.

For each of the three types of objects, PERSON, PLACE and THING,
produce a table of the messages they support and the function of the
messages. For each type of object, say whether each of its messages is
optional or mandatory. 

@paragraph(Problem 5)
Let's add another character to our world -- an officious
DEAN who is paranoid on the subject of beer on campus. When he can no longer
control himself, the DEAN wanders about; any beer he finds, he smashes. 
A procedure MAKE-DEAN is included in your package. To complete it, you need
to write a simple procedure BEERS-AT-PLACE that returns
a list of the BEERS at a given place.  Note that the DEAN is so
paranoid, he doesn't notice beer that is not in someone's possession,
so your procedure should only return a list of the BEERS at a given
place that are actually owned by someone.
If there are no such BEERs, BEERS-AT-PLACE should return the empty list.
Note that there may be many different beers present in the world.
In our world, BEER is simply defined as a  THING which has the name
BEER, so that, for example,
@begin(programexample)
(define Molson (make-thing 'beer))
(define Labatts (make-thing 'beer))
(deflne Carling (make-thing 'beer))
@end(programexample)
is a permissible way of creating several different instances of beer.

Actually make the DEAN and install him in the DEAN-OFFICE, with a
OFFICIOUSNESS threshold of 3. Test your work by reloading @a(ps6.scm)
and exercising it by creating some beer, having one of your characters
possess it and moving the dean around (by sending
him MOVE messages) to ensure that the right things
happen when he (or she) encounters someone possessing beer. Turn in a
listing of your modifications, definitions and new procedures. 

@paragraph(Problem 6)
Let's add one more creature to our menagerie -- a TROLL, named GRENDEL, who
normally lives in a DUNGEON concealed under the EGG-ATRIUM. A  troll
is a creature with rather simple needs. After a certain number of clock
intervals, it gets hungry and leaves its DUNGEON to wander
around the world  seeking food.  It will eat the first person it runs
into, unless that person can offer it the one food it likes better --
a PIZZA. When it's finished eating, the troll returns to its DUNGEON.

Note that as in the case of BEER in the previous problem, a pizza is
defined as a THING that has the name PIZZA.

Although the code to create a troll is incomplete, we might envision
the following kind of interaction.   Suppose some poor soul JULIE is in
BLDG-10 when the hungry troll, GRENDEL, comes along:

@begin(programexample)
==> (julie 'current-position)
BLDG-10

==> (grendel 'move)
GRENDEL moved from EGG-ATRIUM to BLDG-10
GRENDEL says - Hssss--s! I'm going to eat you, JULIE!!
Aarrr--gh!
GRENDEL eats JULIE and belches.
GRENDEL moved from BLDG-10 to DUNGEON
()

==> (julie 'current-position)
HEAVEN
@end(programexample)
On the other hand if JULIE had been carrying a PIZZA, the incident above
would have had a happier ending:
@begin(programexample)
==> (julie 'current-position)
BLDG-10

==> (julie 'list-possessions)
PIZZA
()

==> (GRENDEL 'move)
GRENDEL moved from EGG-ATRIUM to BLDG-10
GRENDEL says - Hssss--s! I'm going to eat you, JULIE!!
JULIE says - Take this pizza instead, please!
GRENDEL says - OK, thanks!
GRENDEL moved from BLDG-10 to DUNGEON
()

==> (julie 'list-possessions)
()
@end(programexample)

An incomplete version of a procedure MAKE-TROLL is included in your file.
Specifically, the procedure EAT-PERSON needs to be completed. If the 
SELECTED-PERSON has a pizza among his or her possessions, then the
SELECTED-PERSON should lose the pizza (which should also be removed from
the list of objects at the current place). Otherwise, the SELECTED-PERSON
should be UNQUEUEd from the queue (which is the way the CLOCK keeps
track of who's alive in our world) and sent to HEAVEN. In either case, the
troll should then be removed from the current place and reestablished
in the DUNGEON with its hunger temporarily satisfied by being reset to 0.
Along the way, add code to make the TROLL and its victim engage in any
dialogue you feel is appropriate.  Actually
make a TROLL, whose name is GRENDEL, and install it in the DUNGEON,
with a HUNGER threshold of 3. Test your work by reloading @a(ps6.scm)
and exercising it as above. 
Turn in a listing of your modifications, definitions and new procedures.


@paragraph(Problem 7)
As the code currently stands, the troll seems to have a distinct
advantage (rumors that the troll is a slightly demented former 6.001
instructor are apparently unfounded).  We can even things up a bit in
the following manner.  Using the procedures FORALL and DELETE, write a procedure called NEARBY, which takes a PLACE as an argument and returns a list 
of all other places in the world that can be reached in at most two steps
from the supplied argument.  Using NEARBY, modify the procedure EAT-PERSON so
that with probability 1 in 4, chanting magic spells in the presence of a troll
causes the selected victim to be magically transported to a nearby
place, selected at random from those specified by the procedure NEARBY.

In particular, implement the notion of "chanting magic spells" by modifying
MAKE-PERSON to support a new message, MAGIC, which causes the
appropriate things to happen.  Then include the necessary code in
EAT-PERSON needed to cause the MAGIC message to be passed to the selected
victim, thereby enabling him to escape the TROLL.
Turn in a listing of your modifications and new procedures.

@paragraph(Problem 8)
While the system we have developed so far provides a means for
simulating a Dungeons & Dragons type world, it is clearly still very
simplistic.  In particular, people in the world have a very limited
set of possible actions, mostly restricted to movement within the
world.  This is in part because THINGS in our world are very simple.
They are basically objects that can be possessed by people.  In this
problem,  you will design and implement a
modification to the system that increases the range of interactions
between objects in the system. 

In particular, you are going to create a new kind of THING that has
magical properties.  For instance, many Adventure games include rods,
staffs, and wands that have magical properties such as
teleportation.   You are to modify our game by defining a new
procedure, called MAKE-WAND, which creates a kind of THING with the
following additional properties.  Wands contain a certain number of
charges, which are expended when they are invoked, and which can be
regained under special circumstances.  Thus, MAKE-WAND will need to
have some way of preserving a local state variable detailing the
number of remaining charges in the wand, which we will define
initially to be 2 when the wand is created.

Remember from Problem 4 that
certain basic messages must be supported by WANDs, since they are a
kind of THING.  In addition, include code in MAKE-WAND to support
three additional messages.  The message CHARGES should cause the
wand to return the number of charges remaining.  The
message WAVE should do nothing if there are no charges left in the
wand or if no one is holding it.  Otherwise, it should reduce the number of charges left by 1,
then select a place at random (using the procedure NEARBY, which you
created in problem 7), and move the person wielding the wand to that
location.   You may find it useful to modify the procedure
MAKE-PERSON to support an additional message MOVE-TO that enables a
person to be moved to a specified location.  The message RECHARGE
should determine whether the wand is currently being held by someone and,
if so, whether the wielder is standing in the computer lab.  If both of
these conditions are true, then the number of charges in the wand
should be reset to 2, otherwise nothing should happen.  

Use the procedure MAKE-WAND to create a magic wand, and cause it to
appear in the COMPUTER-LAB.  Test out your code to make certain it
does what it is intended to.  Turn in a listing of your changes and
procedures. 

@paragraph(Problem 9)
Finally, there are many ways in which our world might become the scene for an 
interesting game. For example, add a new place SNACK-BAR to the set of places,
which one can get to from BLDG-10 by going EAST and from which one can
return to BLDG-36 by going WEST. (Due to a serious miscalculation by the
Admissions Office, MIT in our world 
has so many students that the Campus Patrol has
had to make some Institute corridors one-way.) Define things BEER and PIZZA
and cause them to APPEAR in the SNACK-BAR.  Also define a WAND, as in
Problem 8, and cause it to appear in the COMPUTER-LAB.  Modify the procedures
that make TROLLs and DEANs so that these creatures are added to the queue
that is MOVEd when CLOCK is invoked, and make a troll and a dean
as in problems 5 and 6.

Your goal is to get from the DORMITORY to the SNACK-BAR, pick up both BEER
and PIZZA, and get back to the DORMITORY for a party without losing your
possessions or being eaten by any trolls.  Do this without using the
message MOVE-TO, if you added such a message in problem 8.
You may stop at the computer lab first to get the magic wand, if you
wish.  Remember that in order to allow the other creatures in the
world to interact, you must alternate 
your moves with calls to CLOCK.   Turn in a listing
of your changes and definitions, and a "photo" copy (see the Scheme
Manual, p. 28) of one session of our game.
The difficulty of the
game can be altered by changing the HUNGER and OFFICIOUSNESS thresholds of the
TROLL and DEAN. Have fun!


As we noted at the beginning of the problems, many of them are
concerned with incremental changes to the procedures MAKE-PERSON,
MAKE-DEAN and MAKE-TROLL.  As a consequence, rather than turning in
several different versions of the same procedures, we suggest that
having finished all nine problems, you turn in one version of
each of the modified procedures, clearly marking all of your changes,
and indicating for each change, what problem the change was made in
response to.  Of course, remember to turn in any other things that
were specifically requested for individual problems.

@paragraph(Problem 10 -- Optional)

In problem 8, we introduced a modification to our system by creating
THINGS called WANDS that possessed certain unusual
properties.  This problem illustrated several important meta-level
aspects of message-passing systems.  In particular, it pointed out
several different issues about which one must worry when adding new
objects to the system, such as what extent procedures must be modified
to support the new objects, or what basic messages an object must
support, as well as general consistency issues between the new object
and previously created objects.

For this problem, design and implement another improvement to the
system, by adding either a new kind of PERSON or a new kind of
THING, with unusual properties.  Turn in a description (in English) of
the additions to the system, as well as listings of the procedures you
created and a sample of the program in action.

@b[CONTEST:] Prizes will be awarded for the cleverest programs turned
in for this exercise.


@newpage()
@begin(programexample)
;; This is the file ps6.scm

;; This file defines our imaginary world

;; Here is how we define people.

(define (make-person name place threshold)
  (let ((possessions '())
	(restlessness 0))
    
    (define (me m)
      (cond ((eq? m 'type) 'person)
	    ((eq? m 'name) name)
	    ((eq? m 'place) place)
	    ((eq? m 'look-around)
	     (forall (place 'things)
		     (lambda (thing)
		       (if (not (eq? me thing))
			   (print (thing 'name))))))
	    ((eq? m 'take)
	     (lambda (thing)
	       (if (memq thing (place 'things))
		   (sequence
		    (newline)
		    (princ name)
		    (princ " took ")
		    (princ (thing 'name))
		    (set! possessions (cons thing possessions))
		    (forall (filter (place 'things) person?)
			    (lambda (p)
				(if (and (not (eq? p me))
					 (memq thing (p 'possessions)))
				    (sequence
				     ((p 'lose) thing)
				     (have-fit p)))))
		    ((thing 'change-possessor) me)
		    'taken)
		   (error "Thing taken not at this place"
			  (list (place 'name) thing)))))

	    ((eq? m 'lose)
	     (lambda (thing)
	       (set! possessions (delete thing possessions))
	       ((thing 'change-possessor) 'no-one)
	       'lost))

	    ((eq? m 'list-possessions)
	     (forall possessions
		     (lambda (thing)
		       (print (thing 'name)))))

	    ((eq? m 'current-position)
	     (place 'name))

	    ((eq? m 'exits)
	     (place 'exits))

	    ((eq? m 'go)
	     (lambda (direction)
	       (let ((new-place ((place 'look-in) direction)))
		 (if (not (null? new-place))
		     (move-to new-place)
		     (sequence
		      (newline)
		      (princ "Can't go ")
		      (princ direction)
		      (princ " from ")
		      (princ (place 'name)))))))

	    ((eq? m 'possessions) possessions)

	    ((eq? m 'move)
	     (set! restlessness (1+ restlessness))
	     (if (> restlessness threshold)
		 (let ((new-place (random-place place)))
		   (if (not (null? new-place)) (move-to new-place)))))

	    ((eq? m 'go-to-heaven)
	     (forall possessions
		     (lambda(p) ((me 'lose) p)))
	     ((place 'gone) me)
	     ((heaven 'appear) me)
	     (set! place heaven)
	     'dead)

	    (else
	     (error "I don't know how to do this -- person"
		    (list name m)))))

    (define (move-to new-place)
      (announce-move name place new-place)
      (set! restlessness 0)
      (forall possessions
	      (lambda (p)
		((place 'gone) p)
		((new-place 'appear) p)))
      (let ((new-place-people
	     (filter (new-place 'things) person?)))
	(if (not (null? new-place-people))
	    (sequence
	     (newline)
	     (princ name)
	     (princ " says - Hi, ")
	     (forall new-place-people
		     (lambda(p)
		       (princ (p 'name))
		       (princ " "))))))
      ((place 'gone) me)
      ((new-place 'appear) me)
      (set! place new-place)
      nil)

    ((place 'appear) me)
    (enqueue me)
    me        ; return the dispatch procedure
    ))        ; end of MAKE-PERSON procedure

;; Here we initialize the queue of people in our world and define
;; queue-manipulation procedures.

(define queue '())

(define (enqueue person)
  (set! queue (cons person queue))
  'enqueued)

(define (unqueue person)
  (set! queue (delete person queue))
  'dequeued)


;; Here we define the places in our world

(define Bldg-36 (make-place 'Bldg-36))
(define eric-office (make-place 'eric-office))
(define hal-office (make-place 'hal-office))
(define Tech-Square (make-place 'Tech-Square))
(define computer-lab (make-place 'computer-lab))
(define EGG-Atrium (make-place 'EGG-Atrium))
(define Bldg-10 (make-place 'Bldg-10))
(define dormitory (make-place 'dormitory))
(define heaven (make-place 'heaven))
(define dungeon (make-place 'dungeon))
(define dean-office (make-place 'dean-office))

;; One-way paths connect individual places in the world.

(define (can-go from direction to)
  ((from 'new-neighbor) direction to))

(can-go Bldg-36 'up computer-lab)
(can-go Bldg-36 'north Tech-Square)
(can-go Bldg-36 'west EGG-Atrium)
(can-go Tech-Square 'south Bldg-36)
(can-go Tech-Square 'up hal-office)
(can-go hal-office 'down Tech-Square)
(can-go hal-office 'up eric-office)
(can-go eric-office 'down hal-office)
(can-go computer-lab 'down Bldg-36)
(can-go dormitory 'east Bldg-10)
(can-go Bldg-10 'west dormitory)
(can-go Bldg-10 'north EGG-Atrium)
(can-go dungeon 'up EGG-Atrium)
(can-go EGG-Atrium 'south Bldg-10)
(can-go EGG-Atrium 'east Bldg-36)
(can-go dean-office 'west dormitory)
(can-go dean-office 'down Bldg-10)

;; We define persons as follows:

(define eric (make-person 'eric eric-office 1))
(define hal (make-person 'hal hal-office 2))

;;Here we define a TROLL and a DEAN

(define (make-troll name place threshold)
  (let ((hunger 0)
	(possessions '()))
    (define (me m)
      (cond ((eq? m 'type) 'troll)
	    ((eq? m 'name) name)
	    ((eq? m 'place) place)
	    ((eq? m 'possessions) possessions)
	    ((eq? m 'current-position)
	     (place 'name))
	    ((eq? m 'move)
	     (set! hunger (1+ hunger))
	     (if (> hunger threshold)
		 (if (not (null? (people-at-place place)))
		     (eat-person (people-at-place place))
		     (let ((new-place (random-place place)))
		       (if (not (null? new-place)) (move-to new-place))))))
	    (else
	     (error "I don't know how to do this -- troll" m))))
;
    (define (people-at-place place)
      (filter (place 'things) person?))
;
    (define (eat-person persons)
      (let ((selected-person
	     (nth (random (length persons)) persons)))
	nil
	))
;
    (define (move-to new-place)
      (announce-move name place new-place)
      ((place 'gone) me)
      ((new-place 'appear) me)
      (set! place new-place)
      (if (not (null? (people-at-place new-place)))
	  (eat-person (people-at-place new-place))))
;
    ((place 'appear) me)
    me    ; return the dispatch procedure
    ))    ;end of MAKE-TROLL procedure


(define (make-dean place threshold)
  (let ((officiousness 0)
	(possessions '()))
    (define (me m)
      (cond ((eq? m 'type) 'person)
	    ((eq? m 'go-to-heaven)
	     ((place 'gone) me)
	     ((heaven 'appear) me)
	     (set! place heaven))
	    ((eq? m 'name) 'dean)
	    ((eq? m 'place) place)
	    ((eq? m 'possessions) possessions)
	    ((eq? m 'current-position)
	     (place 'name))
	    ((eq? m 'move)
	     (set! officiousness (1+ officiousness))
	     (if (> officiousness threshold)
		 (if (not (null? (beers-at-place place)))
		     (smash-beer place)
		     (let ((new-place (random-place place)))
		       (if (not (null? new-place)) (move-to new-place))))))
	    (else
	     (error "I don't know how to do this -- dean" m))))

    (define (beers-at-place place)

      '()

      )

    (define (smash-beer this-place)
      (print "DEAN says - Ah-HAH! Caught you!!")
      (print "I do not approve of beer on campus!")
      (print "DEAN smashes beer and returns to DEAN-OFFICE")
      (forall (beers-at-place this-place)
	      (lambda(b)
		(let ((owner (b 'possessor)))
		  ((owner 'lose) b)
		  (have-fit owner)
		  ((this-place 'gone) b))))
      (set! officiousness 0)
      ((this-place 'gone) me)
      ((dean-office 'appear) me)
      (set! place dean-office)
      'smashed)

    (define (move-to new-place)
      (announce-move 'DEAN place new-place)
      ((place 'gone) me)
      ((new-place 'appear) me)
      (set! place new-place)
      (if (not (null? (beers-at-place place)))
	  (smash-beer place)
	  'moved)
      )

    ((place 'appear) me)
    me     ; return the dispatch procedure
    ))     ;end of MAKE-DEAN procedure
@end(programexample)
@newpage()
@begin(programexample)
;; This is the file ps6-adv.scm

;; Here we define places and  things, as well as providing
;; generally useful procedures. You won't have to modify 
;; any of these procedures, so just load this file into Scheme.

;; A very simple implementation of things

(define (make-thing name)
  (let ((possessor 'no-one))
    (define (object m)
      (cond ((eq? m 'type) 'thing)
	    ((eq? m 'name) name)
	    ((eq? m 'change-possessor)
	     (lambda (new-possessor)
	       (set! possessor new-possessor)))
	    ((eq? m 'possessor) possessor)
	    (else
	     (error "I don't know how to do this -- thing"
		    (list name m)))))

    object  ; return the dispatch procedure
    ))

;; Implementation of places
;;
(define (make-place name)
  (let ((neighbors '()) (things '()))
    (define (here m)
      (cond ((eq? m 'type) 'place)
            ((eq? m 'name) name)
	    ((eq? m 'things) things)
	    ((eq? m 'neighbors)
	     (mapcar cdr neighbors))
	    ((eq? m 'exits)
	     (mapcar car neighbors))
	    ((eq? m 'look-in)
	     (lambda (direction)
	       (let ((p (associate direction neighbors)))
		 (if (null? p) nil (cdr p)))))
	    ((eq? m 'appear)
	     (lambda (new-thing)
	       (if (memq new-thing things)
		   (error "Thing already in this place"
			  (list name new-thing)))
	       (set! things (cons new-thing things))
	       'appeared))
	    ((eq? m 'gone)
	     (lambda (thing)
	       (if (not (memq thing things))
		   (error "Disappearing thing not here"
			  (list name thing)))
	       (set! things (delete thing things))
	       'disappeared))
	    ((eq? m 'new-neighbor)
	     (lambda (direction new-neighbor)
	       (if (associate direction neighbors)
		   (error "Direction already assigned a neighbor"
			  (list name direction)))
	       (set! neighbors
		     (cons (cons direction new-neighbor)
			   neighbors))
	       'connected))
	    (else
	     (error "I don't know how to do this -- place"
		    (list name m)))))
    here         ; return the dispatch procedure
    ))

;; The procedure for defining people is in the other file, since
;; we may need to modify it.


;; Some generally useful procedures

(define (announce-move name old-place new-place)
  (newline)
  (princ name)
  (princ " moved from ")
  (princ (old-place 'name))
  (princ " to ")
  (princ (new-place 'name)))

(define (have-fit p)
  (newline)
  (princ "Yaaaah! ")
  (princ (p 'name))
  (princ " is upset!"))

(define (random-place old-place)
  (let ((places (old-place 'neighbors)))
    (if (null? places)
	nil
	(nth (random (length places)) places))))


(define (forall set f)
  (cond ((null? set) nil)
	(else (f (car set))
	      (forall (cdr set) f))))

(define (filter set f)
  (cond ((null? set) '())
	((f (car set))
	 (cons (car set) (filter (cdr set) f)))
	(else (filter (cdr set) f))))

(define (delete o possessions)
  (let ((answer '()))
    (forall possessions
	    (lambda (elem)
	      (if (not (eq? elem o))
		  (set! answer (cons elem answer)))))
    answer))

(define (person? el)
  (eq? (el 'type) 'person))

(define (associate label pairs)
  (cond ((null? pairs) nil)
	((eq? label (caar pairs)) (car pairs))
	(else (associate label (cdr pairs)))))


;;Finally, we define the clock that will control our world:

(define (clock)
   (forall queue move))

(define (move person)
  (person 'move))

@end(programexample)