<> <> <> <> <> <> <> <> <> ANNOTATED CEDAR EXAMPLES ANNOTATED CEDAR EXAMPLES CEDAR 6.1  FOR INTERNAL XEROX USE ONLY CEDAR 6.1  FOR INTERNAL XEROX USE ONLY Annotated Cedar Examples Version 6.1 Release as [Cedar]Documentation>CedarExamplesDoc.tioga © Copyright 1985 Xerox Corporation. All rights reserved. Abstract: This section contains a set of examples of Cedar programs for your reading pleasure. These are actual programs that can be run, used as parts of other programs, or treated as templates to be edited into new programs with similar structures. This memo is probably out of date if it is in hardcopy form. It documents Release 6.1 of Cedar, May 1986. [If you are reading this document on-line in Cedar, try using the Tioga Levels and Lines menus to browse through the top few levels of its structure before reading it straight through.] XEROX Xerox Corporation Palo Alto Research Center 3333 Coyote Hill Road Palo Alto, California 94304 For Internal Xerox Use Only Annotated Cedar Examples: Contents 1. A simple, but complete program 1.1 SimpleExample.mesa  Rick Cattell 1.2. Notes for SimpleExample 1.3 Exercises for SimpleExample 2. A general sort package for lists 2.1 ListSortRef.mesa  Mark Brown 2.2 Notes for ListSortRef interface 2.3 OnlineMergeSortRefImpl.mesa  Mark Brown 2.4 Notes for OnlineMergeSortRefImpl 3. A sample tool using Viewers 3.1. SampleTool.mesa  Scott McGregor 3.2 Notes for SampleTool 4. An evaluator for FUN, a functional programming language 4.1 FUN.mesa  Jim Morris 4.2 Notes for FUN 5. Maze Program (Not fully converted to Cedar6.0) - Greg Nelson 5.1 mazeProg.mesa 5.2 Notes on mazeProg 0. Introduction This section contains a set of four examples of Cedar programs for your reading pleasure (it assumes you are already familiar with the Cedar Language, either by previous osmosis or by having read the Cedar Language Overview). These are actual programs that can be run, used as parts of other programs, or treated as templates to be edited into new programs with similar structures. For each example there is a short discussion of its purpose followed by the program. After each program there is a set of notes to help in reading it. The notes are keyed to the programs by the numbers in parentheses to the right of some lines, e.g., as "--(note 5.1)". You will also find references to lines in the program from the notes, as, e.g., "[line 1.1]". The corresponding lines in the programs are marked as, e.g., [1.1]. When Mesa identifiers appear in the notes, they are displayed in italics to make reading easier; e.g., ReverseName, CommandProc. You should read the examples for understanding and use the notes as references, rather than the other way round. The programs in this document are stored in /Cedar/CedarChest6.1/Top/CedarExamples. Use the DF software to BringOver /Cedar/CedarChest6.1/Top/CedarExamples.df into a subdirectory when you want to run the examples. Clean up the subdirectory ("delete *!*" in the subdirectory) after you are done. Warning: don't try to shift select the test out of this document. You'll likely get something that won't compile right. Just do the Bringover and edit the source. For example: % cd ///Users/hagmann.pa/ % cd Scratch ///Users/hagmann.pa/Scratch/ % BringOver /Cedar/CedarChest6.1/Top/CedarExamples.df ( it types a lot of stuff ) % open SimpleExample 1. A simple, but complete program This first example shows how to write a simple, but complete Cedar program. It illustrates a number of features of the Cedar language and system as well as some of the stylistic conventions used by Cedar programmers (see the Style section): It uses Cedar ROPEs for string manipulation; It uses the IO interface to create and use terminal input and output streams; It registers procedures with the Cedar User Executive (CommandTool) so that you can invoke them like builtin commands of the CommandTool; One of these registered commands creates a process by means of a FORKed procedure call each time you invoke it from the CommandTool; The process then creates a simple Viewer with which you can interact to calculate the values of simple expressions. The program can be run by typing "Run SimpleExample" to the CommandTool. All it does at that point is register two commands with the CommandTool. The first command, ReverseName, simply types your logged-in user name backwards in the UserExec typescript (unless you are Bryan Preas). The second command, Calculate, creates a separate viewer into which you can type simple expressions of the form "constant (("+" | "") constant)*", terminated by a carriage return. It will display the value of the expression. If you wish, you can create multiple calculator viewers by giving the Calculate command to the CommandTool more than once. 1.1 SimpleExample.mesa  Rick Cattell <> <> <> <> DIRECTORY Commander USING [CommandProc, Register], IO USING [char, Error, GetChar, GetInt, int, PeekChar, PutF, PutFR, Reset, rope, SkipWhitespace, STREAM], Process USING [Detach], Rope USING [Cat, Equal, Fetch, Find, FromChar, Length, ROPE, Substr], UserCredentials USING [Get], ViewerIO USING [CreateViewerStreams]; SimpleExample: CEDAR MONITOR --(note 1.2) IMPORTS IO, Commander, Process, Rope, UserCredentials, ViewerIO = --(note 1.3) BEGIN ROPE: TYPE = Rope.ROPE; --(note 1.4) windowCount: INT _ 0; -- a count of the number of calculators created. ReverseName: Commander.CommandProc = BEGIN --(note 1.5) <> userName: ROPE _ UserCredentials.Get[ ].name; --(note 1.6) execStream: IO.STREAM _ cmd.out; -- cmd is an arg to ReverseName. --(note 1.7) backwordsName: ROPE _ NIL; <> dotPos: INT = userName.Find["."]; --(note 1.8) IF dotPos#-1 THEN userName _ userName.Substr[0, dotPos]; IF userName.Equal[s2: "Preas", case: FALSE] THEN execStream.PutF["Hi, Bryan\n"]; <> FOR i: INT DECREASING IN [0..userName.Length[ ]) DO backwordsName _ backwordsName.Cat[ Rope.FromChar[userName.Fetch[i]]] --[1.1] (note 1.9) ENDLOOP; execStream.PutF["Your user name backwards is: %g\n", IO.rope[backwordsName]]; --(note 1.10) END; MakeCalculator: ENTRY Commander.CommandProc = BEGIN --(note 1.11) <> title: ROPE; windowCount _ windowCount+1; title _ IO.PutFR["Adding machine number %g", IO.int[windowCount]]; --(note 1.12) TRUSTED {Process.Detach[FORK Calculate[title]];} --(note 1.13) END; Calculate: PROC[title: ROPE] = BEGIN <> <> opChar: CHAR; number: INT; answer: INT; in, out: IO.STREAM; [in: in, out: out] _ ViewerIO.CreateViewerStreams[title]; --(note 1.14) DO -- Read an expression, terminated by a CR: ENABLE IO.Error => --(note 1.15) IF ec=SyntaxError THEN { in.Reset[ ]; out.PutF["\nIncorrect input. Please retype the expression.\n\n"]; LOOP} ELSE EXIT; opChar _ '+; -- first integer is positive. answer _ 0; -- initialize sum to zero. out.PutF["Type one or more integers separated by + and - and terminate with CR to compute value:\n"]; DO -- Read an operator and an integer, skipping leading blanks, eg., NUL, CR, SP, etc. number _ in.GetInt[ ]; SELECT opChar FROM '+ => answer _ answer + number; '- => answer _ answer - number; ENDCASE => { out.PutF["Illegal operator (%g). Please retype the expression.\n\n", IO.char[opChar]]; EXIT}; IF in.PeekChar[ ]='\n THEN GO TO NextLine; -- the normal way out. []_ in.SkipWhitespace[]; opChar _ in.GetChar[ ]; REPEAT NextLine => { [ ] _ in.GetChar[ ]; -- toss CR --(note 1.16) out.PutF["\nThe answer is: %g.\n\n", IO.int[answer]] }; ENDLOOP; ENDLOOP; END; <> Commander.Register[ --(note 1.17) key: "Calculate", proc: MakeCalculator, doc: "A simple adding machine"]; Commander.Register[ key: "ReverseName", proc: ReverseName, doc: "Reverses your user name"]; END. CHANGE LOG --(note 1.18) Created by Cattell on 21-Apr-82 13:55:09 Changed by Cattell on May 25, 1982 10:58 am <> Changed by Mitchell on August 11, 1982 5:00 pm <> <> < CreateViewerStreams, --, UserExec.RegisterCommand[moved out.PutF to NextLine exit of inner loop so it doesn't print out an answer when an incorrect operator is typed.>> < Commander.CommandProc; UserExec.RegisterCommand-> Commander.Register; UserExec.GetNameAndPassword-> UserCredentials.Get; IO.Handle-> IO.STREAM; IO.CreateViewerStreams-> ViewerIO.CreateViewerStreams; IO.SkipOver[IO.IDBreak]-> IO.SkipWhitespace, skip invisible chars (IO.NUL .. IO.SP); Rope.Upper -- omitted; exec.out-> cmd.out; Bob Taylor->Bryan Preas>> 1.2. Notes for SimpleExample (1.1) These two stylized comments give the name of the module, and who last edited it. The section on Style contains a list of the stylistic conventions recommended for Cedar programmers. (1.2) A MONITOR module is like a PROGRAM module except that it can be used to control concurrent access to shared data (note 1.11). (1.3) SimpleExample imports six interfaces, Commander, IO, Process, Rope, UserCredentials, and ViewerIO because it needs to call procedures defined in those interfaces. (1.4) Since ROPEs are so heavily used in the program, an unqualified version of the type name is generated simply by equating it with the type in the Rope interface. This is a commonly used means for making one or a small set of names from interfaces available as simple identifiers in a module. (1.5) The argument and returns lists given here as comments show the type of Commander.CommandProc; they were inserted semi-automatically using Tioga's "Expand Abbreviation" command to assist in reading the program. ReverseName has this type so that it can be registered with the CommandTool as a command that a user can invoke by typing a simple identifier (note 1.18). The ReverseName procedure prints out the user's login name in reverse order. It strips off the registry extension (e.g. ".PA") and does something different for user name "Preas". (1.6) UserCredentials.Get has the type PROC RETURNS [name, password: ROPE] userName is initialized to the value of the "name" return value from UserCredentials.Get by qualifying the call with ".name". (1.7) cmd is an argument to ReverseName; look at CommandProc in Commander.mesa. (1.8) The notation, userName.Find["."], is interpreted by the compiler as follows: Look in the interface where the type of userName is defined (Rope in this case) and look for the procedure Find, whose first parameter is a ROPE. Generate code to call that procedure, inserting userName at the head of its argument list. Thus userName.Find["."] is an alternate way of saying Rope.Find[userName, "."]. The userName.Find form is called object-style notation, and the Rope.Find form is called procedure-oriented notation. Note also that dotPos is constant over the scope of its declaration, so it is initialized with "=" to prevent any subsequent assignment to it. (1.9) Find, Fetch, Equal, Substr, Cat, and FromChar are all procedures from the Rope interface. The program uses object-style notation for those calls whose first argument is a nameable object, e.g., userName, and procedure-oriented notation otherwise. [line 1.1] is a good example of both. Here it is, spread out to exhibit the two forms: backwordsName _ backwordsName.Cat[ -- object-oriented notation Rope.FromChar[ -- procedure-oriented notation userName.Fetch[i] -- object-oriented notation ] ]; (1.10) IO.PutF is the standard way of providing formatted output to a stream (much like FORTRAN output with format). Its first argument is an IO.STREAM. The second is a ROPE with embedded Fortran-like formatting commands where variables are to be output. The "%g" format is the most useful one; it will handle any sort of variable: INTEGER, CHARACTER, ROPE, etc., in a general default format. The third through last arguments are values to be output, surrounded by calls to inline IO procedures that tell PutF the type of the argument: int[answer], for example. For details, see the description of IO in the Catalog chapter. (1.11) MakeCalculator is an ENTRY procedure to this monitor because it updates the variable windowCount, which is global in SimpleExample and therefore could be incorrectly updated if multiple processes were to invoke MakeCalculator concurrently. When invoked, MakeCalculator creates a new calculator viewer on the screen by invoking Calculate and forking it as a new process (note 1.13). (1.12) IO.PutFR (also known by the name PutFToRope has the same arguments as IO.PutF, but returns a ROPE containing the resultant output rather than sending it to a stream (1.13) The FORK operation creates a new process to execute a regular procedure call. It returns a PROCESS which can either be used to synchronize with the process later (when its root procedure executes a RETURN) and acquire its return values. Alternatively, it can be passed to the procedure Process.Detach, in which case the process can no longer be JOINed to and will simply disappear when its root procedure RETURNs. Note that the combined FORKing and detaching is enveloped in a TRUSTED block. This is because the Detach operation is not intrinsically SAFE, although the stylized combination of FORK and Detach used here actually is. You should use this paradigm when detaching a FORKed process: don't assign the process handle returned by FORK to anything, just use it as the single argument to Process.Detach and surround the whole by a TRUSTED block. (1.14) CreateViewerStreams makes a pair of IO.STREAM objects, in for terminal input, and out for (teletype-style) output. These two returned values are assigned to the local variables in and out using a keyword extractor to ensure that we assign them correctly. (1.15) Calculate parses a simple expression from the in stream using some useful IO functions for input, such as GetInt to provide an INT (skipping over leading blanks), PeekChar to look at the next character while leaving it in the stream for the next input call. These IO procedures can raise the ERROR IO.Error, so there is a catch phrase enabled over the outer (endless) loop to deal with IO.Error. IO.Error also carries an argument, ec, which is an enumerated type defined in IO. If ec=SyntaxError, the user has typed something that is not lexically correct, and the program will regain control and go around the outer loop again. The only other possibility is that the in and out streams were closed (ec=StreamClosed) as a side effect of the user having destroyed the Calculator viewer by bugging the Destroy menu item. This error and code can emanate from any of the IO operations in the loop. In this case the program exits the outer loop, returns from Calculate, and the process that was forked then terminates and disappears. (1.16) If a procedure returns values, the Cedar language requires you to assign them to something, even if you have no use for them in a specific case. The standard mechanism for ignoring a procedure's returned value(s) is an empty extractor, as here. (1.17) Here, at the end of the module, is the code that is executed when the module is started. You can create an instance of a module and start it using the "Run" command in CommandTool. The loader creates instances of programs when loading configurations. If a component of a configuration is not STARTed explicitly, then it will be started automatically (as the result of a trap) the first time one of its procedures is called. See the Language Reference Manual for more information. In this case, the start code for the module consists of two calls on the procedure Commander.Register, which register the commands "Calculate" and "ReverseName" with the CommandTool so that you can invoke the procedures MakeCalculator and ReverseName, respectively, by typing their command names. These procedure calls also illustrate the ability to specify the association between a procedure's formal parameters and the arguments in a specific call using keyword instead of positional notation. Generally, keyword notation is preferred over positional for all but simple one- or two-argument calls, and it is definitely better for two-argument calls if the types of the arguments are the same, e.g., either Copy[to: arg1, from: arg2] or Copy[from: arg2, to: arg1] is preferable to Copy[arg1, arg2] (1.18) By convention each module has a CHANGE LOG following the Cedar text. It is used to record an abbreviated history of changes to the module, saying who made each change, when they made it, and a brief description of what was done. You can insert a new entry in the log by left-clicking Tioga's ChangeLog viewer button; see the Tioga chapter for details. 1.3 Exercises for SimpleExample 1. What do you think the program would do, if you typed the following to CommandTool? ( represents the carriage-return key.) a) Run SimpleExample b) ReverseName c) Calculate Calculate 2. What would the program do, if you typed the following in the calculator's viewer? ( means hitting the Space bar.) a) 1+2+3 b) 1 + 2 - 3 c) 1 - 2+ 3 d) 1 / 2 3. (Skip this part unless you are really interested in Cedar IO details.) Predict what the calculator will do if you type the following. Why? a) 1++ b) 1++ 2 c) 1 -- d) 1 -- -2 e> 1 - - 2 Have fun !! 2. A general sort package for lists This is an example of a Cedar package and consists of two modules: ListSortRef specifies the interface that client programs must import to make use of the package; ListSortRefImpl implements that interface. The package sorts lists of items according to a compare function passed to it along with the list to be sorted. The algorithm is presented as exercise 5.2.4-17 (p. 169) in Knuth Volume III, and is attributed to John McCarthy. The comments in the code give some of the important invariants. 2.1 ListSortRef.mesa  Mark Brown -- File: ListSortRef.mesa -- Last edited By Mitchell on December 20, 1982 3:27 pm -- Last edited By Bob Hagmann on May 8, 1984 9:40:29 am PDT DIRECTORY Basics USING [Comparison]; ListSortRef: CEDAR DEFINITIONS = --(note 2.1) BEGIN Comparison: TYPE = Basics.Comparison; CompareProc: TYPE = PROC[r1, r2: REF ANY] RETURNS [Comparison]; -- Returns less if r1^ < r2^, equal if r1^ = r2^, greater if r1^ > r2^. CompareError: ERROR[reason: Reason]; Reason: TYPE = {typeMismatch, invalidType}; -- errors from a CompareProc. Sort: PROC[list: LIST OF REF ANY, compareProc: CompareProc] --(note 2.2) RETURNS[LIST OF REF ANY]; -- Destructive sort; copy list first if nondestructive sort is needed. -- Returns a list containing the same REFs as list, arranged in ascending order according to compareProc. Order of equal items is not preserved. Compare: CompareProc; -- ! SafeStorage.NarrowRefFault -- (if both parameters do not NARROW to one of ROPE or REF INT.) -- Compares ROPE : ROPE (case significant) and REF INT : REF INT END.--ListSortRef CHANGE LOG Created by MBrown on 21-Apr-81 13:55:09 Changed by MBrown on 10-Dec-81 9:50:15 -- Change comment in Compare (now compares ROPE instead of REF TEXT.) Changed by MBrown on July 5, 1982 4:59 pm -- CEDAR definitions, eliminate type Item. <> <> <> <> <> < Basics>> 2.2 Notes for ListSortRef interface (2.1) Interfaces are defined in DEFINITIONS modules. Basically, a DEFINITIONS module contains the constants, types, and procedure headings (actually procedure types) needed to use a package. Frequently, an interface defines some kind of object with operations (procedures) for that class of object (the Rope interface is a good example of such an object-oriented interface). (2.2) This definition for Sort is used for type-checking in any module that contains a call on Sort or provides an actual implementation of it (note 2.3). Thus, client and implementing programs can count on the fact that they agree on the type of Sort. This separation of definition and implementation enables client and implementing modules to be developed independently of each other, which provides some parallelism in the program development process. Since they are more abstract, interfaces are typically more stable than either clients or implementations. The first argument to Sort has type LIST OF REF ANY. Lists in Cedar are similar to Lisp lists. In this case the type "LIST OF REF ANY" is equivalent to the following pair of Cedar type definitions: ListOfRefAny: TYPE = REF ListCell; ListCell: TYPE = RECORD[first: REF ANY, rest: ListOfRefAny]; The only things that are special about lists are that the compiler automatically generates the equivalent of the above two type definitions for each list type you define, the language provides a CONS operator for allocating and initializing list cells [line 2.1], and list types with the same elements are equivalent, whereas record types are not. 2.3 OnlineMergeSortRefImpl.mesa  Mark Brown -- File OnlineMergeSortRefImpl.mesa -- Last edited by MBrown on July 5, 1982 3:57 pm, -- Mitchell on December 20, 1982 3:22 pm DIRECTORY Rope USING [ROPE, Compare], ListSortRef, SafeStorage USING [NarrowRefFault]; OnlineMergeSortRefImpl: CEDAR PROGRAM --(note 2.3) IMPORTS Rope, SafeStorage EXPORTS ListSortRef = BEGIN ROPE: TYPE = Rope.ROPE; Comparison: TYPE = ListSortRef.Comparison; CompareProc: TYPE = ListSortRef.CompareProc; Sort: PUBLIC PROC [list: LIST OF REF ANY, compareProc: CompareProc] --(note 2.4) RETURNS [LIST OF REF ANY] = { -- The sort is destructive and NOT stable, that is, the relative positions in the result of nodes with equal keys is unpredictible. For a nondestructive sort, copy list first. a, b, mergeTo: LIST OF REF ANY; mergeToCons: LIST OF REF ANY = CONS[NIL, NIL]; --[2.1] (note 2.5) index: TYPE = INT [0..22); -- 22 is the number of bits in word-address space minus 2 (cons cell takes 2**2 words). sorted: ARRAY index OF LIST OF REF ANY _ ALL [NIL]; -- sorted[i] is a sorted list of length 2i or NIL. --(note 2.6) -- make each pair of consecutive elements of list into a sorted list of length 2, then merge it into sorted. UNTIL (a _ list) = NIL OR (b _ a.rest) = NIL DO list _ b.rest; IF compareProc[a.first, b.first] = less THEN --(note 2.7) { a.rest _ b; b.rest _ NIL } ELSE { b.rest _ a; a.rest _ NIL; a _ b }; FOR j: index _ 0, j+1 DO IF (b _ sorted[j]) = NIL THEN { sorted[j] _ a; EXIT } ELSE { --merge (equal length) lists a and b sorted[j] _ NIL; mergeTo _ mergeToCons; DO --assert a#NIL, b#NIL IF compareProc[a.first, b.first] = less THEN { --[2.2] mergeTo.rest _ a; mergeTo _ a; IF (a _ a.rest) = NIL THEN { mergeTo.rest _ b; EXIT }} ELSE { mergeTo.rest _ b; mergeTo _ b; IF (b _ b.rest) = NIL THEN { mergeTo.rest _ a; EXIT }} ENDLOOP; a _ mergeToCons.rest } ENDLOOP; ENDLOOP; -- if list's length was even, a = NIL; if list's length was odd, a = single element list. Merge a and elements of sorted into result (held in a). { j: index _ 0; UNTIL a # NIL DO a _ sorted[j]; IF j < LAST[index] THEN j _ j+1 ELSE RETURN[a]; ENDLOOP; DO --assert a#NIL IF (b _ sorted[j]) # NIL THEN { mergeTo _ mergeToCons; DO -- assert a#NIL AND b#NIL IF compareProc[a.first, b.first] = less THEN { mergeTo.rest _ a; mergeTo _ a; IF (a _ a.rest) = NIL THEN { mergeTo.rest _ b; EXIT } } ELSE { mergeTo.rest _ b; mergeTo _ b; IF (b _ b.rest) = NIL THEN { mergeTo.rest _ a; EXIT } } ENDLOOP; a _ mergeToCons.rest }; IF j < LAST[index] THEN j _ j+1 ELSE RETURN[a]; ENDLOOP; }};--Sort CompareError: PUBLIC ERROR[reason: ListSortRef.Reason] = CODE; Compare: PUBLIC CompareProc --[r1, r2: REF ANY] RETURNS [Comparison] -- = TRUSTED { ENABLE SafeStorage.NarrowRefFault => GOTO BadType; IF r1 = NIL THEN { IF r2 = NIL THEN RETURN [equal] -- define NIL=NIL regardless of type ELSE { temp: REF ANY _ r1; r1 _ r2; r2 _ temp }}; WITH r1 SELECT FROM -- assert r1#NIL --(note 2.8) rope: ROPE => RETURN[rope.Compare[s2: NARROW[r2, ROPE], case: TRUE]]; ri: REF INT => RETURN[CompareINT[ri^, NARROW[r2, REF INT]^]]; --[2.4] ENDCASE => ERROR CompareError[invalidType] EXITS BadType => ERROR CompareError[typeMismatch] }; CompareINT: PROC [int1, int2: INT] RETURNS [Comparison] = INLINE { RETURN [ SELECT TRUE FROM int1 < int2 => less, int1 = int2 => equal, ENDCASE => greater ] }; END.--OnlineMergeSortRefImpl CHANGE LOG Created by MBrown on 21-Apr-81 13:26:10 Changed by MBrown on 19-Aug-81 15:14:34 -- CedarString -> Rope (used only in Compare.) Changed by MBrown on 23-Aug-81 17:45:12 -- Fix bug in sorting NIL. Changed by MBrown on 10-Dec-81 9:57:58 -- Cosmetic changes: ROPE, INT. Changed by MBrown on March 9, 1982 5:03 pm -- Use a bounded array in local frame instead of consing up a list of lists on each call. Even for a 32 bit address space, this is only 60 words of array in the frame. Changed by MBrown on June 28, 1982 11:43 am -- CEDAR implementation. CompareINT no longer uses MACHINE CODE. Changed by MBrown on July 5, 1982 3:58 pm -- Eliminate CARDINALs, redundant range check on j, type Item. <> <> 2.4 Notes for OnlineMergeSortRefImpl (2.3) To be a general-purpose package, this progam must work properly in the presence of multiple processes. This means that any global state must be properly protected by monitors. The writer of this package chose to eliminate all global state from the program, so that no monitor is required. The cost is that one CONS is done on each call (for the "merge-to" list head) [line 2.1]. Clearly the package will get fouled up if asked to sort the same list by two concurrent processes. (2.4) Since Sort is a PUBLIC procedure and has the same name as one of the procedures of the EXPORTed ListSortRef interface, the compiler will check that its type matches the one in ListSortRef. Similarly when a client program imports ListSortRef, the compiler will check that all its uses of ListSortRef.Sort are type-correct by comparing them against the interface. In this way, the client and the implementing modules are known to be in agreement, assuming that they were both compiled using the same ListSortRef. To ensure that they are in agreement, the compiler places a unique identifier (UID) on each module that it compiles. When the client is bound to the implemented procedure (e.g., when they are loaded), the UID that ListSortRef had when the client was compiled is compared against the UID it had when the implementing module was compiled. They must agree for the binding to be allowed, otherwise there is a version mismatch. (2.5) The list head, mergeToCons, simplifies the code a bit. Without it, the first comparison in a merge [line 2.2] would have to be treated specially. Note also that mergeToCons is initialized to refer to a new empty list cell every time Sort is called. (2.6) The array sorted in the local frame is long enough to hold any list of REFs that will fit in the Cedar virtual memory. By keeping this array in the local frame we save both the cost of another allocation and the cost of ref-counting the assignments to array elements. (2.7) The client's compareProc is responsible for narrowing its two REF ANY arguments to specific types. Using a client-supplied procedure and one or more REF ANY parameters is a standard way of introducing some polymorphism into Cedar programs. The costs associated with doing business this way are extra procedure calls and run-time discrimination of REF ANY arguments in client-supplied procedures (see, for example, (note 2.8)). When these costs are deemed too high, one can get some amount of compile-time polymorphism to avoid them. Nothing is free, however, and achieving this run-time performance requires recompiling both the interface and the implementation modules for each application. There is a version of this sorting package that does just that: see the description of OnlineMergeSort in the Cedar Catalog. (2.8) Compare provides clients with a procedure to pass to Sort for comparing ROPEs or INTs. It is a good model for writing your own comparison routine. Since Compare is passed two REF ANY arguments, it must perform run-time type discrimination to determine that it can cope with them. The standard way of doing this is with a discriminating select statement and the NARROW operation. One of the three arms will be executed, depending on the type of value that r1 refers to (note that r1 cannot be NIL at this point because of the preceding code). If r1 is a ROPE (which is actually a REF to a data structure describing the ROPE), then the first arm will be selected. In that arm, rope will be an alias for r1. If r1 is a REF INT, the seond arm will be selected, and ri will be an alias for r1. Otherwise, the ENDCASE arm will be selected and the ERROR CompareError[invalidType] will be raised. Inside the rope: ROPE arm, Compare simply returns the value returned by Rope.Compare. Since Rope.Compare expects parameters s1 and s2 to be ROPEs, however, NARROW is used to cast r2 as a ROPE. If r2 were not a ROPE, NARROW would generate the error SafeStorage.NarrowRefFault, which is caught by the encompassing ENABLE clause and then mapped into CompareError[typeMismatch] by the procedure's EXITS clause. 3. A sample tool using Viewers This program illustrates how to build tools in the CedarViewers' world. The user interface it creates uses both existing classes of viewers as well as a new class of viewer for special effects. It contains a number of sections, each of which demonstrates a particular set of techniques. The best use of this code would be to copy interesting sections as models for creating your own tool. It would be a good idea to try the SampleTool before looking at this example. When you type "Run SampleTool" to the UserExec, the SampleTool will appear in iconic form on the lower left side of the Cedar display. Open it by selecting it with the middle (formerly called YELLOW) mouse button and then try it out to see how it behaves. The first part of the SampleTool viewer consists of the standard line of menu buttons at the top of any viewer with a few of the operations deleted and a new one, "MyMenuEntry", added. The second part holds a "factorial computer", which allows you to compute N! by changing the value of N in the input part of the viewer and then selecting the button labelled "Compute Factorial" with the left (RED) mouse button. The third part of the viewer presents a horizontal, logarithmic bar graph that dynamically updates itself and shows "Words Allocated Per Second" in the Cedar system. 3.1. SampleTool.mesa  Scott McGregor <> <> <> <> <> <> <> <<>> DIRECTORY BasicTime USING [GetClockPulses, PulsesToMicroseconds], Buttons USING [Button, ButtonProc, Create], Commander USING [CommandProc, Register], Containers USING [ChildXBound, Container, Create], Convert USING [Error, ErrorType, IntFromRope, RopeFromReal], Imager USING [Context, MaskBox, SetColor], ImagerBackdoor USING [MakeStipple], Labels USING [Create, Label, Set], Menus USING [AppendMenuEntry, CreateEntry, CreateMenu, Menu, MenuProc], MessageWindow USING [Append, Blink], Process USING [Detach, Pause, SecondsToTicks, Ticks], Rope USING [Cat, Length, ROPE], Rules USING [Create, Rule], SafeStorage USING [NarrowFault, NWordsAllocated], VFonts USING [CharWidth, StringWidth], ViewerClasses USING [PaintProc, Viewer, ViewerClass, ViewerClassRec], ViewerOps USING [CreateViewer, PaintViewer, RegisterViewerClass, SetOpenHeight], ViewerTools USING [GetContents, MakeNewTextViewer, SetSelection]; SampleTool: CEDAR PROGRAM IMPORTS BasicTime, Buttons, Commander, Containers, Convert, Imager, ImagerBackdoor, Labels, Menus, MessageWindow, Process, Rope, Rules, SafeStorage, VFonts, ViewerOps, ViewerTools = BEGIN <> entryHeight: CARDINAL = 15; -- how tall to make each line of items entryVSpace: CARDINAL = 8; -- vertical leading space between lines entryHSpace: CARDINAL = 10; -- horizontal space between items in a line Handle: TYPE = REF SampleToolRec; -- a REF to the data for a particular instance of the sample tool; multiple instances can be created. SampleToolRec: TYPE = RECORD [ -- the data for a particular tool instance outer: Containers.Container _ NIL, -- handle for the enclosing container height: CARDINAL _ 0, -- height measured from the top of the container fact: FactorialViewer, -- the factorial viewer's state graph: GraphViewer ]; -- the bar graph viewer's state MakeSampleTool: Commander.CommandProc = BEGIN my: Handle _ NEW[SampleToolRec]; myMenu: Menus.Menu _ Menus.CreateMenu[]; Menus.AppendMenuEntry[ -- add our command to the menu menu: myMenu, entry: Menus.CreateEntry[ name: "MyMenuEntry", -- name of the command proc: MyMenuProc -- proc associated with command ] ]; my.outer _ Containers.Create[ info: [ -- construct the outer container (note 3.1) name: "Sample Tool", -- name displayed in the caption iconic: TRUE, -- so tool will be iconic (small) when first created column: left, -- initially in the left column menu: myMenu, -- displaying our menu command scrollable: FALSE ]]; -- inhibit user from scrolling contents MakeFactorial[my]; -- build each (sub)viewer in turn MakeGraph[my]; ViewerOps.SetOpenHeight[my.outer, my.height]; -- hint our desired height ViewerOps.PaintViewer[my.outer, all]; -- reflect above change END; MyMenuProc: Menus.MenuProc = BEGIN <> MessageWindow.Append[ message: "You just invoked the sample menu item with the ", clearFirst: TRUE]; IF control THEN MessageWindow.Append[ message: "Control-", clearFirst: FALSE]; IF shift THEN MessageWindow.Append[ message: "Shift-", clearFirst: FALSE]; MessageWindow.Append[ message: SELECT mouseButton FROM red => "Left (formerly called 'Red')", yellow => "Middle (formerly called 'Yellow')", ENDCASE => "Right (formerly called 'Blue')", clearFirst: FALSE]; MessageWindow.Append[message: " mouse button.", clearFirst: FALSE]; MessageWindow.Blink[ ]; END; FactorialViewer: TYPE = RECORD [ input: ViewerClasses.Viewer _ NIL, -- the Text Box for user input result: Labels.Label _ NIL ]; -- result of the computation MakeFactorial: PROC [handle: Handle] = BEGIN --(note 3.2) promptButton, computeButton: Buttons.Button; initialData: Rope.ROPE = "5"; initialResult: Rope.ROPE = "120"; handle.height _ handle.height + entryVSpace; -- space down from the top of the viewer promptButton _ Buttons.Create[ info: [ name: "Type an integer in [0..34]:", wy: handle.height, <> wh: entryHeight, -- specify rather than defaulting so line is uniform parent: handle.outer, border: FALSE ], proc: Prompt, clientData: handle]; -- this will be passed to our button proc handle.fact.input _ ViewerTools.MakeNewTextViewer[ info: [ parent: handle.outer, wx: promptButton.wx + promptButton.ww + entryHSpace, wy: handle.height+2, ww: 15*VFonts.CharWidth['0], -- fifteen digits worth of width wh: entryHeight, data: initialData, -- initial contents scrollable: FALSE, border: FALSE]]; computeButton _ Buttons.Create[ info: [ name: "Compute Factorial", wx: handle.fact.input.wx + handle.fact.input.ww + entryHSpace, wy: handle.height, ww:, -- default the width so that it will be computed for us (note 3.3) wh: entryHeight, -- specify rather than defaulting so line is uniform parent: handle.outer, border: TRUE], clientData: handle, -- this will be passed to our button proc proc: ComputeFactorial]; handle.fact.result _ Labels.Create[ info: [ name: initialResult, -- initial contents wx: computeButton.wx + computeButton.ww + entryHSpace, wy: handle.height, ww: 20*VFonts.CharWidth['0], -- 20 digits worth of width wh: entryHeight, parent: handle.outer, border: FALSE]]; handle.height _ handle.height + entryHeight + entryVSpace; -- interline spacing END; Prompt: Buttons.ButtonProc = BEGIN <> handle: Handle _ NARROW[clientData]; -- get our data ViewerTools.SetSelection[handle.fact.input]; -- force the selection END; ComputeFactorial: Buttons.ButtonProc = BEGIN handle: Handle _ NARROW[clientData]; -- get our data contents: Rope.ROPE _ ViewerTools.GetContents[handle.fact.input]; inputNumber: INT_ 0; resultNumber: REAL _ 1.0; inputError: BOOL_ FALSE; IF Rope.Length[contents]=0 THEN inputNumber _ 0 ELSE inputNumber _ Convert.IntFromRope[contents ! SafeStorage.NarrowFault => {inputNumber_ -1; CONTINUE}; Convert.Error => {SELECT reason FROM Convert.ErrorType.empty => MessageWindow.Append[ -- I guess this should not happen when -- the length of the content is not zero. message: "SampleTool: input is blank.", clearFirst: TRUE ]; Convert.ErrorType.syntax => MessageWindow.Append[ message: "SampleTool: input syntax error.", clearFirst: TRUE ]; Convert.ErrorType.overflow => MessageWindow.Append[ message: "SampleTool: input overflowed.", clearFirst: TRUE ]; ENDCASE; inputError_ TRUE; MessageWindow.Blink[ ]; CONTINUE}; ]; --(note 3.4) IF inputError THEN RETURN; IF inputNumber NOT IN [0..34] THEN { MessageWindow.Append[ message: "I can only compute the factorial for integers in the range of 0 ... 34.", clearFirst: TRUE ]; MessageWindow.Blink[ ] } ELSE { FOR n: INT IN [2..inputNumber] DO resultNumber _ resultNumber*n; ENDLOOP; Labels.Set[handle.fact.result, Convert.RopeFromReal[resultNumber]] }; END; <> GraphViewer: TYPE = RECORD [viewer: ViewerClasses.Viewer _ NIL]; MakeGraph: PROC [handle: Handle] = BEGIN --(note 3.6) xIncr: INTEGER; -- temporarily used for labelling graph below xTab: INTEGER = 10; label: Rope.ROPE _ "1"; -- used to place labels on the graph rule: Rules.Rule _ Rules.Create[ info: [ -- create a bar to separate sections 1 and 2 parent: handle.outer, wy: handle.height, ww: handle.outer.cw, wh: 2]]; Containers.ChildXBound[handle.outer, rule]; -- constrain rule to be width of parent handle.height _ handle.height + entryVSpace; -- spacing after rule [ ] _ Labels.Create[ info: [ name: "Words Allocated Per Second", parent: handle.outer, wx: xTab, wy: handle.height, border: FALSE ]]; handle.height _ handle.height + entryHeight + 2; -- interline spacing handle.graph.viewer _ CreateBarGraph[ parent: handle.outer, x: xTab, y: handle.height, w: 550, h: entryHeight, fullScale: 5.0 ]; -- orders of magnitude handle.height _ handle.height + entryHeight + 2; -- interline spacing xIncr _ handle.graph.viewer.ww/5; -- so we can space labels at equal fifths FOR i: INTEGER IN [0..5) DO -- place the labels, 1, 10, 100, 1000, 10000 along the graph [ ] _ Labels.Create[ info: [ name: label, parent: handle.outer, wx: xTab+i*xIncr - VFonts.StringWidth[label]/2, wy: handle.height, border: FALSE ]]; label _ label.Cat["0"]; -- concatenate another zero each time ENDLOOP; handle.height _ handle.height + entryHeight + entryVSpace; -- extra space at end TRUSTED {Process.Detach[FORK MeasureProcess[handle]]}; -- start the update process END; MeasureProcess: PROC [handle: Handle] = BEGIN --(note 3.7) <> updateInterval: Process.Ticks = Process.SecondsToTicks[1]; mark, nextMark: LONG CARDINAL; words, nextWords, deltaWords, deltaTime: REAL; mark _ BasicTime.PulsesToMicroseconds[BasicTime.GetClockPulses[]]; words _ SafeStorage.NWordsAllocated[ ]; UNTIL handle.graph.viewer.destroyed DO nextMark _ BasicTime.PulsesToMicroseconds[BasicTime.GetClockPulses[]]; deltaTime _ (nextMark - mark) * 1.0E-6; nextWords _ SafeStorage.NWordsAllocated[ ]; deltaWords _ nextWords - words; SetBarGraphValue[handle.graph.viewer, deltaWords/deltaTime]; words _ nextWords; mark _ nextMark; Process.Pause[updateInterval]; ENDLOOP; END; <> <> GraphData: TYPE = REF GraphDataRec; GraphDataRec: TYPE = RECORD [ value: REAL _ 0, -- current value being displayed (normalized) scale: REAL ]; -- "full scale" PaintGraph: ViewerClasses.PaintProc = BEGIN --(note 3.8) myGray: CARDINAL = 122645B; -- every other bit data: GraphData _ NARROW[self.data]; Imager.SetColor[ context: context, color: ImagerBackdoor.MakeStipple[stipple: myGray, xor: FALSE]]; Imager.MaskBox[context: context, box: [xmin: 0, ymin: 0, xmax: data.value, ymax: self.ch]]; END; CreateBarGraph: PROC [x, y, w, h: INTEGER, parent: ViewerClasses.Viewer, fullScale: REAL] RETURNS [barGraph: ViewerClasses.Viewer] = BEGIN --(note 3.9) instanceData: GraphData _ NEW[GraphDataRec]; instanceData.scale _ fullScale; barGraph _ ViewerOps.CreateViewer[ flavor: $BarGraph, -- the class of viewer registered in the start code below info: [ parent: parent, wx: x, wy: y, ww: w, wh:h, data: instanceData, scrollable: FALSE] ]; END; <> SetBarGraphValue: PROC [barGraph: ViewerClasses.Viewer, newValue: REAL] = BEGIN my: GraphData _ NARROW[barGraph.data]; Log10: --Fast-- PROC [x: REAL] RETURNS [lx: REAL] = BEGIN <> <> sqrt10: REAL = 3.162278; t: REAL; lx _ 0; WHILE x > 10 DO x _ x/10; lx _ lx+1 ENDLOOP; -- scale to [1..10] IF x > sqrt10 THEN {x _ x/sqrt10; lx _ lx+0.5}; -- scale to [1..1/sqrt10] t _ (x-1)/(x+1); lx _ lx + 0.86304*t + 0.36415*(t*t*t) -- magic cubic approximation END; my.value _ Log10[1+newValue] * barGraph.cw / my.scale; ViewerOps.PaintViewer[viewer: barGraph, hint: client, clearClient: TRUE]; END; <> graphClass: ViewerClasses.ViewerClass _ --[3.1] NEW[ViewerClasses.ViewerClassRec _ [paint: PaintGraph]]; <> Commander.Register[key: "SampleTool", proc: MakeSampleTool, doc: "Create a sample viewers tool" ]; <> ViewerOps.RegisterViewerClass[$BarGraph, graphClass]; [ ] _ MakeSampleTool[NIL]; -- and create an instance END. CHANGE LOG Changed by S. Chen on May 4, 1984 8:53:19 pm PDT ShowTime.Microseconds -> LONG CARDINAL; ShowTime.GetMark -> BasicTime.PulsesToMicroseconds[BasicTime.GetClockPulses[]]; UserExec.CommandProc -> Commander.CommandProc; UserExec.RegisterCommand[name: ... , proc: ... , briefDoc: ... ] -> Commander.Register[key: ... , proc: ... , doc: ... ]; Convert.ValueToRope[[real[resultNumber]]] -> Convert.RopeFromReal[resultNumber]; MakeSampleTool[NIL, NIL]_ MakeSampleTool[NIL]; Added errors handling for the errors that might be generated by Convert.IntFromRope, e.g., syntax error, overflow; Changed a message to inform the user the allowed input range when it is exceeded; The factorial is computed and displayed only if there is no input error and if the input is an integer in [0..34]. Changed the label "Type a number:" to "Type an integer in [0..34]:" Widened the width of the space for user's input. Changed by Bob Hagmann on May 8, 1984 10:27:29 am PDT deleted last TRUSTED declaration on a procedure Changed by Carl Black on September 19, 1985 1:23:15 pm PDT Converted from Cedar5.2 Graphics to Cedar6.0 Imager. Changed message displayed in MyMenueEntry to display 'Left,' 'Middle,' or 'Right' rather than 'Red,' 'Yellow,' or 'Blue.' Changed by Lissy Bland on July 24, 1986 3:17:07 pm PDT Added keyword indexing in the MakeGraph and PaintGraph procedures, ComputeFactorial; substituted full variable names for use of atoms in ComputeFactorial. Updated DIRECTORY. 3.2 Notes for SampleTool (3.1) Many of the Viewer procedures take a fair number of arguments in order to provide a number of options. Many of these can be defaulted, as in this section of the program. Using keyword notation makes these calls significantly more clear about which parameters are being specified as well as making them independent of the order specified for the parameters. (3.2) The factorial sub-Viewer contains a "Text Box" for the user to enter a number, and a button that computes the factorial of the number in the text box when pushed and writes it in a result field. The fields for the user's input and the result are stored in handle.fact. Note that the name of MakeFactorial's parameter, handle, and its type, Handle, differ only in the case of the "h". In general, having names that differ only in case shifts of letters is a very bad idea. However, this one exception is so compelling and so common that it has become part of the Cedar stylistic conventions: If there is only one variable of a type in a scope, its name can be the same as that of its type except that it should begin with a lowercase letter. Think of it as equivalent to the definite article in English ("the Handle"). (3.3) Buttons.Create will compute the width from the button's name, so we can default this argument to the procedure. Specifying the keyword parameter name w without a value indicates that it should get whatever default value is specified in the definition of Buttons.Create. (3.4) Convert.IntFromRope lets the error SafeStorage.NarrowFault escape from it (stylistically, it really ought to map that error into one defined in its interface). ComputeFactorial catches this error and assigns -1 to inputNumber to trigger the subsequent test for its being in a suitable range and so give the error message "I can't compute factorial for that input" in the message window. (3.5) Atoms provide virtual-memory-wide unique identifiers like $BlackOnGrey (all atom constants are denoted by a leading "$" followed by an identifier). (3.6) The "bar graph" sub-Viewer contains a logarithmic bar graph depicting the number of words per second currently being allocated via the Cedar counted storage allocator. Unlike the factorial sub-Viewer, which only makes use of pre-defined viewer classes, this section defines a new viewer class, $BarGraph [line 3.1], to display information and makes a viewer which is an instance of the class. (3.7) MeasureProcess runs as an independent process, looping as long as the viewer denoted by handle continues to exist. It computes the average number of words allocated per second in Cedar safe storage and then sleeps for a short time before repeating the cycle. (3.8) PaintGraph is called whenever the bar graph contents are to be redisplayed on the screen. It will always be called by the window manager, which will pass it a Graphics.Context, correctly scaled, rotated and clipped for the viewer on the screen. It is passed to the Viewers machinery when the $BarGraph class is created [line 3.1]. (3.9) CreateBarGraph is called to create a new BarGraph viewer. It creates the private data for the new instance and then calls a Viewers' system routine to create the actual viewer. 4. An evaluator for FUN, a functional programming language This standalone program provides interactive entering and evaluation of expressions in a small, functional programming language, FUN, based on Landin's ISWIM language. The language is defined by the following BNF rules: Prog ::= Exp0 "#" Exp0 ::= "let" Id "=" Exp1 "in" Exp0 | Exp1 Exp1 ::= "lambda" Id "." Exp1 | Exp2 Exp2 ::= Exp2 Exp3 | Exp3 Exp3 ::= Id | "(" Exp0 ")" An example FUN program is let Twice = lambda f. lambda y. f(f y) in let ApplyThyself = lambda z . z z in (ApplyThyself Twice Twice) (PLUS 1) 2 # Twice is a function that produces a function which applies Twice's parameter f twice to whatever comes next (y). ApplyThyself applies its parameter z to itself. The result of this program is 18 because (ApplyThyself Twice) = (Twice Twice) = FourTimes, (FourTimes Twice) = SixteenTimes, and SixteenTimes plus 2 is 18. 4.1 FUN.mesa  Jim Morris -- FUN.mesa, -- Last edited by Mitchell on December 16, 1982 2:50 pm -- Last edited by Jim Morris, May 12, 1982 10:28 am -- Last edited by Bob Hagmann, May 8, 1984 11:14:01 am PDT DIRECTORY Ascii USING [Digit, Letter], IO USING [BreakProc, CR, EndOf, Error, GetInt, GetToken, int, PutF, PutFR, refAny, rope, RIS, SP, STREAM, TAB], Process USING [Detach], Rope USING [Equal, Fetch, FromRefText, ROPE], SafeStorage USING [NarrowRefFault], ViewerIO USING [CreateViewerStreams]; FUN: CEDAR PROGRAM --(note 4.1 has been deleted) IMPORTS Ascii, IO, Process, Rope, SafeStorage, ViewerIO = BEGIN ROPE: TYPE = Rope.ROPE; Exp: TYPE = REF ANY;-- always a REF to one of the following --(note 4.2) Variable: TYPE = ROPE; Application: TYPE = REF ApplicationR; ApplicationR: TYPE = RECORD[rator, rand: Exp]; Lambda: TYPE = REF LambdaR; LambdaR: TYPE = RECORD[bv: Variable, body: Exp]; Closure: TYPE = REF ClosureR; ClosureR: TYPE = RECORD[exp: Exp, env: Environment]; Primitive: TYPE = REF PrimitiveR; PrimitiveR: TYPE = RECORD[p: PROC[Exp, Exp] RETURNS [Exp] , state: Exp]; Environment: TYPE = LIST OF RECORD[var: Variable, val: Exp]; din, dout: IO.STREAM; FUNError: ERROR = CODE; --(note 4.3) NoteError: PROC [msg: ROPE] = BEGIN -- this procedure always generates the error FUNError. dout.PutF["\n %g \n\n", IO.rope[msg]]; ERROR FUNError; END; -- The FUN lexical analysis and parsing machinery cToken: ROPE; --(note 4.4) rToken: REF TEXT _ NIL ; Next: PROC = { IF din.EndOf[ ] THEN cToken _ "#" ELSE { rToken _ din.GetToken[StTokenProc, rToken].token; cToken _ Rope.FromRefText[rToken] ; }; }; StTokenProc: IO.BreakProc = BEGIN --(note 4.5) OPEN IO; --(note 4.6) RETURN[ IF Ascii.Letter[char] OR Ascii.Digit[char] THEN other ELSE IF char=SP OR char=CR OR char=TAB THEN sepr ELSE break]; END; Id: PROC RETURNS [i: Variable] = BEGIN IF IsId[cToken] THEN {i _ cToken; Next[ ]} ELSE NoteError["Input Error: No Id"] END; IsId: PROC[x: ROPE] RETURNS [BOOLEAN] = BEGIN RETURN[Ascii.Digit[x.Fetch[0]] OR Ascii.Letter[x.Fetch[0]] AND NOT Rope.Equal[x, "let"] AND NOT Rope.Equal[x, "in"] AND NOT Rope.Equal[x, "lambda"]]; END; Prog: PROC RETURNS [e: Exp] = BEGIN --(note 4.7) e _ Exp0[ ]; IF Rope.Equal[cToken, "#"] THEN RETURN; UNTIL Rope.Equal[cToken, "#"] DO Next[ ] ENDLOOP; NoteError["Input Error: Whole Expression not consumed"]; END; Exp0: PROC RETURNS [Exp] = BEGIN IF Rope.Equal[cToken, "let"] THEN { Next[ ]; {v: Variable = Id[ ]; IF NOT Rope.Equal[cToken, "="] THEN NoteError["Input Error: No ="]; Next[ ]; {val: Exp = Exp1[ ]; IF NOT Rope.Equal[cToken, "in"] THEN NoteError["Input Error: No in"]; Next[ ]; RETURN[ NEW[ApplicationR _ [NEW[LambdaR _ [v, Exp0[ ]]], val]]] } } }; RETURN[Exp1[ ]]; END; Exp1: PROC RETURNS [Exp] = BEGIN IF Rope.Equal[cToken, "lambda"] THEN {Next[ ]; {i: Variable = Id[ ]; IF NOT Rope.Equal[cToken, "."] THEN NoteError["Input Error: No ."]; Next[ ]; RETURN[NEW[LambdaR _ [i, Exp1[ ]]]] } }; RETURN[Exp2[ ]]; END; Exp2: PROC RETURNS [e: Exp] = BEGIN e _ Exp3[ ]; WHILE Rope.Equal[cToken, "("] OR IsId[cToken] DO e _ NEW[ApplicationR _ [e, Exp3[ ]]]; --[4.0] ENDLOOP; END; Exp3: PROC RETURNS [e: Exp] = BEGIN IF Rope.Equal[cToken, "("] THEN { Next[ ]; e _ Exp0[ ]; IF NOT Rope.Equal[cToken, ")"] THEN NoteError["Input Error: No )"]; Next[ ]} ELSE e _ Id[ ]; END; -- The FUN interpreter Eval: PROC[x: Exp, env: Environment] RETURNS [Exp]= BEGIN --(note 4.8) DO WITH x SELECT FROM v: Variable => {t: Environment _ env; UNTIL t=NIL OR Rope.Equal[v, t.first.var] DO t _ t.rest ENDLOOP; RETURN[IF t=NIL THEN x ELSE t.first.val]}; p: Primitive => RETURN[x]; l: Lambda => RETURN[NEW[ClosureR _ [l, env]]]; a: Application => {rator: Exp = Eval[a.rator, env]; rand: Exp = Eval[a.rand, env]; WITH rator SELECT FROM f: Closure => { l: Lambda = NARROW[f.exp ! SafeStorage.NarrowRefFault => NoteError["Evaluation Error: Illegal application"] ]; --[4.1] x _ l.body; env _ CONS[[l.bv, rand], f.env] }; prim: Primitive => RETURN[prim.p[prim.state, rand]]; ENDCASE => NoteError["Evaluation Error: Illegal application"]}; --[4.2] f: Closure => RETURN[x]; ENDCASE ENDLOOP; END; Plus: PROC[d, first: Exp] RETURNS [Exp] = --(note 4.9) {RETURN[NEW[PrimitiveR _ [Plus1, first]]]}; Plus1: PROC[first, second: Exp] RETURNS[v: Variable] = BEGIN ENABLE IO.Error => NoteError["Evaluation Error: Not a number"]; --[4.3] a: INT = IO.GetInt[IO.RIS[NARROW[first, ROPE]]]; --(note 4.10) b: INT = IO.GetInt[IO.RIS[NARROW[second, ROPE]]]; RETURN[IO.PutFR[, IO.int[a+b]]]; END; EvalLoop: PROC = BEGIN DO ENABLE { FUNError => LOOP; --(note 4%11) IO.Error => EXIT}; --(note 4%12) result: Exp _ NIL; Next[ ]; result _ Eval[Prog[ ], LIST[["PLUS", NEW[PrimitiveR _ [Plus, NIL]]]]]; --(note 4.12) dout.PutF["\nResult is %g\n\n",IO.refAny[result]]; --(note 4.11) ENDLOOP END; [din, dout] _ ViewerIO.CreateViewerStreams["Fun"]; TRUSTED {Process.Detach[FORK EvalLoop[ ]]}; END. CHANGE LOG Changed by Bob Hagmann on May 8, 1984 11:14:27 am PDT Cedar 5 conversion from < Cedar 3.5.2 (?): IO.BreakAction, SafeStorage.NewZone eliminated IO.CreateViewerStreams -> ViewerIO.CreateViewerStreams IO.Handle -> IO.STREAM Rope.Digit, Rope.Letter -> Ascii converted IO.BreakProc from Cedar 3.5.2 convertions to Cedar 5 4.2 Notes for FUN (4.1) Comment deleted. (4.2) This sequence of declarations defines the representation for FUN expressions. An expression is parsed into an abstract tree form which can then be interpreted by the Eval procedure. An expression (Exp) can refer to one of five different node types: A Variable, which is represented as a ROPE containing its name; An Application, which consists of an operator (rator) and an operand (rand); A Lambda expression, which consists of a bound variable (bv) and a body; A Closure, which is an expression (exp) together with an Environment, which is a LIST defining a value for each its free variables; A Primitive, which is a Cedar procedure together with some state. Notice that it is perfectly legal to store procedures in data structures. What is actually stored, however, is a pointer to the code. Since Cedar does not support procedures as values in full generality, such procedures cannot be local to other procedures; nor can they refer to their parents' local variables (because, for efficiency of procedure invocation, the Cedar garbage collector does not treat procedures' activation records as collectible storage). We had to define a name for both the node record types and for references to them, e.g., ApplicationR and Application. The record type name is needed when calling the NEW procedure as in NEW[ApplicationR _ [e, Exp3[ ]]] --[4.0] The reference types are used in nodes to provide the tree structure for a FUN expression In declaring an Exp to be a REF ANY, we have told the compiler that it may be a reference to anything at all. This is the recommended way of achieving type variation in Cedar. (A version of Pascal-like variant records is also available, but should only be used when efficiency is crucial.) (4.3) The procedure NoteError types an error message to the user and then generates the ERROR FUNError to clean up the call stack back to EvalLoop, where the error is caught and dealt with (note 4.11). (4.4) The tokenizer and parser for FUN use IO for reading tokens from the input stream din using the StTokenProc to direct the tokenizing facilities provided by IO. (4.5) The value returned by StTokenProc is an enumerated type from the IO interface. (4.6) OPENing IO allows us to omit the IO. prefix from SP, CR, TAB, break, sepr, and other. This is one of the few cases in which an unqualified OPEN should be used. Generally, programs are more easily read when it is obvious which identifiers are imported and which interfaces they come from. If you use OPEN over any but the smallest scope, it is recommended that you use the qualified form, e.g., "OPEN Safe: SafeStorage" over a limited scope, or just "Safe: SafeStorage" in the imports list if the scope is the entire module. (4.7) Prog, Exp0, Exp1, Exp2, and Exp3 constitute a simple recursive descent parser for FUN. (4.8) Eval, Plus, Plus1, and EvalLoop constitute the FUN interpreter. Eval uses WITH-SELECT to discriminate among the various Exp node types and NARROW when there is only one possible type that an Exp could be [line 4.1]. If the NARROW fails, it will raise the signal SafeStorage.NarrowRefFault. If the user were to see that error, it would be somewhat mystifying, so the program catches it and generates NoteError["Evaluation Error: Not a lambda expression"] [line 4.2], which at least says what is actually happening in terms of the FUN language. The same effect is achieved in Plus1 [line 4.3] using an ENABLE clause in the body of the procedure. (4.9) Plus is a "primitive-returning-primitive" that returns a function prepared to add first to whatever comes second. (4.10) This is a standard way to convert a ROPE to an integer; create a stream from the rope using RS and pull (scan) an integer from it. A NARROW could fail if the user typed something like "(PLUS x 1) #SafeStorage.NarrowRefFault would be caught, an error message given to the user, and then the FUNError signal would be generated to unwind control cleanly out to EvalLoop. (4.11) If a problem is encountered while parsing or evaluating a FUN expression, the error FUNError will be generated. EvalLoop catches it and simply continues around the main read-evaluate-print loop. (4.12) When the user destroys the FUN viewer, its din and dout streams will be closed, and any pending call on IO routines will generate the error IO.Error[StreamClosed]. This error is caught so that EvalLoop can then gracefully exit and it process can then disappear. (4.13) The second parameter of Eval is an environment mapping "PLUS" into a primitive. (4.14) This PutF will print result, even if it is a paritally evaluated function or an environment. Try typing "(PLUS 1) #see this. <<>> <<5. Maze Program - Greg Nelson>> <<5.1 mazeProg.mesa>> <<-- MazeProgPartiallyConvertedTo6.0.Mesa>> <<-- Last Edited by GNelson May 9, 1983 2:38 pm>> <<-- Last Edited by Bob Hagmann, May 9, 1984 1:14:34 pm PDT>> <> <<>> <> <<>> <<>> <<-- Once upon a time ...>> <Top>CedarExamples -- % Compile mazeprog -- % @GraphicsToPress.load -- % Run RandomImpl MazeProg -- % _ MazeProg.Maze[] -- (after thirty seconds) -- % print -h Stinger maze.press -- -- Then go find Stinger in the ISL maze (this is what it is really called) and retrieve your own printed maze. >> DIRECTORY Imager USING [Context, MaskVectorI, ScaleT, SetStrokeEnd, SetStrokeJoint, SetStrokeWidth, TranslateT], GraphicsToPress, Random, Vector2 USING [VEC]; MazeProg: PROGRAM IMPORTS GraphicsToPress, Imager, Random = BEGIN <<-- Representation of Cells and Walls>> -- The maze will have n rows of cells and m columns of cells, hence it has n*m cells, indexed from 0 to n*m-1. Here is how the cells are numbered: If a cell's left neighbor is number i, then the cell is number i + 1. If a cell's lower neighbor is i, then the cell is number i+m. If a cell has neither a lower nor a left neighbor, then it is the lower-left corner cell, and it is numbered 0. Thus the bottom row of cells is numbered 0, 1, 2, ... m-1 from left to right, and the left column of cells is numbered 0, m, 2m, 3m, ... (n-1)m from bottom to top. -- There are n rows of (m-1) internal vertical walls, and (n-1) rows of m internal horizontal walls; hence there are n(m-1)+m(n-1) internal walls. We imagine all the internal vertical walls numbered first, from 0 to n(m-1)-1; then all the internal horizontal walls numbered from n(m-1) to n(m-1)+m(n-1)-1. The walls are numbered like the cells, from left to right and then from bottom to top. Thus the bottom row of internal vertical walls is numbered 0, 1, ... (m-2) from left to right, and the left column of internal vertical walls is numbered 0, (m-1), 2(m-1), 3(m-1), ... (n-1)(m-1) from bottom to top. The numbers of the internal horizontal walls start at n(m-1); the numbers of the bottom row of internal horizontal walls exceed this starting point by 0, 1, ... (m-1), and the numbers of the left column of internal horizontal walls exceed the starting point by 0, m, 2m, ... (n-1)m. n: INT = 72; m: INT = 53; numwalls: INT = n * (m - 1) + m * (n - 1); Cell: TYPE = [0 .. n * m); Wall: TYPE = [0 .. numwalls); Vertical: PROC [w: Wall] RETURNS [BOOLEAN] = {RETURN [w < n*(m-1)]}; Horizontal: PROC[w: Wall] RETURNS [BOOLEAN] = {RETURN [w >= n*(m-1)]}; Left: PROC [w: Wall] RETURNS [Cell] = {IF Vertical[w] THEN RETURN[ w + (w / (m - 1)) ] ELSE ERROR}; Right: PROC[w: Wall] RETURNS [Cell] = {IF Vertical[w] THEN RETURN[ w + (w / (m - 1)) + 1 ] ELSE ERROR}; Below: PROC [w: Wall] RETURNS [Cell] = {IF Horizontal[w] THEN RETURN [ w - n * (m - 1) ] ELSE ERROR}; Above: PROC [w: Wall] RETURNS [Cell] = {IF Horizontal[w] THEN RETURN [ w - n * (m - 1) + m ] ELSE ERROR}; <<-- The connectedness algorithm>> -- We use the algorithm called "Quick Find" by Andy Yao in "On the average behavior of set merging algorithms", Proc. ACM Symp. Theory of Computation 8, 1976 192195. Another analysis of the average behavior of the algorithm is in Don Knuth and Arnold Sch\"onhage's, "The expected linearity of a simple equivalence algorithm", Theoretical Computer Science 6, no. 3, 1978 281315. Note, though, that the distribution of merges in our application is more complicated than the distribution analyzed in either paper. -- Two arrays r and q represent the equivalence relation "reachable from" on the cells of the maze, as follows. If c and d are cells, then r[c] = r[d] iff cell c is reachable from cell d. Since initially none of the walls have been removed, initially cell c is reachable from cell d iff c = d; hence we initialize r[c] _ c for all cells c. The role of q is to allow ennumeration of equivalence classes: if c is a cell, then the cells that are reachable from c can be ennumerated thus: c, q[c], q[q[c]], .... The list is circular; it eventually returns to c. Since initially nothing is reachable from c but c, we initialize q[c] _ c for all relevant c. The last invariant is that for all cells c, size[r[c]] is the number of cells reachable from c (hence also from r[c]). -- Two equivalence classes are combined by updating the "r" field of all elements of the smaller class to become the common value of the "r" field of all elements of the larger class, and then splicing the two circular lists into one. r: REF ARRAY Cell OF Cell _ NEW[ARRAY Cell OF Cell]; q: REF ARRAY Cell OF Cell _ NEW[ARRAY Cell OF Cell]; size: REF ARRAY Cell OF INT _ NEW[ARRAY Cell OF INT]; Initrq: PROC = {FOR c:Cell IN Cell DO r[c] _ c; q[c] _ c; size[c] _ 1 ENDLOOP}; Connected: PROC [c, d: Cell] RETURNS [BOOLEAN] = {RETURN [r[c] = r[d]]}; Connect: PROC [c, d: Cell] = {IF ~ Connected[c, d] THEN { c _ r[c]; d _ r[d]; -- now c and d are canonnical representatives of their respective classes IF size[c] > size[d] THEN {t: Cell _ c; c _ d; d _ t}; -- Now c is the root of the smaller equivalence class { cp: Cell _ q[c]; r[cp] _ d; -- true now, and invariant in the next loop: for each cell x in the list -- q[c], q[q[c]], ... up to and including cp, r[x] has been changed to d WHILE cp # c DO cp _ q[cp]; r[cp] _ d ENDLOOP}; -- splice the two equivalence classes and update the size table: {t: Cell _ q[c]; q[c] _ q[d]; q[d] _ t}; size[d] _ size[d] + size[c]}}; <<-- The algorithm for building the maze>> -- We color-code the walls: a "black" wall is one that will be black in the final output, and therefore represents a closed passageway; a "white" wall is one that will be white in the final output, and therefore represents an open passageway connecting two cells; a "grey" wall is one whose final status is not yet determined. Initially all walls are grey. The following general step is repeated until no walls are grey: -- General Step: select a grey wall at random, and consider the two cells that it separates. If these two cells are currently connected by a path that crosses only open passageways (i.e., currently-white walls), then color the wall black; otherwise color it white. -- Note when the general step is finished, the two cells considered in the step will be connected by a path. Since every wall is considered once in the algorithm, when the algorithm is done, every pair of adjacent cells (hence *every* pair of cells) will be connected by a path. It is also easy to see that the general step will not introduce any loops into the maze, since it never opens a passageway between two cells when there is another path between them. Thus the algorithm produces a random (according to some distribution) free tree, which we can hope will be a decent maze. -- To implement the general step, we maintain an array w containing all the walls sorted by color, with the white walls at the left, the grey walls in the middle, and the black walls at the right. More specifically, we maintain the invariant that -- -- w[0], w[1], ... w[firstGrey-1] are the white walls -- w[firstGrey], w[firstGrey+1] ... w[firstBlack-1] are the grey walls -- w[firstBlack], w[firstBlack+1], ... w[numwalls-1] are the black walls -- -- Note that the initial values below satisfy this invariant, since initially all the walls are considered grey. w: REF ARRAY [0 .. numwalls) OF Wall _ NEW[ARRAY [0 .. numwalls) OF Wall]; firstGrey, firstBlack: INT; Initw: PROC = {FOR i:INT IN [0 .. numwalls) DO w[i] _ i ENDLOOP; firstGrey _ 0; firstBlack _ numwalls}; Swap: PROC[i, j: [0 .. numwalls)] = {t:Wall = w[i]; w[i] _ w[j]; w[j] _ t}; BuildMaze: PROC = {WHILE firstGrey < firstBlack DO { i: INT _ Random.ChooseInt[min: firstGrey, max: firstBlack - 1]; -- i is random in [firstGrey, firstBlack) c, d: Cell; -- i _ firstGrey; for debugging SELECT TRUE FROM Vertical[w[i]] => {c _ Left[w[i]]; d _ Right[w[i]]}; Horizontal[w[i]] => {c _ Above[w[i]]; d _ Below[w[i]]} ENDCASE => ERROR; SELECT TRUE FROM Connected[c, d] => {firstBlack _ firstBlack - 1; Swap[i, firstBlack]}; ~Connected[c, d] => {Swap[i, firstGrey]; firstGrey _ firstGrey + 1; Connect[c, d]} ENDCASE => ERROR } ENDLOOP}; <<-- Code for printing the maze>> -- It remains to draw the maze. Each wall will be printed as a black rectangle with dimensions wl by ww points. (wl = wall length, ww = wall width.) Thus the lattice is periodic with period (wl - ww). gc: Imager.Context; wl: INT = 10; ww: INT = 1; scaleFactor: REAL = wl - ww; strokeWidth: REAL = ww / scaleFactor; Initgc: PROC = { gc _ GraphicsToPress.NewContext["maze.press"]; Imager.TranslateT[gc, Vector2.VEC[x: 72.0, y: 72.0]]; <> Imager.ScaleT[context: gc, s: scaleFactor]}; DrawWall: PROC [w: Wall] = { x1, x2, y1, y2: INT; SELECT TRUE FROM Vertical[w] => { x1 _ (w MOD (m - 1)) + 1; x2 _ x1; y1 _ (w / (m - 1)); y2 _ y1 + 1; }; Horizontal[w] => { w _ w - n * (m - 1); x1 _ w MOD m; x2 _ x1 + 1; y1 _ (w / m) + 1; y2 _ y1; } ENDCASE => ERROR; Imager.SetStrokeEnd[context: gc, strokeEnd: square]; Imager.SetStrokeJoint[context: gc, strokeJoint: mitered]; Imager.SetStrokeWidth[context: gc, strokeWidth: strokeWidth]; Imager.MaskVectorI[context: gc, x1: x1, y1: y1, x2: x2, y2: y2]; }; DrawMaze: PROC = {-- draw the interior walls: FOR i:INT IN [firstBlack .. numwalls) DO DrawWall[w[i]] ENDLOOP; -- draw the exterior walls: Imager.MaskVectorI[context: gc, x1: 0, y1: n, x2: 0, y2: 0]; -- west wall -- Imager.MaskVectorI[context: gc, x1: 0, y1: 0, x2: (m - 1), y2: 0]; -- south wall -- Imager.MaskVectorI[context: gc, x1: m, y1: 0, x2: m, y2: n]; -- east wall -- Imager.MaskVectorI[context: gc, x1: m, y1: n, x2: 1, y2: n]; -- north wall -- }; <<-- The catch-all procedure>> Maze: PROC[] = {Initrq[]; Initw[]; Initgc[]; [] _ Random.Create[0, -1]; BuildMaze[]; DrawMaze[]}; <<-- Wish List>> <> <<-- Change Log>> <> END. -- of MazeProg <<5.2 Notes on mazeProg>> <>