This is loops.info, produced by makeinfo version 4.0 from /usr/local/src/BUILD/logo-mode/loops-guide.texi.  File: loops.info, Node: CIRCULAR, Next: DOUBLEdEND, Prev: STACK, Up: BASE CLASSES 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. *Note 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]]  File: loops.info, Node: DOUBLEdEND, Next: QUEUE, Prev: CIRCULAR, Up: BASE CLASSES 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.  File: loops.info, Node: QUEUE, Prev: DOUBLEdEND, Up: BASE CLASSES 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.  File: loops.info, Node: TURTLES, Next: IMPLEMENTATION, Prev: BASE CLASSES, Up: OBJECT ORIENTED PROGRAMMING Turtles =======  File: loops.info, Node: IMPLEMENTATION, Prev: TURTLES, Up: OBJECT ORIENTED PROGRAMMING 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'. * Menu: * SENDING MESSAGES:: * COMPILING OBJECTS::  File: loops.info, Node: SENDING MESSAGES, Next: COMPILING OBJECTS, Prev: IMPLEMENTATION, Up: IMPLEMENTATION 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.  File: loops.info, Node: COMPILING OBJECTS, Prev: SENDING MESSAGES, Up: IMPLEMENTATION 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 *Note 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  File: loops.info, Node: TUTORIAL, Next: ANSWERS, Prev: OBJECT ORIENTED PROGRAMMING, Up: Top Tutorial ******** * Menu: * GRAPHICS:: * SYMBOLIC COMPUTING::  File: loops.info, Node: GRAPHICS, Next: SYMBOLIC COMPUTING, Prev: TUTORIAL, Up: TUTORIAL Graphics ========  File: loops.info, Node: SYMBOLIC COMPUTING, Prev: GRAPHICS, Up: TUTORIAL Symbolic Computing ================== * Menu: * ROUND TABLE:: * DIGITAL CLOCK:: * QUEENS::  File: loops.info, Node: ROUND TABLE, Next: DIGITAL CLOCK, Prev: SYMBOLIC COMPUTING, Up: 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.