circular list class
-------------------

The `circular.class' is creating the circular list structure, as its
main static storage. List operations are carried out using list
`surgery'; directly manipulating pointers to cut out, or splice-in
elements of the list.

It is also the first class with multiple STATIC (nested let) lines,
and with private methods (using LETREC).

     to circular.class
     static [[pointer [[mark]]]]
     static [[start.o [localmake "cl (list :pointer) .setbf :cl :cl]
                      [(object.maker "pair.class :cl)]]]
     static [[end.o [(object.maker "pair.class (send "start.o "get))]]]
     lambda :message
     local [tmp msg self]
     make "msg bf :message make "self first :message
     op letrec [[
        [open [[]
               [.setbf (send "end.o "get) []]
               [op (send "start.o "get)]]]
        [close [[]
                [.setbf (send "end.o "get) (send "start.o "get)]
                [op (send "start.o "get)]]]
        [bl.pair [[clst]
                  [if.tf .eq first bf bf :clst :pointer [op :clst]]
                  [op (bl.pair bf :clst)]]]]
                [case [
                   [first :msg]
                   [[lput]
                    [make "tmp (send "end.o "get)]
                    [.setbf :tmp (list first bf :msg)]
                    [.setbf bf :tmp (send "start.o "get)]
                    [op bf (send "end.o "set bf :tmp)]]
                   [[fput]
                    [make "tmp bf (send "start.o "get)]
                    [.setbf (send "start.o "get) (list first bf :msg)]
                    [.setbf bf (send "start.o "get) :tmp]
                    [if.tf .eq first (send "end.o "get) :pointer [
                       ignore (send "end.o "set bf (send "start.o "get))]]
                    [op (send "start.o "get)]]
                   [[bf butfirst]
                    [.setfirst (send "start.o "set bf (send "start.o "get))
                               :pointer]
                    [make "tmp (send "start.o "get)]
                    [.setbf (send "end.o "get) :tmp]
                    [op :tmp]]
                   [[bl butlast]
                    [make "tmp (send "start.o "get)]
                    [.setbf (send "end.o "set (bl.pair bf :tmp)) :tmp]
                    [op :tmp]]
                   [[first indirect] [op first bf (send "start.o "get)]]
                   [[last] [op first (send "end.o "get)]]
                   [[empty? emptyp]
                    [op .eq first bf (send "start.o "get) :pointer]]
                   [[count]
                    [make "tmp  count bf (open)]
                    [ignore (close)]
                    [op :tmp]]
                   [[export]
                    [make "tmp map "identity bf (open)]
                    [ignore (close)]
                    [op :tmp]]
                   [[import]
                    [make "tmp (send "start.o "set fput :pointer first bf :msg)]
                    [.setbf (send "end.o "set last.pair :tmp) :tmp]
                    [op (send "self "export)]]
                   [[flush] [op (send "self "import [])]]
                   [[memberp member?]
                    [make "tmp  memberp first bf :msg bf (open)]
                    [ignore (close)]
                    [op :tmp]]
                   [[member] [op member first bf :msg (send "self "export)]]
                   [[rotate]
                    [make "tmp first bf (send "start.o "get)]
                    [.setfirst bf (send "start.o "get) :pointer]
                    [.setfirst (send "start.o "get) :tmp]
                    [ignore (send "end.o "set (send "start.o "get))]
                    [op (send "start.o "set bf (send "start.o "get))]]
                   [[type] [op "circular.list.object]]
                   [[set] [op delegate "base.object :message]]
                   [else [op delegate "start.o :message]]]]]
     end

The first STATIC line `static [[pointer [[mark]]]]' creates static
storage with the value [mark]. The next line uses the result of the
first ([mark]), to make the list [[mark]], and then converts it to
circular structure, and saves it in the static storage under the name
START.O. The last STATIC line uses the result of the second, to
create yet another static storage object (END.O), and initializes it
with the pinter to the circular structure created in the second line.
(1)

The order in which these STATIC lines are written is important. It is
probably also important to explain, why is the first object [mark],
written in the static line (and made available to the run-time part
of the circular object), instead of being created with MAKE. The
object `[mark]', is needed later on in the run-time part, to check
for the end of the list condition. Note this; not just any object
[mark], but precisely the same one that was used to create the
circular structure! It is later-on checked with `.eq', so you can use
as many [mark] lists as you like in your circular list, the original
one will still be detected.

CIRCULAR.CLASS defines three private procedures (methods) OPEN,
CLOSE, and BL.PAIR. As these procedures are of no use to any other
objects/procedures, they can safely be hidden within the CIRCULAR
object.

`Circular' is also the first class (we have seen so far) that uses
the word "SELF to send messages to itself. This is a form of
recursion, that object oriented paradigms often use, and it will be
explained later. See TUTORIAL.

`circular.class' objects respond to following messages:

`first ; indirect'
     outputs the first element of the circular list

`fput VALUE'
     inserts the VALUE to the front of the circular list, and outputs
     the new circular list

`bf ; butfirst'
     removes the first element from the circular list, and outputs
     the new circular list

`last'
     outputs the last element of the circular list

`bl ; butlast'
     removes the last element from the circular list, and outputs the
     new list

`lput VALUE'
     inserts the VALUE to the back of the circular list, and outputs
     the new circular list

`empty? ; emptyp'
     outputs true if the circular list is empty (2)

`count'
     outputs the number of top-level elements in the circular list

`member? ; memberp VALUE'
     outputs TRUE if the VALUE is a member of the circular list

`member VALUE'
     outputs the part of the circular list starting with VALUE, but
     as ordinary list. If VALUE is not a `meberp' of the circular
     list, outputs empty list.

`flush'
     empties the circular list, and outputs it ([])

`export'
     outputs the copy of the circular list (as an ordinary list)

`import ORDINARY LIST'
     replaces the value of the circular list with the ORDINARY LIST,
     and outputs that list.

`rotate'
     rotates (shifts left) the circular list, and outputs the new
     circular list

Before we test circular list, we should set the PRINTWIDTHLIMIT
variable to a reasonable value.

     make "printwidthlimit 16

     define "circular1 (object.maker "circular.class)

     show send "circular1 "get
     [[mark] [mark] [mark] [mark] [mark] [mark] [mark] [mark] [mark] [mark] ...]
     show send "circular1 "empty?
     true
      show send "circular1 "export
     []
     show (send "circular1 "lput "a)
     [[mark] a [mark] a [mark] a [mark] a [mark] a [mark] a [mark] a [mark] a ...]
     show (send "circular1 "lput "b)
     [[mark] a b [mark] a b [mark] a b [mark] a b [mark] a b [mark] ...]
     show (send "circular1 "lput "c)
     [[mark] a b c [mark] a b c [mark] a b c [mark] a b c ...]
     show (send "circular1 "fput "1)
     [[mark] 1 a b c [mark] 1 a b c [mark] 1 a b c [mark] ...]
     show send "circular1 "count
     4
     show send "circular1 "export
     [1 a b c]
     show (send "circular1 "member "b)
     [b c]
     show (send "circular1 "member? "x)
     false
     show send "circular1 "bf
     [[mark] a b c [mark] a b c [mark] a b c [mark] a b c ...]
     show send "circular1 "rotate
     [[mark] b c a [mark] b c a [mark] b c a [mark] b c a ...]
     show send "circular1 "rotate
     [[mark] c a b [mark] c a b [mark] c a b [mark] c a b ...]
     show send "circular1 "bl
     [[mark] c a [mark] c a [mark] c a [mark] c a [mark] c a [mark] ...]
     show (send "circular1 "import [1 2 3 4 5])
     [1 2 3 4 5]
     show send "circular1 "get
     [[mark] 1 2 3 4 5 [mark] 1 2 3 4 5 [mark] 1 2 3 ...]
     show send "circular1 "flush
     []
     show send "circular1 "get
     [[mark] [mark] [mark] [mark] [mark] [mark] [mark] [mark] [mark] [mark] ...]
     show (send "circular1 "set [1 2 3 4 5])
     ERROR: set [1 2 3 4 5] not understood by object: circular1
     show send "circular1 "erase.object
     [20006 79950]

---------- Footnotes ----------

(1) This class was written using BUCKET.CLASS, and will still work
with it, if all occurrences of PAIR.CLASS were replaced with
BUCKET.CLASS.

(2) The empty circular list looks like this: [[mark]]

double ended list class
-----------------------

DOUBLE.END.CLASS is functionally very similar to the CIRCULAR.CLASS,
so they can be used for the same programming tasks. However it is
implemented very differently, and works only with the PAIR.CLASS. (1)

This class uses for main storage a special kind of list (2) (double
ended), which means that both ends of a list are directly accessible.
Front through the FIRST pointer, and rear end through BUTFIRST
pointer. From this, it should be obvious, that the easiest way to
achieve that kind of flexibility, is to handle the access to double
ended list via the cons cell (PAIR.CLASS).

We use the PAIR.CLASS to create a cons cell (CELL.O), and then
manipulate its first and butfirst pointers, to gain access to the
double ended list.

     to double.end.class [:init []]
     if not listp :init [(send "base.object "error
                               [Input must be a list!])]
     static [[cell.o [
        (object.maker "pair.class :init ifelse emptyp :init
                      [:init]
                      [last.pair :init])]]]
     lambda :message
     local [msg self tmp]
     make "msg bf :message make "self first :message
     case [
        [first :msg]
        [[lput]
         [make "tmp (list first bf :msg)]
         [ifelse.tf emptyp send "cell.o "get
                    [ignore (send "cell.o "set :tmp)]
                    [.setbf (send "cell.o "gety) :tmp]]
         [op (send "cell.o "sety :tmp)]]
        [[first indirect] [op first send "cell.o "get]]
        [[bf butfirst] [op (send "cell.o "set bf send "cell.o "get)]]
        [[last] [op first send "cell.o "gety]]
        [[empty? emptyp] [op emptyp send "cell.o "get]]
        [[fput]
         [if.tf emptyp send "cell.o "get
                [op (send "self "lput first bf :msg)]]
         [make "tmp (list first bf :msg)]
         [.setbf :tmp send "cell.o "get]
         [op (send "cell.o "set :tmp)]]
        [[import]
         [ignore (send "cell.o "sety last.pair fput "x first bf :msg)]
         [op (send "cell.o "set first bf :msg)]]
        [[bl butlast] [op (send "self "import bl send "cell.o "get)]]
        [[count] [op count send "cell.o "get]]
        [[flush] [op (send "self "import [])]]
        [[member? memberp]
         [op memberp first bf :msg send "cell.o "get]]
        [[member] [op member first bf :msg send "cell.o "get]]
        [[shift.left]
         [make "tmp first send "cell.o "get]
         [ignore send "self "bf]
         [ignore (send "self "lput :tmp)]
         [op send "cell.o "get]]
        [[shift.right]
         [make "tmp first send "cell.o "gety]
         [ignore send "self "bl]
         [op (send "self "fput :tmp)]]
        [[export] [op map "identity send "cell.o "get]]
        [[type] [op "double.ended.list.object]]
        [else [op delegate "cell.o :message]]]
     end

You will notice the slight complication in the STATIC line;

     static [[cell.o [
        (object.maker "pair.class :init ifelse emptyp :init
                      [:init]
                      [last.pair :init])]]]

If the double.end object was created without initial value (it will
default to the empty list), there are no problems. However, if the
INIT was a non empty list, we must make sure that the BUTFIRST part
of the CELL.O gets initialized with the pointer to the `last.pair' of
the input list.

`double.end.class' objects respond to following messages:

`first ; indirect'
     outputs the first element of the double ended list

`fput VALUE'
     inserts the VALUE to the front of the double ended list, and
     outputs the new double ended list

`bf ; butfirst'
     removes the first element from the double ended list, and
     outputs the new double ended list

`last'
     outputs the last element of the double ended list

`bl ; butlast'
     removes the last element from the double ended list, and outputs
     the new list

`lput VALUE'
     inserts the VALUE to the back of the double ended list, and
     outputs the last pair of the double ended list

`empty? ; emptyp'
     outputs true if the double ended list is empty

`count'
     outputs the number of top-level elements in the double ended list

`member? ; memberp VALUE'
     outputs TRUE if the VALUE is a member of the double ended list

`member VALUE'
     outputs the part of the double ended list starting with VALUE.
     If VALUE is not a `meberp' of the double ended list, outputs
     empty list.

`flush'
     empties the double ended list, and outputs it ([])

`export'
     outputs the copy of the double ended list

`import LIST'
     replaces the value of the double ended list with the LIST, and
     outputs that list.

`shift.left'
     shifts left the double ended list (like rotate for CIRCULAR
     list), and outputs the list

`shift.right'
     shifts right the double ended list, and outputs the list

Here are some examples of interaction with one DOUBLE ENDED LIST
object:

     define "double1 (object.maker "double.end.class [1 2 3 4 5])

     show send "double1 "export
     [1 2 3 4 5]
     show send "double1 "first
     1
     show send "double1 "last
     5
     show send "double1 "rotate
     ERROR: rotate not understood by object: double1
     show send "double1 "shift.left
     [2 3 4 5 1]
     show send "double1 "shift.right
     [1 2 3 4 5]
     show send "double1 "count
     5
     show send "double1 "bf
     [2 3 4 5]
     show send "double1 "bl
     [2 3 4]
     show send "double1 "flush
     []
     show (send "double1 "fput "1)
     [1]
     show (send "double1 "lput "2)
     [2](3)
     show (send "double1 "import [a b c d])
     [a b c d]
     show send "double1 "export
     [a b c d]
     show send "double1 "raw
     [[a b c d] d](4)
     show send "double1 "bl
     [a b c]
     show send "double1 "bl
     [a b]
     show send "double1 "bl
     [a]
     show send "double1 "bl
     [a]
     show send "double1 "bl
     bl doesn't like [] as input  in double1
     [run [local "#target make ... ... "cell.o :message]]]]]]]]]]]]]]]]]]

The last line of error message has been shortened, because Logo
printed out the line in which the error occurred. It just happens
that this line is the whole code of the `double.end.class'
object--spanning probably some 20 physical lines. This is standard
Logo behavior, so do not think that you have discovered an error in
LOOPS. None of the raw list structures in LOOPS protect against this.
Just as in standard Logo, you will have to check for empty list,
before you send a message like BUTLAST. On the other hand, the higher
level objects (e.g; STACK, and QUEUE), do have a built in protection.

---------- Footnotes ----------

(1) Actually--PAIR.CLASS was written during implementation of
DOUBLE.END.CLASS.

(2) The underlying structure of double ended list is really an
ordinary list--it is just accessed differently.

(3) Remember-LPUT outputs for efficiency reasons only the last pair
if the list

(4) RAW message is inherited from the PAIR.CLASS. This example is
included just to show you how Logo sees the double ended list.

queue class
-----------

The `queue.class' is queue(1) implemented on top of the DOUBLE ENDED
LIST. All of the work is done by the DOUBLE.END.CLASS object--the
queue class only adds a few checks to prevent empty list errors, and
renames several of double ended list operations.

If you ask yourself--why implementing the queue at all, when Logo has
perfectly good queue operations in library (`queue', and `dequeue')?
The answer is, (in theory only) efficiency. Logo library `queue'
command is implemented with `lput', and to insert the new element
into the queue of length N, it requires `c1'(N) steps(2) The queue
based on double ended list structure can insert the element at the
end of the list in `c2'(1) steps, which--if we consider a very large
queue, is considerable saving. This sounds very promising--however
the problem is in the two constants `c1' for Logo queue, and `c2' for
LOOPS queue. C1 is implemented in C,and runs very fast, while C2 is
implemented in LOOPS code, which is implemented in LOGO code ...
which is all very slow. The bottom line is; LOOPS queue will be
faster, but this will become apparent when the queue grows over some
8000 elements. With short queues Logo QUEUE will be much faster.

     to queue.class
     static [[del.o [(object.maker "double.end.class)]]]
     lambda :message
     local [tmp msg self]
     make "msg bf :message make "self first :message
     case [
        [first :msg]
        [[enqueue] [op first (send "del.o "lput first bf :msg)]]
        [[dequeue]
         [make "tmp send "self "front]
         [ignore send "del.o "bf]
         [op :tmp]]
        [[front]
         [if.tf send "del.o "empty? [(send "del.o "error [queue is empty])]]
         [op send "del.o "first]]
        [[type] [op "queue.object]]
        [[lput fput bf butfirst bl butlast first last shift.left shift.right]
         [op delegate "base.object :message]]
        [else [op delegate "del.o :message]]]
     end

`queue.class' objects respond to following messages:

`enqueue VALUE'
     inserts VALUE as the last element in the queue, and outputs VALUE

`dequeue'
     removes the first element from the queue, and outputs it. It is
     an error if the queue is empty.

`front'
     outputs the first element of the queue. It is an error if the
     queue is empty.

Here are some examples of interaction with one QUEUE object:

     define "q (object.maker "queue.class)

     show send "q "export
     []
     show send "q "front
     ERROR:  queue is empty
     show (send "q "enqueue "a)
     a
     show (send "q "enqueue "b)
     b
     show (send "q "enqueue "c)
     c
     show send "q "size
     ERROR: size not understood by object: q
     show send "q "count
     3
     show send "q "empty?
     false
     show send "q "dequeue
     a
     show send "q "dequeue
     b
     show send "q "dequeue
     c
     show send "q "dequeue
     ERROR:  queue is empty
     show (send "q "enqueue 111)
     111
     show send "q "flush
     []
     show send "q "erase.object
     [19226 255950]

---------- Footnotes ----------

(1) FIFO--first in first out structure

(2) where `c1' is a constant number of primitive operations needed to
move to the next element of the list, looking for the end of the list.

Turtles
=======

Implementation
==============

This section will briefly describe the inner workings of the
`object.maker', class to object transformer/compiler, and the only
other relatively interesting procedure in loops code--`send'.

Sending Messages
----------------

SEND has three roles in LOOPS. All three are syntax related--mostly
cosmetics, and can be described as ensuring the uniform object
calling mechanism.

The first one is to make sure every object receives its own name as a
part of the message. Most of the time objects do not need their own
name, but it should always be present.(1) If object was to be invoked
without SEND, this would not look very logical. Let's say we have
defined an instance of QUEUE.CLASS queue1. Without `send', the
invocation would look like this:

     ;; call 1

     show queue1 "queue1 "dequeue

Here, we have applied top-level queue1 object to two messages,
QUEUE1, and DEQUEUE. This looks very lame--why do we have to use word
QUEUE1 twice? The result would be the same as if using send, but the
invocation with SEND looks much better:

     ;; call 2

     show send "queue1 "dequeue

This looks exactly as described in introduction to OOP; we are not
applying the object to messages, but are sending messages to the
object. The first parameter to SEND is always the quoted name of the
object, and the rest are messages. In our example we are sending the
message DEQUEUE to the object QUEUE1. What the user does not see is
that SEND will convert this call to something very similar to the
direct invocation of object, therefore--although the name QUEUE1
appears only once, SEND will use it twice. Once to invoke the QUEUE1
object, and then to send it messages QUEUE1, and DEQUEUE.

The second role of SEND is more important. LOOPS objects can bee real
(global) procedures, but most of them will be virtual procedures
(values in property lists). Global procedures can be called as in
`call 1', but virtual cannot. The application of a virtual procedure
should be something like this:

     ;; call 3

     show invoke "queue1 "queue1 "dequeue

Yet another syntax variation. Using SEND we can avoid this as well.
Let SEND decide how should the application look like.(2).

The third role of SEND is to fully dereference object's name before
applying the object, therefore ensuring (again) the uniform syntax of
a call. This needs little more elaborating.

We would like to be able to use quoted object's name in every call.
This is OK if we are directly calling the global object (by its real
name), or even a virtual object by its real name, but consider this
situation: From inside one object, we need to call that object
recursively, using SELF as object's name. As this SELF is just a
variable name, it needs to be dereferenced before we can get to the
real object's name. It gets even worse--say that the recursive call
ended with yet another call to SELF. If SEND did not dereference the
name fully *every* time, we would end up with variable SELF, that
would be dereferenced as SELF, that would be dereferenced again as
SELF ...

To avoid this we could use :SELF instead of "SELF in every call that
uses it, dereferencing it manually, but that would upset the uniform
syntax of object calling. Self is really a very simple example of
dereferencing problem because it is always the same name that has to
be dereferenced manually. Consider what happens when you start
passing other objects by name to object during compile-time. Those
names would have to be dereferenced as well(3).

`send', although a very simple procedure, does away with all these
problems, but there is a price to pay--it slows down object
invocation.

     to send [:msg.list] 2
     op send.helper first :msg.list
     end

     to send.helper :send.object
     if.tf listp :send.object ~
           [op apply :send.object (list (fput :send.object bf :msg.list))]
     if.tf definedp :send.object ~
           [op apply :send.object (list (fput :send.object bf :msg.list))]
     op send.helper thing :send.object
     end

`send' calls `send.helper' with object name as the only input.
Object.helper first checks to see if the object is a list. If true
(it must be a virtual object), it applies it to the list of itself
and the rest of inputs.  If not it checks to see if the name is the
name of the user defined global procedure. If true, it applies it as
in the first case. If not it dereferences the name once, and
recursively calls itself. Sooner or later it should arrive either to
the name of the global object, or to the virtual object itself.

This version of `send' is not safe. One can imagine the scenario in
which `send' would spin forever. To avoid this, we can use a sefe
version of `send':

     ; to send [:msg.list] 2
     ; op send.helper first :msg.list 0
     ; end
     ;
     ; to send.helper :send.object :count
     ; if.tf listp :send.object ~
     ;       [op apply :send.object (list (fput :send.object bf :msg.list))]
     ; if.tf definedp :send.object ~
     ;       [op apply :send.object (list (fput :send.object bf :msg.list))]
     ; if.tf equalp :count 10 [
     ;    (send "base.object "error
     ;          (se  "Cannot "dereference "object :send.object))]
     ; op send.helper thing :send.object :count+1
     ; end

This is even more expensive than before, and that's why the first
version is used.

---------- Footnotes ----------

(1) The common reasons for the object to require its own name are;
recursion--object needs to call itSELF, wrong message has been sent
to the object--base object needs the name of the top-level object to
display the error message, and the object has received the message
ERASE.OBJECT--the base object needs to know which top-level object to
trash.

(2) Actually it always looks like CALL 3

(3) A good example is in QUEENS8.CLASS, and QUEEN.CLASS.

Compiling Objects
-----------------

Before we start with `object.maker', something should be said about
the programming style in LOOPS code. After all that Brian(1) has
taught us, one would expect to find here only functional programming.
Most of the code is, but--there are some exceptions. One is the
`letrec' macro. That is to be expected. To achieve LETREC scope rules
LOCAL PROCEDURES, stack is used (and that means
assignment).(2) However `object.maker', contains a few examples of
"lax" programming. You will find there several
`make "something bf :something' within `while' loops. This did not
necessarily have to be so, but with `object.maker' being relatively
complex piece of code--style is of secondary importance.

Even though it is using `while', which (in this case) means
assignment, `object.maker' is a deeply recursive procedure. It recurs
both on FIRST, and BUTFIRST of the class code. Just how and where
this is done will be explained later. Object oriented programming
paradigm itself is based mostly on assignment, so it should not come
as a surprise that assignment is used in LOOPS code.

Another important aspect of LOOPS code is the liberal use of Logo's
*dynamic scope*. Practically nothing in LOOPS would work without it.
This is probably the result of one of Brian's remarks on how well
dynamic scope lends itself to writing compilers(3). Transformer
(compiler) code really is easier to write using the dynamic scope,
but it is also that much more difficult to follow and understand.

For the purpose of easier explanation, `object.maker''s code has been
broken down to several logical blocks:

     to object.maker :&class& [:&args&]
     local [&proc& proc.&text &static& var.&list var.&tmp val.&list &lambda&
                   &optional& formal.&names &locals& init.&static &formals&
                   in.&proc &binding&]

     ;; 1
     make "proc.&text text :&class&

     ;; 2
     make "formal.&names filter [[&x] [op not.tf numberp :&x]] map [
        [&x] [(if.tf listp :&x [op first :&x] [op :&x])]] first :proc.&text
     local :formal.&names
     define "&optional& fput first :proc.&text [[op map "thing :formal.&names]]
     (foreach apply "&optional& :&args& :formal.&names [[&a &f] [make :&f :&a]])
     er (list "&optional&)

     ;; 3
     make "proc.&text bf :proc.&text
     make "&binding& first :proc.&text
     (while [not (or [equalp first :&binding& "static]
                     [equalp first :&binding& "lambda]
                     [emptyp bf :proc.&text])]
            [run :&binding& make "proc.&text bf :proc.&text
                 make "&binding& first :proc.&text])

     ;; 4
     make "var.&list []
     make "&static& first :proc.&text
     ;; checking for top-level object
     if.tf not namep "unq.&object.name [
        local [unq.&object.name method.&stack export.&stack]
        make "unq.&object.name gensym
        make "method.&stack []
        make "export.&stack []]
     make "&proc& (word :unq.&object.name ". gensym ". :&class&)
     er lput (list :&proc&) [[] []]
     bury lput (list :&proc&) [[] []]

     ;; 5
     (while [equalp first :&static& "static]
            [;; get names
            make "var.&tmp firsts last :&static&
            ;; get values & push method name if keyword "method.export found
            make "val.&list (map [
               [&x &y]
               [if.tf equalp first first :&x "method.export
                      [push "method.&stack :&y]]
               [op begin :&x]] bfs last :&static& :var.&tmp)
            ;; bind name-value pairs
            (foreach :var.&tmp :val.&list [[&r &l] [pprop :&proc& :&r :&l]])
            make "var.&list se :var.&list :var.&tmp
            ;; making bindings visible in next STATIC line during compile
            ;; time -- that's why all these &&&...
            local :var.&tmp
            (foreach :var.&tmp :val.&list [[&r &l] [make :&r :&l]])
            ;; try next static line
            make "proc.&text bf :proc.&text
            make "&static& first :proc.&text])

     ;; 6
     ;; mandatory LAMBDA line
     make "&lambda& first :proc.&text
     if not (and [equalp first :&lambda& "lambda]
                 [equalp first last :&lambda& ":]) [
                    (pr [ERROR: Missing or incorrect LAMBDA line in:] :&class&)
                    pr :&lambda&
                    pr [it should look like this:]
                    pr [lambda :messagename]
                    throw "toplevel]
     ;; building object
     make "&locals& list "local :var.&list
     make "init.&static map.se [
        [&var]
        [op (list "make word "" :&var "gprop word "" :&proc& word "" :&var)]
     ] :var.&list
     make "in.&proc []
     if.tf equalp :&class& "bucket.class [
        make "in.&proc (list "make ""#in.procedure# word "" :&proc&)
        make "&locals& list "local fput "#in.procedure# :var.&list]
     ;; stripping column from message name (some obscure 5beta reason)
     make "&formals& (list bf last :&lambda&)
     ;; compiling object
     op compile.object (fput :&formals& fput :&locals& fput se :in.&proc
                             :init.&static insert.method bf :proc.&text)
     end

`1'
     Variable PROC.&TEXT is initialized with the text of the input
     class.

`2'
     This part of code resolves the problem of class optional inputs.
     Actually, most of the work is carried out by Logo parser, but
     some preparations are necessary. Lambda, extracting the names of
     class formal parameters is mapped into the list of class
     parameters. Then, any numbers (default number of inputs) are
     filtered out, and resultant list stored in variable
     FORMAL.&NAMES.

     Next, helper procedure &optional& is defined with the text
     composed of class list of inputs, and only one other line:
     `[op map "thing :formal.&names]'. Local variables (class formal
     parameters) are created in the `object.maker''s environment.
     Foreach is applied to two lists; first being the output of
     helper function &optional& applied to class arguments, and the
     list of class formal parameters. Foreach binds values of
     arguments to the list of formal names in `object.maker''s
     environment.

     Lastly--helper function &optional& is erased.

`3'
     List of class inputs is removed from class text, and the first
     line of class code is bound to the variable &binding&. While
     block, after checking for lines starting with STATIC, or LAMBDA,
     runs each &binding& line, preparing the `object.maker''s
     environment for the first STATIC line. When the first STATIC, or
     a LAMBDA line is found, while exits.

`4'
     Variable VAR.&LIST is initialized with empty list. This will
     hold the names of static storage variables, and virtual objects.
     A check is performed for existence of the variable
     UNQ.&OBJECT.NAME. If the variable does not exist (we are in the
     top-level class) local storage for three variables is reserved.
     Variable UNQ.&OBJECT.NAME is bound to the value of `gensym'.
     This will be the top-level name for all static storage object
     created by the class. Variables METHOD.&STACK, and EXPORT.&STACK
     are initialized with empty lists. Then, regardless of being in
     the top-level or not, another `gensym', and the class name are
     added to the top-level symbol, and stored in the variable
     &PROC&, which will hold the full name of the static storage
     object. All properties with the same name are erased (just to be
     on the safe side), and the name of &PROC& property list is
     buried, to hide it (from the user).

`5'
     Another `while' block is started, resolving STATIC lines, one at
     a time. Variable VAR.&TMP is initialized with the list names of
     all VAR-NAME parts of the first static line. The lambda,
     calculating values of each VAL-EXPRESSION part of STATIC line is
     mapped onto the list VAL-EXPRESSIONs and the contents variable
     VAR.&TMP, and the result is assigned to the variable VAL.&LIST.
     At the same time, if the METHOD.EXPORT keyword is found, its
     method name is pushed onto the METHOD.&STACK. The recursive call
     in `object.maker' is hidden in this lambda--the exact location
     being `[op begin :&x]'.

     Next, `foreach' binds VAR.&TMP names to VAL.&LIST values in
     property lists. If we want to achieve nested LET scope rules for
     multiple STATIC lines, we must export the current STATIC line
     bindings into the `object.maker''s environment. That is done in
     the next FORECH line. This is of-course, very dangerous. We are
     mixing class, and `object.maker''s environments, introducing the
     possibility of name clashing. That's why all those strange
     variable names in `object.maker'. The only advice, to avoid the
     possibility of name clashes, is: do not use variable names that
     include `&' character, and you will be safe.

`6'
     We first check that the LAMBDA line exists, and that it has the
     correct syntax. After that we start building the object:

     Variable &LOCALS& is initialized with the list of local
     variables (static storage) used by the object. The text for
     initializing local variables from property lists (once the
     object is run) is built.

     Finally, the values of variables &FORMALS&, &LOCALS&, and
     INIT.&STATIC are prepended to the run-time part of the class
     text, and everything is compiled by the loops.compiler. Before
     compilation, the run-time part of the class text is parsed for
     export.method references, and the text adjusted accordingly.

This explanation was too brief and dry, to do much good. Anyway, the
full understanding of how the `object.maker' works is not necessary.
It is enough to learn the syntax rules for constructing classes, and
to remember not to use variable names that include the character `&'.
If you really need this character, at least check the names in
`object.maker' to avoid name clashing.

---------- Footnotes ----------

(1) Introducing computer Science Logo Style, by Brian Harvey, MIT
Press 1997.

(2) It is my understanding that Scheme uses the same principle.

(3) CSLS Pascal compiler written in Logo

Tutorial
********

Graphics
========

Symbolic Computing
==================

Round Table
-----------

The problem is described, as the ROUND TABLE problem. It appears that
king Arthur wanted to get rid of his knights.(1) He found a clever
way to do that. He asked them to choose one small number N (a skip
number). When they did, he started counting them one by one, around
the table. He would skip N knights, and execute the next one, then
skip N again, and so on. The last knight remaining at the table was
spared (to tell the story).

We must write a program that prints out names of knights that were
skipped, the name of the knight that was executed, and so on, finally
printing out the name of the last knight that was spared.

We can do this with standard Logo:

What we need is a procedure `round.table' that takes two inputs, a
number N (number of knights to be skipped), and a list of knights. It
should terminate and output the name of the last knight, when only
one name remains in the list. Otherwise it should skip N knights,
remove the first name after that from the list, and call itself
recursively on the list consisting of the rest of the knights. Would
this work? Well not really. What happened to the knights that were
skipped? They obviously have to be included in the recursive call.

If we read the problem one more time, we must notice that the table
is round. What must be done, is to simulate this shape in our list of
knights. As the list is not circular, we can add skipped knights one
by one to the end of the list, creating an illusion of circularity.

This is best solved using helper procedure `skip.knights', which will
step through the list of knights--skipping, and appending to the end,
one by one until the skip number N reaches zero. It should then
return the butfirst of the list to the `round.table' procedure. By
returning the butfirst of the list, we have literally executed the
first knight.

     to round.table :n :lst
     if emptyp bf :lst [op first :lst]
     op round.table :n skip.knights :n :lst
     end

     to skip.knights :skip :lst
     if zero? :skip [(pr "executed: first :lst) op bf :lst]
     (pr "skipped: first :lst)
     op skip.knights :skip-1 lput first :lst bf :lst
     end

We can test it like this:

     (pr "spared: round.table 2 [John Gavin Lancellot Robin Arthur])
     skipped: John
     skipped: Gavin
     executed: Lancellot
     skipped: Robin
     skipped: Arthur
     executed: John
     skipped: Gavin
     skipped: Robin
     executed: Arthur
     skipped: Gavin
     skipped: Robin
     executed: Gavin
     spared: Robin

If it were not for PRINT commands that are here only to keep track of
the progress (but spoil the elegance), this would be purely
functional style. Unfortunately, many find this style difficult to
learn.

You will have probably noticed another problem with previous
solution. We are only simulating the circular structure by `lput'-ing
skipped knights back into the list. Solution would be simpler, if we
were able to model the data exactly in the shape of the problem
description. LOOPS has a ready-made solution for this--CIRCULAR LIST.

We have to define the ROUND TABLE CLASS that will have as its static
storage the circular list of knights, and will be able to respond to
several messages. The list of messages we need to solve the problem
is very short:

`skip'
     Simply skip the first knight

`execute'
     Chop knight's head off

`last?'
     Ask round table if only one knight remains

`initialize'
     This one is not so obvious. We need to be able to re-initialize
     the list of knights for every new run of the round table, even
     if we want to use the same list of knights as before. Do not
     forget that OOP is assignment based, and that means
     side-effects. One of these side-effects is that the circular
     list gets literally shortened, with every execution (just like
     the unlucky knight).

We can start with the frame for the `round.table.class'.

     to round.table.class
     static [[circle [(... ...)]]]
     lambda :msg
     local "first
     op case [
        [first bf :msg]
        [[last?] [(send "circle ...) = 1]]
        [[skip]
         [make "first send "circle ...]
         [ignore send "circle ...]
         [:first]]
        [[execute output]
         [make "first send "circle ...]
         [ignore send "circle ...]
         [:first]]
        [[initialize]
         [(send "circle ... map "identity first bf bf :msg)]]
        [[type] ["knights.object]]
        [else [delegate "base.object :msg]]]
     end

You can try to complete this. Each ellipsis stands for exactly one
word. They should all be messages that the `circular.class' responds
to, except the two in the static line. These two will have to create
the virtual object `circle'.

It is difficult to program, without being able to test your code, so
here is the definition of `knights' procedure, that does king
Arthur's dirty work for him:

     to knights :n :lst
     if not definedp "table [define "table (object.maker "round.table.class)]
     ignore (send "table "initialize :lst)
     while [not send "table "last?] [
        repeat :n [(pr "skipped: send "table "skip)]
        (pr "executed: send "table "execute)]
     (pr "spared: send "table "output)
     end

The `knights' procedure uses `while', which is of-course assignment
based, but fits this context smoothly--there are no obvious direct
`make' assignments to spoil the elegance.

Now, we can complete the `round.table.class':

     to round.table.class
     static [[circle [(object.maker "circular.class)]]]
     lambda :msg
     local "first
     op case [
        [first bf :msg]
        [[last?] [(send "circle "count) = 1]]
        [[skip]
         [make "first send "circle "first]
         [ignore send "circle "rotate]
         [:first]]
        [[execute output]
         [make "first send "circle "first]
         [ignore send "circle "bf]
         [:first]]
        [[initialize]
         [(send "circle "import map "identity first bf bf :msg)]]
        [[type] ["knights.object]]
        [else [delegate "base.object :msg]]]
     end

Creating the `circle' object, and messages LAST?, SKIP, and EXECUTE
need no comments. The message OUTPUT is simply cosmetics. It is the
same as EXECUTE, but as the last knight is not executed, we use the
different name for the same action.

Message INITIALIZE, apart from sending the `circle' object message
IMPORT, must also ensure that the input list is copied(2), because it
will be destroyed during the execution of the `knights' procedure.

We can test this with:

     knights 2 [John Gaven Lancellot Robin Arthur]
     skipped: John
     skipped: Gaven
     executed: Lancellot
     skipped: Robin
     skipped: Arthur
     executed: John
     skipped: Gaven
     skipped: Robin
     executed: Arthur
     skipped: Gaven
     skipped: Robin
     executed: Gaven
     spared: Robin

During the first run, you will notice a brief waiting interval,
before the first printout. That is the time needed by `object.maker'
to compile the `table' object. When you run this next time (even with
changed inputs), there will be no pause.

When object `table' is no longer needed, you should delete it with:

     pr send "table "erase.object
     19114 79950

Exercises
.........

We are using one local variable (FIRST) in the ROUND.TABLE.CLASS
code. If the CIRCULAR.CLASS object is built using the BUCKET.CLASS,
that is the only option. But if we use the PAIR.CLASS (as we do),
than this local variable is not necessary.

`a'
     Write the new definition of the ROUND.TABLE.CLASS, that does not
     use make at all.

     Hint: use the dual storage capacity of the pair.object

`b'
     What is the name of the object (in CIRCULAR.CLASS), whose
     butfirst part we use in part `a'?

---------- Footnotes ----------

(1) Maybe this had something to do with queen Guinevere?

(2) We must provide a copy of the list, and not the list itself,
because we cannot be sure wether the input was a constant (as in the
test run--in which case it doesn't matter), or a list stored in a
variable--which could possibly be used again.