From 7129096ec57c3d1e180644562409719b9e531db5 Mon Sep 17 00:00:00 2001 From: CSRG Date: Sun, 15 Jan 1984 03:35:36 -0800 Subject: [PATCH] BSD 4_3_Net_2 development Work on file usr/src/usr.bin/lisp/pearl/pearlbase.l Work on file usr/src/usr.bin/lisp/pearl/manual.ms Work on file usr/src/usr.bin/lisp/pearl/Makefile Work on file usr/src/usr.bin/lisp/pearl/ltags Work on file usr/src/usr.bin/lisp/pearl/ptags Work on file usr/src/usr.bin/lisp/pearl/franz.l Work on file usr/src/usr.bin/lisp/pearl/ChangeLog Work on file usr/src/usr.bin/lisp/pearl/template Work on file usr/src/usr.bin/lisp/pearl/pearlbulk.l Work on file usr/src/usr.bin/lisp/pearl/db.l Work on file usr/src/usr.bin/lisp/pearl/symord.l Work on file usr/src/usr.bin/lisp/pearl/vars.l Work on file usr/src/usr.bin/lisp/pearl/hook.l Work on file usr/src/usr.bin/lisp/pearl/create.l Work on file usr/src/usr.bin/lisp/pearl/scopy.l Work on file usr/src/usr.bin/lisp/pearl/path.l Work on file usr/src/usr.bin/lisp/pearl/print.l Work on file usr/src/usr.bin/lisp/pearl/hash.l Work on file usr/src/usr.bin/lisp/pearl/history.l Work on file usr/src/usr.bin/lisp/pearl/match.l Work on file usr/src/usr.bin/lisp/pearl/toplevel.l Work on file usr/src/usr.bin/lisp/pearl/fix.l Work on file usr/src/usr.bin/lisp/pearl/alias.l Work on file usr/src/usr.bin/lisp/pearl/inits.l Work on file usr/src/usr.bin/lisp/pearl/pearl.l Work on file usr/src/usr.bin/lisp/pearl/pearllib.l Work on file usr/src/usr.bin/lisp/pearl/ucisubset.l Work on file usr/src/usr.bin/lisp/pearl/implement.ms Work on file usr/src/usr.bin/lisp/pearl/ReadMe Work on file usr/src/usr.bin/lisp/pearl/pearl.1 Work on file usr/src/usr.bin/lisp/pearl/lowlevel.l Work on file usr/src/usr.bin/lisp/pearl/pearlsmall.l Work on file usr/src/usr.bin/lisp/pearl/update.ms Synthesized-from: CSRG/cd2/net.2 --- usr/src/usr.bin/lisp/pearl/ChangeLog | 403 ++ usr/src/usr.bin/lisp/pearl/Makefile | 87 + usr/src/usr.bin/lisp/pearl/ReadMe | 127 + usr/src/usr.bin/lisp/pearl/alias.l | 39 + usr/src/usr.bin/lisp/pearl/create.l | 942 +++++ usr/src/usr.bin/lisp/pearl/db.l | 177 + usr/src/usr.bin/lisp/pearl/fix.l | 702 ++++ usr/src/usr.bin/lisp/pearl/franz.l | 244 ++ usr/src/usr.bin/lisp/pearl/hash.l | 690 ++++ usr/src/usr.bin/lisp/pearl/history.l | 199 + usr/src/usr.bin/lisp/pearl/hook.l | 380 ++ usr/src/usr.bin/lisp/pearl/implement.ms | 2059 ++++++++++ usr/src/usr.bin/lisp/pearl/inits.l | 33 + usr/src/usr.bin/lisp/pearl/lowlevel.l | 552 +++ usr/src/usr.bin/lisp/pearl/ltags | 10 + usr/src/usr.bin/lisp/pearl/manual.ms | 5029 +++++++++++++++++++++++ usr/src/usr.bin/lisp/pearl/match.l | 564 +++ usr/src/usr.bin/lisp/pearl/path.l | 252 ++ usr/src/usr.bin/lisp/pearl/pearl.1 | 41 + usr/src/usr.bin/lisp/pearl/pearl.l | 62 + usr/src/usr.bin/lisp/pearl/pearlbase.l | 35 + usr/src/usr.bin/lisp/pearl/pearlbulk.l | 45 + usr/src/usr.bin/lisp/pearl/pearllib.l | 14 + usr/src/usr.bin/lisp/pearl/pearlsmall.l | 13 + usr/src/usr.bin/lisp/pearl/print.l | 396 ++ usr/src/usr.bin/lisp/pearl/ptags | 45 + usr/src/usr.bin/lisp/pearl/scopy.l | 308 ++ usr/src/usr.bin/lisp/pearl/symord.l | 91 + usr/src/usr.bin/lisp/pearl/template | 97 + usr/src/usr.bin/lisp/pearl/toplevel.l | 341 ++ usr/src/usr.bin/lisp/pearl/ucisubset.l | 917 +++++ usr/src/usr.bin/lisp/pearl/update.ms | 471 +++ usr/src/usr.bin/lisp/pearl/vars.l | 380 ++ 33 files changed, 15745 insertions(+) create mode 100644 usr/src/usr.bin/lisp/pearl/ChangeLog create mode 100644 usr/src/usr.bin/lisp/pearl/Makefile create mode 100644 usr/src/usr.bin/lisp/pearl/ReadMe create mode 100644 usr/src/usr.bin/lisp/pearl/alias.l create mode 100644 usr/src/usr.bin/lisp/pearl/create.l create mode 100644 usr/src/usr.bin/lisp/pearl/db.l create mode 100644 usr/src/usr.bin/lisp/pearl/fix.l create mode 100644 usr/src/usr.bin/lisp/pearl/franz.l create mode 100644 usr/src/usr.bin/lisp/pearl/hash.l create mode 100644 usr/src/usr.bin/lisp/pearl/history.l create mode 100644 usr/src/usr.bin/lisp/pearl/hook.l create mode 100644 usr/src/usr.bin/lisp/pearl/implement.ms create mode 100644 usr/src/usr.bin/lisp/pearl/inits.l create mode 100644 usr/src/usr.bin/lisp/pearl/lowlevel.l create mode 100644 usr/src/usr.bin/lisp/pearl/ltags create mode 100644 usr/src/usr.bin/lisp/pearl/manual.ms create mode 100644 usr/src/usr.bin/lisp/pearl/match.l create mode 100644 usr/src/usr.bin/lisp/pearl/path.l create mode 100644 usr/src/usr.bin/lisp/pearl/pearl.1 create mode 100644 usr/src/usr.bin/lisp/pearl/pearl.l create mode 100644 usr/src/usr.bin/lisp/pearl/pearlbase.l create mode 100644 usr/src/usr.bin/lisp/pearl/pearlbulk.l create mode 100644 usr/src/usr.bin/lisp/pearl/pearllib.l create mode 100644 usr/src/usr.bin/lisp/pearl/pearlsmall.l create mode 100644 usr/src/usr.bin/lisp/pearl/print.l create mode 100644 usr/src/usr.bin/lisp/pearl/ptags create mode 100644 usr/src/usr.bin/lisp/pearl/scopy.l create mode 100644 usr/src/usr.bin/lisp/pearl/symord.l create mode 100644 usr/src/usr.bin/lisp/pearl/template create mode 100644 usr/src/usr.bin/lisp/pearl/toplevel.l create mode 100644 usr/src/usr.bin/lisp/pearl/ucisubset.l create mode 100644 usr/src/usr.bin/lisp/pearl/update.ms create mode 100644 usr/src/usr.bin/lisp/pearl/vars.l diff --git a/usr/src/usr.bin/lisp/pearl/ChangeLog b/usr/src/usr.bin/lisp/pearl/ChangeLog new file mode 100644 index 0000000000..3e98520e9a --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/ChangeLog @@ -0,0 +1,403 @@ + Changes to PEARL since the User's Manual. + +6/26/83 -- Version 3.9: Misc. bug fixes -- distributed with 4.2. +-- Fixed a(n embarassingly) large number of bugs in the functions +relating to blocks and freezing and thawing variables. User visible +changes are that freezeblock and thawblock are now fexprs expecting +the name of the block to be frozen. Blocks without names cannot be +frozen or thawed individually. A prominent bug was also found in +freezebindings which did not work correctly when the structure being +frozen had no non-frozen variables of its own. + +6/21/83 +-- Changed the name of the "selectq" in ucisubset.l to "selectq*" to +avoid the new Franz function "selectq" which requires the default case +to be labeled with "t" or "otherwise". Changed all PEARL code to use +the new Franz selectq. + +5/14/83 -- Version 3.8: Unification added. +-- Added unification pattern matching as an option, using code written +by Dave Chin. To turn on unification, call the function "useunification". +There is currently no way to turn it off since the code as written +cannot handle old unification results if it doesn't think unification +is taking place (controlled by special variable *unifyunbounds*). +It is not as expensive as expected so this may be changed. +-- Also fixed serious bugs in "setv". + +5/12/83 +-- Fixed bug in create which caused the mechanism of changing the type +of create being done in nested structures to fail. + +5/6/83 +-- Fixed bug in printing of global adjunct variables. + +5/1/83 +-- Fixed various major bugs in varreplace. + +4/26/83 -- Version 3.7: Two part compilation and minor bug fixes + in scopy and hooks. +-- Created a way to do a "make" which compiles in two pieces for small +machines. Simply define "make pearl" as either "big" or "small" +depending on memory size (Less than about 2.5 Mb of memory requires +"small"). +-- Changed "scopy" and related functions so that the abbreviation on the +copy is just gensym'ed from the old abbreviation, without adding ":copy". +-- Fixed a bug in the hook functions which caused all slots after the ones +with hooks to execute the result (*done*, etc) of the first one. + +3/28/83 -- Version 3.6: Inherit all slot hooks and predicates and unbind + incorrectly bound global variables after failed match. +--- Slot hooks are now always inherited and added to, rather than +replaced. If the hooks and predicates of a slot are preceded by "instead" +then inheriting doesn't happen and hooks and predicates are replaced. +--- Fixed match so that if an unbound global variable is set during a match +that later fails, the value is restored to *pearlunbound*. The names of +variables that are set are saved in the special variable *globalsavestack*. + +3/18/83 -- Version 3.5: New print functions. +--- Rewrote all the print functions. Externally, the three old +pairs of functions: "valprint"/"valform", "fullprint"/"fullform", +and "abbrevprint"/"abbrevform" behave the same. However, there is now +a function called "allform" which all of these use which adjusts its +treatment of a structure based on several special atoms: + 1. *abbrevprint* -- non-nil value causes abbreviations to be used +whenever possible. "abbrevform" (and thus "abbrevprint") lambda-binds +this to t and calls "allform". "fullform" binds this to nil. + 2. *fullprint* -- non-nil value causes complete information +including hooks and predicates to be given when present. "fullform" +(and thus "fullprint") lambda-binds this to t and calls "allform". +"abbrevform" binds this to nil. + 3. *uniqueprint* -- described below. + 4. *quiet* -- described below. +"valform" lambda-binds both to nil which is their default values. +Thus, the default action of "allform" used by itself will be like "valform". +--- All the default print functions which used to use "valprint" +automatically now use "allprint" so that they can all be changed by +changes to the default values of *abbrevprint* and *fullprint*. +--- The third atom which affects the behavior of all the print functions +is *uniqueprint*. If it is given a non-nil value then if a structure +is encountered more than once during the same top-level call to a +print function, it will be translated into exactly the same cons-cells. +This saves on cons-cells and also makes it possible for the "*form" +functions to handle circular structures, although "sprint" and thus +the "*print" functions can't handle the result. Since most people +seldom have duplications within a structure, the default is OFF (nil). +The assoc list is stored in the special atom *uniqueprintlist*. +--- "form" and "print" functions were added to handle structures, +streams and symbols specially. They are called +"structureform", "structureprint" "symbolform", "symbolprint", +"streamform" and "streamprint" and do not ensure that you give them +the right type of value. +--- The fourth atom which affects the behavior of all the print +functions is *quiet* which, if non-nil, keeps them from running +either sprint or the *form function. This is helpful for when you +wish to turn off ALL printing in one fell swoop. A function called +"quiet" was also added which behaves like progn, except that it +lambda-binds *quiet* to t during the evaluation of its arguments, +provided a local island of "quiet". + +3/8/83 -- Version 3.4: Type tags added. +--- Added a field to definitions, structures, symbols, and databases to +indicate what they were to speed up type checking. All relevant +functions related to structures and databases were changed. +--- Fixed some bugs in releasedb. +--- Many lowlevel functions in PEARL were changed, but none in ways that would +affect most people (because they shouldn't be using the changed functions). + +3/4/83 -- Version 3.3: New faster hashing. +--- Changed internal code to do the hashing so that it only gets the value +out of a slot once instead of as many as 4 times as before. Resulted +in about a 5% speedup for structures only hashed a couple of ways. +Should be more for multiply hashed items. Should also make new +hashing methods easier to add. + +2/25/83 -- Version 3.2: Slot encoding applied to speeded-up match. +--- Rewrote match functions to use the new slot encoding. Provided +about a 10% speedup. +--- There are now two different kinds of match function: "standardmatch" +and "basicmatch" will only match two structures of the same type. +"standardexpandedmatch" and "basicexpandedmatch" will match two +structures which are related hierarchically (one above the other) +on the slots they have in common. "standardfetch" uses the regular +versions and "expandedfetch" uses the expanded versions. + +2/21/83 +--- Changed all special variables in PEARL to be defined with defvar so +that fasl'ing in pearl.o at compile time will automatically declare them +special again. + +2/17/83 -- Version 3.1: Slot encoding for speed. +--- Added major and minor version numbers to PEARL, stored in +"pearlmajorversion" and "pearlminorversion" respectively. +Started at 3.1 for this version. +--- Added new method of storing in slots to speed up some things. +--- Putpath, delsetpath, addsetpath and clearpath now will work on a +slot with any kind of value or variable in it but result in a constant +value. This may cause problems, and if it does it will be "fixed" to +worry about what was there and decide what to do to it. +--- Scopy no longer throws away bound adjunct variables. +--- Many functions listed in the manual as being "proprietary" to PEARL +(i.e., not safe to use) have gone away. There are too many to list here. + +1/23/83 +--- Fixed a bug which made slots inherit hashing when redescribed in an +expanded structure unless new hashing was specifically included. +--- Added a new "hashing mark" "+", for redescribed slots of expanded +structures only, which says copy the old info and add the following +new hashing too. It must come first to be effective. + Thus, the following should work: + (cb x (* a int)) + (ce x y (a ^)) + (ce x z (+ : a ^)) + (ce x w (: + a ^)) ;; anomalous use of + +resulting in: + * hashing in x, + no hashing in y, + both * and : hashing in z, + and only * hashing in w (because of misplacement of +). + +1/19/83 +--- Merged the file sprint.l into ucisubset.l. + +1/18/83 +--- Miscellaneous changes to functions length and others in ucisubset.l +to improve efficiency. + +1/7/83 +--- Changed ,@ to ., in most cases (i.e., whenever equivalent) to +avoid an unneeded append generated by the backquote macro. + +12/24/82 +--- Made change in the definitions of de, df, dm, drm and dsm so that +if the special variable *savedefs* is nil then old definitions of functions +are not saved. This is especially useful in compiling (and hence assembly +and loading) since it will speed it up quite a bit. The saving of the file +the definition was in is also disabled. The variable *savedefs* is +normally t which causes these macros to act as before, saving the +definition, etc. If *savedefs* is nil, then they simply expand into the +appropriate defun or setsyntax. The following lines should be +included in the file to have this effect only at compile time: + (eval-when (compile) + (declare (special *savedefs*)) + (setq *savedefs* nil)) +If you want to permanently disable the saving in your lisp, +simply put a + (setq *savedefs* nil) +in your .lisprc file AFTER the loading of ucisubset.l. + +11/12/82 +--- Removed association of "remove" with Franz's "delete" so that +Franz's remove could be used and fixed all references to "remove" and +"dremove", changing many to "delq"s. +--- Deleted "powercopy" and redefinition of "copy" now that Franz has +correct meaning (doesn't attempt to copy hunks) for copy. + +10/30/82 +--- All the exprs whose names were of the form XXXX1 where XXXX was the +name of a lexpr which was a principle function of PEARL were eliminated +(i.e., absorbed by the other form). +--- Many small changes to speed up PEARL, including: + 1. Changed many progs to lets. + 2. Inserted progn's around (or (non-error) + (not (msg t .....)) + (pearlbreak)) + thus eliminating the not and clarifying the meaning. + 3. Changed many pops to (setq x (cdr x)) (where popped item not wanted). + 4. Changed plus, difference, times and remainder to +&, -&, * and \\. + 5. Changed greaterp and lessp to >& and <&. + 6. Changed minusp to (<& .. 0) + 7. Changed (neq 0 ..) to (not (=& 0 ..)). + 8. Eliminated the intermediate exprs insertdb1, fetch1, etc. + by converting the basic functions insertdb, fetch to use the + &optional syntax. +PRELIMINARY RESULTS: + 25-33% speedup of various test programs. + +10/20/82 +--- Added abbreviation "pdb" for "printdb". +--- Changed usage of nth, push and pop to use Franz Opus 38.32's new +definitions of them, removing them from ucisubset.l. + +9/17/82 +--- Changed scopy, patternize and varreplace to exprs from macros +so that they will compile without complaints of special variables. + +9/16/82 +--- Added new hashing mechanism using label && and called "hash +focusing". If this is found when inserting into the database +then the item is hashed as if it were the item in the slot so +labelled. This is designed for people using a data base all of +whose entries are of the same type (not required, just common +for this application) and enables the contents of a slot to be +more usefully used to discriminate them (e.g., planfors, inference +rules, or almost any such extremely-common binary predicates.) +At fetching time, && is considered less useful than *** or ** and more +useful than * or nothing (subject to debate and change). (This +necessitated the addition of an additional entry in the header of +structure definitions, moving everything else down a slot in the hunk.) +This differs from & (hash aliasing) in that && hash focussing affects +how a structure itself is inserted and fetched, while & simply +affects how structures containing this type of structure are +treated. For example, suppose the unique numbers of A, B, and C +respectively are 1, 2, and 3. C is a symbol. A has one slot X with +* and && hashing. B has one slot Y of type symbol with * hashing. +Then a structure like (A (X (B (Y C)))) will be indexed the +following ways and fetcheverywhere will find it in the following +order: + && which uses the 2 and 3 from B and its C, (ignoring the 1 of A), + and also simply 2 from B. + * on A uses type of B thus using 1 and 2. + also put under 1 of A without using 2 or 3. +If B had an & in its slot then the + * on A is affected by & on B thus using 1 and 3 (ignoring the 2 of B). + +Thus, if you consider A, B, and C to be three levels of information +in the structure, an item can be hashed under any combination of two +of those levels. The normal * method uses levels 1 and 2, the +aliasing & method ignores level 2 and uses levels 1 and 3, and the +new focussing && method ignores level 1 and uses levels 2 and 3. +In addition, the item can be put under 1, 2 or 3 individually by +various combinations of marks (1 = none, 2 = :, 3 = :+&). The only +unavailable combination of the 3 is all three. + +(Added internal-use-only functions are insertbyfocus, removebyfocus, +puthashfocus, gethashfocus, recursetoinsidestandardfetch. + +9/15/82 +--- Added two functions "memmatch" and "memstrequal" which are like +"memq" except that they use "match" and "strequal" respectively +instead of "eq". +--- Added fixes to "scopy" and "patternize" from Dave Chin which allow +them to handle circularly linked structures AND to use the same copy +of the same structure wherever it appears. This required the addition +of a special variable *scopieditems*. This also included a bug fix +which added code to store pointers to the new copies in the +abbreviation atoms stored in them. +--- Added a function called "varreplace" similar to "patternize" which +replaces all bound variables in an item with their values, in effect +permanently freezing them. +--- Added a function called "(intscopy item outeritem)" where intscopy +stands for "internal scopy" exactly the same as "(scopy item)" except +it does the copying as if the item were internal to outeritem, thus +sharing its local and block variables. +--- Split create.l into create.l and scopy.l. + +9/14/82 +--- Moved much of the initialization stuff out of pearl-top-level-init +to be done at load time instead. This cut the minimum startup cost +for PEARL from 4 seconds to 0.8 seconds CPU. +--- Changed setdbsize to remove all current databases before changing +the size, warn if *warn* is set and recreate *maindb* with *db* +pointing to it. Also fixed a bug when removing the last database. +--- Changed the init-files processing to parallel the new Franz method, +looking in the current directory, and then the home directory, and +looking for .init.prl followed by .o, .l or nothing, and then init.prl +followed by .o, .l or nothing. Similarly for start.prl. +--- Fixed cleardb so that it doesn't make new cons-cells for the buckets +and so that it uses connectdb if the database has a parent. Thus, +cleardb is a local database clearer and its effects do not extend up +the DB hierarchy. + +6/6/82 +Added new hashing method. If slots are labelled with *** and all +slots so marked are filled with useful values, then the item is hashed +under the type of structure plus the values of all these slots. +New functions are gethashmulti and puthashmulti. *multiproducts* is a +new special atom containing the numbers to multiply the various values +with to produce the index (currently powers of 16). + +6/3/82 +Fixed a bug in fetcheverywhere which caused it to only find the +bucket for the first *-ed slot, instead of all of them. (Added +to npearl also). + +5/28/82 +Tried replacing the sequential search method of finding slot numbers +for particular slot names with evaluating a concat'ed atom made out +of but timings found it slower so it was +removed. + +5/27/82 +Fixed a problem with storage of variables. Instead of two spots in +the hunk, one for the alist (unfrozen variables) and one for the +alistcp (frozen variables), there is a special cons cell with these +in its car and cdr. This cons cell is pointed to by all substructures +so that they can be used in fetches and matches and will be able to +unbind or freeze or thaw their variables. Additional special variable +is *toplevelalists* (or some such). + +5/6/82 +--- When an individual (including default instance) structure is created, +an abbreviation atom is stored in it. This abbreviation is chosen as +follows: + 1. If the option of having a structure stored in an atom is used, + then that atom is the one used as an abbreviation. Thus + (create individual x Pete) + will have Pete as a abbreviation. + 2. If that option isn't used, then default instances will be + given the abbreviation i:x (where x is the structure type name) + and individuals at the top level will be given a name newsym-ed + from the name of their type. Thus + (create base x) will make a default instance abbreviated i:x and + (create individual x) will be abbreviated x0 or x1 or whatever. +--- New printing and "form-type" functions were added called "abbrevprint" +and "abbrevform" which print the abbreviation (if there is one) for +any structure below the top level. +--- The base name of the type of a slot (i.e., the last word, after +setof's are stripped off) is stored for each slot (a more general +application of the "ppset" information always stored for integer slots +with ordinal types before). This is in preparation for two things: + 1. Enforcing such type descriptions. + 2. Generating knowledge about the slots of a structure so that the + user need not know whether to use fetch or path. + +5/5/82 +The name of an old slot in a new expanded may be changed by following +the new name by the old slotname preceded with an equal sign. Thus +for example: +pearl> (create base X + (A struct)) +(X (A (nilstruct))) +pearl> (create expanded X Y + (B =A) + (C .....)) +(Y (B (nilstruct)) (C .....))) + +NOTE that there MAY NOT be a space between the equal sign and the A +since = is the read macro which expands =A into (*slot* A) but leaves +a single space-surrounded = alone. + +4/28/82 +--- Adapted PEARL to fit Franz Opus 38.13 so that the atoms +showstack-printer and trace-printer are bound to the functions +pearlshowstackprintfn and pearltraceprintfn. (Note the addition of +"pearl" to the beginning of these). Also changed the name of +breakprintfn to pearlbreakprintfn but it is not currently +lambda-bindable. +--- Adapted the reading of .init.prl and .start.prl files to disable +the printing of "[load .init.prl]" by lambda-binding $ldprint to nil +first (Franz Opus 38.14). + +2/22/82 +--- Fixed a bug in the hook disablers. The atoms for path hooks +were misnamed in such a way that you couldn't use hidden and +visible. Instead of *rungethooks*, and other *run...hooks* +forms, they are now *rungetpathhooks* and other *run...pathhooks*. +Note that they must be called as (XXXpath ...) and not (path XXX ...) +when used with hidden and visible. + +2/21/82 +--- Added ability to evaluate an atom when expecting a value of a +different type (besides integers which already worked this way). +For symbols, this is done if the atom isn't a symbol name. +For structures, it must evaluate to a structure. +For Lisp slots, it may not evaluate to an atom. +For setof slots, its value is checked for being of the appropriate +type, including depth of nesting. +--- Added the fetching function "fetcheverywhere" which gathers +ALL the buckets the object could have been hashed into and builds +a stream out of all of them (potentially five buckets). Will wait +to build an "expandedfetcheverywhere" with its potential of +returning 5 times the-depth-of-the-hierarchy buckets. + +vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/Makefile b/usr/src/usr.bin/lisp/pearl/Makefile new file mode 100644 index 0000000000..050b0af0a9 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/Makefile @@ -0,0 +1,87 @@ + +# Makefile for pearl + +# Read the ReadMe file for more info. +# This makefile creates these things: +# pearl - the executable PEARL, loaded into a lisp. +# pearl.o - the object version of PEARL's functions for fasl'ing +# into another lisp file at compile time. +# tags - tags file for PEARL source. +# + +# If LibDir is changed, you must also change the pathnames in pearllib.l +LibDir = /usr/lib/lisp +CopyTo = /dev/null +ManDir = /usr/man/man1 +ObjDir = /usr/ucb +Liszt = ${ObjDir}/liszt +CdTo = .. + +Src = alias.l create.l db.l fix.l franz.l hash.l history.l hook.l \ + inits.l lowlevel.l match.l path.l pearl.l \ + pearlbase.l pearlbulk.l pearllib.l pearlsmall.l \ + print.l scopy.l symord.l \ + toplevel.l ucisubset.l vars.l + +AllSrc = Makefile ChangeLog ReadMe implement.ms ltags \ + manual.ms pearl.1 ptags template update.ms ${Src} + +.l.o: + ${Liszt} $< + +# Make "pearl.o" and "pearl" from scratch. +# NOTE: At installations where memory is less than 2.5Mb, +# "make pearl" normally makes "small" which builds PEARL in two steps. +# If your installation has more memory, "pearl" can be changed to +# make "big" instead. In this case, "install" below should also be +# changed to make "biginstall" instead of "smallinstall". +pearl: small + echo "(savepearl)" | pearl.o + @echo pearl done + +pearlbase.o: pearlbase.l + +pearlbulk.o: pearlbase.o pearlbulk.l + +small: pearlbase.o pearlbulk.o + ${Liszt} -r pearlsmall.l -o pearl.o + +big: + ${Liszt} -r pearl.l + +# Install the executable pearl in ObjDir and the +# fasl'able pearl.o for compiling code using PEARL in LibDir. +# NOTE: "install" can be changed to use "biginstall" on big enough machines. +install: smallinstall + +smallinstall: small + echo "(savepearl)" | pearl.o + mv pearlbase.o ${LibDir}/pearlbase.o + mv pearlbulk.o ${LibDir}/pearlbulk.o + ${Liszt} -r pearllib.l -o pearl.o + mv pearl.o ${LibDir}/pearl.o + mv pearl ${ObjDir}/pearl + cp pearl.1 ${ManDir}/pearl.1 + @echo pearl done + +biginstall: big + echo "(savepearl)" | pearl.o + mv pearl.o ${LibDir}/pearl.o + mv pearl ${ObjDir}/pearl + cp pearl.1 ${ManDir}/pearl.1 + @echo pearl done + +tags: /dev/tty ${Src} + -rm -f tags + awk -f ltags ${Src} | sort > tags + +# For distribution purposes. +copysource: ${AllSrc} + (tar cf - ${AllSrc} | (cd ${CopyTo} ; tar xf -)) + +scriptcatall: ${AllSrc} + @(cd ${CdTo} ; scriptcat pearl pearl ${AllSrc}) + +clean: + -rm -f pearl pearl.o + diff --git a/usr/src/usr.bin/lisp/pearl/ReadMe b/usr/src/usr.bin/lisp/pearl/ReadMe new file mode 100644 index 0000000000..3021cc6ef6 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/ReadMe @@ -0,0 +1,127 @@ +ReadMe file for the distribution of the Franz implementation of PEARL. + 8/9/83 by Joe Faletti + +PEARL is an AI programming language implemented on top of Franz Lisp +by Joseph Faletti and Michael Deering under the direction of Robert +Wilensky at the Berkeley AI Research Project (BAIR). + +DOCUMENTATION + For more information on PEARL's capabilities, see the following: + +[1] Deering, M., Faletti, J., and Wilensky, R. 1981. PEARL: An Efficient +Language for Artificial Intelligence Programming. In the Proceedings +of the Seventh International Joint Conference on Artificial Intelligence. +Vancouver, British Columbia. August, 1981. + +[2] Deering, M., Faletti, J., and Wilensky, R. 1982. The PEARL Users Manual. +Berkeley Electronic Research Laboratory Memorandum No. +UCB/ERL/M82/19. March, 1982. + +[3] Faletti, J., and Wilensky, R. 1982. The Implementation of PEARL. +Unpublished memo. + +The last two are included in vtroff source form in this distribution +but the page numbers of [2] may be off by a bit (sorry! -- if someone +bothers to convert the manual for automatic table of contents and +index generation, we'd be happy to use it!). (More below). + +The manual [2] may be printed and distributed to users with no fear +of copyright infringement. However, for those without suitable printing +facilities, a single photocopy of the manual suitable for auto-feed copying +for local distribution of the manual may be acquired from: + Berkeley AI Research Project + Robert Wilensky, Director + Computer Science Division + 553 Evans Hall + University of California, Berkeley + Berkeley, CA 94720 +This version will include an addendum summarizing the changes +described in the file ChangeLog. + +BUG REPORTS: + Bug reports should be mailed to Pearl-Bugs@Berkeley by ARPANET or +ucbvax!pearl-bugs by USENET. PEARL is being provided as is for the +cost of distribution with Franz and as such carries no warranty or +guarantee. + +CONTENTS OF THIS DIRECTORY: + The files in this directory fall into two categories: A) the source and +make file for building a version of PEARL in Franz and B) documentation. + + A) Source and make file for building a version of PEARL in Franz. +These files are described briefly after the following description of +how to make a version of PEARL. + +To Make PEARL: + A version of PEARL may be made by changing to this directory and +executing a "make pearl". As delivered, this makes "small" which compiles +PEARL in two pieces, and builds "pearl.o" (which loads the two pieces +into a lisp) and then executes the "savepearl" function which dumps a +lisp called "pearl" in the current directory containing all of PEARL +with the PEARL top level installed and ready to start up from scratch. +This form is necessary on machines with less than about 2.5Mb of memory. +If your installation is larger, you can change "pearl" to make "big" +instead of "small" and change "install" to make "biginstall" instead +of "smallinstall". This will compile PEARL in one piece, creating +"pearl.o" simply by compiling the file "pearl.l" which "includes" all +the other source files described below. + Making PEARL from scratch takes about 13 minutes of CPU time, or about +15 minutes of real time (times the load average) on a VAX 780. + To install the executable pearl in the usual object directory, +/usr/ucb, and the load module pearl.o in the Franz library /usr/lib/lisp, +execute a "make install". If you change where the library is you must +also change the absolute path names in the file "pearllib.l" (which is used +in a "make small" to make it easy to load the two halves of PEARL with a +single file). + +The Source for PEARL: + The source for PEARL is described below in the order that it is +included in "pearl.l". + +ucisubset.l --- PEARL was originally implemented in UCILisp. This file + defines those functions from UCILisp still used in PEARL. +franz.l --- Franz version of functions that are likely to need + to be redefined for a particular lisp. +lowlevel.l --- Lowest level functions (mostly macros) in PEARL + used to access the various data structures. +db.l --- Functions for creating databases. +vars.l --- Functions to handle pattern-matching variables. +symord.l --- Functions for creating symbols and ordinals. +hook.l --- Functions used by everything else to handle hooks (demons). +create.l --- Functions to create PEARL structures. +scopy.l --- Functions to copy PEARL structures. +path.l --- The PATH function. +print.l --- Functions to print PEARL objects. +hash.l --- Functions using hashing info in structures to insert and + fetch from data bases. +match.l --- Functions to match and/or compare structures. +history.l --- Functions used to implement the history mechanism in the + toplevel loop. +toplevel.l --- Variation on the Franz toplevel loop for PEARL, + including functions for dumping various versions of a running PEARL. +fix.l --- Variation on the "fixit" debugger adapted for PEARL. +alias.l --- Code to save various functions under alternative names. +inits.l --- Code which must run at load time to initialize a PEARL + environment. + +Documentation included in this directory: + +manual.ms --- The -ms source of the PEARL manual as published in the + reference [2] above. This should be vtroffable to produce a copy + of the PEARL manual, although the page numbers were done by hand + and thus may be off by a bit if anything is changed. It may also + be nroffed, although the page numbers will most certainly be off. +update.ms --- The -ms source for an update to the manual covering PEARL + up through Version 3.9 paginated for appending to the manual. +ChangeLog --- A listing in reverse date order of things changed in + PEARL since the manual was published. +template --- Visual representation of the allocation of information in + the hunks used by PEARL for various internal data structures. +implement.ms --- An unfinished memo on the implementation of PEARL. + Includes a simple example of how to implement forward and backward + chaining in PEARL and a bit more detail on the hashing mechanism. +ltags --- A tags file for the various function and macro definition + mechanisms used in PEARL (more than standard Franz). +ptags --- A tags file for files which contain mixed Lisp functions and + PEARL structure definitions. + diff --git a/usr/src/usr.bin/lisp/pearl/alias.l b/usr/src/usr.bin/lisp/pearl/alias.l new file mode 100644 index 0000000000..ead51cc5ff --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/alias.l @@ -0,0 +1,39 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; alias.l ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Aliases for various functions -- some for history's sake, some +; for abbreviation's sake +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +; For history: +;(aliasdef 'powercopy 'copy 'subr) +(aliasdef 'minform 'valform 'subr) +(aliasdef 'minprint 'valprint 'subr) +(aliasdef 'listform 'fullform 'subr) +(aliasdef 'shortform 'valform 'subr) +(aliasdef 'listprint 'fullprint 'subr) +(aliasdef 'shortprint 'valprint 'subr) +(aliasdef 'insert-db 'insertdb 'subr) +(aliasdef 'next-item 'nextitem 'subr) +(aliasdef 'remove-db 'removedb 'subr) +(aliasdef 'expanded-fetch 'expandedfetch 'subr) +(aliasdef 'symbol-e 'symbole 'subr) +(aliasdef 'combine-skels 'combineskels 'subr) +(aliasdef 'quasi-quote 'quasiquote 'subr) +(aliasdef 'define-set 'ordinal 'fsubr) +(aliasdef 'usersave 'savefresh 'subr) +(aliasdef 'user-save 'usersave 'subr) +(aliasdef 'pearl-rep-loop 'pearlreploop 'subr) + +; Abbreviations: +(aliasdef 'cr 'create 'fsubr) +(aliasdef 'dbcr 'dbcreate 'macro) +(aliasdef 'ppath 'path 'macro) +(aliasdef 'vp 'valprint 'subr) +(aliasdef 'fp 'fullprint 'subr) +(aliasdef 'ap 'abbrevprint 'subr) +(aliasdef 'dp 'debugprint 'subr) +(aliasdef 'pdb 'printdb 'subr) + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/create.l b/usr/src/usr.bin/lisp/pearl/create.l new file mode 100644 index 0000000000..10f7668c65 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/create.l @@ -0,0 +1,942 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; create.l ;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Functions for creating, copying, and merging structures. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +; Create a new structure of one of the five types: +; BASE: build a new structure with all new slots. +; EXPANDED: build new slots in addition to slots inherited from +; a BASE or EXPANDED structure. +; INDIVIDUAL: create an instance of a BASE or EXPANDED structure, +; filling in slots or inheriting defaults from above. +; PATTERN: create an instance of a BASE or EXPANDED structure but +; fill in unspecified slots with ?*ANY*. +; FUNCTION: build a new structure with slots describing the +; arguments to the function. + +; Generalized syntax for this function is: +; +; (CREATE +; [{HashingInfo} {{{:=} } | ^} +; { : } +; {} ] +; . . . . . . . +; [{HashingInfo} {{{:=} } | ^} +; { : } +; {} ] ) + +; BASE structures have no and only new slots. +; EXPANDED structures should have at least one new slot and inherit +; default values from the . +; INDIVIDUAL structures have only old slots and inherit default values from +; the ; if the occurs, the atom +; is set to point to the internal form which is also +; returned as the value of CREATE. +; PATTERN structures have only old slots and all unspecified slots are +; set to ?*ANY* rather than inheriting a default. +; FUNCTION structures have no and only new slots. +; They are interpreted as functions to be run rather than structures +; to be accessed when they are MATCHed, FETCHed or PATHed. +; +; The structure created is always stored in the SPECIAL variable *LASTCREATED* +; in addition to the if specified and the atom formed +; by prepending a 'd:' to the front of the . +; +; If the SlotValue for a slot in a BASE or EXPANDED structure is preceded +; by a :=, then the slot is filled with this value but it is not +; used as the default for this slot in future INDIVIDUALS and +; EXPANDEDS. +; If the SlotValue is not preceded by a :=, then the value represents a +; default to be inherited by INDIVIDUALs and new EXPANDEDS. + +; This just sets the two atoms *toplevelp* and *currentcreatetype* +; and calls the real workhorse "insidecreate". +(df create (l) + (setq *toplevelp* t) + (setq *currentcreatetype* (car l)) + (apply (function insidecreate) l)) + +; Pick apart the atoms before the slots, handle them and pass the +; rest on to the appropriate version of create XXX. +(df insidecreate (l) + (let ((type (car l)) + (abbrev (cond (*toplevelp* '*buildabbrev*) + ( t nil))) + (name1 (cadr l)) + (name2 (caddr l)) + (name3 (cadddr l)) + slots) + (cond ((reallitatom name2) + (setq abbrev name2) + (setq slots (cdddr l)) + (cond ((reallitatom name3) + (setq abbrev name3) + (setq slots (cddddr l))) + ( t (setq name3 name2)))) + ( t (setq name3 (setq name2 name1)) + (setq slots (cddr l)))) + (and (memq type '(ind individual pat pattern)) + (eq name1 name3) + (setq name3 '*lastcreated*)) + (set name3 + (setq *lastcreated* + (selectq type + ((individual ind) + (createindividual name1 abbrev slots)) + (base + (createbase name1 abbrev slots)) + ((expanded exp) + (createexpanded name1 name2 abbrev slots)) + ((pattern pat) + (createpattern name1 abbrev slots)) + ((function fn) + (createfunction name1 abbrev slots)) + (otherwise (msg t "CREATE: Illegal selector: " type + " in created structure: " l t) + (pearlbreak))))))) + +; Create a new structure and insert it in the database. +(defmacro dbcreate (&rest rest) + `(insertdb (create .,rest))) + +(defmacro cb (&rest rest) + `(create base .,rest)) + +(defmacro ci (&rest rest) + `(create individual .,rest)) + +(defmacro ce (&rest rest) + `(create expanded .,rest)) + +(defmacro cp (&rest rest) + `(create pattern .,rest)) + +(defmacro cf (&rest rest) + `(create function .,rest)) + +(defmacro base (&rest rest) + `(create base .,rest)) + +(defmacro ind (&rest rest) + `(create individual .,rest)) + +(defmacro individual (&rest rest) + `(create individual .,rest)) + +(defmacro pexp (&rest rest) + `(create expanded .,rest)) + +(defmacro expanded (&rest rest) + `(create expanded .,rest)) + +(defmacro pat (&rest rest) + `(create pattern .,rest)) + +(defmacro pattern (&rest rest) + `(create pattern .,rest)) + +(defmacro fn (&rest rest) + `(create function .,rest)) + +(defmacro pfunction (&rest rest) + `(create function .,rest)) + +; Put a *VAR* variable in the structure's assoc-list and return the cons-cell. +(defmacro installvar (varname) + `(cond ((eq '*any* ,varname) *any*conscell*) + ; else, if there, return it. + ((assq ,varname (getalist *currenttopcreated*))) + ; else, add it (which also returns the special conscell). + ( t (addalist ,varname *currenttopcreated*)))) + +; Install an adjunct variable in the slot. +(defmacro installadjunct (adjunctvar) + `(let (var) + (cond ((dtpr ,adjunctvar) + (setq var (cadr ,adjunctvar)) + (selectq (car ,adjunctvar) + (*var* (installvar var)) + (*global* var) + (otherwise + (msg t "CREATE: no adjunct variable given after colon " + "-- rest of slot is: " ,adjunctvar slot t) + (pearlbreak)))) + ( t (msg t "CREATE: no adjunct variable given after colon. " + "Rest of slot is: " ,adjunctvar slot t) + (pearlbreak))))) + +(dm handlepossibleadjunctvar (none) ; but assumes SLOT, SLOTVALUE, & VALUETYPE. + '(let ((adjunctvar (car slot))) + (and (eq adjunctvar ':) + (cond ((neq valuetype 'CONSTANT) + (msg t "CREATE: Adjunct variables not allowed in " + "slots whose values are also variables." t) + (pearlbreak)) + ( t (setq slot (cdr slot)) ; throw away ":". + (setq adjunctvar (pop slot)) + (setq valuetype 'ADJUNCT) + (setq slotvalue (cons slotvalue + (installadjunct adjunctvar)))))))) + +; Ensure that value is of type TYPENUM (used after ! or on value in atom +; where setof value expected). Value returned (t / never) is used +; only in evaluating atom. If error, doesn't return. +(de enforcetype (value typenum) + (or (selectq typenum + (0 (structurep value)) + (1 (psymbolp value)) + (2 (numberp value)) + (3 (not (reallitatom value))) + (otherwise + (apply (function and) + (mapcar (funl (singlevalue) + (enforcetype singlevalue + (- typenum 4))) + value)))) + (progn (msg t "CREATE: Value after ! or bound to atom in SETOF " + "slot is of wrong type. Value is: " value t) + (pearlbreak)))) + +; Get the value for a slot. +; If preceded by an ! then it is already in internal form but verify this. +; If is preceded by a $ then it should be evaluated before continuing +; processing (on its value). +(dm constructvalue (none) + '(let ((typenum (getslottype slotnum defblock)) + (ppset (getppset slotnum defblock))) + (selectq (car slot) + (\! (setq slot (cdr slot)) + (setq newvalue (eval (pop slot))) + (enforcetype newvalue typenum) + (setq valuetype 'CONSTANT) + (setq slotvalue newvalue)) + (\$ (setq slot (cdr slot)) + (setq newvalue (eval (pop slot))) + (setq valuetype 'CONSTANT) + (setq slotvalue (buildvalue newvalue typenum ppset))) + (otherwise + (cond ((and (dtpr (car slot)) + (eq (caar slot) '*var*)) + (setq valuetype 'LOCAL) + (setq newvalue (cadr (pop slot))) + (setq slotvalue (installvar newvalue))) + ((and (dtpr (car slot)) + (eq (caar slot) '*global*)) + (setq valuetype 'GLOBAL) + (setq slotvalue (cadr (pop slot)))) + ( t (setq valuetype 'CONSTANT) + (setq slotvalue + (buildvalue (pop slot) typenum ppset)))))))) + +; Generate the default value for slots of the given type. +(defmacro defaultfortype (typenum) + `(selectq ,typenum + (0 (eval (instatom 'nilstruct))) + (1 (eval (symatom 'nilsym))) + (2 0) + (3 nil))) + +; Look at the ISA to find the default value, or the else use +; the default default for that type. +(defmacro inheritvalue (structdef) + `(let ((isa ,structdef)) + (cond ((or (null isa) + (not (getenforce slotnum isa))) + (setq slotvalue (defaultfortype (getslottype slotnum defblock))) + (setq valuetype 'CONSTANT)) + ( t (let ((default (getdefaultinst isa))) + (setq slotvalue (getslotvalue slotnum default)) + (setq valuetype (getslotvaluetype slotnum default))))))) + +; Look for predicates and hooks. Use tconc to keep in order. +(dm handlepredicatesandhooks (none) + '(progn + (setq predlist (ncons nil)) + (setq slothooklist (ncons nil)) + (while (setq fcn (pop slot)) + (cond ((atom fcn) + (cond ((eq fcn 'instead) + ; Don't inherit hooks. + (putpred slotnum nil valblock)) + ((memq fcn '(if hook)) + ; A hook follows. + (tconc slothooklist (cons (pop slot) (pop slot)))) + ; Structure predicate. + ((structurenamep fcn) + (tconc predlist (eval (defatom fcn)))) + ; Otherwise, a predicate name. + ( t (tconc predlist fcn)))) + ; Otherwise an s-expression predicate. + ( t (tconc predlist fcn)))) + (putpred slotnum + (nconc (car predlist) (getpred slotnum valblock)) + valblock) + (putslothooks slotnum + (nconc (car slothooklist) (getslothooks slotnum valblock)) + valblock))) + +; Build a new slot in the current structure. +(dm buildslot (none) + '(progn + (setq slotname (pop slot)) + (clearhashandformat slotnum defblock) + ; To gather hashing and enforce information before installing in defblock. + (setq hashcollect 0) + (setq reqstruct nil) + + ; Check for hashing marks first. + (while (selectq slotname + ; First starred slot used for > hashing if no & present. + (* (and (\=& 0 first*edslot) + (setq first*edslot (minus slotnum))) + (addhash* hashcollect)) + (** (addhash** hashcollect)) + (*** (addhash*** hashcollect)) + (& (cond ((not (\=& 0 hashalias)) + (msg t "CREATE: Only 1 hash alias (&) or " + "selected slot (^) allowed in: " + newname t) + t) + ( t (setq hashalias slotnum)))) + (^ (cond ((not (\=& 0 hashalias)) + (msg t "CREATE: Only 1 hash alias (&) or " + "selected slot (^) allowed in: " + newname t) + t) + ( t (setq hashalias (minus slotnum))))) + (&& (cond ((not (\=& 0 hashfocus)) + (msg t "CREATE: Only 1 hash focus (&&) " + "allowed in: " newname t) + t) + ( t (setq reqstruct t) + (setq hashfocus slotnum)))) + (: (addhash: hashcollect)) + (:: (addhash:: hashcollect)) + (> (addhash> hashcollect)) + (< (addhash< hashcollect))) + (setq slotname (pop slot))) + (and (\=& 0 (length slot)) + (progn (msg t "CREATE: Missing slot name and/or type in slot number " + slotnum " of structure: " newname t) + (pearlbreak))) + + ; Slotname now holds the slotname. Should be checked for duplicates!! + (putslotname slotnum (ncons slotname) defblock) + + ; Now look for the type. + (setq typenum 0) + (setq slottype (pop slot)) + (while (selectq slottype + (struct (setq reqstruct nil) + nil) ; i. e., add 0 to TYPENUM. + (symbol (setq typenum (1+ typenum)) nil) + (int (setq typenum (+ 2 typenum)) nil) + (lisp (cond ((not (\=& 0 typenum)) + (msg t "CREATE: not allowed. " + "Type changed to in slot " + slotname " of " newname t) + (setq typenum 3) nil) + ((not (\=& 0 hashcollect)) + (setq hashcollect 0) + (msg t "CREATE: No hashing allowed on " + " slots in slot " slotname + " of " newname t))) + (setq typenum 3) nil) + (setof (setq typenum (+ 4 typenum)) t) + (otherwise + ; Either an ordinal type ==> integer, + ; or a structure name ==> struct, or an error. + (cond ((memq slottype *ordinalnames*) + (setq typenum (+ 2 typenum)) nil) + ((structurenamep slottype) + (setq reqstruct nil) + nil) ; i. e., add 0 to TYPENUM. + ( t (msg t "CREATE: Illegal type: " slottype + " in slot: " slotname " of " newname t) + nil)))) + (setq slottype (pop slot))) + (and reqstruct + (progn (msg t "CREATE: && hashing only allowed on STRUCT slots." + t " Bad slot is called " slotname + " and is of type " slottype t) + (pearlbreak))) + ; Save the last word of the type which is possibly a structure or + ; ordinal type name for future use. + (putppset slotnum slottype defblock) + (putslottype slotnum typenum defblock) + + ; Next, look for a value, or ^ to inherit from above; + ; these may be preceded by := or == to determine future + ; "enforcing" (should be less strong term) of this default. + (setq slotvalue nil) + (setq valuetype nil) + (setq enforce (pop slot)) + (selectq enforce + (:\= (cond ((eq (car slot) '^) + (setq slot (cdr slot)) + (inheritvalue nil)) + ( t (constructvalue)))) + (\=\= (addenforce hashcollect) + (cond ((eq (car slot) '^) + (setq slot (cdr slot)) + (inheritvalue nil)) + ( t (constructvalue)))) + ((^ nil) + (addenforce hashcollect) + (inheritvalue nil)) + (otherwise (push enforce slot) + (addenforce hashcollect) + (constructvalue))) + + (handlepossibleadjunctvar) + + ; Hash, enforce, slotvalue and valuetype can now be installed. + (puthashandenforce slotnum hashcollect defblock) + (putslotvaluetype slotnum valuetype valblock) + (putslotvalue slotnum slotvalue valblock) + + (handlepredicatesandhooks))) + +; Create a new structure of type BASE: a structure with ALL NEW slots. +(de createbase (newname abbrev slots) + (and (eq newname 'nilstruct) + (boundp (defatom 'nilstruct)) + (progn (msg t "CREATE BASE: Cannot redefine nilstruct." t) + (pearlbreak))) + (and (structurenamep newname) + *warn* + (msg t "CREATE BASE: Warning: Creating a new definition" + " of an existing structure: " newname t)) + (prog (defblock slotname slottype enforce fcn ppset slot length isa + typenum valblock predlist slothooklist + first*edslot basehooks basehookbefore newvalue reqstruct + hashalias hashfocus hashcollect slotvalue valuetype) + + ; Process base hooks if the first "slot" is named "if" or "hook". + (cond ((memq (caar slots) '(if hook)) + (setq basehookbefore (cdr (pop slots))) + (setq basehooks (ncons nil)) + + ; Use tconc to preserve order. + (while basehookbefore ; is not NIL + (tconc basehooks (cons (pop basehookbefore) + (pop basehookbefore)))) + (setq basehooks (car basehooks))) + ( t (setq basehooks nil))) + + ; Allocate hunks for definition and default instance (valblock) + ; based on number of slots. + (setq defblock (allocdef (setq length (length slots)))) + (setq valblock (allocval length)) + (puttypetag '*pearldef* defblock) + (puttypetag '*pearlinst* valblock) + (cond (*toplevelp* (setq *currenttopcreated* valblock) + (setq *currentpearlstructure* valblock) + (initbothalists valblock) + (setq *currenttopalists* (getbothalists valblock)) + ; Include the current environment in + ; the variable assoc-list. + (and *blockstack* + (putalist (cdar *blockstack*) valblock)) + (setq *toplevelp* nil)) + ( t (putbothalists *currenttopalists* valblock))) + + (putdef defblock valblock) + (putdefaultinst valblock defblock) + (set (instatom newname) valblock) + (set (defatom newname) defblock) + (and abbrev + (cond ((eq abbrev '*buildabbrev*) + (putabbrev (instatom newname) valblock)) + ( t (putabbrev abbrev valblock)))) + (putuniquenum (newnum) defblock) + (putstructlength length defblock) + (putisa nil defblock) + (putexpansionlist nil defblock) + (putbasehooks basehooks defblock) + (putpname newname defblock) + + (setq hashalias 0) + (setq hashfocus 0) + (setq first*edslot 0) + (for slotnum 1 length + (setq slot (pop slots)) + (buildslot)) + + (cond ((\=& 0 hashalias) (puthashalias first*edslot defblock)) + ( t (puthashalias hashalias defblock))) + (puthashfocus hashfocus defblock) + + (return valblock))) + +; Create a new individual just for this slot. +(defmacro buildstructvalue (struct) + `(cond ((and (atom ,struct) ; if an atom + (boundp ,struct) ; and bound + (structurep (eval ,struct))) ; to a structure, + (eval ,struct)) ; evaluate it. + ; Otherwise, recursively call create. + ( t (selectq (car ,struct) + ; New create type in slot. + ((ind individual pat pattern fn function + base exp expanded) + (let ((*currentcreatetype* (car ,struct))) + (apply (function insidecreate) ,struct))) + (otherwise + ; Otherwise, use current create type. + (apply (function insidecreate) + (cons *currentcreatetype* ,struct))))))) + +; Get a pointer to the symbol. +(defmacro buildsymbolvalue (sym) + `(cond ((symbolnamep ,sym) (eval (symatom ,sym))) + ; If not a symbol name, then ... + ((and (atom ,sym) ; if an atom + (boundp ,sym) ; and bound + (psymbolp (eval ,sym))) ; to a symbol, + (eval ,sym)) ; evaluate it. + ; Otherwise, error. + ( t (msg t "CREATE: " ,sym " is used in a slot of type SYMBOL but " + "neither is the name of a symbol nor evaluates to one." t) + (pearlbreak)))) + +; Get an integer using PPSET if not an integer. +(defmacro buildintvalue (intval bppset) + `(let (assocval) + (cond ((numberp ,intval) ,intval) + ; Ordinal type given for ppset. + ((and ,bppset ; is not NIL. + (setq assocval (assq ,intval (eval (ordatom ,bppset))))) + (cdr assocval)) + ; Some other atom which is bound to an integer. + ((and (atom ,intval) + (boundp ,intval) + (numberp (eval ,intval))) + (eval ,intval)) + ; Otherwise, error. + ( t (msg t "CREATE: Unbound atom or non-integer value: " + ,intval " in integer slot." t) + (pearlbreak))))) + +; Construct a new value of the specified type using the pplist if necessary +(de buildvalue (value typenum ppset) + (selectq typenum + (0 (buildstructvalue value)) + (1 (buildsymbolvalue value)) + (2 (buildintvalue value ppset)) + (3 value) ; i.e., could be anything they want. + (otherwise + (cond ((and (atom value) + (boundp value) + (enforcetype (eval value) typenum)) + (eval value)) + ( t (mapcar (funl (singlevalue) + (buildvalue singlevalue + (- typenum 4) ppset)) + value)))))) + +; Return the position number of SLOTNAME in structure DEFBLOCK. +(defmacro slotnametonumber (slotname defblock) + `(progn + (setq slotlocation 0) + (for slotnum 1 (getstructlength ,defblock) + (and (memq ,slotname (getslotname slotnum ,defblock)) + (setq slotlocation slotnum))) + slotlocation)) + +; Find the slotname in SLOT, put it in SLOTNAME, and find its SLOTNUM. +(dm findslotnum (none) + '(progn + (setq slotname slot) + (while (memq (car slotname) '(* ** *** & ^ && : :: < > +)) + (setq slotname (cdr slotname))) + (cond ((and (dtpr (cadr slotname)) + (eq '*slot* (car (cadr slotname)))) + (setq slotname (cadr (cadr slotname))) + (minus (slotnametonumber slotname olddefblock))) + ( t (setq slotname (car slotname)) + (slotnametonumber slotname olddefblock))))) + +; Look up through ISA links and add name to Expansion Lists. +; Assumes PROG vars NEWNAME and OLDDEFBLOCK. +(dm addtoexpansionlists (none) + '(progn + (setq isa olddefblock) + (while isa ; is not null + (putexpansionlist (cons defblock (getexpansionlist isa)) isa) + (setq isa (getisa isa))))) + +; Copy definition for one slot. +(dm copyslice (none) + '(progn + (putslottype slotnum (getslottype slotnum olddefblock) defblock) + (putslotname slotnum (getslotname slotnum olddefblock) defblock) + (putppset slotnum (getppset slotnum olddefblock) defblock) + (puthashandformat slotnum (gethashandformat slotnum olddefblock) defblock))) + +; Copy default values, predicates, and hooks for one slot. +(dm copyslot (none) + '(progn + (putslotvaluetype slotnum (getslotvaluetype slotnum oldvalblock) valblock) + (putslotvalue slotnum (getslotvalue slotnum oldvalblock) valblock) + (putpred slotnum (getpred slotnum oldvalblock) valblock) + (putslothooks slotnum (getslothooks slotnum oldvalblock) valblock))) + +; Copy an old slot from an ISA into the current structure. +(dm fillbaseslot (none) + '(progn + (cond ((<& slotnum 0) + (setq slotnum (minus slotnum)) + (setq newslotnamep t)) + ( t (setq newslotnamep nil))) + + ; First check for changed hashing. + (setq slotname (pop slot)) + (clearhashandformat slotnum defblock) + (setq hashcollect 0) + (while (selectq slotname + (* (and (\=& 0 first*edslot) + (setq first*edslot (minus slotnum))) + (addhash* hashcollect) t) + (** (addhash** hashcollect) t) + (*** (addhash*** hashcollect) t) + (& (cond ((not (\=& 0 hashalias)) + (msg t "CREATE EXPANDED: Only 1 hash alias " + "(&) or selected slot (^) allowed in: " + newname t) + t) + ( t (setq hashalias slotnum)))) + (^ (cond ((not (\=& 0 hashalias)) + (msg t "CREATE EXPANDED: Only 1 hash alias " + "(&) or selected slot (^) allowed in: " + newname t) + t) + ( t (setq hashalias (minus slotnum))))) + (&& (cond ((not (\=& 0 hashfocus)) + (msg t "CREATE EXPANDED: Only 1 hash focus " + "(&&) allowed in: " newname t) + t) + ( t (setq hashfocus slotnum)))) + (: (addhash: hashcollect) t) + (:: (addhash:: hashcollect) t) + (> (addhash> hashcollect) t) + (< (addhash< hashcollect) t) + (+ (setq hashcollect (gethashinfo slotnum olddefblock)) + t)) + (setq slotname (pop slot))) + + (and (\=& 0 (length slot)) + (progn (msg t "CREATE EXPANDED: Missing slot name and/or value in: " + newname t) + (pearlbreak))) + + (and newslotnamep + (pop slot) + (addslotname slotnum slotname defblock)) + + ; Next, check for value or ^, possibly preceded by := or ==. + (setq enforce (pop slot)) + (selectq enforce + (:\= (cond ((eq (car slot) '^) ; a waste. + (setq slot (cdr slot)) + (inheritvalue (getisa defblock))) + ( t (constructvalue)))) + (\=\= (addenforce hashcollect) + (cond ((eq (car slot) '^) + (setq slot (cdr slot)) + (inheritvalue (getisa defblock))) + ( t (constructvalue)))) + ((^ nil) (addenforce hashcollect) + (inheritvalue (getisa defblock))) + (otherwise (push enforce slot) + (addenforce hashcollect) + (constructvalue))) + + (handlepossibleadjunctvar) + + ; Hash, enforce, slotvalue and valuetype can now be installed. + (puthashandenforce slotnum hashcollect defblock) + (putslotvaluetype slotnum valuetype valblock) + (putslotvalue slotnum slotvalue valblock) + + (handlepredicatesandhooks))) + +; Create a new structure of type EXPANDED: build new slots in +; addition to slots inherited from a BASE or EXPANDED structure. +(de createexpanded (basename newname abbrev slots) + (and (eq newname 'nilstruct) + (progn (msg t "CREATE EXPANDED: Cannot redefine nilstruct." t) + (pearlbreak))) + (and (structurenamep newname) + *warn* + (msg t "CREATE EXPANDED: Warning: Creating a new definition of " + "an existing structure: " newname t)) + (or (structurenamep basename) + (progn (msg t "CREATE EXPANDED: " basename + " is not the name of a previously declared structure." t + " New name is " newname ". Slots are: " slots t) + (pearlbreak))) + (prog (defblock valblock oldvalblock olddefblock slotname + slottype enforce slot oldlength length slotnum + typenum slotnumlist beginslots predlist slothooklist + fcn ppset isa first*edslot slotlocation basehooks + basehookbefore newvalue result item reqstruct + newslotnamep hashalias hashfocus hashcollect + slotvalue valuetype) + (setq olddefblock (eval (defatom basename))) + (setq oldlength (getstructlength olddefblock)) + + ; Handle base hooks, if first "slot" is called "if" or "hook". + (cond ((memq (caar slots) '(if hook)) + (setq basehookbefore (cdr (pop slots))) + (setq basehooks (ncons nil)) + (while basehookbefore ; is not NIL + (tconc basehooks (cons (pop basehookbefore) + (pop basehookbefore)))) + (setq basehooks (nconc (car basehooks) + (getbasehooks olddefblock)))) + ( t (setq basehooks (getbasehooks olddefblock)))) + + ; Create a list of slotnumbers for the slotnames in SLOTS, + ; meanwhile also determining the LENGTH. + (setq beginslots slots) ; save to process again. + (setq slotnumlist (ncons nil)) + (setq length oldlength) + (while (setq slot (pop slots)) + (cond ((not (\=& 0 (setq slotnum (findslotnum)))) + ; Old slot name or new name for old slot (negative). + (tconc slotnumlist slotnum)) + ; Otherwise, new slot name: increase length. + ( t (setq length (1+ length)) + (tconc slotnumlist length)))) + (setq slotnumlist (car slotnumlist)) + (setq slots beginslots) + + ; Allocate new hunks. + (setq defblock (allocdef length)) + (setq valblock (allocval length)) + (puttypetag '*pearldef* defblock) + (puttypetag '*pearlinst* valblock) + (cond (*toplevelp* (setq *currenttopcreated* valblock) + (setq *currentpearlstructure* valblock) + (initbothalists valblock) + (setq *currenttopalists* (getbothalists valblock)) + ; Include the current environment in + ; the variable assoc-list. + (and *blockstack* + (putalist (cdar *blockstack*) valblock)) + (setq *toplevelp* nil)) + ( t (putbothalists *currenttopalists* valblock))) + + (putdef defblock valblock) + (putdefaultinst valblock defblock) + (set (instatom newname) valblock) + (set (defatom newname) defblock) + (and abbrev + (cond ((eq abbrev '*buildabbrev*) + (putabbrev (instatom newname) valblock)) + ( t (putabbrev abbrev valblock)))) + (putuniquenum (newnum) defblock) + (putstructlength length defblock) + + ; Set up the hierarchy of ISAs. + (putisa olddefblock defblock) + (putexpansionlist nil defblock) + (addtoexpansionlists) + + (putbasehooks basehooks defblock) + (putpname newname defblock) + (setq oldvalblock (getdefaultinst olddefblock)) + + ; (puthashalias 0 defblock) + (setq hashalias 0) + (setq hashfocus 0) + (or (<& (setq first*edslot (gethashalias olddefblock)) 0) + (setq first*edslot 0)) + ; Copy old slots in first. + (for slotnum 1 oldlength + (copyslice) + (copyslot olddefblock)) + ; Run base hooks attached to the base we are expanding. + (and (getbasehooks olddefblock) + (setq item valblock) + (checkrunhandlebasehooks1 '& slotnum oldlength) + (buildslot)) + ( t (fillbaseslot)))) + (cond ((\=& 0 hashalias) (puthashalias first*edslot defblock)) + ( t (puthashalias hashalias defblock))) + (cond ((\=& 0 hashfocus) (puthashfocus (gethashfocus olddefblock) + defblock)) + ( t (puthashfocus hashfocus defblock))) + + ; Run base hooks attached to the base we are expanding. + (and (getbasehooks olddefblock) + (setq item valblock) + (checkrunhandlebasehooks1 '>expanded *runexpandedhooks*) + (setq valblock item)) + (return valblock))) + +; Fill in an individual slot with the value specified. If the value is +; prefaced by the character "^" then the value should be inherited from +; above but there are still predicates and/or IFs to process. +(dm fillindivslot (none) + '(progn + (setq slotname (pop slot)) + ; Find slot number. + (and (\=& 0 (setq slotnum (slotnametonumber slotname defblock))) + (progn (msg t "CREATE: Undefined slot: " slotname + ", in individual or pattern: " basename) + (pearlbreak))) + (cond ((\=& 0 (length slot)) + (msg t "Missing value in: CREATE INDIVIDUAL (or PATTERN) " + basename ". Remaining slots are: " slots t) + (pearlbreak)) + ; If ^, inherit. + ((eq (car slot) '^) + (setq slot (cdr slot)) + (inheritvalue defblock)) + ; Otherwise, construct a new value and insert. + ( t (constructvalue))) + + (handlepossibleadjunctvar) + + ; Store type and value. + (putslotvaluetype slotnum valuetype valblock) + (putslotvalue slotnum slotvalue valblock) + + (handlepredicatesandhooks))) + +; Create a new structure of type INDIVIDUAL: an instance of a +; BASE or EXPANDED structure. Slots are either filled explicitly +; or they inherit defaults from above. +(de createindividual (basename abbrev slots) + (or (structurenamep basename) + (progn (msg t "CREATE INDIVIDUAL: " basename + " is not the name of a previously declared structure." + t " Slots are: " slots t) + (pearlbreak))) + (prog (defblock valblock slotname length slotnum oldvalblock + isa typenum ppset slot predlist slothooklist fcn + slotlocation newvalue result item + slotvalue valuetype) + + ; Find definition and allocate hunk for individual. + (setq defblock (eval (defatom basename))) + (setq valblock (allocval (setq length (getstructlength defblock)))) + (puttypetag '*pearlinst* valblock) + (cond (*toplevelp* (setq *currenttopcreated* valblock) + (setq *currentpearlstructure* valblock) + (initbothalists valblock) + (setq *currenttopalists* (getbothalists valblock)) + ; Include the current environment in + ; the variable assoc-list. + (and *blockstack* + (putalist (cdar *blockstack*) valblock)) + (setq *toplevelp* nil)) + ( t (putbothalists *currenttopalists* valblock))) + + (and abbrev + (cond ((eq abbrev '*buildabbrev*) + (putabbrev (eval `(newsym ,(getpname defblock))) valblock)) + ( t (putabbrev abbrev valblock)))) + (putdef defblock valblock) + (setq oldvalblock (getdefaultinst defblock)) + + ; Copy slots from old structure first, then run base hooks. + (for slotnum 1 length + (copyslot defblock)) + (and (getbasehooks defblock) + (setq item valblock) + (checkrunhandlebasehooks1 'individual *runindividualhooks*) + (setq valblock item)) + (return valblock))) + +; Copy default values, predicates, and hooks for one slot. +(dm copypatternslot (none) + '(progn + (putslotvaluetype slotnum 'LOCAL valblock) + (putslotvalue slotnum *any*conscell* valblock) + (putpred slotnum (getpred slotnum oldvalblock) valblock) + (putslothooks slotnum (getslothooks slotnum oldvalblock) valblock))) + +; Create a new structure of type PATTERN: an instance of a BASE or +; EXPANDED structure. Unspecified slots are filled with ?*ANY*. +(de createpattern (basename abbrev slots) + (prog (defblock valblock oldvalblock slotname length slotnum isa + slotlocation slot predlist slothooklist fcn typenum + ppset newvalue result item slotvalue valuetype) + (or (structurenamep basename) + (progn (msg t "CREATE PATTERN: " basename + " is not the name of a previously declared structure." + t) + (pearlbreak))) + + ; Get definition and allocate hunk for pattern. + (setq defblock (eval (defatom basename))) + (setq valblock (allocval (setq length (getstructlength defblock)))) + (setq oldvalblock (getdefaultinst defblock)) + (puttypetag '*pearlinst* valblock) + (cond (*toplevelp* (setq *currenttopcreated* valblock) + (setq *currentpearlstructure* valblock) + (initbothalists valblock) + (setq *currenttopalists* (getbothalists valblock)) + ; Include the current environment in + ; the variable assoc-list. + (and *blockstack* + (putalist (cdar *blockstack*) valblock)) + (setq *toplevelp* nil)) + ( t (putbothalists *currenttopalists* valblock))) + + (putdef defblock valblock) + (and abbrev + (cond ((eq abbrev '*buildabbrev*) + (putabbrev (eval `(newsym ,(getpname defblock))) valblock)) + ( t (putabbrev abbrev valblock)))) + + ; Copy slot values from base and run base hooks on base structure. + (for slotnum 1 length + (copypatternslot)) + (and (getbasehooks defblock) + (setq item valblock) + (checkrunhandlebasehooks1 'pattern *runpatternhooks*) + (setq valblock item)) + (return valblock))) + +; Create a new structure of type FUNCTION: a structure with slots +; describing the arguments to the function of the same name. +(de createfunction (fcnname abbrev slots) + ; Function must already be defined and be a lambda (expr). + (cond ((islambda fcnname) + (putprop fcnname t 'functionstruct) + (createbase fcnname abbrev slots)) + ( t (msg t "CREATE FUNCTION: Only lambdas (exprs) allowed as " + "function structures: " fcnname slots t) + (pearlbreak)))) + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/db.l b/usr/src/usr.bin/lisp/pearl/db.l new file mode 100644 index 0000000000..47a5564128 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/db.l @@ -0,0 +1,177 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; db.l ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Functions for building and releasing a forest of data bases. +; See the file "template" plus the discussion in the "lowlevel.l" file for +; a picture and an idea of how data bases are arranged internally. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +; Clear out the *db* conscells in the two parts of the data base, +; thus releasing the old buckets for GC, IF they aren't pointed +; to from elsewhere. +(de cleardb (&optional (db *db*)) + (let ((parent (getdbparent db)) + (db1 (getdb1 db)) + (db2 (getdb2 db))) + (cond (parent (connectdb db parent)) + ( t (for slotnum 0 (1- *db1size*) + (rplacd (cxr slotnum db1) nil)) + (for slotnum 0 (1- *db2size*) + (rplacd (cxr slotnum db2) nil)))) + t)) + +; Used by builddb to connect the sibling's buckets with its parent's. +; Also used by cleardb on a sibling. +(de connectdb (newdb olddb) + (let ((newdb1 (getdb1 newdb)) + (newdb2 (getdb2 newdb)) + (olddb1 (getdb1 olddb)) + (olddb2 (getdb2 olddb))) + (for slotnum 0 (1- *db1size*) + (rplacd (cxr slotnum newdb1) (cxr slotnum olddb1))) + (for slotnum 0 (1- *db2size*) + (rplacd (cxr slotnum newdb2) (cxr slotnum olddb2))) + t)) + +; Set the size for data bases to 2 to the "poweroftwo" -- actually +; the next smaller prime number. +; *Availablesizes* is in inits.l and is designed to +; make the data bases a factor of 4 apart +; EXCEPT in Franz, where the largest are equal-sized. +(de setdbsize (poweroftwo) + (let (pair rebuilddb) + (and *activedbnames* + (progn (and *warn* + (msg t "SETDBSIZE: Warning: Size change " + "is causing the release of all databases." + t " You must rebuild all " + "but the default yourself." t)) + (mapcar (funl (dbname) (releasedb (eval dbname))) + (copy *activedbnames*)) + (setq rebuilddb t) + )) + (and (or (<& poweroftwo 2.) + (>& poweroftwo 13.)) + (progn (msg t "SETDBSIZE: Database size is a power to raise 2 to" + t " and must be greater than 1 and less than 14." + t " It cannot be " poweroftwo "." t) + (pearlbreak))) + (or (setq pair (assq poweroftwo *availablesizes*)) + (progn (msg t "SETDBSIZE: " + "Database sizes are integer powers to raise 2 to." t) + (pearlbreak))) + (setq *db2size* (cdr pair)) + ; The sizes of the two parts of the data base are + ; in a 1 to 4 ratio. + (setq pair (assq (- poweroftwo 2.) *availablesizes*)) + (setq *db1size* (cdr pair)) + (and rebuilddb + (setq *db* (builddb *maindb*))) + t)) + +; (BUILDDB NEWDB OLDDB) Build an extension to OLDDB called NEWDB. If OLDDB +; is NIL then build at the bottom level, else add as a leaf of the tree. +; The new data base is stored under the atom which is its name, +; unlike the rest of PEARL objects (i.e., no special-prefix atom). +; Each new leaf has each of its hash buckets tied into the buckets of the +; parent so that nextitem need not know how many data bases it is +; dealing with. +(df builddb (l) + (let ((newdbname (car l)) + (olddbname (cadr l))) + (and (memq newdbname *activedbnames*) + (progn (msg t "BUILDDB: " newdbname + " is already an active database name." t) + (pearlbreak))) + (and olddbname + ; Two db's given but old one bad. + (not (memq olddbname *activedbnames*)) + (progn (msg t "BUILDDB: " olddbname + " is not an active database name." t) + (pearlbreak))) + (let ((newdb (makhunk 7)) + (olddb (and olddbname + (eval olddbname))) + (db1 (makhunk *db1size*)) + (db2 (makhunk *db2size*))) + (push newdbname *activedbnames*) + (putdbname newdbname newdb) + (set newdbname newdb) + (puttypetag '*pearldb* newdb) + (putdbchildren nil newdb) + (setdbactive newdb) + (putdbparent olddb newdb) + (putdb1 db1 newdb) + (putdb2 db2 newdb) + ; add the *db* conscells. + (for slotnum 0 (1- *db1size*) + (rplacx slotnum db1 (cons '*db* nil))) + (for slotnum 0 (1- *db2size*) + (rplacx slotnum db2 (cons '*db* nil))) + (and olddb ; Two db's. + ; add to parent's children. + (putdbchildren (cons newdb (getdbchildren olddb)) + olddb) + ; Connectdb does the extra work for adding to the tree. + (connectdb newdb olddb)) + newdb))) + +; Release a data base. If its children are also released, then +; it can be garbage collected. If not, do not mark it inactive +; until they are. +(de releasedb (db) + (and (not (databasep db)) + (progn (msg t "RELEASEDB: Argument is not a database." t) + (pearlbreak))) + (let ((dbname (getdbname db)) + (parent (getdbparent db))) + (and (not (memq dbname *activedbnames*)) + (progn (msg t "RELEASEDB: Trying to release an inactive database: " + db t) + (pearlbreak))) + (cond ((null (getdbchildren db)) ; No children. + (setq *activedbnames* (delq (getdbname db) *activedbnames*)) + (and (equal *activedbnames* '(nil)) + (setq *activedbnames* nil)) + (set dbname (unbound)) + (putdbname nil db) + (and parent + (putdbchildren (delq db (getdbchildren parent)) parent)) + (cleardbactive db) + (putdbparent nil db) + (while (and parent ; There's a parent -- + (null (getdbchildren parent)) ; with 0 children -- + (not (getdbactive parent))) ; that's inactive. + (cleardb parent) + (putdb1 nil parent) + (putdb2 nil parent) + ; Save next parent with prog1 and then remove self from + ; parent's child list and clear out own parent pointer + (setq parent + (prog1 + (getdbparent parent) ; To be the new parent + (and (getdbparent parent) + (putdbchildren + (delq parent + (getdbchildren (getdbparent parent))) + (getdbparent parent)) + ) + (putdbparent nil parent)))) + (cleardb db) + (puttypetag '*pearlinactivedb* db) + (putdb1 nil db) + (putdb2 nil db)) + ( t (setq *activedbnames* (delq dbname *activedbnames*)) + (and (equal *activedbnames* '(nil)) + (setq *activedbnames* nil)) + (set dbname (unbound)) + (putdbname nil db) + (cleardbactive db) + (puttypetag '*pearlinactivedb* db) + (putdb1 nil db) + (putdb2 nil db))) + t)) + + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/fix.l b/usr/src/usr.bin/lisp/pearl/fix.l new file mode 100644 index 0000000000..d28f68abed --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/fix.l @@ -0,0 +1,702 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; fix.l ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; The fixit debugger modified to use "pearlfixprintfn" and to allow +; use of "> fcnname" or "> 'newvalue" in case of an undefined +; function or unbound variable respectively. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +; Modified for use with PEARL by Joe Faletti 1/6/82 + +;; (eval-when (compile eval) +;; (or (get 'cmumacs 'version) (load 'cmumacs))) +; Only the necessary functions are included, below +; dv (=defv), ***, lineread, and ty + +;--- dv :: set variable to value +; (dv name value) name is setq'ed to value (no evaluation) +; (same as defv) +; +(defmacro dv (name value) + `(setq ,name ',value)) + +;--- *** :: comment macro +; +(defmacro *** (&rest x) nil) + +(defmacro lineread (&optional (x nil)) + `(%lineread ,x)) + +(def ty (macro (f) (append '(exec cat) (cdr f)))) + +; LWE 1/11/81 Hack hack.... +; +; LWE 1/11/81 Bet you didn't know this, but this won't work INTERPRETED, +; but Dave assures me it works compiled. (In MACLisp...) +; +(declare (special cmd frame x cnt var init label part incr limit selectq)) + +(dv fixfns + ((*** This is FIXIT written by David Touretzky and adapted to Franz by Don + Cohen) + (declare (special framelist rframelist interrupt-handlers handler-labels) + (special prinlevel prinlength evalhook-switch traced-stuff) + (special lastword piport hush-debug) + (*fexpr editf step type)) + (sstatus feature fixit) + (*rset t) + ER%tpl + fixit + debug + debug-iter + debug1 + debug-bktrace + Pdebug-print + Pdebug-print1 + debug-findcall + debug-scanflist + debug-scanstk + debug-getframes + debug-nextframe + debug-upframe + debug-dnframe + debug-upfn + debug-dnfn + debug-showvar + debug-nedit + debug-insidep + debug-findusrfn + debug-findexpr + debug-replace-function-name + debug-pop + debug-where + debug-sysp + interrupt-handlers + handler-labels + (or (boundp 'traced-stuff) (setq traced-stuff nil)) + (or (boundp 'evalhook-switch) (setq evalhook-switch nil)) + (setq hush-debug nil))) + +(or (boundp 'traced-stuff) (setq traced-stuff nil)) +(or (boundp 'evalhook-switch) (setq evalhook-switch nil)) +(or (boundp 'debug-sysmode) (setq debug-sysmode nil)) +(setq hush-debug nil) + +(*** This is FIXIT written by David Touretzky and adapted to Franz by Don Cohen) + +(declare (special framelist rframelist interrupt-handlers handler-labels) + (special prinlevel prinlength evalhook-switch traced-stuff) + (special lastword piport hush-debug debug-sysmode) + (*fexpr editf step type) + (special system-functions\)) + +(sstatus feature fixit) + +(*rset t) + +(progn 'compile + (dv ER%tpl fixit) + (dv ER%brk fixit) + (dv ER%err fixit) + ) + +(def fixit + (nlambda (l) + (prog (piport) + (do nil (nil) (eval (cons 'debug l)))))) + +(def debug + (nlambda (params) + (prog (cmd frame framelist rframelist nframe val infile) + (setq infile t) + (and evalhook-switch (step nil)) + (setq rframelist + (reverse + (setq framelist + (or (debug-getframes) + (list + (debug-scanstk '(nil) '(debug))))))) + (setq frame (debug-findexpr (car framelist))) + ;(tab 0) + ; top level ones and calls to err and break. + (cond + ((and (car params) (not (eq (car params) 'edit))) + (terpri) +; (princ '|;debug |) +; (princ params) + (princ (cadddr params)) + (cond ((cddddr params) + (princ '| -- |) + (princ (cddddr params)))) + (terpri) + (go loop))) + (Pdebug-print1 frame nil) + (terpri) + (cond (hush-debug (setq hush-debug nil) (go loop)) + ((not (memq 'edit params)) (go loop))) + (drain nil) + (princ '|type e to edit, to debug: |) + (setq val (tyi)) + (cond ((or (\=& val 69) (\=& val 101)) + (and (errset (debug-nedit frame)) + (setq cmd '(ok)) + (go cmdr))) + ((or (\=& val 78) (\=& val 110)) (terpri) (debug-pop))) + loop (terpri) + (princ ':) + (cond ((null (setq cmd (lineread))) + (terpri) (reset))) + cmdr (cond + ((dtpr (car cmd)) + (setq val (eval (car cmd) (cadddr frame))) + (pearlfixprintfn val) +; (print (valform val)) + (terpri) + (go loop))) + (setq nframe (debug1 cmd frame)) + (and (not (atom nframe)) (setq frame nframe) (go loop)) + (print (or nframe (car cmd))) + (princ '" Huh? - type h for help") + (go loop)))) + +(def debug-iter + (macro (x) + (cons 'prog + (cons 'nil + (cons 'loop + (cons (list 'setq 'nframe (cadr x)) + '((setq cnt (|1-| cnt)) + (and (or (null nframe) (\=& 0 cnt)) + (return nframe)) + (setq frame nframe) + (go loop)))))))) + +(def debug1 + (lambda (cmd frame) + (prog (nframe val topframe cnt item) + (setq topframe (car framelist)) + (or (eq (typep (car cmd)) 'symbol) (return nil)) + ; if "> name", replace function name with new atom + (and (eq (car cmd) '>) + (return (debug-replace-function-name cmd topframe))) + (and (eq (getchar (car cmd) 1) 'b) + (eq (getchar (car cmd) 2) 'k) + (return (debug-bktrace cmd frame))) + (setq cnt + (cond ((fixp (cadr cmd)) (cadr cmd)) + ((fixp (caddr cmd)) (caddr cmd)) + (t 1))) + (and (<& cnt 1) (setq cnt 1)) + (setq item + (cond ((symbolp (cadr cmd)) (cadr cmd)) + ((symbolp (caddr cmd)) (caddr cmd)))) + (and item + (cond ((memq (car cmd) '(u up)) + (setq cmd (cons 'ups (cdr cmd)))) + ((memq (car cmd) '(d dn)) + (setq cmd (cons 'dns (cdr cmd)))))) + (selectq (car cmd) + (top (Pdebug-print1 (setq frame topframe) nil)) + (bot (Pdebug-print1 (setq frame (car rframelist)) nil)) + (p (Pdebug-print1 frame nil)) + (pp (valprint (caddr frame))) + (where (debug-where frame)) + (help + (cond ((cdr cmd) (eval cmd)) + (t (ty |/usr/lisp/doc/fixit.ref|)))) + ((\? h) (ty |/usr/lisp/doc/fixit.ref|)) + ((go ok) + (setq frame (debug-findexpr topframe)) + (cond ((eq (caaddr frame) 'debug) + (freturn (cadr frame) t)) + (t (fretry (cadr frame) frame)))) + (pop (debug-pop)) + (step (setq frame (debug-findexpr frame)) + (step t) + (fretry (cadr (debug-dnframe frame)) frame)) + (redo (and item + (setq frame + (debug-findcall item frame framelist))) + (and frame (fretry (cadr frame) frame))) + (return (setq val (eval (cadr cmd))) + (freturn (cadr frame) val)) + (edit (debug-nedit frame)) + (editf + (cond ((null item) + (setq frame + (or (debug-findusrfn (debug-nedit frame)) + (car rframelist)))) + ((dtpr (getd item)) + (errset (funcall 'editf (list item)))) + (t (setq frame nil)))) + (u (debug-iter (debug-upframe frame)) + (cond + ((null nframe) (terpri) (princ '||))) + (Pdebug-print1 (setq frame (or nframe frame)) nil)) + (d (setq nframe + (or (debug-iter (debug-dnframe frame)) frame)) + (Pdebug-print1 nframe nil) + (cond ((eq frame nframe) + (terpri) + (princ '||)) + (t (setq frame nframe)))) + (up (setq nframe (debug-iter (debug-upfn frame))) + (cond + ((null nframe) (terpri) (princ '|top of stack|))) + (setq frame (or nframe topframe)) + (Pdebug-print1 frame nil)) + (dn (setq frame + (or (debug-iter (debug-dnfn frame)) + (car rframelist))) + (Pdebug-print1 frame nil) + (cond + ((not (eq frame nframe)) + (terpri) + (princ '||)))) + (ups (setq frame + (debug-iter + (debug-findcall item frame rframelist))) + (and frame (Pdebug-print1 frame nil))) + (dns (setq frame + (debug-iter + (debug-findcall item frame framelist))) + (and frame (Pdebug-print1 frame nil))) + (sys (setq debug-sysmode (not debug-sysmode)) + (patom "sysmode now ")(patom debug-sysmode) (terpr)) + (otherwise + (cond ((not (dtpr (car cmd))) + (*** should there also be a boundp test here) + (debug-showvar (car cmd) frame)) + (t (setq frame (car cmd)))))) + (return (or frame item))))) + +(def debug-replace-function-name + (lambda (cmd frame) (prog (oldname newname errorcall nframe) + (setq errorcall (caddr frame)) + (cond ((eq (caddddr errorcall) '|eval: Undefined function |) + (setq oldname (cadddddr errorcall)) + (setq newname (cadr cmd)) + (setq cnt 3) + (setq frame (debug-iter (debug-dnframe frame))) + (dsubst newname oldname frame) + (fretry (cadr frame) frame)) + ((eq (caddddr errorcall) '|Unbound Variable:|) + (setq oldname (cadddddr errorcall)) + (setq newname (eval (cadr cmd))) + (setq cnt 3) + (setq frame (debug-iter (debug-dnframe frame))) + (dsubst newname oldname frame) + (fretry (cadr frame) frame)) + ( t (return nil)))))) + +(def debug-bktrace + (lambda (cmd oframe) + (prog (sel cnt item frame nframe) + (mapc '(lambda (x) + (setq sel + (cons (selectq x + (f 'fns) + (a 'sysp) + (v 'bind) + (e 'expr) + (c 'current) + (otherwise 'bogus)) + sel))) + (cddr (explodec (car cmd)))) + (setq item + (cond ((eq (typep (cadr cmd)) 'symbol) (cadr cmd)) + ((eq (typep (caddr cmd)) 'symbol) (caddr cmd)))) + (cond ((debug-sysp item) (setq sel (cons 'sysp sel))) + ((not (memq 'sysp sel)) + (setq sel (cons 'user sel)))) + (setq cnt + (cond ((fixp (cadr cmd)) (cadr cmd)) + ((fixp (caddr cmd)) (caddr cmd)) + (item 1))) + (cond ((null cnt) + (setq frame + (cond ((memq 'current sel) oframe) + (t (car rframelist)))) + (go dbpr)) + ((null item) + (setq frame (car framelist)) + (and (or (not (memq 'user sel)) + (atom (caddr (car framelist))) + (not (debug-sysp (caaddr (car framelist))))) + (setq cnt (|1-| cnt))) + (setq frame + (cond ((\=& 0 cnt) frame) + ((memq 'user sel) + (debug-iter (debug-dnfn frame))) + (t (debug-iter (debug-dnframe frame))))) + (setq frame (or frame (car rframelist))) + (go dbpr)) + (t (setq frame (car framelist)))) + (setq frame + (cond ((and (\=& cnt 1) + (not (atom (caddr (car framelist)))) + (eq item (caaddr (car framelist)))) + (car framelist)) + ((debug-iter (debug-findcall item frame framelist))) + (t (car rframelist)))) + dbpr (Pdebug-print frame sel oframe) + (cond ((eq frame (car rframelist)) + (terpri) + (princ '||) + (terpri)) + (t (terpri))) + (cond + ((memq 'bogus sel) + (terpri) + (princ (car cmd)) + (princ '| contains an invalid bk modifier|))) + (return oframe)))) + +(def Pdebug-print + (lambda (frame sel ptr) + (prog (curframe) + (setq curframe (car framelist)) + loop (cond ((not + (and (memq 'user sel) + (not (atom (caddr curframe))) + (debug-sysp (caaddr curframe)))) + (Pdebug-print1 curframe sel) + (and (eq curframe ptr) (princ '| <--- you are here|))) + ((eq curframe ptr) + (terpri) + (princ '| <--- you are somewhere in here|))) + (and (eq curframe frame) (return frame)) + (setq curframe (debug-dnframe curframe)) + (or curframe (return frame)) + (go loop)))) + +(def Pdebug-print1 + (lambda (frame sel) + (prog (prinlevel prinlength varlist) + (and (not (memq 'expr sel)) + (setq prinlevel 2) + (setq prinlength 5)) + (cond + ((atom (caddr frame)) + (terpri) + (princ '| |) + (pearlfixprintfn (caddr frame)) +; (print (valform (caddr frame))) + (princ '| <- eval error|) + (return t))) + (and (memq 'bind sel) + (cond ((memq (caaddr frame) '(prog lambda)) + (setq varlist (cadr (caddr frame)))) + ((and (atom (caaddr frame)) (dtpr (getd (caaddr frame)))) + (setq varlist (cadr (getd (caaddr frame)))))) + (mapc (function + (lambda (v) + (debug-showvar v + (or (debug-upframe frame) + frame)))) + (cond ((and varlist (atom varlist)) (ncons varlist)) + (t varlist)))) + (and (memq 'user sel) + (debug-sysp (caaddr frame)) + (return nil)) + (cond ((memq (caaddr frame) interrupt-handlers) + (terpri) + (princ '<------------) + (print (cadr (assq (caaddr frame) handler-labels))) + (princ '-->)) + ((eq (caaddr frame) 'debug) + (terpri) + (princ '<------debug------>)) + ((memq 'fns sel) + (terpri) + (and (debug-sysp (caaddr frame)) (princ '| |)) + (print (caaddr frame))) + (t (terpri) + (pearlfixprintfn + (cond ((eq (car frame) 'eval) (caddr frame)) + (t (cons (caaddr frame) (cadr (caddr frame)))))) +; (print +; (valform +; (cond ((eq (car frame) 'eval) (caddr frame)) +; (t (cons (caaddr frame) (cadr (caddr frame))))))) + )) + (or (not (symbolp (caaddr frame))) + (eq (caaddr frame) (concat (caaddr frame))) + (princ '| |)) + (return t)))) + +(def debug-findcall + (lambda (fn frame flist) + (prog nil + loop (setq frame (debug-nextframe frame flist nil)) + (or frame (return nil)) + (cond ((atom (caddr frame)) + (cond ((eq (caddr frame) fn) (return frame)) (t (go loop)))) + ((eq (caaddr frame) fn) (return frame)) + (t (go loop)))))) + +(def debug-scanflist + (lambda (frame fnset) + (prog nil + loop (or frame (return nil)) + (and (not (atom (caddr frame))) + (memq (caaddr frame) fnset) + (return frame)) + (setq frame (debug-dnframe frame)) + (go loop)))) + +(def debug-scanstk + (lambda (frame fnset) + (prog nil + loop (or frame (return nil)) + (and (not (atom (caddr frame))) + (memq (caaddr frame) fnset) + (return frame)) + (setq frame (evalframe (cadr frame))) + (go loop)))) + +(def debug-getframes + (lambda nil + (prog (flist fnew) + (setq fnew + (debug-scanstk '(nil) + (cons 'debug interrupt-handlers))) + loop (and (not debug-sysmode) + (not (atom (caddr fnew))) + (eq (caaddr fnew) 'debug) + (eq (car (evalframe (cadr fnew))) 'apply) + (memq (caaddr (evalframe (cadr fnew))) interrupt-handlers) + (setq fnew (evalframe (cadr fnew)))) + (and (not debug-sysmode) + (null flist) + (eq (car fnew) 'apply) + (memq (caaddr fnew) interrupt-handlers) + (setq fnew (evalframe (cadr fnew)))) + (and (not debug-sysmode) + (eq (car fnew) 'apply) + (eq (typep (caaddr fnew)) 'symbol) + (not (eq (caaddr fnew) (concat (caaddr fnew)))) + (setq fnew (evalframe (cadr fnew))) + (setq fnew (evalframe (cadr fnew))) + (setq fnew (evalframe (cadr fnew))) + (setq fnew (evalframe (cadr fnew))) + (go loop)) + (and (not debug-sysmode) + (not (atom (caddr fnew))) + (memq (caaddr fnew) '(evalhook* evalhook)) + (setq fnew (evalframe (cadr fnew))) + (go loop)) + (and (not debug-sysmode) + (eq (car fnew) 'apply) + (eq (caaddr fnew) 'eval) + (cadadr (caddr fnew)) + (or (not (fixp (cadadr (caddr fnew)))) + (\= (cadadr (caddr fnew)) -1)) + (setq fnew (evalframe (cadr fnew))) + (go loop)) + (and fnew + (setq flist (cons fnew flist)) + (setq fnew (evalframe (cadr fnew))) + (go loop)) + (return (nreverse flist))))) + +(def debug-nextframe + (lambda (frame flist sel) + (prog nil + (setq flist (cdr (memq frame flist))) + (and (not (memq 'user sel)) (return (car flist))) + loop (or flist (return nil)) + (cond + ((or (atom (caddr (car flist))) + (not (debug-sysp (caaddr (car flist))))) + (return (car flist)))) + (setq flist (cdr flist)) + (go loop)))) + +(def debug-upframe + (lambda (frame) + (debug-nextframe frame rframelist nil))) + +(def debug-dnframe + (lambda (frame) + (debug-nextframe frame framelist nil))) + +(def debug-upfn + (lambda (frame) + (debug-nextframe frame rframelist '(user)))) + +(def debug-dnfn + (lambda (frame) + (debug-nextframe frame framelist '(user)))) + +(def debug-showvar + (lambda (var frame) + (terpri) + (princ '| |) + (princ var) + (princ '| = |) + (pearlfixprintfn + ((lambda (val) (cond ((atom val) '\?) (t (car val)))) + (errset (eval var (cadddr frame)) nil))))) +; (print +; (valform +; ((lambda (val) (cond ((atom val) '\?) (t (car val)))) +; (errset (eval var (cadddr frame)) nil)))))) + +(def debug-nedit + (lambda (frame) + (prog (val body elem nframe) + (setq elem (caddr frame)) + (setq val frame) + scan (setq val (debug-findusrfn val)) + (or val (go nofn)) + (setq body (getd (caaddr val))) + (cond ((debug-insidep elem body) + (princ '\=) + (print (caaddr val)) + (edite body + (list 'f (cons '\=\= elem) 'tty:) + (caaddr val)) + (return frame)) + ((or (eq elem (caddr val)) (debug-insidep elem (caddr val))) + (setq val (debug-dnframe val)) + (go scan))) + nofn (setq nframe (debug-dnframe frame)) + (or nframe (go doit)) + (and (debug-insidep elem (caddr nframe)) + (setq frame nframe) + (go nofn)) + doit (edite (caddr frame) + (and (debug-insidep elem (caddr frame)) + (list 'f (cons '\=\= elem) 'tty:)) + nil) + (return frame)))) + +(def debug-insidep + (lambda (elem expr) + (car (errset (edite expr (list 'f (cons '\=\= elem)) nil))))) + +(def debug-findusrfn + (lambda (frame) + (cond ((null frame) nil) + ((and (dtpr (caddr frame)) + (symbolp (caaddr frame)) + (dtpr (getd (caaddr frame)))) + frame) + (t (debug-findusrfn (debug-dnframe frame)))))) + +(def debug-findexpr + (lambda (frame) + (cond ((null frame) nil) + ((and (eq (car frame) 'eval) (not (atom (caddr frame)))) + frame) + (t (debug-findexpr (debug-dnframe frame)))))) + +(def debug-pop + (lambda nil + (prog (frame) + (setq frame (car framelist)) + l (cond ((null (setq frame (evalframe (cadr frame))))(reset))) + (cond ((and (dtpr (caddr frame))(eq (caaddr frame) 'debug)) + (freturn (cadr frame) nil))) + (go l)))) + +(def debug-where + (lambda (frame) + (prog (lev diff nframe) + (setq lev (- (length framelist) (length (memq frame rframelist)))) + (setq diff (- (length framelist) lev 1)) + (Pdebug-print1 frame nil) + (terpri) + (cond ((\=& 0 diff) (princ '|you are at top of stack.|)) + ((\=& 0 lev) (princ '|you are at bottom of stack.|)) + (t (princ '|you are |) + (princ diff) + (cond ((\=& diff 1) (princ '| frame from the top.|)) + (t (princ '| frames from the top.|))))) + (terpri) + (and (or (atom (caddr frame)) (not (eq (car frame) 'eval))) + (return nil)) + (setq lev 0) + (setq nframe frame) + lp (and (setq nframe (debug-findcall (caaddr nframe) nframe framelist)) + (setq lev (|1+| lev)) + (go lp)) + (princ '|there are |) + (princ lev) + (princ '| |) + (princ (caaddr frame)) + (princ '|'s below.|) + (terpri)))) + +(def debug-sysp + (lambda (x) + (and (sysp x) (symbolp x) (not (dtpr (getd x)))))) + +(dv interrupt-handlers (fixit)) + +(dv handler-labels + ((fixit error) + (debug-ubv-handler ubv) + (debug-udf-handler udf) + (debug-fac-handler fac) + (debug-ugt-handler ugt) + (debug-wta-handler wta) + (debug-wna-handler wna) + (debug-iol-handler iol) + (debug-*rset-handler rst) + (debug-mer-handler mer) + (debug-gcd-handler gcd) + (debug-gcl-handler gcl) + (debug-gco-handler gco) + (debug-pdl-handler pdl))) + + +(or (boundp 'traced-stuff) (setq traced-stuff nil)) + +(or (boundp 'evalhook-switch) (setq evalhook-switch nil)) + +(setq hush-debug nil) + + +;; other functions grabbed from other cmu files to make this file complete +;; unto itself + +;- from sysfunc.l + +(defun build-sysp nil + (do ((temp (oblist) (cdr temp)) + (sysfuncs)) + ((null temp)(setq system-functions\ sysfuncs));atom has ^G at end + (cond ((getd (car temp)) + (setq sysfuncs (cons (car temp) sysfuncs)))))) + +(defun sysp (x) ; (cond ((memq x system-functions\)t)) + (memq x '(funcallhook* funcallhook evalhook evalhook* + continue-evaluation))) + +(or (boundp 'system-functions\) (build-sysp)) + +(defun fretry (pdlpnt frame) + (freturn pdlpnt + (cond ((eq (car frame) 'eval) (eval (caddr frame) (cadddr frame))) + ((eq (car frame) 'apply) + (eval `(apply ',(caaddr frame) ',(cadaddr frame)) + (cadddr frame)))))) + + +; - from cmu.l + +(def %lineread + (lambda (chan) + (prog (ans) + loop (setq ans (cons (read chan 'EOF) ans)) + (cond ((eq (car ans) 'EOF) (return (reverse (cdr ans))))) + loop2(cond ((eq 10 (tyipeek chan)) (return (reverse ans))) + ((memq (tyipeek chan) '(41 93)) + (tyi chan) + (go loop2)) + (t (go loop)))))) + + +(aliasdef 'pearlbreak 'fixit) + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/franz.l b/usr/src/usr.bin/lisp/pearl/franz.l new file mode 100644 index 0000000000..d55ae6f7e2 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/franz.l @@ -0,0 +1,244 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;; franz.l ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Franz-dependent PEARL functions, declarations, and initializations +; that don't use PEARL functions. +; Functions to make Franz accept UCI Lisp functions are in ucisubset.l +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +; Version numbers, major and minor. +(defvar pearlmajorversion 3) +(defvar pearlminorversion 9) +;3.1: Use of lets and other speedups and new slot encoding. +;3.2: Slot encoding applied to speeded-up match. +;3.3: New faster hashing. +;3.4: Type tags added to symbols, instances, definitions and databases. +;3.5: New print functions. +;3.6: Made hooks additive and fixed global variables in failed matches. +;3.7: Minor bug fixes in scopy and hooks. +;3.8: Unification added; minor bug fixes in setv and create. +;3.9: Bug fixes in blocks and freezing; selectq becomes selectq*. + +; db: +(declare (*fexpr builddb)) +(defvar *pearldb*) +(defvar *pearlinactivedb*) +(defvar db) +(defvar *db1size*) +(defvar *db2size*) + +(defvar *availablesizes* '((-1. . 1.) (0. . 1.) (1. . 1.) (2. . 3.) + (3. . 7.) (4. . 13.) (5. . 29.) (6. . 61.) + (7. . 127.) (8. . 127.) (9. . 127.) + (10. . 127.) (11. . 127.) + (12. . 127.) (13. . 127.))) +;(( +; For UCI Lisp or Franz (7. . 127.) (8. . 251.) (9. . 509.) +; with vectors (soon?). (10. . 1021.) (11. . 2039.) +; (12. . 4093.) (13. . 8191.))) +; (setq buildpplst nil) + +(defvar *maindb*) +(defvar *db*) +(defvar *activedbnames* nil) + +; vars: +(declare (*fexpr varvalue setv *var* *global* global unbind)) +(declare (*fexpr block endblock endanyblocks setblock)) + +; hook: +(defvar *runallslothooks* t) +(defvar *runallbasehooks* t) + +(defvar *runputpathhooks* t) +(defvar *runclearpathhooks* t) +(defvar *runaddsetpathhooks* t) +(defvar *rundelsetpathhooks* t) +(defvar *runaddpredpathhooks* t) +(defvar *rundelpredpathhooks* t) +(defvar *rungetpathhooks* t) +(defvar *rungetpredpathhooks* t) +(defvar *rungethookpathhooks* t) +(defvar *runapplypathhooks* t) + +(defvar *runmatchhooks* t) +(defvar *runsmergehooks* t) +(defvar *runindividualhooks* t) +(defvar *runexpandedhooks* t) +(defvar *runpatternhooks* t) +(defvar *runnextitemhooks* t) +(defvar *runfetchhooks* t) +(defvar *runinsertdbhooks* t) +(defvar *runremovedbhooks* t) +(defvar *runindbhooks* t) +(defvar *runnextequalhooks* t) +(defvar *runstrequalhooks* t) + +; symord and create and scopy (and all): +(defvar *pearlunbound*) +(defvar *equivclass*) +(defvar *invisible*) +(defvar *warn* t) + +(defvar *pearlsymbol*) +(defvar *pearldef*) +(defvar *pearlinst*) + +(declare (*fexpr pearlbreak symbol ordinal create cr insidecreate)) +(defvar nilstruct) +(defvar d:nilstruct) +(defvar i:nilstruct) +(defvar s:nilsym) +(defvar *lastcreated*) +(defvar *toplevelp*) +(defvar *currenttopcreated*) +(defvar *currenttopalists*) +(defvar *currenttopcopy*) +(defvar *currentcreatetype*) +(defvar *ordinalnames* nil) +(defvar *globallist* nil) +; So that unique numbers start at 0. +(defvar *lastsymbolnum* -1) +(defvar *unhashablevalues*) +(defvar *any*conscell*) +(defvar *blockstack* nil) +(defvar *zero-ordinal-value* 0) +(defvar *currentpearlstructure* nil) +(defvar *currentstructure* nil) +(defvar *scopieditems*) + +; path: +(defvar *pathtop*) +(defvar *pathlocal*) + +; print: +(declare (*fexpr foreach quiet)) +(defvar *fullprint* nil) +(defvar *abbrevprint* nil) +(defvar *uniqueprint* nil) +(defvar *uniqueprintlist* nil) +(defvar *streamprintlength* 2) +(defvar *quiet* nil) +(defvar prinlevel) +(setq prinlevel 7) +(defvar printvar) +(defvar pearltraceprintfn) +(defvar pearlshowstackprintfn) +(defvar pearlbreakprintfn) +(defvar pearlfixprintfn) +(defvar msgprintfn) +(defvar pearltracebreakprintfn) +(defvar pearlprintfn) +(defvar dskprintfn) +(defvar trace-printer) +(setq trace-printer 'pearltraceprintfn) +(defvar showstack-printer) +(setq showstack-printer 'pearlshowstackprintfn) +(defvar top-level-print) +(setq top-level-print 'pearltracebreakprintfn) + +; if t, then enters and exits to tracing are quiet, +; but info is still kept so (tracedump) will work +(defvar \$tracemute) + +; hash: +(defvar *stream*) +(defvar *stream:*) +(defvar *function-stream:*) +(defvar *slotvalues* (makhunk 64)) +(defvar *hashingmarks* (makhunk 64)) +; (and via lowlevel.l): +(defvar *multiproducts* '(16. 256. 4096. 65536. 1048576. 16777216. + 268435456. 42944967296.)) + +; match: +(defvar *matchunboundsresult* nil) +(defvar *globalsavestack* nil) +(defvar *equivsavestack* nil) +(defvar *unifyunbounds* nil) +(defvar xvar) +(defvar yvar) + +; history: +(defvar *historynumber* -1.) +(defvar *historysize* 64.) +(defvar *usealiases* t) +(defvar *history* (makhunk *historysize*)) +(defvar *histval* (makhunk *historysize*)) +(defvar *printhistorynumber* nil) +(defvar *readlinechanged*) + +; PEARL-top-level: +(defvar *firststartup* t) +(defvar *pearlprompt* '|pearl> |) +(declare (*fexpr savepearl)) + +; Franz: PEARL-top-level: +(defvar pearl-title (concat " plus PEARL " + pearlmajorversion "." + pearlminorversion)) +(defvar franz-not-virgin) +(defvar pearl-top-level-init) +(defvar top-level) +(defvar franz-minor-version-number) +(defvar franz-top-level) +(defvar +) +(defvar ++) +(defvar +++) +(defvar *) +(defvar **) +(defvar ***) +(defvar ER%tpl) +(defvar ER%brk) +(defvar ER%err) +(defvar evalhook) +(defvar \$gcprint) +(defvar funcallhook) +(defvar tpl-errlist) +(defvar user-top-level) +(defvar top-level-eof) + +; PEARL-break-err-handler or trace or fixit debugger: +(defvar break-level-count) +(defvar debug-level-count) +(defvar errlist) + +; (funl (x...) body) expands to (function (lambda (x...) body)). +(defmacro funl (&rest rest) + `(function (lambda .,rest))) + +; Various Lisps store functions different ways. Check for +; lambda-ness (expr-ness). +(de islambda (fcn) + (and (neq 'binary (type fcn)) + (setq fcn (getd fcn))) + (or (and (eq 'binary (type fcn)) + (eq 'lambda (getdisc fcn))) + (and (dtpr fcn) + (eq 'lambda (car fcn))))) + +; Tests for an actual literal atom rather than nil!! +(defmacro reallitatom (potatom) + `(let ((pot ,potatom)) + (and (symbolp pot) + pot))) + +; To avoid problems with UCI Lisp's unbound, we use a special value +; for PEARL (pattern-matching) variables to indicate unboundness. +(dm punbound (none) + ''*pearlunbound*) + +(defmacro pboundp (a) + `(neq ,a (punbound))) + +(defmacro punboundatomp (yyy) + `(eq ,yyy (punbound))) + +;(aliasdef 'To 'From 'Property) means define To to be the same as From +; (under Property in UCILisp). HOWEVER, in Franz it means copy the +; function definition of To to From and ignore Property. +(defmacro aliasdef (to from property) + `(putd ,to (getd ,from))) + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/hash.l b/usr/src/usr.bin/lisp/pearl/hash.l new file mode 100644 index 0000000000..4064d2505d --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/hash.l @@ -0,0 +1,690 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; hash.l ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Functions for hashing, inserting, and fetching items into the +; data bases, plus operating on streams. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +; Find the next item on the CDDR list of the stream that matches the CADR of +; the stream and return it, also updating the stream. +(de nextitem (stream) + (or (streamp stream) + (progn (msg t "NEXTITEM: Not a stream: " stream t) + (pearlbreak))) + (setq stream (cdr stream)) ; Throw away the *STREAM*. + (cond ((eq t (car stream)) ; This means function structure. + (prog1 (evalfcn (cdr stream)) + (rplacd (rplaca stream nil) nil))) + ((null (cadr stream)) nil) ; Test for empty stream + ; Stream built by standardfetch. + ; To debug or modify this, you must draw a picture of what + ; standardfetch built because of the way it is written. + ((not (dtpr (cadr stream))) + (prog (item result) + (setq item (car stream)) + (setq *currentpearlstructure* item) + (checkrunhandlebasehooks1 'nextitem *runnextitemhooks*) + (return item))) + ; Stream built by expandedfetch (or fetcheverywhere). + ; To debug or modify this, you must draw a picture of what + ; expandedfetch built because of the way it is written. + ((not (dtpr (caadr stream))) + (prog (item result) + (setq item (car stream)) + (setq *currentpearlstructure* item) + (checkrunhandlebasehooks1 'nextitem *runnextitemhooks*) + (return item))))) + +(defmacro hashinfo (slotnum) + `(cxr ,slotnum *hashingmarks*)) + +(defmacro sethashinfo (slotnum value) + `(rplacx ,slotnum *hashingmarks* ,value)) + +(defmacro slotval (slotnum) + `(cxr ,slotnum *slotvalues*)) + +(defmacro storeslot (slotnum value) + `(rplacx ,slotnum *slotvalues* ,value)) + +; If there is anything to hash this slot on, say so and put it in HASHV. +(defmacro hashablevalue (slotnum item defblock hashinfo) + `(not (memq (setq hashv (gethashvalue ,slotnum ,item ,defblock ,hashinfo)) + *unhashablevalues*))) + +; If this slot is to take part in a hashing combination, (and it is the +; second one in :: or ** hashing), then add it to the right hash bucket. +(dm hashslot (none) + '(cond ((\=& 0 hashinfo) nil) ; No hashing to be done + ((hashablevalue slotnum item defblock hashinfo) ; Sets HASHV + (and (gethash* hashinfo) + (puthash2 unique hashv db2 item)) +; (and (gethash: hashinfo) +; (puthash1 hashv db1 item)) + (and (gethash** hashinfo) + (cond ((null mark**) + ; First one found. + (setq mark** hashv)) + ; Second one found + ((neq t mark**) + (puthash3 unique mark** hashv db2 item) + (setq mark** t)) + ; Third or greater found. + ( t (msg t "HASH: More than two **'s in: " + (getpname defblock) t)))) +; (and (gethash:: hashinfo) +; (cond ((null mark::) +; ; First one found. +; (setq mark:: hashv)) +; ; Second one found +; ((neq t mark::) +; (puthash2 mark:: hashv db2 item) +; (setq mark:: t)) +; ; Third or greater found. +; ( t (msg t "HASH: More than two ::'s in: " +; (getpname defblock) t)))) + (and (gethash*** hashinfo) + (cond ((null mark***) + ; First one found. + (setq mark*** (ncons hashv))) + ; Later ones found. + ( t (tconc mark*** hashv)))) +))) + +; For each of the four ways of hashing, or else just based on the type, +; check to see if the pattern can be hashed that way and if so, +; RETURN the right hashbucket. If the previous one can't be done, +; try the next one but stop with the first that can be done. +; The order is ***, **, ::, &&, *, and :. +(dm insidestandardfetch (none) + '(cond ((prog2 + (for slotnum 1 length + (and (gethash*** (hashinfo slotnum)) + (cond ((eq (punbound) + (setq hashv (slotval slotnum))) + (setq mark nil) + (return nil)) + ((null mark) + (setq mark (ncons nil)) + (tconc mark hashv) + nil) + ( t (tconc mark hashv))))) + mark) + (gethashmulti unique (car mark) db2)) + ((for slotnum 1 length + (and (gethash** (hashinfo slotnum)) + (cond ((eq (punbound) + (setq hashv (slotval slotnum))) + (return nil)) + ((null mark) (setq mark hashv) nil) + ( t (return (gethash3 unique mark hashv db2))))))) +; ((for slotnum 1 length +; (and (gethash:: (hashinfo slotnum)) +; (cond ((eq (punbound) +; (setq hashv (slotval slotnum))) +; (return nil)) +; ((null mark) (setq mark hashv) nil) +; ( t (return (gethash2 mark hashv db2))))))) + ((and (not (\=& 0 focus)) + (pboundp (setq hashv (slotval focus)))) + (recursetoinsidestandardfetch (getslotvalue focus item) db1 db2)) + ((for slotnum 1 length + (and (gethash* (hashinfo slotnum)) + (and (pboundp (setq hashv + (slotval slotnum))) + (return (gethash2 unique hashv db2)))))) +; ((for slotnum 1 length +; (and (gethash: (hashinfo slotnum)) +; (and (pboundp (setq hashv +; (slotval slotnum))) +; (return (gethash1 hashv db1)))))) + ( t (gethash1 unique db1)))) + +(de recursetoinsidestandardfetch (item db1 db2) + (let* ((defblock (getdefinition item)) + (length (getstructlength defblock)) + (*slotvalues* (makhunk (1+ length))) + (*hashingmarks* (makhunk (1+ length))) + (unique (getuniquenum defblock)) + mark hashv focus hashinfo) + (setq focus (gethashfocus defblock)) + (for slotnum 1 length + (setq hashinfo (gethashinfo slotnum defblock)) + (sethashinfo slotnum hashinfo) + (or (and (\=& 0 hashinfo) + (not (\=& focus slotnum))) + (storeslot slotnum + (gethashvalue slotnum item defblock hashinfo)))) + (insidestandardfetch))) + +; Return a pair consisting of the ITEM and a hash-bucket-list that should +; have what we are looking for in it. +(de standardfetch (item &optional (db *db*)) + (cond ((get (pname item) 'functionstruct) + (cons '*stream* (cons t item))) + ( t (prog (mark defblock bucket db1 db2 hashv result focus + length hashinfo unique) + (setq defblock (getdefinition item)) + (setq *currentpearlstructure* item) + (checkrunhandlebasehooks1 'fetch *runfetchhooks*) + (return (cons '*stream* (cons item bucket))))))) + +(aliasdef 'fetch 'standardfetch) + +(de expandedfetch (item &optional (db *db*)) + (cond ((get (pname item) 'functionstruct) + (cons '*stream* (cons t item))) + ( t (prog (mark defblock defblocklist buckets db1 db2 hashv result + focus length hashinfo) + (setq defblock (getdefinition item)) + (setq *currentpearlstructure* item) + (checkrunhandlebasehooks1 'fetch *runfetchhooks*) + (return (cons '*stream* (cons item buckets))))))) + +; Find the object EVERYWHERE it might be: ; (Well, only 1 for each hash method). +; For each of the four ways of hashing, plus just based on the type, +; check to see if the pattern can be hashed that way and if so, +; return the right hash bucket. A list of these lists is made. +; NIL's are removed in the main function. +; The order is ***, **, ::, &&, *, and :. +(dm insidefetcheverywhere (none) + '(let ((bucketlist (ncons nil))) + (for slotnum 1 length + (and (gethash*** (hashinfo slotnum)) + (cond ((eq (punbound) + (setq hashv (slotval slotnum))) + (setq mark nil) + (return nil)) + ((null mark) (setq mark (ncons hashv)) nil) + ( t (tconc mark hashv))))) + (and mark + (tconc bucketlist + (gethashmulti unique (car mark) db2)) + (setq mark nil)) + (for slotnum 1 length + (and (gethash** (hashinfo slotnum)) + (cond ((eq (punbound) + (setq hashv (slotval slotnum))) + (return nil)) + ((null mark) (setq mark hashv) nil) + ( t (tconc bucketlist + (gethash3 unique mark hashv db2)) + (setq mark nil) + (return nil))))) + (and (not (\=& 0 focus)) + (pboundp (setq hashv (slotval focus))) + (tconc bucketlist + (recursetoinsidestandardfetch (getslotvalue focus item) + db1 db2))) + (for slotnum 1 length + (and (gethash* (hashinfo slotnum)) + (and (pboundp (setq hashv + (slotval slotnum))) + (tconc bucketlist + (gethash2 unique hashv db2))))) + (tconc bucketlist + (gethash1 unique db1)) + (car bucketlist))) + +; Return a list consisting of the ITEM and a list of hash-bucket-list +; that must have what we are looking for in it if it's there. +(de fetcheverywhere (item &optional (db *db*)) + (cond ((get (pname item) 'functionstruct) + (cons '*stream* (cons t item))) + ( t (prog (mark defblock buckets db1 db2 hashv result focus + length hashinfo unique) + (setq defblock (getdefinition item)) + (setq length (getstructlength defblock)) + (setq focus (gethashfocus defblock)) + (for slotnum 1 length + (setq hashinfo (gethashinfo slotnum defblock)) + (sethashinfo slotnum hashinfo) + (or (and (\=& 0 hashinfo) + (not (\=& focus slotnum))) + (storeslot slotnum + (gethashvalue slotnum item + defblock hashinfo)))) + (setq *currentpearlstructure* item) + (checkrunhandlebasehooks1 'fetch *runfetchhooks*) + (return (cons '*stream* (cons item buckets))))))) + +; Discover if a hash alias is to be used. +(dm noalias (none) + '(cond ((>& alias 0) + (cond ((gethash< hashinfo) + (cond ((gethash> hashinfo) nil) ; < > cancels + ( t t))) + ( t nil))) + ( t (cond ((gethash< hashinfo) t) + ( t (cond ((gethash> hashinfo) nil) ; < > cancels + ( t t))))))) + +; Get the value that should be hashed for the given slot of ITEM +; else return unbound. +(de gethashvalue (slotnum item defblock hashinfo) + (let + ((potential (getvalue slotnum item)) + alias) + (cond ((null potential) nil) + ((pboundp potential) + (let ((potdef (getdefinition potential))) + (selectq (getslottype slotnum defblock) + (0 (setq alias (gethashalias potdef)) + (cond ((or (noalias) + (\=& 0 alias)) + (getuniquenum potdef)) + ( t + (setq alias (abs alias)) + (gethashvalue alias potential potdef + (gethashinfo alias potdef))))) + (1 (getuniquenum potential)) ; Symbol. + (2 potential) ; Integer. + (3 (punbound)) ; Lisp not hashed. + (otherwise nil)))) ; SetOf not hashed (YET). + ( t (punbound))))) + +; Fetch the first item matching the pattern. +(defmacro firstfetch (pattern) + `(nextitem (fetch ,pattern))) + +(defmacro fetchcreate (&rest rest) + `(fetch (create .,rest))) + +(defmacro inlinefetchcreate (&rest rest) + `(fetch (quote ,(create rest)))) + +(defmacro inlinecreate (&rest rest) + `(quote ,(create rest))) + +; Build a value to pass to the function for the parameter for this slot. +(dm fcnslot (none) + '(let ((slotv (getvalue slotnum item)) + (type (getslottype slotnum defblock))) + (cond ((eq slotv (punbound)) (punbound)) + ((and (<& type 4) + (or (not (\=& 0 type)) + (not (get (getpname (getdefinition slotv)) + 'functionstruct)))) slotv) + ((\=& 0 type) + (evalfcn slotv)) + ((\=& 0 (boole 1 3 type)) + (mapcar (function evalfcn) slotv)) + ( t slotv)))) + +; Evaluate a function structure. +(de evalfcn (item) + (cond ((dtpr item) (mapcar (function evalfcn) item)) + ((not (get (getpname (getdefinition item)) 'functionstruct)) item) + ( t (let* ((defblock (getdefinition item)) + (length (getstructlength defblock)) + (fcncall (ncons nil)) + slotv) + (tconc fcncall (getpname defblock)) + (for slotnum 1 length + (tconc fcncall (fcnslot))) + (apply* (caar fcncall) (cdar fcncall)))))) + +; A kludge to be removed (with disguisedas) when we implement VIEWS. +(defmacro getstructorsymnum (strsym) + `(cond ((psymbolp ,strsym) (getuniquenum ,strsym)) + ( t (getuniquenum (getdefinition ,strsym))))) + +; (DISGUISEDAS Filler Struct DB) means "Is filler a struct? +; if there is an item in the data base DB of the form +; (STRUCT ( FILLER) ... ) +; then return it. If not, return NIL. +(de disguisedas (filler struct &optional (db *db*)) + (prog (fillernum bucket db2 item value) + (setq db2 (getdb2 db)) + (setq fillernum (getstructorsymnum filler)) + (setq bucket (remq '*db* + (gethash2 (getuniquenum struct) fillernum db2))) + loop + (cond ((null bucket) (return nil)) + ((and (eq struct (getdefinition (setq item (pop bucket)))) + (neq (punbound) (setq value (getvalue 1 item))) + (eq (getstructorsymnum value) fillernum)) + (return item)) + ( t (go loop))))) + +(de insertbyfocus (focus item db1 db2) + (prog (unique mark** mark:: mark*** defblock + value hashinfo hashv focusslotnum) + (setq defblock (getdefinition focus)) + (setq unique (getuniquenum defblock)) + (puthash1 unique db1 item) + (and (not (\=& 0 (setq focusslotnum (gethashfocus defblock)))) + (pboundp (setq value (getvalue focusslotnum focus))) + (insertbyfocus value item db1 db2)) + (for slotnum 1 (getstructlength defblock) + (setq hashinfo (gethashinfo slotnum defblock)) + (cond ((\=& 0 hashinfo) nil) + ((hashablevalue slotnum focus defblock hashinfo) ; Sets HASHV + (and (gethash* hashinfo) + (puthash2 unique hashv db2 item)) +; (and (gethash: hashinfo) +; (puthash1 hashv db1 item)) + (and (gethash** hashinfo) + (cond ((null mark**) + ; First one found. + (setq mark** hashv)) + ; Second one found + ((neq t mark**) + (puthash3 unique mark** hashv db2 item) + (setq mark** t)) + ; Third or greater found. + ( t (msg t "HASH: More than two **'s in: " + (getpname defblock) t)))) +; (and (gethash:: hashinfo) +; (cond ((null mark::) +; ; First one found. +; (setq mark:: hashv)) +; ; Second one found +; ((neq t mark::) +; (puthash2 mark:: hashv db2 item) +; (setq mark:: t)) +; ; Third or greater found. +; ( t (msg t "HASH: More than two ::'s in: " +; (getpname defblock) t)))) + (and (gethash*** hashinfo) + (cond ((null mark***) + ; First one found. + (setq mark*** (ncons hashv))) + ; Later ones found. + ( t (tconc mark*** hashv)))) + ))) + (and mark*** + (puthashmulti unique (car mark***) db2 item)))) + +; We must put this struct into the data base somewhere, +; perhaps in several places. +(de insertdb (item &optional (db *db*)) + (or item + (progn (msg t "Trying to INSERTDB a nil item: " item t) + (pearlbreak))) + (and (dtpr item) + (progn (msg t "Trying to INSERTDB a cons-cell: " item t) + (pearlbreak))) + (cond ((get (getpname (getdefinition item)) 'functionstruct) + (evalfcn item)) + ( t + (prog (unique mark** mark:: mark*** defblock db1 db2 + value hashinfo hashv result focus) + (setq defblock (getdefinition item)) + (setq *currentpearlstructure* item) + (checkrunhandlebasehooks1 'insertdb *runinsertdbhooks*) + (return item))))) + +; For each way that this slot can be hashed, destructively remove the +; item from the correct bucket. Expects SLOTNUM, DEFBLOCK, ITEM, +; MARK**, MARK::, MARK***, HASHV, UNIQUE, DB1, DB2. +(dm removeslot (none) + '(cond ((\=& 0 hashinfo) nil) ; No hashing to be done + ((hashablevalue slotnum item defblock hashinfo) ; Sets HASHV + (and (gethash* hashinfo) + (delq item (gethash2 unique hashv db2))) +; (and (gethash: hashinfo) +; (delq item (gethash1 hashv db1))) + (and (gethash** hashinfo) + (cond ((null mark**) + (setq mark** hashv)) + ((neq t mark**) + (delq item (gethash3 unique mark** hashv db2)) + (setq mark** t)) + ( t (msg t "More than two **'s in: " + (getpname defblock) t)))) +; (and (gethash:: hashinfo) +; (cond ((null mark::) +; (setq mark:: hashv)) +; ((neq t mark::) +; (delq item (gethash2 mark:: hashv db2)) +; (setq mark:: t)) +; ( t (msg t "More than two ::'s in: " +; (getpname defblock) t)))) + (and (gethash*** hashinfo) + (cond ((null mark***) + ; First one found. + (setq mark*** (ncons hashv))) + ; Later ones found. + ( t (tconc mark*** hashv)))) +))) + +(de removebyfocus (focus item db1 db2) + (prog (unique mark** mark:: mark*** defblock hashinfo hashv focusslotnum) + (setq defblock (getdefinition focus)) + (setq unique (getuniquenum defblock)) + (dremove item (gethash1 unique db1)) + (and (not (\=& 0 (setq focusslotnum (gethashfocus defblock)))) + (removebyfocus (getvalue focusslotnum focus) item db1 db2)) + (for slotnum 1 (getstructlength defblock) + (setq hashinfo (gethashinfo slotnum defblock)) + (cond ((\=& 0 hashinfo) nil) + ((hashablevalue slotnum focus defblock hashinfo) ; Sets HASHV + (and (gethash* hashinfo) + (delq item (gethash2 unique hashv db2))) +; (and (gethash: hashinfo) +; (delq item (gethash1 hashv db1))) + (and (gethash** hashinfo) + (cond ((null mark**) + (setq mark** hashv)) + ((neq t mark**) + (delq item (gethash3 unique mark** hashv db2)) + (setq mark** t)) + ( t (msg t "More than two **'s in: " + (getpname defblock) t)))) +; (and (gethash:: hashinfo) +; (cond ((null mark::) +; (setq mark:: hashv)) +; ((neq t mark::) +; (delq item (gethash2 mark:: hashv db2)) +; (setq mark:: t)) +; ( t (msg t "More than two ::'s in: " +; (getpname defblock) t)))) + (and (gethash*** hashinfo) + (cond ((null mark***) + ; First one found. + (setq mark*** (ncons hashv))) + ; Later ones found. + ( t (tconc mark*** hashv)))) + ))) + (and mark*** + (delq item (gethashmulti unique mark*** db2))) + )) + +; We may have to remove this struct from several places so look +; every place it might have been hashed. +(de removedb (item &optional (db *db*)) + (or item + (progn (msg t "Trying to REMOVEDB a nil item: " item t) + (pearlbreak))) + (and (dtpr item) + (progn (msg t "Trying to REMOVEDB a cons-cell: " item t) + (pearlbreak))) + (or (structurep item) + (progn (msg t "Trying to REMOVEDB a non-structure: " item t) + (pearlbreak))) + (cond ((get (getpname (getdefinition item)) 'functionstruct) nil) + ( t + (prog (unique mark** mark:: mark*** defblock db1 db2 + hashinfo hashv result focus) + (setq defblock (getdefinition item)) + (setq *currentpearlstructure* item) + (checkrunhandlebasehooks1 'removedb *runremovedbhooks*) + (return item))))) + +; Find the next item on the CDDR list of the stream that is STREQUAL to +; the CADR of the stream and return it, also updating the stream. +(de nextequal (stream) + (or (streamp stream) + (progn (msg t "NEXTEQUAL: not a stream: " stream t) + (pearlbreak))) + (setq stream (cdr stream)) ; Throw away the *STREAM*. + (cond ((eq t (car stream)) ; This means function structure. + (prog1 (evalfcn (cdr stream)) + (rplacd (rplaca stream nil) nil))) + ((null (cadr stream)) nil) ; Test for empty stream + ; Stream built by standardfetch. + ; To debug or modify this, you must draw a picture of what + ; standardfetch built because of the way it is written. + ((not (dtpr (cadr stream))) + (prog (item result) + (setq item (car stream)) + (setq *currentpearlstructure* item) + (checkrunhandlebasehooks1 'nextequal *runnextequalhooks*) + (return item))) + ; Stream built by expandedfetch (or fetcheverywhere). + ; To debug or modify this, you must draw a picture of what + ; expandedfetch built because of the way it is written. + ((not (dtpr (caadr stream))) + (prog (item result) + (setq item (car stream)) + (setq *currentpearlstructure* item) + (checkrunhandlebasehooks1 'nextequal *runnextequalhooks*) + (return item))))) + +; Find out if an EQUAL ITEM is in the DB by using FETCH and then +; applying NEXTEQUAL. +(de indb (item &optional (db *db*)) + (prog (result newitem answer) + (setq *currentpearlstructure* item) + (checkrunhandlebasehooks1 'indb *runindbhooks*) + (and newitem + (neq item newitem) + (setq answer item)) + (return answer))) + +; (FOREACH STREAM FCN) applies FCN to each element returned by +; NEXTITEM from STREAM. +(df foreach (l) + (let ((stream (eval (car l))) + (fcn (cadr l)) + item) + (while (setq item (nextitem stream)) + (apply* fcn (ncons item))))) + +; Convert a stream to a list of actual matchers. +(de streamtolist (stream) + (let ((result (ncons nil)) + item) + (while (setq item (nextitem stream)) + (tconc result item)) + (car result))) + + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/history.l b/usr/src/usr.bin/lisp/pearl/history.l new file mode 100644 index 0000000000..6a367cd497 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/history.l @@ -0,0 +1,199 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; history.l ;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Functions for adding a command to the command history, printing +; the command history, processing aliased atoms and handling +; the history-invoking splice macros ! and $. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +; Given two lists of atoms, determine if the first is a prefix of the second. +(de prefix (item1 item2) + (prog () + prefixloop + (cond ((null item1) (return t)) ; item1 ran out first: succeed. + ((null item2) (return nil)) ; item2 ran out first: fail. + ((neq (car item1) (car item2)) ; no match: fail. + (return nil)) + ; Otherwise, try next atoms. + ( t (setq item1 (cdr item1)) + (setq item2 (cdr item2)) + (go prefixloop))))) + +; Add the LINE to the *history* hunk in the *historynumber* spot, +; after possibly replacing it with its alias (for atoms) saved +; on the property list under the ALIAS property. +(de addhistory (line) + (let (alias) + ; Replace with alias if there is one. + (and *usealiases* + (litatom line) + (setq alias (get line 'alias)) + (setq line alias)) + + ; Store in the command history table. + (setq *historynumber* (1+ *historynumber*)) + (rplacx (\\ *historynumber* *historysize*) + *history* + (copy line)) ; To eliminate macroexpansions. + + ; If it has been changed by read macros, print it out again. + (cond (*readlinechanged* + (pearlprintfn line) + (terpri))) + line)) + +; Print the command history. Optional argument determines how +; many commands get printed, otherwise, the whole history. +(de history narg + (cond ((\=& 0 narg) + (cond ((ge *historynumber* *historysize*) + (for command (1+ (- *historynumber* *historysize*)) + *historynumber* + (msg t command ": " + (cxr (\\ command *historysize*) + *history*)))) + ( t (for command 0 *historynumber* + (msg t command ": " (cxr command *history*)))))) + ( t + (cond ((ge *historynumber* (arg 1)) + (for command (1+ (- *historynumber* (arg 1))) + *historynumber* + (msg t command ": " + (cxr (\\ command *historysize*) + *history*)))) + ( t (for command 0 *historynumber* + (msg t command ": " (cxr command *history*))))))) + '*invisible*) + +; Look for a command with the next atom as a prefix and return the command. +(de prefixcommandhistory () + (let* ((wanted (read)) + (wanthead (explode wanted)) + (commandnum *historynumber*) + (stoppingcommand (cond ((ge *historynumber* *historysize*) + (- *historynumber* *historysize*)) + ( t -1.))) + commandhead) + (setq *readlinechanged* t) + (while (and (>& commandnum stoppingcommand) + (not (prefix wanthead + (prog2 (setq commandhead + (cxr (\\ commandnum + *historysize*) + *history*)) + (setq commandhead + (explode + (cond ((atom commandhead) + commandhead) + ( t (car commandhead))))) + )))) + (setq commandnum (1- commandnum))) + + (cond ((>& commandnum stoppingcommand) + (ncons (cxr (\\ commandnum *historysize*) + *history*))) + ( t (ncons (concat '\! wanted)))))) + +; History command invoker. +(dsm \! + (lambda () + (let + (num whole) + (selectq (tyipeek) + (33. (readc) ; !! + (setq *readlinechanged* t) + (ncons (cxr (\\ *historynumber* *historysize*) + *history*))) + (58. (readc) (setq num (read)) ; !: + (setq *readlinechanged* t) + (setq whole (cxr (\\ *historynumber* *historysize*) + *history*)) + (cond ((atom whole) (ncons whole)) + ( t (ncons (nth num whole))))) + (94. (readc) ; !^ + (setq *readlinechanged* t) + (setq whole (cxr (\\ *historynumber* *historysize*) + *history*)) + (cond ((atom whole) (ncons whole)) + ( t (ncons (cadr whole))))) + (42. (readc) ; !* + (setq *readlinechanged* t) + (setq whole (cxr (\\ *historynumber* *historysize*) + *history*)) + (cond ((atom whole) (ncons whole)) + ( t (cdr whole)))) + (36. (readc) ; !$ + (setq *readlinechanged* t) + (setq whole (cxr (\\ *historynumber* *historysize*) + *history*)) + (cond ((atom whole) (ncons whole)) + ( t (ncons (last whole))))) + (9. (ncons '\!)) ; !Tab + (10. (ncons '\!)) ; !LF + (13. (ncons '\!)) ; !CR + (32. (ncons '\!)) ; !Blank + (41. (ncons '\!)) ; !rpar + ((48. 49. 50. 51. 52. 53. 54. 55. 56. 57.) ; !Number + (setq *readlinechanged* t) + (setq num (read)) + (ncons (cxr (\\ num *historysize*) + *history*))) + (otherwise (prefixcommandhistory))) ; !Prefix + ))) + +; Look for a command with the next atom as a prefix and return its value. +(de prefixcommandvalue () + (let* ((wanted (read)) + (wanthead (explode wanted)) + (commandnum *historynumber*) + (stoppingcommand (cond ((ge *historynumber* *historysize*) + (- *historynumber* *historysize*)) + ( t -1.))) + commandhead) + (setq *readlinechanged* t) + (while (and (>& commandnum stoppingcommand) + (not (prefix wanthead + (prog2 (setq commandhead + (cxr (\\ commandnum + *historysize*) + *histval*)) + (setq commandhead + (explode + (cond ((atom commandhead) + commandhead) + ( t (car commandhead))))) + )))) + (setq commandnum (1- commandnum))) + + (cond ((>& commandnum stoppingcommand) + (cxr (\\ commandnum *historysize*) + *histval*)) + ( t (concat '\$ wanted))))) + +; History command result invoker. +(dsm \$ + (lambda () + (let + (num whole) + (ncons + (selectq (tyipeek) + (36. (readc) ; $$ + (setq *readlinechanged* t) + (list 'quote + (cxr (\\ *historynumber* *historysize*) + *histval*))) + (9. '\$) ; $Tab + (10. '\$) ; $LF + (13. '\$) ; $CR + (32. '\$) ; $Blank + (41. '\$) ; !rpar + ((48. 49. 50. 51. 52. 53. 54. 55. 56. 57.) ; $Number + (setq *readlinechanged* t) + (setq num (read)) + (list 'quote (cxr (\\ num *historysize*) + *histval*))) + (otherwise ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; $Prefix + (list 'quote (prefixcommandvalue)))))))) + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/hook.l b/usr/src/usr.bin/lisp/pearl/hook.l new file mode 100644 index 0000000000..75a4e5b012 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/hook.l @@ -0,0 +1,380 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; hook.l ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Functions for filling in, running and processing the results of +; both slot and base hooks. Also, hidden and visible. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +; Convert an equal sign followed by an atom into (*SLOT* atom) +; for use in both predicates and hooks. +(drm \= + (lambda () + (let ((nextchar (tyipeek))) + (cond ((\=& 9. nextchar) '\=) + ((\=& 10. nextchar) '\=) + ((\=& 13. nextchar) '\=) + ((\=& 32. nextchar) '\=) + ((\=& 41. nextchar) '\=) + ((eqstr (ascii nextchar) '\=) + (readc) + '\=\=) + ( t (list '*slot* (read))))))) + +; Convert a slotname into a slot number for a particular type of structure. +(defmacro numberofslot (slotname defblock) + `(for slotnum 1 (getstructlength ,defblock) + (and (memq ,slotname (getslotname slotnum ,defblock)) + (return slotnum))) + ) + +; Fill a predicate or hook (FCN) in with the right things, using +; VALUE for * or >*, +; ITEM for ** or >** and to find variables and slotvalues, +; and DEFBLOCK to find slotnumbers. +(de fillin1 (fcn value item defblock) + (cond ((null fcn) nil) + ((atom fcn) (cond ((eq '** fcn) (list 'quote item)) + ((eq '* fcn) (list 'quote value)) + ((eq '>** fcn) (list 'quote item)) + ((eq '>* fcn) (list 'quote value)) + ( t fcn))) + ((dtpr fcn) + (cond ((eq '*slot* (car fcn)) + (list 'quote + (getvalue (numberofslot (cadr fcn) defblock) + item))) + ((eq '*var* (car fcn)) + (list 'quote + (valueof (cadr fcn) item))) + ((eq '*global* (car fcn)) + (cadr fcn)) + ( t (mapcar (funl (x) (fillin1 x value item defblock)) + fcn)))) + ( t fcn))) + +; Fill a two-item predicate or hook (FCN) in with the right things, using +; VAL1 for * +; VAL2 for >* +; ITEM1 for ** and to find variables and slotvalues, +; ITEM2 for >** +; RESULT for ? +; and DEFBLOCK to find slotnumbers. +; Must be made into a LEXPR in UCI Lisp because of number of arguments. +(de fillin2 (fcn val1 val2 item1 item2 defblock result) + (cond ((null fcn) nil) + ((atom fcn) (cond ((eq '** fcn) (list 'quote item1)) + ((eq '>** fcn) (list 'quote item2)) + ((eq '* fcn) (list 'quote val1)) + ((eq '>* fcn) (list 'quote val2)) + ((eq '\? fcn) (list 'quote result)) + ( t fcn))) + ((dtpr fcn) + (cond ((eq '*slot* (car fcn)) + (list 'quote + (getvalue (numberofslot (cadr fcn) defblock) + item1))) + ((eq '*var* (car fcn)) + (list 'quote + (valueof (cadr fcn) item1))) + ((eq '*global* (car fcn)) + (cadr fcn)) + ( t (mapcar (funl (x) (fillin2 x val1 val2 + item1 item2 + defblock result)) + fcn)))) + ( t fcn))) + +; If an atom, apply it, else fill it in and evaluate it. +(defmacro executehook1 (fcn value item defblock) + `(cond ((atom ,fcn) (apply* ,fcn (ncons ,value))) + ( t (eval (fillin1 ,fcn ,value ,item ,defblock))))) + +; If an atom, apply it, else fill it in and evaluate it. +(defmacro executehook2 (fcn val1 val2 item1 item2 defblock result) + `(cond ((atom ,fcn) (apply* ,fcn (list ,val1 ,val2))) + ( t (eval (fillin2 ,fcn ,val1 ,val2 + ,item1 ,item2 ,defblock ,result))))) + +; If slothooks are supposed to be run, run them and check for *done*, +; *fail* or *use*, doing the appropriate thing. Can almost be +; used alone but assumes SLOTNUM, ITEM, RESULT, and VALUE. +(defmacro checkrunhandleslothooks1 (fcn runhooksatom) + `(and *runallslothooks* + ,runhooksatom + (setq result + (let ((defblock (getdefinition item)) + (alist (getslothooks slotnum item)) + (retvalue nil) + pair) + (while (and (not retvalue) + (setq pair (pop alist))) + (and (eq (car pair) ,fcn) + (setq retvalue + (executehook1 (cdr pair) value + item defblock)) + (or (and (dtpr retvalue) + (memq (car retvalue) + '(*fail* *done* *use*))) + (setq retvalue nil)))) + retvalue)) + (dtpr result) + (selectq (car result) + (*done* (and (cdr result) + (return (cadr result))) + (return value)) + (*fail* (and (cdr result) + (return (cadr result))) + (return '*fail*)) + (*use* (setq value (cadr result)))))) + +; *done* and *fail* cause an immediate return. *use* changes the +; value that was going to be used. +(defmacro handlehookresult (oldval newval) + `(and (dtpr ,newval) + (selectq (car ,newval) + (*done* (and (cdr ,newval) + (return (cadr ,newval))) + (return ,oldval)) + (*fail* (and (cdr ,newval) + (return (cadr ,newval))) + (return '*fail*)) + (*use* (setq ,oldval (cadr ,newval)))))) + +; If slothooks are supposed to be run, run them and check for *done*, +; *fail* or *use*, doing the appropriate thing. Can almost be +; used alone but assumes RESULT and ITEM. +(defmacro checkrunhandlebasehooks1 (fcn runhooksatom) + `(and *runallbasehooks* + ,runhooksatom + (setq result + (let ((retvalue nil) + alist + pair + defblock) + (and item + (setq defblock (getdefinition item)) + (setq alist (getbasehooks defblock))) + (while (and (not retvalue) + (setq pair (pop alist))) + (and (eq (car pair) ,fcn) + (setq retvalue + (executehook1 (cdr pair) item + item defblock)) + (or (and (dtpr retvalue) + (memq (car retvalue) + '(*fail* *done* *use*))) + (setq retvalue nil)))) + retvalue)) + (dtpr result) + (selectq (car result) + (*done* (and (cdr result) + (return (cadr result))) + (return item)) + (*fail* (and (cdr result) + (return (cadr result))) + (return '*fail*)) + (*use* (setq item (cadr result)))))) + +; If slothooks are supposed to be run, run them. Assumes SLOTNUM, +; ITEM, and VALUE. This is not a standalone function, since it +; does not handle RESULT but rather returns it. +(defmacro checkandrunslothooks2 (fcn hooks val1 val2 item1 item2) + `(let ((defblock (getdefinition ,item1)) + (retvalue nil) + pair) + (while (and (not retvalue) + (setq pair (pop ,hooks))) + (and (eq (car pair) ,fcn) + (setq retvalue + (executehook2 (cdr pair) ,val1 ,val2 + ,item1 ,item2 defblock result)) + (or (and (dtpr retvalue) + (memq (car retvalue) + '(*fail* *done* *use*))) + (setq retvalue nil)))) + retvalue)) + +; Assumes XVAL or YVAL is where you want changes. +(defmacro doslothooks2< (fcn runhookatom) + `(cond ((and *runallslothooks* + ,runhookatom) + (setq newxval nil) + (setq newyval nil) + (and (setq xhooks (getslothooks slotnum item1)) + (setq newxval + (checkandrunslothooks2 ,fcn xhooks xval yval + item1 item2))) + (and (setq yhooks (getslothooks slotnum item2)) + (setq newyval + (checkandrunslothooks2 ,fcn yhooks yval xval + item2 item1))) + (handlehookresult xval newxval) + (handlehookresult yval newyval)))) + +; Assumes RESULT is where you want changes. +(defmacro doslothooks2> (fcn runhookatom) + `(cond ((and *runallslothooks* + ,runhookatom) + (setq newxval nil) + (setq newyval nil) + (and (setq xhooks (getslothooks slotnum item1)) + (setq newxval + (checkandrunslothooks2 ,fcn xhooks xval yval + item1 item2))) + (and (setq yhooks (getslothooks slotnum item2)) + (setq newyval + (checkandrunslothooks2 ,fcn yhooks yval xval + item2 item1))) + (handlehookresult result newxval) + (handlehookresult result newyval)))) + +(defmacro checkandrunbasehooks2 (fcn item1 item2) + `(let* ((retvalue nil) + (defblock (getdefinition ,item1)) + (alist (getbasehooks defblock)) + pair) + (while (and (not retvalue) + (setq pair (pop alist))) + (and (eq (car pair) ,fcn) + (setq retvalue + (executehook2 (cdr pair) ,item1 ,item2 + ,item1 ,item2 defblock result)) + (or (and (dtpr retvalue) + (memq (car retvalue) + '(*fail* *done* *use*))) + (setq retvalue nil)))) + retvalue)) + +; Assumes ITEM1 and ITEM2 are where you want changes. +(defmacro dobasehooks2< (fcn runhookatom) + `(cond ((and *runallbasehooks* + ,runhookatom) + (setq newitem1 (checkandrunbasehooks2 ,fcn item1 item2)) + (setq newitem2 (checkandrunbasehooks2 ,fcn item2 item1)) + (handlehookresult item1 newitem1) + (handlehookresult item2 newitem2)))) + +; Assumes RESULT is where you want changes. +(defmacro dobasehooks2> (fcn runhookatom) + `(cond ((and *runallbasehooks* + ,runhookatom) + (setq newitem1 (checkandrunbasehooks2 ,fcn item1 item2)) + (setq newitem2 (checkandrunbasehooks2 ,fcn item2 item1)) + (handlehookresult result newitem1) + (handlehookresult result newitem2)))) + +; Runbasehooks for single items for the user. +(de runbasehooks1 (fcn item) + (and (null item) + (progn (msg t "RUNBASEIFS1: Null item given to run hooks on." t) + (pearlbreak))) + (let* ((retvalue nil) + (defblock (getdefinition item)) + (alist (getbasehooks defblock)) + pair) + (while (and (not retvalue) + (setq pair (pop alist))) + (and (eq (car pair) fcn) + (setq retvalue (executehook1 (cdr pair) item item defblock)) + (or (and (dtpr retvalue) + (memq (car retvalue) '(*fail* *done* *use*))) + (setq retvalue nil)))) + retvalue)) + +; Runbasehooks for two items for the user. +(de runbasehooks2 (fcn item1 item2 result) + (and (null item1) + (progn (msg t "RUNBASEIFS2: Null first item given to run hooks on." t) + (pearlbreak))) + (and (null item2) + (progn (msg t "RUNBASEIFS2: Null second item given to run hooks on." t) + (pearlbreak))) + (let* ((retvalue nil) + (defblock (getdefinition item1)) + (alist (getbasehooks defblock)) + pair) + (while (and (not retvalue) + (setq pair (pop alist))) + (and (eq (car pair) fcn) + (setq retvalue + (executehook2 (cdr pair) item1 item2 + item1 item2 defblock result)) + (or (and (dtpr retvalue) + (memq (car retvalue) '(*fail* *done* *use*))) + (setq retvalue nil)))) + retvalue)) + +; Run slot hooks for the slot named SLOTNAME for one item for the user. +(de runslothooks1 (fcn item slotname value) + (and (null item) + (progn (msg t "RUNSLOTIFS1: Null item given to run hooks on." t) + (pearlbreak))) + (let* ((retvalue nil) + (defblock (getdefinition item)) + (slotnum (numberofslot slotname defblock)) + (alist (getslothooks slotnum item)) + pair) + (while (and (not retvalue) + (setq pair (pop alist))) + (and (eq (car pair) fcn) + (setq retvalue + (executehook1 (cdr pair) value item defblock)) + (or (and (dtpr retvalue) + (memq (car retvalue) '(*fail* *done* *use*))) + (setq retvalue nil)))) + retvalue)) + +; Run slot hooks for the slot named SLOTNAME for two items for the user. +; Must be made into a LEXPR in UCI Lisp because of number of arguments. +(de runslothooks2 (fcn item1 item2 slotname val1 val2 result) + (and (null item1) + (progn (msg t "RUNSLOTIFS1: Null first item given to run hooks on." t) + (pearlbreak))) + (and (null item2) + (progn (msg t "RUNSLOTIFS1: Null second item given to run hooks on." t) + (pearlbreak))) + (let* ((retvalue1 nil) + (retvalue2 nil) + (defblock (getdefinition item1)) + (slotnum (numberofslot slotname defblock)) + (alist (getslothooks slotnum item1)) + pair) + (while (and (not retvalue1) + (setq pair (pop alist))) + (and (eq (car pair) fcn) + (setq retvalue1 + (executehook2 (cdr pair) val1 val2 + item1 item2 defblock result)) + (or (and (dtpr retvalue1) + (memq (car retvalue1) '(*fail* *done* *use*))) + (setq retvalue1 nil)))) + (setq defblock (getdefinition item2)) + (setq slotnum (numberofslot slotname defblock)) + (setq alist (getslothooks slotnum item2)) + (while (and (not retvalue2) + (setq pair (pop alist))) + (and (eq (car pair) fcn) + (setq retvalue2 + (executehook2 (cdr pair) val2 val1 + item2 item1 defblock result)) + (or (and (dtpr retvalue2) + (memq (car retvalue2) '(*fail* *done* *use*))) + (setq retvalue2 nil)))) + (cons retvalue1 retvalue2))) + +; Run command with its associated *run...hooks* atom set to nil +; temporarily with a let so that its hooks WON'T be run. +(defmacro hidden (command) + (let ((name (concat '*run (car command) 'hooks*))) + `(let ((,name nil)) + ,command))) + +; Run command with its associated *run...hooks* atom set to t +; temporarily with a let so that its hooks WILL be run. +(defmacro visible (command) + (let ((name (concat '*run (car command) 'hooks*))) + `(let ((,name t)) + ,command))) + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/implement.ms b/usr/src/usr.bin/lisp/pearl/implement.ms new file mode 100644 index 0000000000..e1b832cc43 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/implement.ms @@ -0,0 +1,2059 @@ +.so /usr/lib/vlpmacs +.ND +.ds CH +.ds CF - % - +.po 1.00i +.nr LL 6.25i +.RP +.TL +.LG +The Implementation of PEARL +.SM +.sp 1 +A Package for Efficient Access to +Representations in Lisp* +.FS +* This research was sponsored in part by the Office of Naval Research +under contract N00014-80-C-0732 and the National Science Foundation +under grant MCS79-06543. +.FE +.AU +Joseph Faletti +Robert Wilensky +.AI +Computer Science Division +Department of EECS +University of California, Berkeley +Berkeley, California 94720 +.sp 1 +March 1982 +.AB +PEARL is an AI language developed with space and +time efficiencies in mind. +In addition to providing the usual facilities such as +slot-filler objects, demons and associative data bases, +PEARL introduces stronger typing on slots, +user-assisted hashing mechanisms, and a forest of data bases. +The resulting product is a simple but powerful and efficient +tool for AI research. +.AE +.NH +Introduction +.sp 3 +.PP +We have developed an AI language called PEARL (Package for Efficient +Access to Representations in Lisp). +Unlike the recent tendency toward +elaborate representation languages such as KRL [1] +or language generators such as RRL [5], PEARL is +a more modest system that combines a number of useful +AI techniques into a very efficient package. +PEARL provides the user with a set of operators for defining, creating, +and manipulating slot-filler objects, as well as placing them into +associative data bases, upon which further operations may be performed. +Besides the usual goal of providing the user with a more meaningful +interface than is available via Lisp, PEARL has the following salient +characteristics: +.IP 1) +PEARL combines some features of predicate calculus-like data bases with +those of frame-based systems like FRL [9]. +.IP 2) +PEARL introduces typing to user-defined knowledge structures. +.IP 3) +PEARL allows the user to manipulate a forest of associative +data bases implemented as hash tables. +.IP 4) +Fetches from the data base return streams of answers. +Retrieval is based on pattern matching. +.IP 5) +PEARL is very efficient. +PEARL uses its own internal representation +for knowledge structures for both economy of storage and speed. +A great deal of effort has gone into exploiting type information +not available in most AI languages to eliminate searching inefficiencies. +In addition, the user may easily specify, as part of a knowledge +structure definition, a great deal of information about how +objects should be indexed for efficient retrieval. +Thus PEARL provides much of the power +of expression of other AI languages without the usual overhead. +.LP +Perhaps most significantly, PEARL is actually being used in the +construction of several AI systems. +In particular, the latest version of PAM [12], +a story understanding program, has been re-programmed in PEARL. +PANDORA [13], a planning program now under development at Berkeley, +is also written in PEARL. +Our experience has led us to conclude that PEARL +is an effective AI tool for the creation of efficient AI programs. +.sp 3 +.PP +The following is a quick overview of the paper: +First we present an overview of PEARL by discussing a sample session +which demonstrates the primary functions provided. +Next we present some measurements as evidence that PEARL is +indeed efficient. +The bulk of the paper then describes the details of each of PEARL's +main functions -- creating structures, the form of the data bases, +indicating indexing methods, fetching from the data bases, predicates +and matching, matching variables, and demons. +This is followed by descriptions of the various implementations of +PEARL and their relative speeds plus evidence that PEARL's hashing +mechanism does in fact speed up fetching. +Finally, we compare PEARL to its nearest cousins, FRL and KRL. +.NH +An Overview and Sample Application Of PEARL +.sp 3 +.PP +In the section we give an overview of PEARL by presenting an +extended example of PEARL's use. +The example we will use to demonstrate the various features of +PEARL before going into each in more detail is a \fIvery simple\fR +inference mechanism based on forward and backward inferences rules. +In order to explain and motivate the various pieces of PEARL (and +Lisp) code, we present them in the order that one would most likely +design them, rather than the order that they must be entered +into PEARL. Afterwards, they would have to be moved around so +that things are defined before being referenced. +.sp 3 +.PP +To implement the inference mechanism, we will want to ensure that +we perform forward inferences whenever we insert a concept into +the data base and backward inference whenever we fetch a concept +from the data base. The easiest way to accomplish this is to +create two demons, one for forward inference and one for backward +inference which will be run when insert and fetching respectively +happens. These will need to be attached to all concepts which we +want to make inferences from, so we need a \fIstructure\fR (PEARL's +name for a slot/filler object) which we will call \fIConcept\fR. +It will have no slots but will be used as the root of our +conceptual hierarchy so that all concepts can inherit the +inference demons from it. +(We will add these later when we know what their names are). +We do this in PEARL by declaring a \fIbase\fR structure called \fIConcept\fR: +.DS +(create base Concept) +.DE +.sp 3 +.PP +We will then want to describe some of the concepts that we +wish to make inferences about. +For the purposes of this example, we will present only enough +information to use backward inference to determine that Samuel is +probably poor from the fact that he is a professor. +So we will want structures which describe a person, a professor, +a salary level, and being poor. +\fIPerson\fR is an expanded \fIConcept\fR; +that is, it should inherit everything not otherwise specified from +the structure \fIConcept\fR. +It will have one slot (for our current purposes) containing the +person's name which we will represent as a \fIsymbol\fR which is +used in PEARL for creating literals (that it, something with no +conceptual content): +.DS +.Ls +(create \kAexpanded Concept Person + \h'|\nAu'(* Name symbol)) +.Le +.DE +.LP +Included in our definition is a special hashing mark (*) on the +Name slot which says that the value in this slot should be +helpful in indexing \fIPerson\fR structures. +This is true because we are likely to be asking questions of the +data base like "Is Samuel the name of a person?". +For example, suppose we have declared the symbol Samuel: +.DS +(symbol Samuel) +.DE +.LP +and asserted into the data base the fact that there is a person named +\fISamuel\fR by creating an individual instance of a \fIPerson\fR +with the \fIName\fR slot filled with the symbol \fISamuel\fR and +inserting it into the data base: +.DS +.Ls +(insertdb (create \kAindividual Person Sam + \h'|\nAu'(Name Samuel))) +.Le +.DE +.LP +(As a side effect of the above, the individual structure instance +\fI(Person (Name Samuel))\fR is stored in the Lisp atom \fISam\fR +for future use.) +The function \fIinsertdb\fR uses the hashing information we gave +for \fIPerson\fR to insert this structure in the data base in +two places: under the fact that it is a \fIPerson\fR which is +automatic for all structures and under the combination of +\fIPerson\fR and \fISamuel\fR because we bothered to provide +the extra information in our definition of \fIPerson\fR. +.sp 3 +.PP +Now we can "phrase" the question "Is Samuel the name +of a person?" as: +.DS +.Ls +(setq Stream (fetch (create \kAindividual Person + \h'|\nAu'(Name Samuel))) +.Le +.DE +.LP +that is, by creating an individual \fIPerson\fR with name \fISamuel\fR, +and fetching it from the data base. +This returns a hash bucket from the data base which is chosen +based on two parts of our pattern: the fact that it is a +\fIPerson\fR structure (because this is always available) +plus the value in the Name slot (because we labelled this slot +in our definition of \fIPerson\fR. +Given this stream (virtual list) of possible matches, we ask +whether there is in fact something there which matches our pattern: +.DS +(setq Result (nextitem Stream)) +.DE +.LP +If Result is \fInil\fR then the fact that Sam is a Person is not +in the data base. +If it is, then Result will contain the structure in the data base. +.sp 3 +.PP +Similarly, we declare the structure \fIProfessor\fR, +a predicate about a (structure of type) \fIPerson\fR and +assert that Sam is a \fIProfessor\fR using the structure +value we stored in \fISam\fR before: +.DS +.Ls +(create \kAexpanded Concept Professor + \h'|\nAu'(* > Person Person)) +(insertdb (create \kAindividual Professor + \h'|\nAu'(Person Sam))) +.Le +.DE +.sp 3 +.PP +In choosing a way to index this structure, we consider the fact +that Person slot of \fIProfessor\fR will always contain a +\fIPerson\fR structure and thus the combination of \fIProfessor\fR +and \fIPerson\fR will not help to spread these out in our data base. +However, the value of the first marked slot \fIName\fR of Person will +contain widely varying information so the combination of +\fIProfessor\fR and this value will work well. +The hashing mark ">" instructs PEARL to do precisely this. +We also define \fISalary\fR, a relation between an \fIEmployee\fR +and a salary level: +.DS +.Ls +(create \kBexpanded Concept Salary + \h'|\nBu'\kA(* > Employee Person) + \h'|\nAu'( Level symbol)) +.Le +.DE +.LP +Here the first slot is starred because we are likely to ask for +the salary of Sam. +If we were also likely to ask for all people with Low salaries, +then we would star the second slot also. +Finally, we define \fIPoor\fR, a predicate about a \fIPerson\fR: +.DS +.Ls +(create \kAexpanded Concept Poor + \h'|\nAu'(* > Person Person)) +.Le +.DE +.LP +Having defined the types of objects we know about and the few +actual facts we know, we are ready to describe the inference +rules. +Forward rules say that if the value in the Fact slot is true then +the value in the Implies slot is true also. +We are likely to fetch them using Fact as a key, so we mark that +slot as useful in hashing: +.DS +.Ls +(create \kBbase ForwardRule + \h'|\nBu'\kA(* Fact Concept) + \h'|\nAu'( Implies Concept)) +.Le +.DE +.LP +Backward rules say that if you want to know if the value in the Need +slot is true then check to see if the value in the LookFor slot is true: +.DS +.Ls +(create \kBbase BackwardRule + \h'|\nBu'\kA(* Need Concept) + \h'|\nAu'( LookFor Concept)) +.Le +.DE +.LP +Finally, we need to add some rules to our data base. +Since we are likely to know a lot of inference rules and to want +to access them often, it would help to keep them in a different +data base separate from other facts to speed up access. +So we build a special data base just for inference rules: +.DS +(builddb *Rules*) +.DE +.LP +Then we insert some rules into it: +.DS +(symbol Low) +.DE +.DS +.Ls +\fI; If you want to know if someone is poor, check for a low pay level.\fP +(insertdb \kA(create \kBindividual BackwardRule + \h'|\nBu'\kC(Need (Poor (Person ?Person))) + \h'|\nCu'(LookFor (Salary \kB(Employee ?Person) + \h'|\nBu'(Level Low)))) + \h'|\nAu'*Rules*) +.Le +.DE +.DS +.Ls +\fI; If you want to know if someone's pay level is low, check to\fP +\fI; see if they are a professor.\fP +(insertdb \kA(create \kDindividual BackwardRule + \h'|\nDu'\kB(Need (Salary \kC(Employee ?Person) + \h'|\nCu'(Level Low))) + \h'|\nBu'(LookFor (Professor (Person ?Person)))) + \h'|\nAu'*Rules*) +.Le +.DE +.LP +Note in our rules that we use the pattern matching variable \fI?Person\fR. +In the first rule this ties together the person who is poor with the +person whose is paid at a low level. +In the second rule it ties together the person with low pay +to the professor. +Although these two rules have variables with the same name, no +naming conflict arises because most variables in PEARL are local +to the structure they are used in. +.sp 3 +.PP +Next we are in a position to say how to make forward inferences: +.DS +.Ls +\fI; MakeForwardInference is a demon, triggered by insertions into the\fP +\fI; data base, which fetches forward inference rules predicated upon\fP +\fI; the Fact being inserted and inserts the implications from the\fP +\fI; rule into the data base.\fP +(de \kDMakeForwardInference (Fact) + \h'|\nDu'(prog \kC(Rules Rule) + \h'|\nCu'\kB(setq \kDRules + \h'|\nDu'(fetch \kA(create \kCpattern ForwardRule + \h'|\nCu'(Fact Fact)) + \h'|\nAu'*Rules*)) + \h'|\nBu'(while \kA(setq Rule (nextitem Rules)) + \h'|\nAu'(insertdb (path get Rule 'Implies))))) +.Le +.DE +.LP +This says to fetch all forward inference rules with the new fact +in the Fact slot and assert each of their associated Implies slots. +.sp 3 +.PP +Making backward inferences is similar but a bit more complex +because we want it to stop right away if it succeeds: +.DS +.Ls +\fI; MakeBackwardInference is a demon, triggered by fetches from the\fP +\fI; data base which fetches backward inference rules whose Need\fP +\fI; slot contains the Fact being inserted and fetches the value\fP +\fI; of the rule's LookFor slot from the data base until one succeeds.\fP +(de \kBMakeBackwardInference (Fact) + \h'|\nBu'(prog \kA(Rules Rule Found Try) + \h'|\nAu'\kC(setq Rules (fetch \kD(create \kBpattern BackwardRule + \h'|\nBu'(Need Fact)) + \h'|\nDu'*Rules*)) + \h'|\nCu'\kD(setq Found nil) + \h'|\nDu'\kA(while \kB(and \kC(not Found) + \h'|\nCu'(setq Rule (nextitem Rules))) + \h'|\nBu'\kC\fI; Get the LookFor slot's value.\fP + \h'|\nCu'\kB(setq Try (path get Rule 'LookFor)) + \h'|\nBu'(cond (\kC(nextitem (fetch Try)) + \h'|\nCu'\kB(insertdb Fact) + \h'|\nBu'(setq Found t)))) + \h'|\nAu'(return Found))) +.Le +.DE +.LP +Finally, we can finish our description of \fIConcept\fR by saying +that all concepts inserted into the data base should run the demon +MakeForwardInference after the insertion has been performed (">insertdb"). +All concepts fetched from the data base should run MakeBackwardInference +\fIbefore\fR the fetch has been performed ("insertdb MakeForwardInference + \h'|\nAu'\fR. +.NH +How Fast Is PEARL? +.sp 3 +.PP +PEARL achieves its space efficiency and some of its time efficiency +by requesting a block of memory from Lisp for each structure +instance or definition. +The contents or defining information are then packed within +this block. +Since much of the defining information is Boolean, +this provides substantial savings in space for definitions. +Data bases are managed similarly. +.sp 3 +.PP +As a rough measure of PEARL's execution speed on the PDP-10, +we created a test data base of 4000 structures, in which the +average unsuccessful query took 0.0042 CPU seconds (237 per +second) and the average successful query took 0.0073 CPU seconds +(136 per second). +Note that PEARL's hashing mechanism results in particularly fast +determination of failure. +As another measure of PEARL's execution speed, we +compared the original implementation of PAM [12] written purely in Lisp +(with no special consideration for efficiency) +with the current implementation which uses PEARL. +The average time required by the original to process a single +sentence in a 5-sentence story was 5.6 CPU seconds. +The new version, which builds a more complete representation of +the overall structure of the story and uses a significantly +larger collection of knowledge, requires an average of only +0.56 CPU seconds per sentence in a 23-sentence story. +.sp 3 +.PP +For measurements demonstrating the effectiveness of the hashing, +and comparisons between various implementations, see the section +below on performance. +.NH +Objects and Structures +.sp 3 +.PP +PEARL has four basic types: \fIinteger\fR, \fIsymbol\fR, \fIstructure\fR, +and \fIlisp\fR. +Objects of type \fBinteger\fR are the usual numeric type, and objects +of type \fBlisp\fR can be any non-atomic Lisp object. +\fBSymbols\fR (objects of type \fIsymbol\fR) correspond to atoms in Lisp, +and are simply primitive objects with predeclared unique labels. +There is a special built-in symbol \fBnilsym\fR +(corresponding to \fInil\fR when considered as an atom) +which denotes a value of type symbol carrying no special conceptual +information, that is, devoid of meaning. +\fBStructures\fR are collections of slots. +Each slot of a structure +may be filled with an object of one of the four types. +There is also a meta-type for slots, \fBsetof\fR, +which can be applied (recursively) to any basic type to generate a new type, +which will consist of a list of the specified type of objects. +There is a special built-in structure \fBnilstruct\fR respresenting +the standard empty structure (similar to \fInil\fR when considered +as the empty list). +.sp 3 +.PP +Types of structures must be predefined, with the number of slots, and +their names and types specified via a user declaration. +When an instance +of a structure is created and its slots filled, only objects with the +same type as the slot may fill it. +In addition, new structures may +build upon old ones in a hierarchical fashion by specifying new slots +to add to the old ones. +This hierarchy may be used in operations upon the data base. +.sp 3 +.PP +Since the data bases are hash tables (to be described in +more detail later), each symbol and type of structure is assigned +a unique integer at definition time to be used by the hash function +to compute a location in the hash table. +This contributes significantly to the speed of data base operations +in PEARL since it allows the hash function +to be a simple computation based on these numbers rather than +depending on the spelling of the names. +It also helps to prevent +structures with similar names from being hashed in similar ways. +In particular, the unique numbers 0 and 1 are automatically +assigned to \fInilsym\fR and \fInilstruct\fR. +.sp 3 +.PP +For example, symbols are declared as follows: +.DS +\fIpearl>\fB(symbol John Home Here) + \fI(John Home Here)\fR +.DE +.LP +This call to \fIsymbol\fR sets up three unique objects whose print +names are "John", "Home", and "Here" and associates with +them the next three unique integers (2, 3, and 4). +Note that the value returned is a \fIlist of the symbols created\fR, +not a list of Lisp atoms and PEARL's print function prints this +value out as \fI(John Home Here)\fR. +.sp 3 +.PP +The internal structure built by \fIsymbol\fR is a hunk of memory +big enough for two pointers pointing to the name and unique number. +.DS + Internal representat\kaion of the symbol John: + + s:John ---> \h'|\nau'Unique Number \kb---|---> 2 + \h'|\nau'Print Name \h'|\nbu'---|---> John + +.DE +.LP +Although we generally chose to use hunks of memory where possible +to save space (as demonstrated below), this representation +saves no space since it is equivalent to a cons-cell. +However, we chose to build it as a hunk and not a cons-cell since +in this way, PEARL can more easily distinguish it as a symbol +rather than a list cell. +The atom \fIs:John\fR is created with its value +set to the symbol John so that this unique symbol can be +generated at a later time, leaving the atom \fIJohn\fR available for +use by the user. +.sp 3 +.PP +New types of structures and instances of previously defined +types of structures are all created with the function \fBcreate\fR. +The statement +.DS +\fIpearl>\fB(create base Act + (Actor symbol) ) + \fI(Act (Actor nilsym))\fR +.DE +.LP +will define the primitive type \fIAct\fR with one slot named +\fIActor\fR and containing any single object of type symbol. +At the same time, \fIcreate\fR produces and returns an individual +instance known as the \fBdefault-instance\fR which contains the +standard default values for each slot. +PEARL also provides a +mechanism for changing these default values at definition time. +In this case, the slot Actor contains the default symbol \fInilsym\fR. +The other defaults are \fInilstruct\fR for structures, zero for integers +and \fInil\fR for slots of type \fIlisp\fR or \fIsetof\fR. +Again, the object returned by \fIcreate\fR is an internally represented +structure, not a list. +The representation of the definition and default-instance structures +internally as hunks of memory is as follows: +.DS +\klStructure definition for\km Act Default-instance for Act + + \h'|\nmu' <--------\kn| +\h'|\nlu'Unique Number \h'|\nmu'---|---> 5 \h'|\nnu'|----|---\koDefinition +\h'|\nlu'Length \h'|\nmu'---|---> 1 \h'|\nou'Var-List \kp---|---> nil +\h'|\nlu'Default Instance\h'|\nmu'---|---------->\h'|\nou'Var-List Copy \h'|\npu'---|---> nil +\h'|\nlu'Isa \h'|\nmu'---|---> nil +\h'|\nlu'Print Name \h'|\nmu'---|---> Act \h'|\nou'Value or Var Name \h'|\npu'---|---> nilsym +\h'|\nlu'Hash Alias \h'|\nmu'---|---> 0 \h'|\nou'Var-Value Pair \h'|\npu'---|---> nil +\h'|\nlu'Expansion List \h'|\nmu'---|---> nil \h'|\nou'Predicate List \h'|\npu'---|---> nil +\h'|\nlu'Base Ifs \h'|\nmu'---|---> nil \h'|\nou'Slot If List \h'|\npu'---|---> nil + +\h'|\nlu'Hash Information\h'|\nmu'---|---> 0 \h'|\nou' ^ +\h'|\nlu'Type Number \h'|\nmu'---|---> 0 \h'|\nou' | +\h'|\nlu'Slot Print Name\h'|\nmu'---|---> Actor \h'|\nou'i:Act +\h'|\nlu'PP Set Info \h'|\nmu'---|---> nil + \h'|\nmu' ^ + \h'|\nmu' | + \h'|\nmu'd:Act +.DE +.LP +There are many values in the above structure which are not yet +important to our discussion and which will be explained later. +The key values so far in the definition information are the unique +number, length of the structure (number of slots), the default +instance, and the print names of the structure itself and of its slot(s). +In the default instance note that a pointer to the definition is +kept in each instance to allow quick access to the unique number, +and other information during hashing and matching. +This means that the only time that a definition must be +accessed through its special atom (\fId:Act\fR in this case) +is when a new instance is created. +.sp 3 +.PP +The most important feature of this representation however, is the +speed gained by the use of hunks. +In order to represent this +information as an S-expression, we would need one cons-cell (space +for two pointers) per piece of information with half of this space +wasted on the pointer to the next cons-cell. +Accessing a particular piece of information would require +\fIcdr\fRing down the list an appropriate number of times +which is potentially quite slow with a larger number of slots. +Also, since this definition information is pointed to by all +instances, the uniqueness of at least its header +cell must be maintained requiring some extra effort on the +part of the programmer in Lisp. +However, given the cost of a cons-cell in terms of garbage +collection time, it would be best to maintain the uniqueness +of all of its parts. +.sp 3 +.PP +By using a hunk, we can +.IP 1) +easily guarantee the uniqueness of a definition or instance, +.IP 2) +save the space used by list pointers, thus using half the space, +.IP 3) +use no new cons-cells after a structure is created, +.IP 4) +access any piece of a structure in constant time +(essentially two adds and a multiply at the worst), and +.IP 5) +compile all access operations relatively efficiently. +.LP +Thus, the use of hunks rather than lists contributes significantly +to the speed of PEARL. +.sp 3 +.PP +Once we have defined the \fIbase\fR structure Act, +we can define more specific forms of Acts in terms of +it, using the \fBexpanded\fR argument to \fIcreate\fR in +place of \fIbase\fR: +.DS +\fIpearl>\fB(create expanded Act Trans + (From symbol) + (To symbol)) + \fI(Trans (Actor nilsym) + (From nilsym) + (To nilsym))\fR +.DE +.LP +Here, we are declaring that Transes (transfers) are Acts with +two additional slots for the initial location From and the final +location To which are both symbols. +In addition to the information +diagrammed above, the structure definitions for Act and Trans are now +connected via their Isa and Expansion List fields (that is, the Isa +field of Trans points to Act and Trans is an element of the +Expansion List field of Act. +In this way, a complete tree of the +concept hierarchy rooted at a base structure is accessible from any +element in that hierarchy. +.sp 3 +.PP +This hierarchy can be expanded to any depth. +Thus, we can now further +differentiate between various kinds of transfers, defining mental +transfers (MTrans) and physical transfers (PTrans). +In MTrans, the +mental object MObject slot will contain another concept and is thus +of type structure: +.DS +\fIpearl>\fB(create expanded Trans MTrans + (MObject struct)) + \fI(MTrans (Actor nilsym) + (From nilsym) + (To nilsym) + (MObject (nilstruct)))\fR +.DE +.DS +\fIpearl>\fB(create expanded Trans PTrans + (From Here) + (Object symbol)) + \fI(PTrans (Actor nilsym) + (From Here) + (To nilsym) + (Object nilsym))\fR +.DE +.LP +Slots which are not filled by the user when creating +an individual are filled in automatically with the default value +from the default instance. +Note in the definition of PTrans that we give the +default value of \fIHere\fR for the previously defined slot +\fIFrom\fR by simply including the slot and its new value. +This means that whenever we create an \fIindividual\fR instance +of PTrans but do not specify a value for the From slot, it will +be filled in with the value Here: +.DS +\fIpearl>\fB(create individual PTrans + (Actor John) + (Object John) + (To Home)) +\fI(PTrans (Actor John) + (From Here) + (To Home) + (Object John))\fR +.DE +.LP +This last structure denotes "John went home (from here)" in Schank's +Conceptual Dependency [11] theory of representation. +These representations are used in the rest of the paper simply +as an example of PEARL's use. +However, PEARL makes no commitment to any +particular set of predicates or primitives and can be used equally +well with any type of slot-filler structure. +.sp 3 +.PP +Slots within a structure may also be filled with a +pattern-matching variable, in which case the structure may +be viewed as a pattern. +The simplest form of pattern is one in which any unspecified +slots are filled with the \fImatch-anything\fR variable \fI?*any*\fR. +For example, a pattern matching any PTranses performed by John +could be defined as follows: +.DS +\fIpearl>\fB(create pattern PTrans + (Actor John)) +\fI(PTrans (Actor John) + (From ?*any*) + (To ?*any*) + (Object ?*any*))\fR +.DE +.LP +However, \fBany\fR individual PEARL structure, including one with +all of its slots filled with actual values, can be used as a +pattern. +Thus, the first individual PTrans created above is +a pattern which matches only instances of John Ptransing home +from Here. +The sole purpose of using the \fIpattern\fR option to +\fIcreate\fR rather than \fIindividual\fR is +to change the default value for all types of slots to \fI?*any*\fR. +Variables are indicated by preceding them with a question mark +as in ?X for the variable X and, other than \fI?*any*\fR, they are +bound as part of the matching process (usually during a +fetch from the data base) which is discussed further below. +PEARL also provides functions for accessing and changing the +values of slots within individual structures +and for automatically naming the structure created. +.sp 3 +.PP +Variables come in two other flavors in PEARL and are discussed in more +detail in the sections on matching and variables. +.NH +Data Base Facilities +.sp 3 +.PP +PEARL allows for a forest of associative data bases +into which structures may be placed, and later fetched +via structure patterns. +Since many AI programs spend a significant part of their time +searching for knowledge in growing data bases, this needs to +be as efficient as possible. +.sp 3 +.PP +Hashing is the usual programming solution to accessing a particular +element from within a large set. +However, traditionally, hashing has two prerequisites that are seldom +easy for an AI programmer to meet: +.IP 1) +The hash function must be carefully chosen in +advance to do a good job of spreading out the items to be inserted +with a minimum of computation. +In traditional applications of hash tables, this meant finding +a function which converts a (set of) string(s) into an index. +.IP 2) +Only completely specified items can be searched for. +That is, one may +not ask of a hash table "Find the closest one to X". +.LP +Unfortunately, since the knowledge structures used in AI are +much more complex than simple strings, finding a good hash +function is very difficult. +Also, in AI programming, normal hashing would only handle fetching +a particular fact from the data base, which would make the fetching +mean "Is this (completely specified) fact true?" +But it is much more likely that what is wanted is the (set of) thing(s) +which match a much more general pattern. +.sp 3 +.PP +For these reasons, hashing in the normal sense is +inappropriate for AI data bases. +As a result, the traditional solution to the need for efficient +indexing into an AI data base is the discrimination net. +Or, in some cases, the data base is reduced to a linear list with +its inefficiency ignored (or tolerated). +With a discrimination net, the user often must carefully determine +the structure of the net and the nature of the tests to be made at +each level. +This is necessary to reduce the breadth of the net at each level, +since a discrimination net usually implies a linear search through +the possible values at each branch point. +As the knowledge changes, the representation hierarchy must change +to avoid this breadth problem, drawing the programmer away from the +problem at hand into worrying about indexing every step of the way +and forcing the representation into unnatural distinctions. +Generalized pattern matching is also difficult, making questions +like "What in the data base is close to X?" hard to ask. +.sp 3 +.PP +Thus, a common problem with most AI data base implementations +is the system's lack of knowledge about how best to automatically +organize information for efficient and flexible retrieval. +The user usually has such knowledge, but needs to be able to provide +it in an easy way. +Moreover, if possible, this knowledge should be used to build a +hash table with its attendant speed, rather than a discrimination net. +The system must then provide a hash function which is +flexible enough to handle a large range of objects. +Such a hash table must also be organized in such a way that items may +be found which match a general pattern. +.sp 3 +.PP +PEARL provides such a hash table and hash function, designed in such a +way that the user gets a significant speed up with only the effort +required to define objects as already been described above. +In addition, PEARL encourages the user to provide as much extra +knowledge as possible when a structure type is defined. +The choice of a particular structure hierarchy does not affect the +efficiency of the hashing so the representations are not twisted +to achieve efficiency. +Since the purpose of a hash function is to scatter +similar items, the required information consists of +indicating those slots whose values are most likely +to distinguish two similar structures. +.sp 3 +.PP +This information is provided in the form of labels on +these slots in the definition of the structure. +Since only symbols and structures are assigned a unique integer at +definition time, slots of type \fIsymbol\fR, \fIstructure\fR +and \fIinteger\fR may contain such hashing information but slots +of type \fIlisp\fR may not. +These labels specify ways in which the unique number of the item being +hashed may be combined with the unique numbers associated with the +values of the labelled slots to provide a set of one, two, or three +numbers to be combined into an index into the hash table. +The particular ways of specifying these slots and the +ways of grouping them is described below, +but first we describe the form of a single data base and +the organization of a forest of data bases. +.sp 3 +.PP +Each data base is implemented as a pair of hash tables in which +each bucket is a list of the objects hashing to that spot. +The possible sizes of the data bases are chosen from the set of primes +which are just barely smaller than the powers of two, +(that is, 1, 3, 7, 13, 29, 61, 127, ...). +The two hash tables are chosen to be off by a factor of four, +(that is, 1+7, 3+13, ... 29+127, ...). +The two data bases are chosen to be of different sizes because +it was hard to find a hash function to provide a good spread +in a large table for single small integers like the unique numbers +associated with structures. +The currently-used hash functions can be described as follows: +.DS +Let Size1 and Size2 be the sizes of the two hash tables. +Then the hash functions are: + + For indexes based on one number X: + X mod Size1 + For indexes based on two numbers X and Y: + (4096 * Y + X ) mod Size2 + For indexes based on three numbers X, Y and Z: + ( (4096 * 4096 * Z) + (4096 * Y) + X ) mod Size2 +.DE +.LP +Thus the smaller of the two hash tables is used to enter +items indexed under only one unique number. +The larger is used for items indexed under combinations of +two or three numbers. +The sizes for hash tables can be chosen by the user to match the +number and variety of objects, the number of data bases being used +and the size of their machine's memory. +.sp 3 +.PP +In order to allow flexible fetching using a pattern which is only +partly specified, and since the place we look must be determined based +upon the information that \fIis\fR provided in the pattern, +an item must be placed everywhere we are likely to be able to +look for it. +Thus, PEARL will index all individual instances of a structure type +which are inserted into the data base +under as many different hashing strategies as it can, +using the information provided by the user in the +definition of that type of structure. +Then to fetch with a particular pattern, PEARL need only use one of +the hashing strategies which uses slots from the pattern whose +values are considered hashable. +.sp 3 +.PP +Whether there is hashing information or not, all individuals are +indexed in the smaller data base under (the unique integer +assigned to) their structure type. +Thus, with no effort, the user automatically gets one level +of distinction which provides a significant improvement +in efficiency over the often-used linked list. +This minimal use of hashing in PEARL is also an +improvement over discrimination nets since nets usually +imply a linear search through the possible values at each +branch point of the net instead of random access. +Of course, if the number of types of structures is +larger than the size of the data base, then after this random access, +there is still potentially a list of items to be searched linearly. +.sp 3 +.PP +At this point, the speed with which the matching process +eliminates structures of the wrong type becomes important. +But the easily available unique number in each item provides a quick +test to eliminate items of the wrong type. +(For a complete description of the matching process, see the section on +predicates and matching.) +.sp 3 +.PP +However, no amount of speed-up of the matching process can help as +much as a greater degree of discrimination by the hash function. +So to improve upon this automatic type of hashing, PEARL +needs to know which slots or collections of slots of a structure +are likely to help split up objects of the same type. +We will now describe each of the available hashing methods and the +circumstances in which you would want to use them. +.sp 3 +.PP +The simplest case of adding hashing information is to label slots +whose values, in combination with the type of structure, would provide +a good distinction. +To indicate that a particular slot is useful in this way, +the user puts an asterisk (*) in that slot in the declaration. +Thus +.DS +\fIpearl>\fB(create base PlanFor + (* Goal struct) + ( Plan struct)) +\fI(PlanFor (Goal (nilstruct)) + (Plan (nilstruct)))\fR +.DE +.LP +defines a type PlanFor with slots for a goal and a plan, and indicates that +PlanFors should be indexed to be retrieved by the content of +their Goal slot plus the fact that they are PlanFors. +PEARL then uses the unique integers associated with the PlanFor +type and with whatever type of value is in the Goal slot. +.sp 3 +.PP +Since the object filling the Goal slot of a PlanFor will always be +a structure of type Goal, using an asterisk in the Goal slot will not +actually distinguish PlanFors from one another. +In this case, we may +also wish to specify that the value that fills the Goal slot is to be +used to in a slightly different way to create the index. +For example, if the Objective of the Goal +is deemed more significant for such purposes than the fact that it +is a Goal, we can indicate this as follows: +.DS +\fIpearl>\fB(create base Goal + ( Planner symbol) + (& Objective struct)) +\fI(Goal (Planner nilsym) + (Objective (nilstruct)))\fR +.DE +.LP +This will inform PEARL that structures that indexing on slots +in other structures which are filled with Goal-type structures +should instead use the Objective slot for further discriminations. +Thus, Goals change the way in which other structures use them to +index but the way in which Goals themselves are indexed +will not be affected. +This hash labelling of Goal is called \fBhash aliasing\fR and +will cause all PlanFors to be indexed +under the number for the PlanFor type plus the number for the type of value in +the Objective slot of the Goal, and thus all PlanFor's for Goals for a +particular type of Objective will be indexed in the same bucket. +As a short hand, the phrase "indexed under the number for the PlanFor +type plus the number for the type of value in the Objective slot of +Goal" is abbreviated as "PlanFor + Objective(Goal)" +.sp 3 +.PP +It might be the case that PlanFor was the only structure +indexed based on Goals which would benefit from this and that +some structures would actually be hurt by this because they +expected Goals to be only one of many types of values. +In this case, putting the control of how Goals get used by +other structures into the definition of Goal is a bad idea. +Instead, the control can be moved up into only the +problematic structures. +These structures can simply add the ">" hash label to +a starred slot, causing PEARL to use the first starred slot of +the slot-filling structure instead of its type. +.DS +\fIpearl>\fB(create base Goal + (Planner symbol) + (* Objective struct)) +\fI(Goal (Planner nilsym) + (Objective (nilstruct)))\fR +.DE +.DS +\fIpearl>\fB(create base PlanFor + (* > Goal struct) + (Plan struct)) +\fI(PlanFor (Goal (nilstruct)) + (Plan (nilstruct)))\fR +.DE +.LP +If the user wanted to also star the Planner slot of Goal, +but wanted the Objective slot to be used in cases where the +containing structure had a ">", +then the use of an "^" on the Objective slot will allow that: +.DS +\fIpearl>\fB(create base Goal + (* Planner symbol) + (* ^ Objective struct)) +\fI(Goal (Planner nilsym) + (Objective (nilstruct)))\fR +.DE +.LP +thus allowing Goals inserted directly into the data base to be +indexed by the combinations (Goal + Planner(Goal)) and +(Goal + Objective(Goal)) while objects containing Goals would +use the Objective slot rather than Goal (Object + Objective(Goal)). +If most structures containing Goals would benefit from the use of +the hash aliasing label & in Goal, but only one or two are hurt by it, +the use of "&" in Goal can be overridden by the structures +which will contain Goals by adding the "<" hash label to the starred +slot, thus giving the controlling structure the last word over how +it is hashed. +.DS +\fIpearl>\fB(create base Goal + ( Planner symbol) + (& Objective struct)) +\fI(Goal (Planner nilsym) + (Objective (nilstruct)))\fR +.DE +.DS +\fIpearl>\fB(create base OffendedStructure + (* < Slot struct)) +\fI(OffendedStructure (Slot nilstruct)))\fR +.DE +.sp 3 +.PP +The above methods are all designed to allow the indexing of a +structure to be based upon the type of structure and the type of the +value of one slot. +There are sometimes cases where one slot is not +enough to distinguish items sufficiently but two slots would do a much +better job. +For example, a program which dealt with a large number of +Goals of several planners might want to be able to ask whether a +particular planner had a particular objective. +Putting an asterisk in each of the slots of Goal would allow +hashing by one or the other, but it would be even faster to use the +fact it was a Goal, plus the values of both the Planner and Objective +slots. +Labelling this pair of slots with "**" causes their values +plus the structure type to be combined into an index. +.DS +\fIpearl>\fB(create base Goal + (* ** Planner symbol) + (* ** Objective struct) ) +\fI(Goal (Planner nilsym) + (Objective (nilstruct) ) )\fR +.DE +.LP +This is also useful whenever the range of types of values in +each slot is limited but the combinations of the two +have a wider range. +.sp 3 +.PP +On the other hand, it may sometimes be useful to know all +structures containing a particular type of value in any prominent +slots. +Thus for example, if a program has many kinds of structures all +containing references to individual planners, it might be useful +to be able to efficiently ask the question "What do I know about +John?". +In this case, the use of a ":" hash label on those slots of relevant +structures which contain Planners causes all those +structure to be indexed by that slot's value only, without +regard to the structure type. +This would result in some bucket in the smaller data base to contain +all structures which refer to John in such a labelled slot, +because they would all be indexed under that single value. +Note that this is similar to the "&" type of hashing, +but affects the structure itself instead of containing structures. +.sp 3 +.PP +Finally, there is a hash labelling which is the combination +of these last two ideas. +It may sometimes be useful to know all structures containing a two +particular types of values in prominent slots. +Thus for example, if a program has many kinds of acts and states +all containing references to individual person/object and the time +of occurrence, it might be useful to be able to efficiently ask +the question "What did John do at 8 o'clock?". +Thus, the use of a single pair of slots (in each structure) labelled +with "::" causes the value of those two slots to be combined +into an index. +.DS +\fIpearl>\fB(create base Act + (:: Actor struct) + (:: Time int) ) +\fI(Act (Actor (nilstruct)) + (Time 0) )\fR +\fIpearl>\fB(create base State + (:: Object struct) + (:: Time int) ) +\fI(State (Object (nilstruct)) + (Time 0) )\fR +.DE +In this case, all states of John or acts by John would be indexed +under John plus the time, thus ending up in the same hash bucket. +.sp 3 +.PP +The hashing mechanism was designed to give the user benefit in +proportion to the effort expended in determining hash labels. +With no effort, the structure type provides some help. +With the addition of each label or pair of labels, +an item to be inserted into the data base is indexed into +another location in the hash table. +Thus the cost of extra labels is simply the time to find +another hash bucket (a few adds and multiplies), and add +the item to the front of the list implying the time and +space incurred by one cons-cell. +The benefit at fetching time is the ability to use this +extra information to narrow in on a small subset of +the items in the data base which are most likely to +be what is desired. +.sp 3 +.PP +It is often the case that a program needs to build several +data bases where one or more are extensions of another. +For example, consider a planner which is trying to choose +between two alternative plans. +One way to do this is to simulate carrying each one out to +determine its likely effects (good or bad) to help in the +decision. +Thus the program might want to build a data base for each +into which it could assert the various facts determined by +the simulation. +Both of these new data bases would be considered extensions of the +usual data base with the added feature that anything stored in +them was simply expected to be true in the future. +Thus, after the simulation, it might be desireable to delete the +data base of the plan not chosen and the program would certainly +not want to assert the effects of the simulation into its regular +data base since they are not in fact true. +.PP +PEARL provides both these abilities by providing facilities for +building a forest of data bases. +The regular data base which is built automatically is called +\fI*maindb*\fR. +To build two extensions from this, one uses the function +\fIbuilddb\fR: to build a tree of data bases: +.DS +\fIpearl>\fB(builddb Test1 *maindb*) +\fI(database: Test1)\fR +\fIpearl>\fB(builddb Test2 *maindb*) +\fI(database: Test2)\fR +.DE +.LP +We can then assert various facts from the simulation into each of +these new data bases. +If we subsequently fetch from Test1, we will get back all facts +which were asserted into either \fITest1 \fBor \fI*maindb*\fR. +When we have decided which to use, we can then free up the one +that is no longer needed. +.NH +Fetching +.sp 3 +.PP +To fetch an object from a data base, the user invokes the +fetcher with a structure to be used as a pattern. +For efficiency, +PEARL tries to narrow down the possible choices without +actually matching this pattern against any knowledge in the +data base. +Thus, narrowing down the possibilities and avoiding +matching as long has possible are the two driving goals of the +fetching algorithm. +In order to narrow down the choices, +information in the pattern is examined to determine +which of the hashing indices is most likely to narrow +down the choices. +This determination is made based on the ways in which PEARL has been +instructed to hash structures of the same type as the pattern and also +based on which slots of the pattern actually have a useful value for +hashing. +\fINilsym\fR, \fInilstruct\fR, \fInil\fR and \fIunbound\fR values +are not considered useful. +Given the values which are considered useful and the hashing +information for the type of structure, the hierarchy of buckets to be +chosen is as follows: +.DS +** hashing +:: hashing +* hashing +: hashing +.DE +.LP +All the other hashing labels are modifiers on these four +methods and affect what values are used to compute the index. +.sp 3 +.PP +The resulting hash index is used to choose a bucket from the hash +table which is returned to the user as a result stream. +No matching between the pattern and objects +in the data base occurs at this point and the +stream simply contains pointers to all data base items +in the same hash bucket, regardless of whether they actually +match the pattern. +PEARL appends the pattern to the front of this +stream for subsequent use. +For example, to fetch all PlanFors involving Goals whose Objective +is a PTrans, we create a pattern for this type of object: +.DS +\fIpearl>\fB(setq PTransGoals (create pattern PlanFor + (Goal (Goal (Objective (PTrans)))) + (Plan ?Plan))) +\fI(PlanFor (Goal (Goal (Planner ?*any*) + (Objective (PTrans (Actor ?*any*) + (Object ?*any*) + (From ?*any*) + (To ?*any*))))) + (Plan ?Plan))\fR +.DE +.LP +and then call the function \fBfetch\fR with this pattern as an +argument: +.DS +(setq PTransGoalStream (fetch PTransGoals)) +.DE +.sp 3 +.PP +The user may then extract items from +the stream one at a time by successive requests to \fBnextitem\fR: +.DS +(setq Result (nextitem PTransGoalStream)) +.DE +.LP +At each request, the pattern is matched against successive +items from the hash bucket until one matches, +in which case it is returned, +or until the potential items run out, +in which case \fInil\fR is returned. +.NH +Predicates and Matching +.sp 3 +.PP +Predicates may also be attached to a slot specifying constraints on +the values of pattern-matching variables. +Each time a match is made between the slots of two structures +(described in detail below), the predicates of each slot are run to +determine whether the match should succeed or fail. +Two types of predicates are provided by PEARL. +The first type are Lisp functions or expressions to be evaluated. +If a predicate is simply the name of a function, that function is +applied to the slot value from the opposing structure. +If it is an S-expression, it is processed for special forms +which indicate where to get the arguments and then evaluated. +For example, the following pattern will require that the variable in +its first slot be bound to a positive integer value with the predicate +\fIplusp\fR. +It also requires that the variable in its third slot be bound +to a value which is a member of its second slot (\fB"*"\fR refers +to the value in the current slot of the opposing structure and +\fI"=Two"\fR refers to the value in the slot named Two of the +opposing structure): +.DS +\fIpearl>\fB(create individual Example + (One ?One plusp) + (Two ?*any*) + (Three ?Three (member * =Two) ) ) +\fI(Example (One ?One) + (Two ?*any*) + (Three ?Three) )\fR +.DE +.sp 3 +.PP +The second type of predicate is called a \fBstructure predicate\fR and +consists of the name of a structure type. +Its effect is to restrict the value in a structure slot to being a +structure of the specified type. +Thus another way to restrict the value of the Objective of the Goal in +the Goal slot of the PlanFor which was fetched above, is to put a variable +in the slot and add a PTrans predicate: +.DS +\fIpearl>\fB(setq PTransGoals (create pattern PlanFor + (Goal (Goal (Objective ?O PTrans))) + (Plan ?Plan))) +\fI(PlanFor (Goal (Goal (Planner ?*any*) + (Objective ?O))) + (Plan ?Plan))\fR +.DE +.LP +The effect is the same but testing the type of the value is much more +efficient than doing the matching process on the two PTranses slot by +slot. +.sp 3 +.PP +For efficiency, the semantics of the matching have been +constrained to avoid the usual variable naming problems. +Two structures match if they can be unified. +However, no attempt is made to detect circularities, +nor are variables ever bound to other variables. +Circularities have never actually occurred in our experience and +most variables are local to the pattern they appear in, +so naming conflicts do not arise. +Of course it would be straightforward to add checks for +these problems if one was willing to incur the expense. +.sp 3 +.PP +The variables in a structure are implemented as an assoc-list attached +to the structure so that a list of the variables of a structure can be +located quickly. +However, \fIassoc\fR is only used for external lookup of a variable. +Once the structure has been created, each slot containing a variable +has a pointer to the special cons-cell associated with it in the +assoc-list so that it has immediate access to its value. +In particular, the name of the variable is not even accessed during +the matching process, since its value is all that is needed. +.sp 3 +.PP +In general, the matching procedure takes two structures +which each may contain variables. +If the structures are not definitionally the same type +then the match fails automatically. +This quickly eliminates items which happen to hash to the same slot. +Otherwise, each structure is viewed as a sequence of slots +which are successively matched between the two structures. +Two structures of the same type match if and only if each of their +slots matches the corresponding slot of the other structure. +Each slot is filled in one of three ways: +.IP 1) +The slot may contain an actual value of its type (for example, +a slot of type \fIstructure\fR may contain a PTrans). +.IP 2) +The slot may contain a user-defined variable. +.IP 3) +The slot may contain the special match-anything variable \fI?*any*\fR. +.LP +If the slot contains a variable (other than \fI?*any*\fR) which has not +been bound then it may become bound as a side effect of the +matching process. +Once a variable is bound to a real value during the +matching process, for the purposes of matching, it will +be treated as if the slot were filled with that value. +.sp 3 +.PP +We now examine each of the pairings of slot values which may +occur and how they are matched. +If either of the two slots being matched contains the special +variable \fI?*any*\fR, then the slots match by definition, +regardless of the contents of the other slot. +If both slots contain variables that are unbound, the slots do not +match. +(This is true even if the two variables are textually +the same name, since they are each considered local to their +particular structures.) +If one slot contains an unbound variable (and the other +a bound variable or a value), then any predicates on the +slot with the unbound variable are tested to see if the +unbound variable should be bound to the bound value. +If so, then the unbound variable is bound to the value +of the other slot, and the two slots match. +If any of the predicates return \fInil\fR, the two slots do not +match, the variable is not bound, and the entire match fails. +.sp 3 +.PP +If both slots contain either bound variables or values, +then the values of the two slots are compared. +If the slot is of type \fIstructure\fR, then the entire matching +algorithm is recursively applied. +If the slot is of types \fIinteger\fR or \fIlisp\fR, then \fIequal\fR is used. +If the type is \fIsymbol\fR, than the two values must be the same symbol. +Regardless of the type, any predicates associated with the +slot are run and all must succeed. +.sp 3 +.PP +For example, if we create two structures, one representing Sam +and one with a variable in the \fIName\fR slot: +.DS +\fIpearl>\fB(create individual Person Sam + (Name Samuel)) +\fI(Person (Name Samuel))\fR +\fIpearl>\fB(create individual Person PersonPattern + (Name ?FirstName)) +\fI(Person (Name ?FirstName))\fR +.DE +.LP +then match them and look at the result in \fIPersonPattern\fR: +.DS +\fIpearl>\fB(match Sam PersonPattern) +\fIt\fR +\fIpearl>\fBPersonPattern +\fI(Person (Name ?FirstName = Samuel))\fR +.DE +.LP +we find that they do match and the variable \fI?FirstName\fR in +\fIPersonPattern\fR has been bound to the symbol \fISamuel\fR. +.PP +We now take a slightly more complicated example. +In PEARL's matching algorithm there is no sense that one of its +arguments is the pattern and one the thing to be matched to, so +both may have variables. +As long as the variables are in different slots so that \fImatch\fR +will never try to match two unbound variables to each other, the +matching will work fine. +Thus, if we want our backward inference mechanism from the extended +example in section 2 to not only tell us \fIthat\fR Sam has a low +salary but in fact \fIwhat level\fR of salary he had, we could +fetch the following structure: +.DS +.Ls +(create \kBindividual Salary SamsSalary + \h'|\nBu'\kA(Employee Sam) + \h'|\nAu'(Level ?Level)) +.Le +.DE +.LP +This would result in the backward inference demon using the +following pattern to fetch rules that might tell it about +finding a person's salary: +.DS +\fIpearl> \fB(create pattern BackwardRule Wanted + (Need (Salary (Employee Sam) + (Level ?Level)))) +\fI(BackwardRule (Need (Salary (Employee (Person (Name Sam))) + (Level ?Level))) + (LookFor ?*any*))\fR +.DE +.LP +In processing the resulting stream, the matcher would be called +upon to match the above pattern \fIWanted\fR to the following +rule (which is in the data base but which we recreate for +this example): +.DS +\fIpearl> \fB(create individual BackwardRule Known + (Need (Salary (Employee ?Person) + (Level Low))) + (LookFor (Professor (Person ?Person)))) +\fI(BackwardRule (Need (Salary (Employee ?Person) + (Level Low))) + (LookFor (Professor (Person ?Person))))\fR +.DE +Matching these will succeed and in the process the variables +\fI?Level\fR in \fIWanted\fR and \fI?Person\fR in \fIKnown\fR +will be bound: +.DS +\fIpearl> \fB(match Wanted Known) + \fIt\fR +\fIpearl> \fBWanted +\fI(BackwardRule (Need (Salary (Employee (Person (Name Sam))) + (Level ?Level = Low))) + (LookFor ?*any*))\fR +\fIpearl> \fBKnown +\fI(BackwardRule (Need (Salary (Employee ?Person = (Person (Name Sam))) + (Level Low))) + (LookFor (Professor (Person ?Person + = (Person (Name Sam))))))\fR +.DE +.NH +Variables +.sp 3 +.PP +There are three types of pattern matching variables in PEARL. +Global variables (which are just Lisp variables) must be declared +and are never unbound by PEARL. +All undeclared variables are local to the individual structure in +which they are mentioned. +Local variables are dummy variables, local to a particular +structure and any of its components which were created +in the same instant. +They are all unbound by PEARL before every match on that structure. +The examples given of variables in the previous section were of local +variables which require no declaration. +The third, intermediate, type of variable provides lexical +scoping within groups of structures. +Lexically scoped variables are like local variables in that they +are unbound by PEARL before a match is made, but have their +scope extended across several structures as indicated by the user. +.sp 3 +.PP +Consider the following examples of the three types of variables. +For our first example, suppose that in a data base representing the +planning knowledge of a particular person is an Ego structure which +records the identity of that person. +The program wishes to determine this and to remember it in a variable +called Planner. +Planner is declared to be global and then used to fetch the +appropriate knowledge structure from the data base: +.DS +.Ls +(global Planner) +(nextitem (fetch (create \kAindividual Ego + \h'|\nAu'(Identity ?Planner)))) +.Le +.DE +.LP +At this point, the Lisp atom Planner is bound to the +identity of the planner. +We can now ask for all PTranses in the data base involving the planner +as the Actor and Object: +.DS +.Ls +(setq Pat (create \kBindividual Ptrans + \h'|\nBu'\kA(Actor ?Planner) + \h'|\nAu'\kB(Object ?Planner) + \h'|\nBu'\kA(From ?Start) + \h'|\nAu'(To ?Dest))) +(setq Stream (fetch Pat)) +.Le +.DE +.LP +At this point the pattern in Pat has two local variables, +\fI?Start\fR and \fI?Dest\fR which will be unbound before each match and +may be bound to a new value during each match. +\fI?Planner\fR on the other hand is global and will continue to have the +value it received during the original fetch it was used in. +.sp 3 +.PP +With a global variable, a group of structures are allowed to share a +variable whose value is constant once it is set the first time. +Furthermore, all structures are thereafter required to share this same +variable and are precluded from having their own variable with the +same name. +However, it is sometimes useful to group a set of structures together +via a set of variables which we wish to behave like local variables in +every other way. +Furthermore we might wish to have several such groups which can each +have a variable with this same name. +For example, a body of PEARL structures conceptually composing a +single frame should be made to share the same variables but it should +be possible to have several instances of such a frame with the same +variable names tying each group together without interfering with the +others. +Each instance of this group of variables is then local to that frame. +However, the results of matching any particular component +of the frame will be detectable in the variables associated +with the other components. +This is done in PEARL by dynamically declaring a scope with local +variables which are imposed upon all structures created until that +scope is closed. +For example, consider the following sequence: +.DS +.Ls +(block Plan1 (Planner Goal)) +(create \kBindividual PlanFor + \h'|\nBu'\kA(Goal ?Goal) + \h'|\nAu'(Plan ?Plan)) +(create \kBindividual Goal + \h'|\nBu'\kA(Planner ?Planner) + \h'|\nAu'(Objective ?Objective)) +(create \kAindividual Plan + \h'|\nAu'\kB(Planner ?Planner) + \h'|\nBu'\kA(Goal ?Goal) + \h'|\nAu'(Steps ?Steps)) +(endblock Plan1) +.Le +.DE +.LP +This sequence creates three structures which are intimately tied +together via the variables \fI?Planner\fR and \fI?Goal\fR which +are declared in the enclosing block. +After this code executes, if any of the structures is fetched from +the data base, any binding of these two variables would have an +immediate effect in all of them. +In addition, the values of these variables are available simply by +knowing the name of the block, so that one can ask for the value of +the Planner variable in Plan1 directly. +However, now that the block has been closed, other structures are +free to have variables with the same names. +.NH +Demons +.sp 3 +.PP +A common AI mechanism provided by AI languages is one of +"if-added" functions or demons. +PEARL has a general ability to attach functions called \fIhooks\fR +to base structures (\fIbase hooks\fR) or to slots of individual +structures (\fIslot hooks\fR). +Base hooks are run whenever the particular PEARL function that the +hook is labelled with accesses an individual of that type. +Slot hooks are put into individual and are run whenever the particular +PEARL function that the hook is labelled with accesses that slot +of the individual. +In order to allow these hooks to tailor the operation of the +various PEARL functions on particular structures or types of +structures, these demons may be invoked either before or after +the PEARL function they are labelled with does its work. +If they run before, they are allowed to short-circuit the function's +action or perform it themselves and specify a value to return. +If they run after, they may also modify the value to be returned. +.sp 3 +.PP +For example, in the extended example at the beginning of this +paper, we presented a simple inference package which would run +automatically whenever an object was fetched or inserted. +To implement this, we wrote two functions MakeForwardInference +and MakeBackwardInference. +MakeForwardInference was designed to use rules which said if +you learn X then infer Y. +MakeBackwardInference was designed to use rules which said if +you want to know X then check to see if you know Y. +Learning something while using PEARL usually means inserting +something into the data base, so we wish to have +MakeForwardInference run whenever we insert some concept +into the data base, after the insertion. +Wanting to know something while using PEARL means fetching +it from the data base, so we wish to have MakeBackwardInference +run whenever we fetch some concept from the data base, before the +actual fetch takes place. +This was accomplished by attaching these two functions as demons +to the base structure Concept as follows: +.DS +.Ls +(create \kBbase Concept + \h'|\nBu'(if \kAfetch MakeBackwardInference)) +.Le +.DE +.LP +A similar mechanism is available for attaching demons to individual +slots of structures. +Other than through matching, the principle way that slots of +already created structures get changed is through the PEARL +function \fIputpath\fR. +For example, if Sam got a raise, making his salary level +\fIMedium\fR, we might want to change the \fILevel\fR slot of +his Salary structure: +.DS +(putpath SamsSalary 'Level (getsymbol 'Medium)) +.DE +If there were facts in the data base (like the fact that Sam is +poor) which depended on this fact, we would be interested in +monitoring Sam's salary level so that we could fix this up. +Of course, a general data dependency mechanism would be much +better but if you did not have one, one possible way of +accompishing this would be to attach a demon to the Level slot of +\fISamsSalary\fR at the time of creation: +.DS +.Ls +(create \kBindividual Salary SamsSalary + \h'|\nBu'\kA(Employee Sam) + \h'|\nAu'(Level ^ if >putpath (AdjustPoorness =Employee *))) +.Le +.DE +This assumes that \fIAdjustPoorness\fR is a function expecting the +name of the person and the new level. +.PP +Like predicates, a PEARL demon may be either the name of a function +to be run with the structure or slot as its argument +or it may be a general S-expression which contains any of the +special forms which refer to the current structure or slot. +Besides the built-in PEARL functions which automatically check for +demons with their names on them attached to slots that they touch, +there is a facility for user-defined functions to explicitly +request that demons on structures or slots that they touch be run. +However, this action is not automatic; +the involved functions must explicitly run the demons. +.NH +Implementations +.sp 3 +.PP +The main emphasis of efficiency considerations within PEARL was +to allow the user to avoid inefficient algorithms. +We also tried to make the code itself as efficient as possible. +To make the user interface as friendly as possible, +error checking is done whenever it can be done efficiently. +As a result of these two principles, PEARL is fast and +friendly enough for use as a serious programming language. +.sp 3 +.PP +PEARL was also intended to be portable. +It was originally developed on a DEC 20 and moved with no +modification to a DEC PDP-10 under UCI Lisp. +It was then moved to a VAX-11/780 under Franz Lisp [3] [4] +which at that time did not provide a facility for allocating +hunks of memory and thus required the lowest level of the +implementation to be rewritten using arrays. +Since the lowest level of the UCI Lisp version was written in +Lisp assembler (LAP) operating on blocks of memory, this new +Franz Lisp version was somewhat less efficient. +When "hunks" were added to Franz Lisp, we attempted to modify +the VAX version to use them. +However, since Franz Lisp hunks behave significantly differently +in several ways from blocks of memory in UCI Lisp, this was +abandoned temporarily. +Instead, we used what we learned to redesign the lowest level of +the UCI Lisp version of PEARL so that it could be easily moved +between UCI Lisp and Franz Lisp and then moved it back to the VAX. +.PP +We now believe that PEARL could be moved to another Lisp by +rewriting about a dozen functions and adding the macros +needed to convert from UCI Lisp to the target Lisp. +(Only one of these is now machine coded on the PDP-10, +a routine for doing address arithmetic. +The Franz Lisp version is completely in Lisp.) +The primary functions which must be rewritten pertain to creating +and accessing hunks of memory and modifying the top level +read-eval-print loop. +We are currently verifying PEARL's portability by moving it to +both MACLisp and Lisp Machine Lisp. +.NH +Performance +.sp 3 +.PP +As mentioned, PEARL gains much of its speed during fetches from the +data base by using a user-assisted hashing mechanism. +Here we present some evidence that this mechanism does in +fact speed up access to the data base. +To test this, we timed the running of a recent version of PAM, +a story understanding program [12], which was written using PEARL. +For these timings, we used the Franz Lisp version of PEARL. +Since the size of PEARL data bases is user-settable, we compared +two runs of PAM on a large (23 sentence) story, one using the +largest available hash table (see below for details of sizes) +and one using the smallest available hash table which is logically +equivalent to a linear list. +.sp 3 +.PP +For each run we read in the initial knowledge and program +once and then processed the story three times to test the effects +of the data base getting fuller. +The results are as follows: +.DS +\h'|\nau' + \kaSmall Table \kbLarge Table + +Load \h'|\nau'68 + 13 \h'|\nbu'30 + 5 + +Run 1 \h'|\nau'96 + 10 \h'|\nbu'65 + 10 + +Run 2 \h'|\nau'113 + 11 \h'|\nbu'66 + 9 + +Run 3 \h'|\nau'129 + 9 \h'|\nbu'65 + 10 +.DE +.LP +Note that while the large hash table was quite stable as the +amount of information in it approximately tripled, the small +hash table causes the execution times to increase substantially +as the data base fills up. +.sp 3 +.PP +In similar comparisons with UCI Lisp on the PDP 10, the results +were even more dramatic. +Times for the large data base were flat but using a small data base, +each run's time was bigger than the previous run by 50% of the first +run's time and each run's garbage collection time was bigger +than the previous by 100% of the first run's garbage collection time. +.DS + \kaSmall Table \kbLarge Table + +Load \h'|\nau'17 + 2 \h'|\nbu'16 + 2 + +Run 1 \h'|\nau'64 + 13 \h'|\nbu'24 + 2 + +Run 2 \h'|\nau'92 + 22 \h'|\nbu'24 + 1 + +Run 3 \h'|\nau'125 + 33 \h'|\nbu'26 + 2 +.DE +.LP +This indicates that PEARL could make large programs running on +the PDP10 must faster. +It also indicates that although the VAX is a slower machine, +with its virtual memory it behaves quite well under what a load +that taxes the PDP 10. +.sp 3 +.PP +Another piece of timing we performed is also interesting to those +considering moving to VAXes from PDP 10s. +All of the above timings were of compiled versions of PEARL on +both machines. +(The PAM code was not compiled.) +Thus, Franz Lisp on the VAX seems to run the same program +with 2-2.5 times the CPU time of UCI Lisp on the PDP 10. +Since the ratio between the speeds of the processors is estimated +at 2.5, compiled Franz Lisp code competes favorably (modulo the +processor speed) with compiled UCI Lisp code. +However, we also tried running PAM with uncompiled versions +of PEARL on both machines. +In this case, we found that the Franz Lisp version ran 10 times +slower, while the UCI Lisp version ran only 3 times slower. +This would seem to imply that either the Franz Lisp interpreter +is abnormally slow or that the UCI Lisp interpreter is +unusually fast. +When the MAC Lisp and Lisp Machine Lisp versions are running, we +will explore this further. +.sp 3 +.PP +Although we have not done any extensive profiling of PAM to +determine where all the time is spent, we have tried disabling the +printing functions while running PAM. +Doing this, we discovered that PAM spends about 55% of its time +doing input and output. +This breaks down to 5% for input, 10% for conversion to list +structure from internal PEARL structures and 40% for actual +(pretty-)printing by Lisp. +.NH +Comparison to FRL +.sp 3 +.PP +Of the existing AI languages, PEARL has the most in common with FRL. +This is true partly because both languages use several good ideas +which have been around in AI for some time. +It is also partly true because some of PEARL's features were added +in imitation of the example representation language XRL presented +in Charniak[2] (which the authors admit is partly in imitation of +FRL and KRL). +In this section, we discuss some of the ways that PEARL differs +from FRL. +.sp 3 +.PP +Like PEARL, FRL is designed for representing slot-filler objects. +However, in FRL these objects are modelled more after frames as +described by Minsky [7] whereas PEARL's structures lean more +toward logical predicates. +In particular, frames become \fIactivated\fR or +\fItriggered\fR by being instantiated and the data base +is simply all the activated frames; +there seems to be no distinction between instantiating a +frame and adding it to the data base. +In contrast to PEARL, frames are not encoded internally but +represented as multiple depth association lists and the FRL +data base is not hash coded. +The FRL manual [10] seems to imply that it is in fact a linked list +subject to a sequential search. +The idea of separating frames into groups like PEARL's multiple +data bases has been recently added as "domains" [6]. +.sp 3 +.PP +Whereas PEARL requires type information on its slots and uses this +information to advantage, FRL requires no information on the type +or even number of values which will be allowed. +This of course allows the user more flexibility but makes it more +difficult for FRL to deal efficiently with each slot. +.sp 3 +.PP +In addition to the slot/filler features, FRL uses 6 primary +representation techniques to improve the flexibility of frames. +These are comments on slots, abstraction through slot inheritance, +inherited default values for slots, constraints on slot values, +indirection through values in other frames and attached procedures. +We look briefly now at each of these. +.IP 1) +Comments in FRL are attached to slots and are generally used to +remember where the value in a slot came from although they could +be used for anything. +This is a useful feature which in PEARL must be +implemented as a separate set of predicates inserted into the data +base or as dynamically-added attached procedures. +We have not added them to PEARL because we are unsure whether such +information should rightly be distinguished from predications +about where other pieces of knowledge came from. +.IP 2) +The notion of inheritance of slots from more abstract objects is +quite similar in FRL and PEARL, since this is one of the features +PEARL inherited through XRL. +The principle difference is that while in PEARL all slots must be +predeclared (because of the internal mode of storage), FRL allows +the addition of slots at a later time. +.IP 3) +The notion of default values was similarly inheritted from FRL by PEARL. +However, in designing PEARL we wished to more clearly separate the +idea of a general piece of knowledge represented by the definition +of a type of structure along with its set of defaults from an instance +of such a structure. +As a result PEARL stores the default values for slots in the special +instance of each type of structure called the \fIdefault instance\fR. +In contrast, FRL does not make this distinction clear and provides +for both a default and a value in a slot of a frame. +Apparently a frame may be both an instance and a generalization +at the same time. +.IP 4) +FRL's notion of constraints is significantly stronger and more +complex than PEARL's. +PEARL provides for predicates on slots but these are only enforced +during matching on slots containing variables. +FRL on the other hand provides three flavors of constraint with +different degrees of restriction. +A \fIrequirement\fR is a strong predicate on a slot which must be +true of the value in that slot. +A \fIpreference\fR is a weaker predicate which may be relaxed. +A weaker special case of a preference is a default which simply +suggests a specific value which can be easily overridden. +.IP 5) +A feature of FRL which goes hand-in-hand with the idea of triggered +frames (and is thus lacking in PEARL) is that of indirection. +This allows a frame to specify constraints on slots of other +frames that are currently active when it is triggered. +Thus indirection provides what might be considered a "horizontal" +version of the vertical notion of default inheritance. +.IP 6) +Demons and attached procedures are old ideas in AI but FRL +introduced a new twist on them which PEARL then took one step +further. +FRL provides for if-added, if-needed, and if-removed procedures which +are attached to slots and rather than being triggered by arbitrary +conditions are instead run only in the case of adding, requesting +or removing the value of a slot. +These attached procedures are enforced by the functions that +perform these types of access, thus providing for idiosyncratic +forms of inheritance or finding a slot value. +In PEARL we extend this idea so that there are a large variety of +access functions which may trigger attached procedures (hooks). +In addition, these procedures are allowed to affect the actions +of the access functions, thus allowing a particular class of +objects to tailor the behavior of most of PEARL's functions. +Similarly, procedures to tailor the performance of printing and +other functions on objects (rather than their slots) are provided +by both FRL (via the SELF slot) and by PEARL (via base hooks) +In addition, a form of detached procedures ("sentinels") have +recently been added to FRL [6] in which the triggering condition +is the activation of a group of frames. +.sp 3 +.PP +In contrast to more ambitious knowledge representation languages, +FRL and PEARL are similar in their fairly restricted matching +procedures which are essentially slot-by-slot matches with no +provision for matching to a degree or forcing a match via mapping +as in MERLIN [8]. +.sp 3 +.PP +Finally, there are two features of hierarchical representations +which FRL provides but which are not yet provided by PEARL. +The principal one is the ability to store multiple views of an object +thus allowing a frame to inherit slots from several other frames. +The second one is the ability to move an object down the hierarchy, +thus providing the dynamic ability to further specify a previously +general frame based on new information. +Both of these are in the works since we have encountered a need for them. +.NH +Comparison to KRL +.sp 3 +.PP +.bp +.NH +References +.sp 2 +.IP [1] +Bobrow, D. G., and Winograd, T. "An Overview of KRL, a Knowledge +Representation Language." +\fICognitive Science\fR 1:1 (1977). +.IP [2] +Charniak, E., Riesbeck, C. K., and McDermott, D. V. +\fIArtificial Intelligence Programming\fR. Hilldale, New Jersey: +Lawrence Erlbaum Associates, 1980. +.IP [3] +Fateman, R., "Views on Transportability of Lisp and Lisp-based Systems", +in \fIProc. of the 1981 ACM Symposium on Symbolic and Algebraic +Computation\fR p 137-141, (ACM order no 505810), 1981. +.IP [4] +Foderaro, J. K., and Sklower, K. L. +\fIThe Franz Lisp Manual\fR in \fIBerkeley UNIX Reference Manual\fR, +Vol. 2c., Computer Systems Research Group, Computer Science Div. +EECS Dept., University of California, September, 1981 +.IP [5] +Greiner, R., and Lenat, D. "A Representation Language Language." +In \fIProc. First NCAI\fR. Stanford, CA, August, 1980, +165-169. +.IP [6] +?????, ?. "Extended Features of FRL" ?????, reproduced in forthcoming +edition of [4], 1982. +.IP [7] +Minsky, M. "A Framework for Representing Knowledge" in P. H. +WInston (Ed.) \fIThe Psychology of Computer Vision\fR, +New York: McGraw-Hill, 1975. +.IP [8] +Moore, J., and Newell, A. "How Can MERLIN Understand?" in L. Gregg +(Ed.), \fIKnowledge and Cognition\fR, Lawrence Erlbaum Associates, 1973. +.IP [9] +Roberts, R. B., and Goldstein, I. P. +"NUDGE, A Knowledge-Based Scheduling Program." +In \fIProc. IJCAI-77\fR. Cambridge, MA, August, 1977, 257-263. +.IP [10] +Roberts R. B., and Goldstein, I. P. +\fIThe FRL Manual\fR, MIT AI Memo, September, 1977, reproduced in +forthcoming edition of [4], 1982. +.IP [11] +Schank, R. \fIConceptual Information Processing\fR. Amsterdam: North Holland, +1975. +.IP [12] +Wilensky, R. "Understanding Goal-Based Stories", +Technical Report 140, Computer Science Department, +Yale University, New Haven, CT, September 1978. +.IP [13] +Wilensky, R. +"Meta-Planning: Representing and Using Knowledge about Planning in Problem +Solving and Natural Language Understanding." +\fICognitive Science\fR 5:3 (1981). +.rm CF +.bp 0 +.sp 14 +.B +.LG +.ce +Table Of Contents +.SM +.sp 2 +.DS + 1. Introduction \ka 1 + 2. An Overview and Sample Application Of PEARL \h'|\nau' 2 + 3. How Fast Is PEARL? \h'|\nau' 6 + 4. Objects and Structures \h'|\nau' 7 + 5. Data Base Facilities \h'|\nau'11 + 6. Fetching \h'|\nau'17 + 7. Predicates and Matching \h'|\nau'18 + 8. Variables \h'|\nau'21 + 9. Demons \h'|\nau'23 +10. Implementations \h'|\nau'24 +11. Performance \h'|\nau'25 +12. Comparison to FRL \h'|\nau'26 +13. Comparison to KRL \h'|\nau'29 +14. References \h'|\nau'31 +.DE +.bp 0 +.sp 14 +.SH +Acknowledgements +.PP +PEARL was originally a joint project of Joe Faletti and Mike +Deering (now at the Fairchild AI Lab in Palo Alto) aimed at +redesigning, extending and completely rewriting an earlier +package designed and written by Mike. +PEARL owes many ideas and much of its success to Mike who +has been involved in all design decisions. +In particular, the hashing scheme which is responsible for +much of PEARL's efficiency was originally his idea. +.PP +The initial move of PEARL to the VAX from which we learned enough +to make the second one easier was accomplished by Mike Deering +and Doug Lanam (now at the Hewlett Packard AI Lab in Palo Alto). +The move was made significantly easier by Doug's UCI Lisp +compatibility package for Franz Lisp. +.PP +The authors wish to thank Mike and Doug for their contributions. +We also wish to thank the members of the Berkeley AI Research +group (BAIR) who have used PEARL during its development and made +many valuable suggestions based on active experience in its use. diff --git a/usr/src/usr.bin/lisp/pearl/inits.l b/usr/src/usr.bin/lisp/pearl/inits.l new file mode 100644 index 0000000000..6dc0221553 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/inits.l @@ -0,0 +1,33 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; inits.l ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Expressions which set the values of special variables and create +; nilsym and nilstruct and which use PEARL functions and so must +; be done AFTER everything is loaded. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +(progn + ; A very special cell. + (setq *any*conscell* (cons '*any* (punbound))) + ; Define the default symbol. + (or (boundp (symatom 'nilsym)) + (symbol nilsym)) + ; Define the default empty structure. + (or (boundp (defatom 'nilstruct)) + (create base nilstruct)) + ; Values that should not take part in hashing. + ; Used to include ",(eval (defatom 'nilstruct)) ,(eval (symatom 'nilsym))". + (setq *unhashablevalues* `(nil ,(punbound) ,(unbound))) + (putprop 'history '(history) 'alias) + (putprop 'h '(history 22) 'alias) + (defprop quote "'" printmacro) + (defprop pearlequals "=" printmacro) + (defprop *var* "?" printmacro) + (defprop *global* "?" printmacro) + (setdbsize 7.) + (builddb *maindb*) + (setq *db* *maindb*) + ) + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/lowlevel.l b/usr/src/usr.bin/lisp/pearl/lowlevel.l new file mode 100644 index 0000000000..74b4231a79 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/lowlevel.l @@ -0,0 +1,552 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;; lowlevel.l ;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Macros (mostly) for accessing structures, symbols and definitions. +; See the file "template" for a picture of how structures and +; symbols and data bases are arranged to explain the simplest +; of the functions below. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +; Throughout the code for PEARL: +; defblock: will contain a definition of a structure, +; valblock: will contain an instance of a structure, +; slotnum: will contain a slot number to index into a structure. +; An attempt has been made throughout the rest to similarly name +; things to be obvious. + +; These macros are designed so that PEARL can be moved to a new Lisp +; simply by implementing the functions "makhunk", "cxr", and +; "rplacx" to behave as they do in Franz Lisp. + +(defmacro getdefaultinst (defblock) + `(cxr 3 ,defblock)) + +(defmacro getdefinition (valblock) + `(cxr 0 ,valblock)) + +(defmacro allocdef (numofslots) + `(makhunk (+ 10 (* 4 ,numofslots)))) + +(defmacro allocval (numofslots) + `(makhunk (+ 4 (* 4 ,numofslots)))) + +(defmacro puttypetag (tag hunk) + `(rplacx 1 ,hunk ,tag)) + +(defmacro gettypetag (hunk) + `(cxr 1 ,hunk)) + +(defmacro putstructlength (size defblock) + `(rplacx 2 ,defblock ,size)) + +(defmacro getstructlength (defblock) + `(cxr 2 ,defblock)) + +(defmacro putuniquenum (num defblockorsym) + `(rplacx 0 ,defblockorsym ,num)) + +(defmacro getuniquenum (defblockorsym) + `(cxr 0 ,defblockorsym)) + +; Generate a new unique number. +(dm newnum (none) + '(setq *lastsymbolnum* (1+ *lastsymbolnum*))) + +; Special atom for each structure's definition. +(de defatom (symbol) + (concat 'd: symbol)) + +; Special atom for each structure's default instance. +(de instatom (symbol) + (concat 'i: symbol)) + +; Special atom for each symbol. +(de symatom (symbol) + (concat 's: symbol)) + +; Special atom for each block. +(de blockatom (symbol) + (concat 'b: symbol)) + +; Special atom for each ordinal type. +(de ordatom (symbol) + (concat 'o: symbol)) + +(defmacro putsymbolpname (name block) + `(rplacx 2 ,block ,name)) + +(defmacro getsymbolpname (symbolitem) + `(cxr 2 ,symbolitem)) + +(defmacro putpname (name blk) + `(rplacx 5 ,blk ,name)) + +(defmacro getpname (blk) + `(cxr 5 ,blk)) + +(defmacro putdef (defblock valblock) + `(rplacx 0 ,valblock ,defblock)) + +(defmacro putisa (isa valblock) + `(rplacx 4 ,valblock ,isa)) + +(defmacro getisa (valblock) + `(cxr 4 ,valblock)) + +(defmacro putdefaultinst (valblock defblock) + `(rplacx 3 ,defblock ,valblock)) + +(defmacro puthashalias (hashnum blk) + `(rplacx 6 ,blk ,hashnum)) + +(defmacro gethashalias (blk) + `(cxr 6 ,blk)) + +(defmacro puthashfocus (hashnum blk) + `(rplacx 7 ,blk ,hashnum)) + +(defmacro gethashfocus (blk) + `(cxr 7 ,blk)) + +(defmacro putexpansionlist (explist blk) + `(rplacx 8 ,blk ,explist)) + +(defmacro getexpansionlist (blk) + `(cxr 8 ,blk)) + +(defmacro putbasehooks (hooklist defblk) + `(rplacx 9 ,defblk ,hooklist)) + +(defmacro getbasehooks (defblk) + `(cxr 9 ,defblk)) + +(de addbasehook (conscell item) + (let* ((itemdef (getdefinition item)) + (oldhooks (getbasehooks itemdef))) + (cond (oldhooks (nconc1 oldhooks conscell)) + ( t (putbasehooks itemdef (ncons conscell)))))) + +(defmacro getslotname (slotnum blk) + `(cxr (+ 8 (* 4 ,slotnum)) ,blk)) + +(defmacro putslotname (slotnum slotname blk) + `(rplacx (+ 8 (* 4 ,slotnum)) ,blk ,slotname)) + +(defmacro addslotname (slotnum slotname blk) + `(rplacx (+ 8 (* 4 ,slotnum)) ,blk + (cons ,slotname (cxr (+ 8 (* 4 ,slotnum)) ,blk)))) + +(defmacro putslottype (slotnum typenum blk) + `(rplacx (+ 7 (* 4 ,slotnum)) ,blk ,typenum)) + +(defmacro getslottype (slotnum blk) + `(cxr (+ 7 (* 4 ,slotnum)) ,blk)) + +(defmacro putppset (slotnum setname blk) + `(rplacx (+ 9 (* 4 ,slotnum)) ,blk ,setname)) + +(defmacro getppset (slotnum blk) + `(cxr (+ 9 (* 4 ,slotnum)) ,blk)) + +(defmacro initbothalists (inst) + `(rplacx 2 ,inst (ncons nil))) + +(defmacro putbothalists (alist inst) + `(rplacx 2 ,inst ,alist)) + +(defmacro getbothalists (inst) + `(cxr 2 ,inst)) + +(defmacro getalist (inst) + `(cdr (cxr 2 ,inst))) + +(defmacro putalist (alist inst) + `(rplacd (cxr 2 ,inst) ,alist)) + +; This must return the new special conscell. +(defmacro addalist (var inst) + `(let ((specialcell (cons ,var (punbound)))) + (putalist (cons specialcell (getalist ,inst)) ,inst) + specialcell)) + +; The frozen variables are kept here instead of the regular assoc-list. +(defmacro getalistcp (inst) + `(car (cxr 2 ,inst))) + +(defmacro putalistcp (alist inst) + `(rplaca (cxr 2 ,inst) ,alist)) + +(defmacro getabbrev (inst) + `(cxr 3 ,inst)) + +(defmacro putabbrev (abbrev inst) + `(rplacx 3 ,inst ,abbrev)) + +; Put zero as the (initial) hash and format info. +(defmacro clearhashandformat (slotnum defblock) + `(rplacx (+ 6 (* 4 ,slotnum)) ,defblock 0)) + +(defmacro puthashandformat (slotnum hashnum defblock) + `(rplacx (+ 6 (* 4 ,slotnum)) ,defblock ,hashnum)) + +(defmacro gethashandformat (slotnum defblock) + `(cxr (+ 6 (* 4 ,slotnum)) ,defblock)) + +(defmacro puthashandenforce (slotnum hashnum blk) + `(rplacx (+ 6 (* 4 ,slotnum)) ,blk + (boole 7 (boole 1 (boole 10. 127. 0) + (cxr (+ 6 (* 4 ,slotnum)) ,blk)) + (boole 1 127. ,hashnum)))) + +(defmacro puthashinfo (slotnum hashnum blk) + `(rplacx (+ 6 (* 4 ,slotnum)) ,blk + (boole 7 (boole 1 (boole 10. 63. 0) + (cxr (+ 6 (* 4 ,slotnum)) ,blk)) + (boole 1 63. ,hashnum)))) + +(defmacro addhash* (hashnum) + `(setq ,hashnum (boole 7 1 ,hashnum))) + +(defmacro addhash** (hashnum) + `(setq ,hashnum (boole 7 2 ,hashnum))) + +(defmacro addhash: (hashnum) + `(setq ,hashnum (boole 7 4 ,hashnum))) + +(defmacro addhash:: (hashnum) + `(setq ,hashnum (boole 7 8. ,hashnum))) + +(defmacro addhash> (hashnum) + `(setq ,hashnum (boole 7 16. ,hashnum))) + +(defmacro addhash< (hashnum) + `(setq ,hashnum (boole 7 32. ,hashnum))) + +(defmacro addhash*** (hashnum) + `(setq ,hashnum (boole 7 64. ,hashnum))) + +(defmacro addenforce (hashnum) + `(setq ,hashnum (boole 7 128. ,hashnum))) + +(defmacro gethashinfo (slotnum blk) + `(boole 1 63. + (cxr (+ 6 (* 4 ,slotnum)) ,blk))) + +(defmacro gethash* (hashnum) + `(\=& 1 (boole 1 1 ,hashnum))) + +(defmacro gethash** (hashnum) + `(\=& 2 (boole 1 2 ,hashnum))) + +(defmacro gethash: (hashnum) + `(\=& 4 (boole 1 4 ,hashnum))) + +(defmacro gethash:: (hashnum) + `(\=& 8. (boole 1 8. ,hashnum))) + +(defmacro gethash> (hashnum) + `(\=& 16. (boole 1 16. ,hashnum))) + +(defmacro gethash< (hashnum) + `(\=& 32. (boole 1 32. ,hashnum))) + +(defmacro gethash*** (hashnum) + `(\=& 64. (boole 1 64. ,hashnum))) + +(defmacro getenforce (slotnum defblock) + `(\=& 128. (boole 1 128. (cxr (+ 6 (* 4 ,slotnum)) ,defblock)))) + +; The format information is eventually intended for custom tailoring of +; printing of structures but we've never gotten around to adding it. +; The main idea is whether to print it if it contains the default +; value, or whether to print to a limited depth, or whether to print +; at all, etc. +(defmacro putformatinfo (slotnum hashnum blk) + `(rplacx (+ 6 (* 4 ,slotnum)) ,blk + (boole 7 + (boole 1 (boole 10. 192. 0) + (cxr (+ 6 (* 4 ,slotnum)) ,blk)) + (boole 1 192. (lsh ,hashnum 6))))) + +(defmacro getformatinfo (slotnum blk) + `(lsh (boole 1 + (boole 10. 192. 0) + (cxr (+ 6 (* 4 ,slotnum)) ,blk)) -6)) + +(defmacro putpred (slotnum value inst) + `(rplacx (+ 2 (* 4 ,slotnum)) ,inst ,value)) + +(defmacro getpred (slotnum inst) + `(cxr (+ 2 (* 4 ,slotnum)) ,inst)) + +(defmacro putslothooks (slotnum slothooklist inst) + `(rplacx (+ 3 (* 4 ,slotnum)) ,inst ,slothooklist)) + +(defmacro getslothooks (slotnum inst) + `(cxr (+ 3 (* 4 ,slotnum)) ,inst)) + +; Values of slots in PEARL structures are of one of four types. +; The type is stored as an atom in the "slotvaluetype" +; and describes what type of value will be found in the "slotvalue". +; The possible types and what is put in "slotvalue" are: +; CONSTANT A constant value -- the value. +; LOCAL A local variable -- the variable's alist conscell +; (name . value). +; ADJUNCT A constant value plus an adjunct variable +; -- a conscell with CAR = the constant value +; and CDR = the adjvar's conscell +; (name . value). +; GLOBAL A global variable -- the (atom) name of the global variable. +; + +(defmacro putslotvaluetype (slotnum type inst) + `(rplacx (* 4 ,slotnum) ,inst ,type)) + +(defmacro getslotvaluetype (slotnum inst) + `(cxr (* 4 ,slotnum) ,inst)) + +(defmacro putslotvalue (slotnum value inst) + `(rplacx (1+ (* 4 ,slotnum)) ,inst ,value)) + +(defmacro getslotvalue (slotnum inst) + `(cxr (1+ (* 4 ,slotnum)) ,inst)) + +(dm equivclass (none) + ''*equivclass*) + +(de equivclassp (potequivclass) + (and (dtpr potequivclass) + (eq (equivclass) (car potequivclass)))) + +; returns (punbound) for unified variables instead of the equiv cons cell. +(defmacro getvalofequivorvar (equivorvar) + `(let ((val ,equivorvar)) + (cond ((equivclassp val) (punbound)) + ( t val)))) + +(defmacro getvalue (slotnum inst) + `(let ((value (getslotvalue ,slotnum ,inst))) + (selectq (getslotvaluetype ,slotnum ,inst) + (CONSTANT value) ; A constant value. + (LOCAL (getvalofequivorvar (cdr value))) ; A local var. + (ADJUNCT (car value)) ; A constant plus adjvar. + (GLOBAL (getvalofequivorvar (eval value))) ; A global var. + (otherwise (punbound))))) + +; Same as getvalue, except that if the slot has an variable in it +; the atom in "var" gets set to that value. +(defmacro getvarandvalue (slotnum inst var) + `(let ((value (getslotvalue ,slotnum ,inst))) + (selectq (getslotvaluetype ,slotnum ,inst) + (CONSTANT (set ,var nil) + value) ; A constant value. + (LOCAL (set ,var value) + (getvalofequivorvar (cdr value))) ; A local var. + (ADJUNCT (set ,var (cdr value)) + (car value)) ; A constant plus adjvar. + (GLOBAL (set ,var value) + (getvalofequivorvar (eval value))) ; A global var. + (otherwise (punbound))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; The next bunch of functions are for hashing and building data bases. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +; For each data base, there are three parts (each a hunk): +; the header which contains the name, +; whether it is active +; its parent and children and ... +; the two parts of the actual data base: +; DB1 for items hashed under one value. +; DB2 for items hashed under two or more values. +; DB1 and DB2 each contain pointers to conscells whose cars are the +; atom *db* and whose cdrs are the list of items in that bucket. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; FIRST, the functions to access and add to a hash bucket: + +; Items hashed under only one integer are in DB1. +(defmacro gethash1 (num1 db1) + `(cxr (\\ ,num1 *db1size*) ,db1)) + +; Add the item to the front of the appropriate hash bucket (AFTER the +; special *db* conscell). +(defmacro puthash1 (num1 db1 item) + `(let ((bucket (gethash1 ,num1 ,db1))) + ; Avoid exact duplicates. + (or (memq ,item bucket) + (rplacd bucket (cons ,item (cdr bucket)))) + bucket)) + +; Items hashed under either two or more integers are in DB2. +(defmacro gethash2 (num1 num2 db2) + `(cxr (\\ (+ ,num1 (* ,num2 1024.)) *db2size*) + ,db2)) + +; Add the item to the front of the appropriate hash bucket (AFTER the +; special *db* conscell). +(defmacro puthash2 (num1 num2 db2 item) + `(let ((bucket (gethash2 ,num1 ,num2 ,db2))) + ; Avoid exact duplicates. + (or (memq ,item bucket) + (rplacd bucket (cons ,item (cdr bucket)))) + bucket)) + +(defmacro gethash3 (num1 num2 num3 db2) + `(cxr (\\ (+ ,num1 + (* ,num2 1024.) + (* ,num3 1048576.)) ; = 1024 * 1024 + *db2size*) + ,db2)) + +; Add the item to the front of the appropriate hash bucket (AFTER the +; special *db* conscell). +(defmacro puthash3 (num1 num2 num3 db2 item) + `(let ((bucket (gethash3 ,num1 ,num2 ,num3 ,db2))) + ; Avoid exact duplicates. + (or (memq ,item bucket) + (rplacd bucket (cons ,item (cdr bucket)))) + bucket)) + +(defmacro gethashmulti (num1 others db2) + `(cxr (\\ (+ ,num1 + (apply (function +) + (mapcar (function *) + ,others *multiproducts*))) + *db2size*) + ,db2)) + +; Add the item to the front of the appropriate hash bucket (AFTER the +; special *db* conscell). +(defmacro puthashmulti (num1 others db2 item) + `(let ((bucket (gethashmulti ,num1 ,others ,db2))) + ; Avoid exact duplicates. + (or (memq ,item bucket) + (rplacd bucket (cons ,item (cdr bucket)))) + bucket)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Now the header info. + +(defmacro putdbname (name db) + `(rplacx 0 ,db ,name)) + +(defmacro putdbchildren (childlist db) + `(rplacx 2 ,db ,childlist)) + +(defmacro setdbactive (db) + `(rplacx 3 ,db t)) + +(defmacro cleardbactive (db) + `(rplacx 3 ,db nil)) + +(defmacro putdbparent (parent db) + `(rplacx 4 ,db ,parent)) + +(defmacro putdb1 (db1 db) + `(rplacx 5 ,db ,db1)) + +(defmacro putdb2 (db2 db) + `(rplacx 6 ,db ,db2)) + +(defmacro getdbname (db) + `(cxr 0 ,db)) + +(defmacro getdbchildren (db) + `(cxr 2 ,db)) + +(defmacro getdbactive (db) + `(cxr 3 ,db)) + +(defmacro getdbparent (db) + `(cxr 4 ,db)) + +(defmacro getdb1 (db) + `(cxr 5 ,db)) + +(defmacro getdb2 (db) + `(cxr 6 ,db)) + +; The following predicates do the best we can to check for the type of +; object by checking what we hope are reasonably unique arrangements +; of values. In the case of definitions, instances, databases and +; symbols, a tag is put in the hunk saying what it is. This is +; assumed to be enough. + +(de streamp (potstream) + (and (dtpr potstream) + (eq '*stream* (car potstream)))) + +(de databasep (potdb) + (and (hunkp potdb) + (let ((tag (gettypetag potdb))) + (or (eq tag '*pearldb*) + (eq tag '*pearlinactivedb*))))) + +(de blockp (potblock) + (let* ((name (car potblock)) + (blockname (blockatom name))) + (and (boundp blockname) + (eq name + (car (eval blockname))) + (eq potblock + (eval blockname))))) + +(de definitionp (potdef) + (and (hunkp potdef) + (eq '*pearldef* (gettypetag potdef)))) + +(de psymbolp (potsymbol) + (and (hunkp potsymbol) + (eq '*pearlsymbol* (gettypetag potsymbol)))) + +(de structurep (potstruct) + (and (hunkp potstruct) + (eq '*pearlinst* (gettypetag potstruct)))) + +(de symbolnamep (potname) + (let ((symname (symatom potname))) + (and (boundp symname) + (psymbolp (eval symname))))) + +(de structurenamep (potname) + (let ((defname (defatom potname))) + (and (boundp defname) + (definitionp (eval defname))))) + +; Determine the print name of an arbitrary object. +(de pname (item) + (cond ((definitionp item) (getpname item)) + ((structurep item) (getpname (getdefinition item))) + ((psymbolp item) (getsymbolpname item)) + ((databasep item) (getdbname item)) + ((atom item) item) + ((streamp item) (msg t "PNAME: streams do not have pnames: " + item t)) + ( t (msg t "PNAME: " item " does not have a printname")))) + +; For loop patterned after (do for ...) in UCI Lisp, except that an +; initial value is required instead of RPT (and there is no DO). +(defmacro for (val init final &rest body) + `((lambda (,val pforlim) + (prog (pforval) + pforlab + (and (>& ,val pforlim) + (return pforval)) + (setq pforval (progn .,body)) + (setq ,val (1+ ,val)) + (go pforlab))) + ,init + ,final)) + +; While loop patterned after (do while ...) in UCI Lisp. +(defmacro while (val &rest body) + `(prog (pwhval) + pwhlab + (and (not ,val) + (return pwhval)) + (setq pwhval (progn .,body)) + (go pwhlab))) + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/ltags b/usr/src/usr.bin/lisp/pearl/ltags new file mode 100644 index 0000000000..b6c8c6ff9c --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/ltags @@ -0,0 +1,10 @@ +/^\(de / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(df / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(dm / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(drm / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(dsm / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(def/ { print $2 " " FILENAME " /^" $0 "$/" } +/^\(putd / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(setsyntax / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(setq / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(aliasdef / { print $2 " " FILENAME " /^" $0 "$/" } diff --git a/usr/src/usr.bin/lisp/pearl/manual.ms b/usr/src/usr.bin/lisp/pearl/manual.ms new file mode 100644 index 0000000000..c21da7f96d --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/manual.ms @@ -0,0 +1,5029 @@ +.ND +.nr LL 75n +.nr LT 80n +.rm CF +.ds LH PEARL Documentation +.rm CH +.ds RH Page % +.po 1.00i +.ls 1 +.hy 14 +.RP +.TL +.LG +.LG +Using the PEARL AI Package +.sp 1 +.SM +\fR(\fIP\fRackage for \fIE\fRfficient \fIA\fRccess to \fIR\fRepresentations in \fIL\fRisp)* +.NL +.FS +* This research was sponsored in part by the Office of Naval Research +under contract N00014-80-C-0732 and the National Science Foundation +under grant MCS79-06543. +.FE +.AU +Michael Deering +Joseph Faletti +Robert Wilensky +.AI +Computer Science Division +Department of EECS +University of California, Berkeley +Berkeley, California 94720 +.sp 1 +February 1982 +.AB +This document is a tutorial and manual for PEARL +(Package for Efficient Access to Representations in Lisp), +an AI language developed with space and time efficiencies in mind. +PEARL provides a set of functions for creating hierarchically-defined +slot-filler representations and for efficiently and flexibly inserting +and fetching them from a forest of associative data bases. +In addition to providing the usual facilities such as demons and matching, +PEARL introduces stronger typing on slots and user-assisted hashing +mechanisms. +.AE +.NH 0 +Introduction +.PP +PEARL (Package for Efficient Access to Representations in Lisp) is +a set of functions for creating hierarchically-defined slot-filler +representations and for efficiently and flexibly inserting and fetching +them from a forest of data bases. +Its intended use is in AI programming and it has been used at Berkeley +in the development of several AI programs including PAM [7] and +PANDORA [8]. +.PP +PEARL has the expressive power found in other AI knowledge +representation languages, but is extremely time-space efficient. +For example, using a data base of 4000 entries, PEARL takes only +about 4.2 CPU milliseconds for an average unsuccessful query and +7.3 CPU milliseconds of an average successful query on a PDP-10. +.PP +This document describes PEARL's use and is intended for the +beginning user. +(A description of the implementation of PEARL will be available +shortly.) +The best way to approach PEARL is to read this document up through +section 11 and then to take it to a terminal and reread it, typing +in the examples and observing their effects. +.PP +PEARL was implemented by Michael Deering and Joseph Faletti. +It was originally developed on a DEC PDP-10 under UCI Lisp +and was subsequently moved to a DEC VAX 11/780 under Franz Lisp +with help from Douglas Lanam and Margaret Butler. +Both PEARL and its documentation are still +being developed, improved, and debugged. +Any comments or suggestions will be appreciated. +Send them to Joe Faletti via Arpanet or Unix mail +(Kim\fB.\fRFaletti\fB@\fRBerkeley or ucbvax\fB!\fRkim\fB.\fRfaletti). +.bp +.DS +.sp 5 +.DE +.NH +Running PEARL +.PP +PEARL is implemented as a set of functions compiled and +loaded into Lisp. +Thus the full power of Lisp is available in addition to the added +power of PEARL. +.PP +Since PEARL runs under two different Lisps on two different machines, +there are a few differences between versions. +Most of these differences are in the method of starting PEARL up +and in the names of external files accessed by PEARL. +The two parts of this section describe how to start up PEARL either +under Franz Lisp or under UCI Lisp. +You need only read the section which is applicable to your Lisp. +.NH 2 +Under Franz Lisp +.PP +To access PEARL, simply run the core version of Lisp +containing PEARL. On Berkeley Unix, this is available by typing +the command: +.DS + % ~bair/bin/pearl +.DE +or, if ~bair/bin is in your search path, simply: +.DS + % pearl +.DE +During the startup process, PEARL will read in two +files, \fB.init.prl\fR and \fB.start.prl\fR, if they exist. +These files are designed for purposes similar to those +of \fI.lisprc\fR. +However, they split these functions into two groups. +In your \fI.init.prl\fR file you should include any +expressions which change the user-settable parameters to PEARL. +(For example, methods for setting the size of data bases, +the print function, and the prompt are described below.) +.PP +When you wish to have other files read in at startup time, +this usually needs to be done after PEARL's parameters are set. +PEARL is set up so that after the reading of \fI.init.prl\fR, it sets +any necessary parameters which you have not set in your .init.prl +and then reads in the file \fI.start.prl\fR if you have one. +This is where any processing which requires the +attention of PEARL (such as the existence of its data bases) +should be placed. +Thus \fI.init.prl\fR is primarily for initializing PEARL +and \fI.start.prl\fR is for starting up your use of PEARL. +\fBNote:\fR unlike most Unix programs which look for startup files +only in your home directory, thereby limitting you to only one +environment for each program, PEARL looks for each file first in +the current directory and if there is none, then it looks in your +home directory. +This allows you to tailor invocations of PEARL to the kind of work +you do in a particular directory. +.bp +.PP +After reading in these two files, PEARL will then place you in a +modified prompt-read-eval-print loop, with a default prompt of "PEARL> ". +This can be changed by setting the special variable +\fB*pearlprompt*\fR to the desired value. +If you want the standard Lisp prompt "-> " to be used by PEARL, +you must set \fI*pearlprompt*\fR to \fInil\fR in your \fI.init.prl\fR +and PEARL will do the right thing. +.PP +The primary feature of the PEARL prompt-read-eval-print loop is that +it uses a different print function. +The default function is +.DS +(lambda (*printval*) + (valprint *printval* 4) ) +.DE +but this can be changed to whatever you desire by giving +a new function definition to \fBpearlprintfn\fR. +The PEARL prompt-read-eval-print loop also contains a number of +features to improve upon the standard Lisp top level. +These include a history mechanism and are described in chapter 25. +.PP +There are quite a few functions from UCI Lisp which have been added +to PEARL to make it easier to move programs to Franz Lisp. +A list of these with brief documentation of differences is +included in an appendix. +.NH 2 +Under UCI Lisp +.PP +To access PEARL, simply run the core version of Lisp containing PEARL. +On the Berkeley KL-10 system, this is available by typing the system call +.DS +RU PEARL[5500,504,PEARL] +.DE +During the startup process, PEARL will read in two files, +INIT.PRL and START.PRL, if they exist. +The file INIT.PRL is designed for purposes similar to those +of INIT.LSP. +In this file you should include any expressions which +change the user-settable parameters to PEARL. +(For example, methods for setting the size of data bases, +the print function, and the prompt are described below.) +If you wish to use the REALLOC function to +enlarge your memory space, this call should be the +last call in your INIT.PRL file. +.PP +When you wish to have other files read in at startup +time, this usually needs to be done after the REALLOC. +The common kludge with UCI Lisp to solve this is to define +an INITFN (initialization function) which does this and then +to reset the INITFN to \fInil\fR which returns you to the +standard Lisp prompt-read-eval-print loop. +However, PEARL sets the INITFN for its own purposes so +that this common "solution" will not work. +Instead, PEARL is set up so that after the reading of INIT.PRL, +it sets any necessary parameters which you have not set in your +INIT.PRL and then reads in the file START.PRL if you have one. +This is where any processing which requires the +attention of PEARL should be placed. +Thus INIT.PRL is primarily for initializing PEARL and +START.PRL is for starting up your use of PEARL. +.PP +After reading in these two files, PEARL will then place you in a +modified prompt-read-eval-print loop, with a default prompt of "PEARL> ". +The ">" portion is the (modified) Lisp prompt which is printed +whenever \fIread\fR is invoked and can be changed +with the UCI Lisp function INITPROMPT. +The "PEARL" is PEARL's addition and can be set by +setting the special variable \fB*pearlprompt*\fR +to the desired value. +If you do not want any prompt added by PEARL other than the Lisp +prompt you must set \fI*pearlprompt*\fR to \fInil\fR in your +INIT.PRL and PEARL will do the right thing. +.PP +The main feature of the PEARL prompt-read-eval-print loop is +that it uses a different print function. +The default function is +.DS +(lambda (*printval*) + (valprint *printval* 4) ) +.DE +but this can be changed to whatever you desire by giving the +function \fBpearlprintfn\fR a new definition. +Note that \fIdskin\fR and the break package have been +changed slightly to also use of this print function. +Also, although the functions names and examples below are in +lower case, PEARL in UCI Lisp expects them all in upper +case, just as the rest of the UCI Lisp functions. +.NH +Creating Simple Objects. +.PP +PEARL allows four basic types of objects. +The first two are integers and arbitrary Lisp objects +and are created in the usual Lisp fashion. +The second two are structured types provided by PEARL, +and are stored in an internal form as blocks of memory. +These latter types are called \fBsymbols\fR and \fBstructures\fR. +.NH 2 +Defining Symbols +.PP +\fBSymbol\fRs are PEARL's internal atomic symbols. +Semantically they are like Lisp atoms, but are represented +and used differently to make PEARL more efficient. +Before they are used, symbols must +be declared (and thus defined to PEARL) by a call to the function +\fBsymbol\fR, which takes as arguments any number of atoms +whose names will be used to create symbols. +For example, +.DS +(symbol John) +.DE +creates one symbol called John and +.DS +(symbol Bob Carol Ted Alice Home + Office School Healthy NewYork) +.DE +creates several symbols at one time. +\fISymbol\fR is an nlambda (fexpr) and returns +a list containing the names of the symbols it created. +A one-argument lambda (expr) version is available as \fBsymbole\fR. +.PP +There are two ways to get at the actual (unique) symbol: +you can use the function \fBgetsymbol\fR or you can evaluate the +atom whose name is built out of the symbol name with the characters +\fBs:\fR on the front. +The function \fBsymatom\fR will build this atom for you when +given a symbol name. +For example, to set B to the symbol Bob use any of: +.DS +(setq B (getsymbol 'Bob) ) +(setq B s:Bob) +(setq B (eval (symatom 'Bob)) +.DE +.LP +Given an internal symbol, you can find out its print name by passing +it to the function \fBpname\fR (which also will return the print name +of other types of PEARL objects). +.NH 2 +Defining Structures +.PP +\fBStructure\fRs in PEARL provide the ability to define and manipulate +logical groupings of heterogeneous data and are essentially objects +with slots and slot fillers. +As such, they act more like "records" +in Pascal or "structures" in C than Lisp lists. +In reality they are more than both, but for the moment the reader +should keep records in mind. +.PP +Just as you must define the form +of a record in Pascal before defining the value of a variable whose +type is that kind of record, it is necessary to define each particular +form of structure you wish to use in PEARL before creating an +object with that form. +PEARL provides one function called \fBcreate\fR which +is used both to define kinds of structures and to +create individual instances of these structures. +(One function is provided for both because a special individual +is created as a side effect of each definition. +More on this is provided in section 7 on defaults.) +The first argument to \fIcreate\fR distinguishes +between a call which defines and one which creates an individual. +There are three kinds of defining calls (\fIbase\fR, \fIexpanded\fR +and \fIfunction\fR) and two kinds of instance-creating calls +(\fIindividual\fR, \fIpattern\fR) to \fIcreate\fR. +Only one of each (\fIbase\fR and \fIindividual\fR) is described +in this section. +The rest are left for later. +.PP +To start off with an example, let us suppose that you wish to represent +the conceptual act "PTrans" from the Conceptual Dependency (CD) notation +of Schank. +(The examples in this documentation assume a passing +familiarity with CD but lack of this should not hurt you too badly +and PEARL itself does not restrict you in any way to CD. +PTrans stands for Physical Transfer which has four "cases": actor doing +the transfer, object being transferred, original location and final +location.) +First we must define the form which PTrans structures will take. +In C this would be a type definition for the type PTrans as +follows (assuming a system-provided definition of the type \fIsymbol\fR): +.DS +struct PTrans { + symbol Actor; + symbol Object; + symbol From; + symbol To; +}; +.DE +In Pascal this would be +.DS +type PTrans = record + Actor : symbol; + Object : symbol; + From : symbol; + To : symbol + end; +.DE +.LP +In PEARL, +.DS +(create base PTrans + (Actor symbol) + (Object symbol) + (From symbol) + (To symbol) ) +.DE +does the job. +Note first of all that in order to define a new form +of structure, the first argument to \fIcreate\fR must be \fBbase\fR. +Note also that the second argument to \fIcreate\fR is the name of the +structure form to be created. +Following this is a list of ( ) pairs. +Structures are currently allowed to have up to 32 slots +in Franz PEARL or 18 in UCI Lisp PEARL as long as all slots +within a particular structure have mutually distinct names. +Different structures may have slots of the same name. +Thus in applications of PEARL to CD twenty different structure +types might all have an Actor slot. +.PP +Five types are allowed for slots: \fBsymbol\fR, \fBstruct\fR, +\fBint\fR, \fBlisp\fR, and \fBsetof \fR. +\fISymbol\fR and \fIstruct\fR are the types just described. +\fIInt\fR is a normal Lisp integer value. +The type \fIlisp\fR allows arbitrary \fBnon-atomic\fR Lisp values. +Finally, \fIsetof \fR allows you to define sets consisting +of all symbols (\fIsetof symbol\fR) or all structures (\fIsetof struct\fR) +and can be done recursively (\fIsetof setof struct\fR). +.NH +Creating Individual Instances of Defined Structures +.PP +Once you have defined a specific form of structure like PTrans, you +can create an individual PTrans using \fBindividual\fR as the first +argument to \fIcreate\fR and the name of the base structure you want +an individual instance of as the second argument. +The rest of the arguments are ( ) pairs in which +the must be of the type that the slot was declared to be. +The slots may be listed in any order and need not be in the same +order as defined. +For example, to create an instance of John going home +from the office (i.e., John PTransing himself from the office to +home) you would use this call to \fIcreate\fR: +.DS +(create individual PTrans + (Actor John) + (Object John) + (From Office) + (To Home) ) +.DE +\fICreate\fR will return an object of type PTrans, with the slots filled +in as indicated. +The object returned has been created and stored as +a \fIhunk\fR of memory in Franz Lisp or a block of memory in Binary +Program Space in the UCI Lisp (rather than Free Storage where most +Lisp objects are stored). +Since you are using the PEARL prompt-read-eval-print loop, +the object returned by \fIcreate\fR will be printed in an external list +form, something like the above. +However, if you print a structure using the standard Lisp print +functions (as for example some break packages will do), it will +be printed by Franz Lisp in the normal way it prints hunks. +(Warning: Since the structure actually contains a circular +reference to another hunk, this will cause problems with programs +which do not set \fIprinlevel\fR in Franz Lisp so general packages which +you wish to add to PEARL should be modified to use some PEARL +print function.) +With UCI Lisp's normal print function, it will show up as an +address in Binary Program Space, looking something like "#31534". +.PP +As with any Lisp function that returns an object, +we must store (a pointer to) the result of \fIcreate\fR somewhere +(for example, in the atom Trip) +if we wish to reference it in the future. +Otherwise, the created object will be inaccessible. +(This point is clearer if you consider +that Pascal would insist that you do something with the result +of the function call, although PEARL and many languages like Lisp +and C in which every subprogram is a value-returning function allow +you to construct a value and then blithely go on your way without +using it.) +.PP +To store (a pointer to) the instance returned by \fIcreate\fR in +the atom Trip, you could do the following: +.DS +(setq Trip (create individual PTrans + (Actor John) + (Object John) + (From Office) + (To Home) ) ) +.DE +Since this is a common operation, \fIcreate\fR provides the option of +having (a pointer to) the newly created instance automatically +assigned to a Lisp atom. +This is accomplished by including the +name of the atom as the third argument to \fIcreate\fR. +If the third argument to \fIcreate\fR is an atom rather than a +( ) pair, \fIcreate\fR stores the new +object in this atom. +Thus the effect of the previous example can be achieved by: +.DS +(create individual PTrans Trip + (Actor John) + (Object John) + (From Office) + (To Home) ) +.DE +(In addition, when \fIcreate base PTrans\fR is used, an assignment is +automatically made to the atom PTrans, thus making the defaultinstance +of a structure easily available. +To preserve this, calls to create of the form +\fI(create individual PTrans PTrans ...)\fR are disallowed (that +is, ignored). +In case you should actually wish to use the atom PTrans for other +purposes, evaluating the atom built by prepending \fBi:\fR onto +the structure name will give you the default instance of a base +structure and evaluating the atom built by prepending \fBd:\fR +will give you the actual definition. +Changing the value of these atoms is \fBvery dangerous\fR. +Given the name of a structure, the functions \fBinstatom\fR and +\fBdefatom\fR will construct these atoms for you. +For more information about the item assigned to \fIPTrans\fR +and \fIi:PTrans\fR, see the section 7 on defaults.) +.PP +PTrans is an example of a structure whose slots are all +of the type \fIsymbol\fR. +A more complex example is that of MTrans (Mental Transfer: +an actor transfering a concept (Mental Object) from one place +to another (usually from himself to someone else). +The MObject slot is some other act and so would be of +type \fIstruct\fR resulting in the following definition: +.DS +(create base MTrans + (Actor symbol) + (MObject struct) + (From symbol) + (To symbol) ) +.DE +A sample instance of MTrans is \fIJohn told Carol that he +was going home from the office\fR and would be created with +.DS +(create individual MTrans InformLeaving + (Actor John) + (MObject (PTrans Leaving + (Actor John) + (Object John) + (From Office) + (To Home) ) ) + (From John) + (To Carol) ) +.DE +.LP +Note that to fill a slot of type \fIstruct\fR (or \fIsetof struct\fR) +with a structure value within a +\fIcreate\fR one just embeds the appropriate arguments for a recursive +call to \fIcreate\fR, \fIexcept\fR that you \fBmay\fR leave out +\fIindividual\fR since it would just be repetitive. +If you should want to create an object of another type within +an individual or base structure, you must include the alternative +argument (\fIindividual\fR, \fIbase\fR, \fIpattern\fR, \fIexpanded\fR, +or \fIfunction\fR) before the type name. +This is particularly useful when you wish to create a pattern +with an individual instance in one of its slots. +.PP +The optional third argument of an atom name for storing +in may be included at each level if you wish. +In the example above, \fIcreate\fR actually will create two +new instances, an MTrans which will be stored in InformLeaving, +and a PTrans which is pointed to by the MObject slot of the +MTrans and is also pointed to by Leaving. +In this case, neither InformLeaving nor Leaving is required. +If Leaving were left out, then one would still have a way +to get at the PTrans via the MObject slot of the MTrans that +InformLeaving points to. +However, if InformLeaving were left out and the +result of the call to \fIcreate\fR were not stored any other way, +there is one more way that the MTrans would be accessible. +The value of the most recently created object is always +stored in the special variable \fB*lastcreated*\fR by +\fIcreate\fR so the value of the MTrans would remain +accessible until the next call to \fIcreate\fR. +Note that if there are recursive calls to \fIcreate\fR during this +time in order to process structure values in slots, the value of +\fI*lastcreated*\fR is continually changing to the most recent +one and the setting of \fI*lastcreated*\fR is the last thing +\fIcreate\fR does. +There is also a special variable called \fB*currenttopcreated*\fR +which is set by \fIcreate\fR at the top level call as soon as +the space for an individual or default instance is allocated. +Since it is sometimes handy for a piece of user code which +runs during \fIcreate\fR (see the sections on !, $, predicates and +demons) to be able to access the topmost object, +\fI*currenttopcreated*\fR is sometimes quite useful. +.PP +As in C and Pascal, one can embed to any level. +\fICreate\fR does not have facilities +for more complex networks of structures, as there are other +functions in PEARL which allow their construction. +\fICreate\fR is mainly used to create objects for other +functions to manipulate. +.NH +Accessing Slots of Structures +.PP +In C and Pascal one can access the slots of a record or structure by +using dot notation. +For example, in Pascal the To slot of the MObject slot of +the MTrans pointed to by InformLeaving would be accessed +with the expression InformLeaving.MObject.To (or perhaps +more accurately InformLeaving\fB^\fR.MObject\fB^\fR.To +since slots really contain pointers to objects). +In Pascal and C, there are essentially only two things that +one can do to a slot of a record or structure: access it +(get its value) and assign to it (give it a new value). +In PEARL the macro \fBpath\fR provides +a large number of ways to access and/or change the values +in slots of individual structures. +(In the UCI Lisp version this is called \fIppath\fR +to distinguish it from the system function \fIpath\fR.) +A call to \fIpath\fR is of the following general form: +.DS +(path ) +.DE + determines the action to be performed +and is not evaluated. + should evaluate to the object in which the slot +occurs (or in whose depths the object occurs). + should evaluate either to the atom name of the +slot desired in or a list of the slot names +which one must follow to get down to the slot. + (which is only needed when it makes sense) +should evaluate to the value to be put into the slot +(or otherwise used in performing the function). +At this point, we will only describe the two s +corresponding to accessing and assigning. +These are \fBget\fR and \fBput\fR respectively. +Thus to access the value of a slot, you would use +.DS +(path get ) +.DE +(No value is needed; +the purpose of this call is to get the value.) +To assign a value to a slot, you would use +.DS +(path put ) +.DE +For example, to access the Actor slot of the PTrans in Trip, either of +the following is appropriate: +.DS +(path get Trip 'Actor) +(path get Trip '(Actor) ) +.DE +This is essentially equivalent to a reference to +\fITrip\fB^\fI.Actor\fR in Pascal. +.PP +To access a slot within a structure in a slot of type \fIstruct\fR, +add the slot names to the , just as we access +embedded fields within fields in Pascal by adding more slots +to the accessing expression. +For example, to access the place +John told Carol he was going in our MTrans example above, we +want the To slot of the MObject slot of the MTrans stored in +InformLeaving: +.DS +(path get InformLeaving '(MObject To) ) +.DE +This is essentially equivalent to a reference to +\fIInformLeaving\fB^\fI.MObject\fB^\fI.To\fR in Pascal. +PEARL will check each slot reference, and will indicate if +a slot name is not found (perhaps due to a misspelling or an +unbound slot). +.PP +Similarly, to change the Actor of our PTrans in Trip to be Bob: +.DS +(path put Trip '(Actor) (getsymbol 'Bob) ) +.DE +and to change the To slot within the MObject of the MTrans: +.DS +(path put InformLeaving '(MObject To) (getsymbol 'School) ) +.DE +which is essentially equivalent to assigning a value to +\fIInformLeaving\fB^\fI.MObject\fB^\fI.To\fR in Pascal. +Note that the order of the arguments to these functions is in +\fBnot like\fR the argument ordering of \fIputprop\fR. +.PP +\fBCAUTION\fR: +\fIPath\fR does not check values to ensure that they are of the +correct type before putting them in a slot. +Also, a change in a structure with \fIpath\fR +does not cause it to be reinserted in the data base +(see the next section). +Thus, before changing a structure, one should remove it from +the data base and then reinsert it after the change. +.PP +These functions were gathered under the macro \fIpath\fR because of +their similarity. +However, if you prefer to have the action being performed lead off the +function name in keeping with \fIputprop\fR, \fIget\fR, \fIputd\fR, +\fIgetd\fR, etc., these two functions are also available as +\fBputpath\fR and \fBgetpath\fR with similar names also provided for +all the other forms of path described below. +Thus the name "path" may be tacked onto the end of one of the action +selectors to \fIpath\fR but the rest of the arguments to these +functions remain the same. +.PP +There are quite a few other operations which are allowed through +\fIpath\fR which you will not need or understand until you have read +the rest of this documentation. +We describe them here for completeness but suggest you skip +to the next section during your first reading. +If you feel there is one missing, feel free to suggest it since +they are easy to add. +.IP +\fIpath \fBclear\fR or \fBclearpath\fR -- sets the selected path to +the standard default value for its type (\fInilsym\fR, +\fInilstruct\fR, zero or \fInil\fR). +Note that this is only the standard default and does +not inherit a default from above. +See section 7 for more on default values. +.IP +\fIpath \fBaddset\fR or \fBaddsetpath\fR -- add the specified value to +a slot of type \fIsetof\fR. +.IP +\fIpath \fBdelset\fR or \fBdelsetpath\fR -- delete the specified value +from a slot of type \fIsetof\fR. +.IP +\fIpath \fBgetpred\fR or \fBgetpredpath\fR -- get the list of +predicates on the slot. +.IP +\fIpath \fBaddpred\fR or \fBaddpredpath\fR -- add the specified +predicate to the predicates on the slot. +.IP +\fIpath \fBdelpred\fR or \fBdelpredpath\fR -- delete the specified +predicate from the predicates on the slot. +.IP +\fIpath \fBgethook\fR or \fBgethookpath\fR -- get the assoc-list of +hooks (demons) on the slot. +.IP +\fIpath \fBapply\fR or \fBapplypath\fR -- arguments to this function +are a , followed by the , and +. +The is applied to the value of the slot. +(In the UCI Lisp version, \fIapply#\fR is used so that macros will work. +In the Franz Lisp version, a PEARL-supplied version of \fIapply\fR +called \fBapply*\fR is used which also handles macros "right".) +.PP +(Skip this next paragraph until you have read about hashing and +the data bases.) +The method of processing the path in \fBpath\fR functions allows a +form of indirection through the data base that is sometimes +helpful when you use symbols in slots as unique pointers to +other structures. +Suppose you had the following definitions: +.DS +(create base Person + (* Identity symbol) + ( Name lisp) ) +.DE +.DS +(dbcreate individual Person + (Identity John) + (Name (John Zappa) ) +.DE +and you want to ask \fI"what is the Name of the Person in the +Actor slot of Trip (above)"\fR which you might normally write as: +.DS +(getpath (fetch (create pattern Person + (Identity ! (getpath Trip 'Actor) ) ) ) + 'Name) +.DE +This is very hard to understand. +A shorthand for this is the following: +.DS +(getpath Trip '(Actor Person Name) ) +.DE +which behaves like this: when \fIpath\fR gets to the symbol in +the Actor slot of Trip, it notices that there is still more path +to follow. +It then interprets the next symbol in the path as the +name of a type and does a quick equivalent of fetch of a Person +with its first slot set to John. +It then continues to follow the path specified in this new +structure, finishing up with the value of the Name slot +of the structure. +(Note that this depends on Person structures being hashed by the +relevant slot and will fail otherwise. +Also note that the tendency of most users of PEARL has been away +from the use of symbols as indirections to larger structures and +toward actually putting the larger structure in the slot. +In this case this would imply putting the Person structure in the +Actor slot of PTrans and eliminate the need for "Person" in the +path list.) +.NH +Storing In and Retrieving From the Data Base -- The Simplest Way +.PP +So far we have shown how to create structures and have treated +them pretty much like C structures or Pascal records. +However, PEARL's most important departures from these languages +involve its data base facilities. +PEARL's data base can be thought of as one large +bag into which any structure can be placed. +The data base can hold hundreds, even thousands of separate objects. +There are two basic operations that can be performed upon +the data base, inserting with the function \fIinsertdb\fR +and retrieving with a combination of the functions +\fIfetch\fR and \fInextitem\fR. +.NH 2 +Storing In the Data Base: \fIInsertdb\fR and \fIRemovedb\fR +.PP +While the simplest forms of these actions are +relatively straightforward, the power and efficiency of PEARL +derives from the nuances and controls available with these +functions which take up much of the rest of this document. +Much of the power develops from knowledge provided by the user about +how each kind of structure is likely to be retrieved (and therefore +how it should be stored). +Thus, the data base benefits from knowing as much as possible +in advance about the objects that will be placed within it. +This information is provided by using a large variety +of extra flags during definition calls to \fIcreate\fR. +It is used by \fIinsertdb\fR to hash objects into a specific +\fIhash bucket\fR in the data base, by \fIfetch\fR to retrieve the +correct hash bucket from the data base, and by \fInextitem\fR +to filter the desired objects from this bucket. +.PP +PEARL allows the construction and use of multiple data bases which are +described in detail later. +Without exerting any effort, a data base is automatically created +called \fB*maindb*\fR and pointed to by the special variable \fB*db*\fR. +In general, all PEARL functions which deal with a data base have an +optional last argument which specifies which data base to use. +If it is missing, then the default data base pointed to by +\fI*db*\fR is assumed. +Thus you can change the default data base +simply by assigning the desired data base to \fI*db*\fR. +For simplicity, this optional data base argument is not +mentioned in the following discussion. +.PP +The function \fBinsertdb\fR takes a single structure argument and +inserts it into the data base. +In its simplest form \fIinsertdb\fR requires no user flags on the +definitions of structures. +In this case, \fIinsertdb\fR simply hashes on the type of the +structure regardless of its specific contents so that each +entry ends up in a bucket with all other entries of that type. +For example, to insert into the data base the PTrans which was +saved in the Lisp variable Trip above, you simply provide it as an +argument to \fIinsertdb\fR: +.DS +(insertdb Trip) +.DE +We could also put the PTrans (saved in Leaving whose To slot +was changed to School) which was the MObject of the MTrans above +in the data base with: +.DS +(insertdb Leaving) +.DE +Since no information has been provided by the user about how to +efficiently distinguish PTranses in general, these two will be stored +in the same bucket (as will all PTranses). +When inserting an item into a bucket, \fIinsertdb\fR will check +to ensure that this specific item is not already in that bucket +(using \fIeq\fR) and will only insert it if +it is not already there, thus avoiding duplicates. +.PP +The function \fBremovedb\fR takes a single structure argument +and removes it from any place in the data base where it has been +put using \fIeq\fR to determine equality. +.PP +Since one often wants to create an individual and then insert it into +the data base, there is a macro \fBdbcreate\fR provided whose +arguments are precisely like \fIcreate\fR. +Thus, \fI(dbcreate individual PTrans ....)\fR expands into +\fI(insertdb (create individual PTrans ....) )\fR. +.NH 2 +Retrieving Hash Buckets From the Data Base: Fetch +.PP +.hy next-item +The simplest case of fetching from the data base is +equivalent to asking if a particular, completely defined +object is in the data base. +This is performed by a combination of the functions +fIfetch\fR and \fInextitem\fR. +The first step is to retrieve the hash bucket(s) for the object. +For example, to determine whether the object stored in Trip is in the +data base, the first step is to call the function \fBfetch\fR and +store what it returns (the form of what is returned is described +below): +.DS +(setq PotentialTrips (fetch Trip) ) +.DE +.PP +The function \fIfetch\fR takes a single structure argument which is +called the \fBpattern\fR. +What \fIfetch\fR returns includes this pattern and the hash bucket(s) +from the data base which contain those structures which are +most likely to "match". +The rules of "matching" are fairly complex and are described in +detail in section 20, but for the moment it is enough to know that +two structures match if their respective slots contain equal values. +Thus matching is closer to Lisp's \fIequal\fR than to \fIeq\fR. +.NH 2 +Accessing the Results of a Fetch: Nextitem. +.PP +Conceptually, what \fIfetch\fR returns is a restricted type of \fBstream\fR. +A stream is a "virtual" list, whose items are computed only as needed. +When a fetch from the data base is performed, the pattern provided +is only used to construct a stream containing that pattern and the +appropriate hash bucket from the data base; +no matching (comparing) +between the pattern and objects in the data base occurs. +Thus the stream contains pointers to all data base items in the +same hash bucket, regardless of their likelihood of matching the pattern. +Therefore, the \fIstream\fR or "virtual list" returned by \fIfetch\fR is +in fact bigger than the list of actual items which match. +(For this reason, the default PEARL print function only prints how +many potential items are in the stream.) +.PP +For our purposes, you should regard the object that \fIfetch\fR +returns to be a funny sort of black box, whose only use is as +an argument to the function \fBnextitem\fR. +\fINextitem\fR will compute the next element to be removed from the stream. +When elements are extracted from the stream with the function \fInextitem\fR, +the pattern is "matched" against successive items from the hash bucket +until one matches (and is returned) or until the potential items run out +(and \fInil\fR is returned). +.PP +\fINextitem\fR is very much like the function \fIpop\fR in Lisp because it +updates the status of the stream to reflect the +extraction of the "topmost element" similar to the way \fIpop\fR replaces +its list argument with its \fIcdr\fR. +\fINextitem\fR does this by destructively modifying the stream +(but not the hash bucket); +once the top item +has come off it is no longer a part of the stream. +Like \fIpop\fR, \fInextitem\fR returns \fInil\fR if the stream is empty. +.PP +A stream, as returned by \fIfetch\fR in PotentialTrips, +will \fBnever\fR be \fInil\fR but instead will be a list. +In all cases, the first element will be the atom \fB*stream*\fR. +In most cases, the second element (\fIcadr\fR) is the pattern (object +being fetched) and the rest (\fIcddr\fR) is +the hash bucket that the object hashes to. +However, it is entirely possible for the hash bucket to either +fail to contain any instances of the object, or to contain +multiple instances of the object. +The form that is printed by PEARL's default print function is: +the atom \fB*stream:*\fR, the object being fetched, +and the number of potential items in the stream, +avoiding the prining of a lengthy result. +(If the pattern is actually a function structure, then the atom +used is \fB*function-stream:*\fR.) +.PP +Thus, to actually determine whether the object in Trip is in the data +base, it is necessary to ask for the \fInextitem\fR in the bucket of +the stream PotentialTrips (that is, in the \fIcddr\fR) +which matches the object being fetched (that is, the \fIcadr\fR +of PotentialTrips): +.DS +(setq FirstResult (nextitem PotentialTrips) ) +(setq SecondResult (nextitem PotentialTrips) ) +.DE +If nothing matching Trip occurred in the data base, FirstResult would +contain \fInil\fR; +otherwise, it would contain an object in the data base +which matches Trip. +If you have typed in all the examples we have shown you above, +then FirstResult will contain the same value as Trip. +SecondResult will be \fInil\fR. (The only other object in the same +bucket is the value of Leaving, but that does not match because +its To slot contains School after the \fIpath put\fR above.) +If the two structures in Trip and Leaving both contained +the same slot fillers, they would both match Trip and each +would be returned by \fInextitem\fR on successive calls. +.PP +This is essentially the only type of fetching that is +useful with the information presented so far, +but more powerful types will be described shortly. +.PP +Since the functions \fIcreate\fR, \fIfetch\fR, and \fInextitem\fR +are often used in combination, several macros combining them are +provided by PEARL: +.IP +When you wish to create a pattern only long enough to use it as an +argument to \fIfetch\fR, you can use the macro \fBfetchcreate\fR +which is defined in such a way that \fI(fetchcreate blah)\fR is +equivalent to \fI(fetch (create blah) )\fR ). +.IP +If you want to do a \fIfetchcreate\fR in a function definition and +you wish the pattern to be created only once but used each time +this function is called (a potential savings in space and time), +the macro \fBinlinefetchcreate\fR will call \fIcreate\fR when it +expands and then expand to a call to fetch with this pattern. +.IP +If you want to do a \fIcreate\fR in a function definition and +you wish the object to be created only once, +the macro \fBinlinecreate\fR will call \fIcreate\fR when it +expands and effectively replace itself with the result. +.IP +When you wish to fetch but only need the resulting stream long +enough to use it as an argument to \fInextitem\fR, you can use +the macro \fBfirstfetch\fR which is defined in such a way that +\fI(firstfetch blah)\fR is equivalent to \fI(nextitem (fetch blah) )\fR ). +.IP +If your only goal in fetching some fully-specified object is to +test for its existence in the data base, the function \fBindb\fR +which expects a single structure argument will return \fInil\fR +if it is not there, and non-\fInil\fR if it is. +(Note that \fIindb\fR uses \fIstrequal\fR rather than \fImatch\fR.) +.IP +It is sometimes convenient to have a list of all the items which would be +returned by successive calls to \fInextitem\fR on a stream. +The function \fBstreamtolist\fR expects a stream argument and +returns a list of the items which the stream would produce. +.NH +The Default Values for Unspecified Slots +.PP +When creating an instance of a given type, one may not always +wish to fill in all the slots of the structure, either because +the slot value is unknown or immaterial. +PEARL has a mechanism for filling unfilled slots with default values. +The simplest form of defaulting involves two +predefined objects, \fBnilsym\fR and \fBnilstruct\fR. +\fINilsym\fR is a \fIsymbol\fR, and roughly corresponds to Lisp's +\fInil\fR when \fInil\fR is viewed as an atom. +\fINilstruct\fR is a structure without any slots, +and corresponds to a null structure. +In the absence of a specified value, PEARL will fill in slots +of an individual instance of a structure being created +with \fInilsym\fR if the slot type is \fIsymbol\fR, +\fInilstruct\fR if the slot type is \fIstruct\fR, zero if the slot +is of type \fIint\fR, and Lisp \fInil\fR +if the slot is of type \fIlisp\fR or \fIsetof \fR. +Note that it is up to the user to decide upon the meaning of +\fInilsym\fR and \fInilstruct\fR during further processing. +For example, you must decide for your own application whether +a \fInilstruct\fR filling the MObject slot of a MTrans indicates +that nothing was said or that what was said is unknown. +.PP +Often you may desire closer control over the default values of +a particular slot within individual instances. +For example, suppose you had a definition of Person that +includes several pieces of information about a person: +.DS +(create base Person + (Identity symbol) + (Age int) + (Salary int) + (Health symbol) ) +.DE +The Identity slot would be filled in with a unique symbol for +that person (such as the symbol John), the Age slot would contain +the age in years, the Salary slot would get the person's monthy salary +in dollars, and the Health slot would contain a \fIsymbol\fR indicating +their state of health. +Now in creating an individual instance of a Person +the Identity slot should be always filled in, but we may desire the +other slots to be defaulted to 30 (years), 20000 (dollars) and Healthy. +However, under the default system described so far, these would be +defaulted to zero, zero and \fInilsym\fR. +PEARL provides the ability to specify individual defaults for +each slot of a particular structure type. +This is done at \fIbase\fR creation time by following the type +within a slot with the new default value. +Thus our definition of Person would be: +.DS +(create base Person + (Identity symbol) + (Age int 30) + (Salary int 20000) + (Health symbol Healthy) ) +.DE +Although the main purpose of a call to \fIcreate base\fR is to define +a structure, it also creates a special individual of the type +being defined which has its slots filled with the default values. +For this reason this individual is called the \fBdefault instance\fR +of that type. +It is a structure instance like any other, only a +pointer to it is kept with the type definition, and it is consulted +whenever an instance of that type is constructed. +Thus the default values (either the user-defined defaults or +the standard defaults) will always be used whenever the user +declines to fill in a slot of a structure instance. +For more on defaults, see the discussion of inheriting in +section 19 on creating expanded structures. +.NH +Using Patterns For More Flexible and Powerful Retrieval +.PP +If the fetching mechanisms described so far were the +only sort of fetching that we could do, \fIfetch\fR +(and PEARL) would not be very useful. +What is needed is a way to only partially specify the +values in the structure to be fetched. +Note that the default mechanism does not accomplish this, +since all slots are specified at creation time, even if they +get \fInilsym\fR, \fInilstruct\fR, or \fInil\fR for a value. +What is needed is the ability to specify a \fIdon't care\fR +value for slots whose values should not affect the matching +process during retrieval. +The easiest way to accomplish this in PEARL is to create +a type of object called a \fBpattern\fR. +A \fIpattern\fR is similar to an \fIindividual\fR instance of +a structure except that a special pattern-matching variable +called \fB?*any*\fR which means \fIdon't care\fR or \fImatch anything\fR +is used as the default value for unspecified slots. +(The reason for its name will be clear after the description +of pattern-matching variables later in this section. +Even more detail on pattern-matching variables and more powerful +patterns is provided in sections 21-23 on the matching process, +blocks, lexically scoped variables, and the +unbinding of variables.) +.PP +Patterns are created with \fIcreate\fR using \fIpattern\fR +as the first argument. +Other than this, their syntax is exactly the same as individuals. +An example of a \fIpattern\fR creation is: +.DS +(create pattern PTrans JohnWentSomewhere + (Actor John) + (Object John) ) +.DE +This pattern would match any instance of PTrans in which John +was both the actor and the object being moved. +(Note that this pattern is stored in the Lisp variable +JohnWentSomewhere in the same way as other individuals.) +The main use of patterns is as arguments to \fIfetch\fR, as in: +.DS +(setq PotentialGoings (fetch JohnWentSomewhere) ) +.DE +\fIFetch\fR will return a stream containing all PTranses in the +data base in which John was the actor and object, regardless +what the From and To slots contain. +More complex examples can be created. +Patterns can be embedded as in: +.DS +(create pattern MTrans InformJohnGoingSomewhere + (MObject (PTrans (Actor John) + (Object John) ) ) ) +.DE +Since all unspecified slots are filled with ?*any*, this pattern +will return any MTranses concerning any of John's PTranses +when passed to \fIfetch\fR. +Thus, if we insert InformLeaving from above in the data base: +.DS +(insertdb InformLeaving) +.DE +then the following will fetch that object: +.DS +(nextitem (fetch InformJohnGoingSomewhere) ) +.DE +.PP +Usually one is interested in a more specific piece of information. +For example, if you knew that John told Carol something and wanted +to find out what it was, then you could do this two ways. +One is to create a pattern, fetch it and look at the MObject slot of +the result: +.DS +(create pattern MTrans WhatDidJohnTellCarol + (Actor John) + (From John) + (To Carol) ) +(setq Result (firstfetch WhatDidJohnTellCarol) ) +(path get Result 'MObject) +.DE +However, you might prefer to use a pattern which explicitly +shows that you want that value and gives you a slightly easier +way to get at it. +In this case, you can specify a pattern-matching variable +in the MObject slot of the pattern. +A pattern-matching variable is created by preceding an atom with a +question mark \fB?\fR as in \fI?What\fR. +The question mark is a read macro character which reads the next +atom and builds the list \fI(*var* What)\fR out of it (or +\fI(*global* What)\fR if \fIWhat\fR has previously been declared +global to PEARL; +see below for more on global variables.). +During matching, this variable will get bound to the value +of the slot it gets matched against: +.DS +(create individual MTrans WhatDidJohnTellCarol + (Actor John) + (MObject ?What) + (From John) + (To Carol) ) +(firstfetch WhatDidJohnTellCarol) +.DE +To access the value of a pattern-matching variable in +a structure, one uses either the function \fBvalueof\fR +(which is an expr) or the fexpr \fBvarvalue\fR. +Both functions have two arguments: the name of the +pattern-matching variable whose value you want and +the structure it occurs in (which is evaluated internally +by \fIvarvalue\fR). +Thus both of the following are equivalent: +.DS +(valueof \fB'\fRWhat WhatDidJohnTellCarol) +(varvalue What WhatDidJohnTellCarol) +.DE +.NH +Marking Structures During Creation For More Efficient Retrieval +.PP +Besides specifying what type each structure is, the simplest +piece of information that \fIinsertdb\fR would like the user +to give it through \fIcreate\fR concerns which slot(s) of +a type would be most likely to contain unique information +about a particular instance of that type. +This information is used to differentiate instances of the +type from each other, so that they will be hashed into +different hash buckets. +This is similar to the "keys" that many data base systems ask for. +For PTrans, the Actor slot is often the best choice for this role. +For Person, the Identity slot would be the best choice for this role. +Such unique slots are indicated to \fIcreate\fR when defining a +type by placing an asterisk '*' before the slotname in a +( ) pair. +For example, our new definitions of PTrans and Person +to take advantage of this would look like: +.DS +(create base PTrans + (* Actor symbol) + ( Object symbol) + ( From symbol) + ( To symbol) ) +(create base Person + (* Identity symbol) + ( Age int 30) + ( Salary int 20000) + ( Health symbol Healthy) ) +.DE +If you execute this when you have already executed the other examples +in this document, PEARL will warn you that you are redefining the +base structures PTrans and Person. +This is all right, since that is precisely what we want to happen. +However, the previous instances of PTrans will remain hashed in the +more inefficient way and will not match any later PTrans structures +that are defined. +If you find these warnings annoying when redefining structures, +they may be turned off by setting the special variable +\fB*warn*\fR to \fInil\fR instead of the initial \fIt\fR. +(Note that the Lisp scanner requires a space (or other +white space) to separate the asterisk from the slotname. +Otherwise one would have the slotname \fI*Actor\fR). +.PP +Any number of starred slots may be provided within a structure +definition, but usually only one or two are necessary. +How one decides which slots should be starred is an +art, and depends significantly on your application and the nature +of your data. +The basic rule of thumb is to choose those slots +whose values vary the most widely from instance to instance. +A bad choice will not usually cause the system to bomb or +operate incorrectly in any way, but when it comes time to +fetch an object back out of the data base the system may have +to take the time to scan a large amount of the data base +rather than finding the desired object very rapidly. +Thus execution time is usually the only penalty one pays +for an improper choice of slots to star. +.PP +However, there is one type of use of a slot which can cause +problems in combination with hashing information. +It involves the use of pattern-matching variables and will +serve as a useful example of how to use variables and of how +\fIinsertdb\fR and \fIfetch\fR use the hashing +information to insert and find objects. +The key difference between them is that while \fIinsertdb\fR +inserts an object in as many places as it can, \fIfetch\fR only +looks for it in the \fBbest\fR place. +(What we mean by best will be more obvious after section 13.) +.PP +The problem situation occurs when you wish to insert items +into the data base which contain a variable in the starred +slot (representing general knowledge) and then use, +as a pattern, a structure with that slot filled. +Thus, the following sequence will fail to find Thing +in the data base and instead will return \fInil\fR: +.DS +(create base Thing + (* One int) ) +.DE +.DS +(dbcreate individual Thing DBThing + (One ?O) + (Two 2) ) +.DE +.DS +(nextitem (fetchcreate individual Thing PatThing + (One 1) + (Two 2) ) +.DE +This fails \fIsimply because of the hashing\fR. +Let us see why. +When \fIinsertdb\fR is asked to put something into the data base, +it seeks to put it as many places as the hashing information +indicates are good places to want to look for it. +With no hashing information at all, the only thing \fIinsertdb\fR +can do is to put the object with all other objects of its type. +Thus, with no hashing information, all Things are put together in +the same hash bucket. +With the hashing information, \fIinsertdb\fR would like to put +DBThing in a second (and better) place based on the fact that it +is a Thing \fIand\fR on the value of its One slot. +Unfortunately, its One slot has an unbound variable in it and does +not provide any information which is useful. +Thus the hashing process puts DBThing into the data base in +only one place. +However, when \fIfetch\fR indexes PatThing, it uses the hashing +information to determine that it should look in the data base +under the best combination which is \fIThing + 1\fR. +Since DBThing is not there, it is not found. +If we remove the asterisk, this sequence will return +DBThing with ?O bound to 1 because both DBThing and PatThing will +get indexed into the same spot (along with all other Things). +Thus you should be very careful when determining how to hash +types of structures when you intend to insert them into +the data base with variables in them. +(An alternative solution which could be more efficient if used +carefully is to use the function \fIfetcheverywhere\fR which is +described in section 13. +This problem can also sometimes be solved with the use of adjunct +variables, described in section 14.) +.PP +After more of the system has been described and examples of fetching +and inserting have been given the user will have a better +understanding of this process. +.PP +As another example, let us now create and insert an instance +of our new PTrans which has the Actor slot starred: +.DS +(dbcreate individual PTrans Trip + (Actor John) + (Object John) + (From Office) + (To Home) ) +.DE +This would insert Trip with all other PTranses and, because of the +starred slot Actor, also with any other PTranses with a value of +John in the Actor slot. +Next we redefine and recreate the MTrans: +.DS +(create base MTrans + (* Actor symbol) + ( MObject struct) + ( From symbol) + ( To symbol) ) +.DE +.DS +(create individual MTrans InformLeaving + (Actor John) + (MObject (PTrans Leaving + (Actor John) + (Object John) + (From Office) + (To Home) ) ) + (From John) + (To Carol) ) +.DE +reinsert the PTrans from the MTrans: +.DS +(insertdb Leaving) +.DE +and finally create and insert two other instances of a PTrans, +one with different values in the From and To slots +and one with different values in the Actor and Object slot: +.DS +(create individual PTrans Trip + (Actor John) + (Object John) + (From Home) + (To School) ) +.DE +.DS +(create individual PTrans + (Actor Ted) + (Object Ted) + (From Office) + (To Home) ) +.DE +Note that this last PTrans will be indexed under the combination +of PTrans and Ted and thus will not be in the same hash bucket we +look in when fetching Trip (which is indexed by PTrans and John): +.DS +(setq PotentialTrips (fetch Trip) ) +(setq Result (nextitem PotentialTrips) +PotentialTrips +.DE +Notice the form of the stream PotentialTrips at this point. +.NH +Printing Structures, Symbols and Other PEARL Objects +.PP +As mentioned in the beginning, PEARL stores symbols and +structures (and their definitions) in hunks of memory +that are circularly linked. +Lisp cannot print out the contents of these blocks in a useful way. +Franz Lisp sometimes goes into an infinite loop trying to print them +and the best UCI Lisp can do is tell you its address, +like #2934, which is not very informative. +As mentioned above, the PEARL prompt-read-eval-print loop knows how +to print these in symbolic form. +However, when you want your own programs to print +them, PEARL provides you with two pairs of functions +to convert these blocks into more readable form. +The first we will discuss is the function \fBvalform\fR. +\fIValform\fR takes a \fIstruct\fR, a \fIsymbol\fR or any other type +of PEARL or Lisp object as an argument and returns a +Lisp S-expression describing the object. +Thus if one calls \fIvalform\fR on our PTrans in Trip: +.DS +(setq TripAsList (valform Trip) ) +.DE +the Lisp variable TripAsList will contain the S-expression: +.DS +(PTrans (Actor John) (Object John) (From Home) (To School) ) +.DE +Note that \fIvalform\fR does not cause the PTrans to be printed out +at the user's terminal, it is merely a function that returns an +S-expression (just as the Lisp function \fIlist\fR does.) +PEARL functions will operate upon structures and symbols only +when they are in their internal form, so the primary reason +for converting structures to S-expressions is to print them +(or to modify them for use as new input to \fIcreate\fR). +So PEARL provides a more useful function \fBvalprint\fR +that is effectively \fI(sprint (valform ) )\fR. +(\fBSprint\fR is a function provided by UCI Lisp or Franz PEARL +which prints a Lisp expression in a nicely indented form. +There are more details on \fIsprint\fR in the appendix on UCI Lisp +functions added to PEARL.) +\fIValprint\fR is normally used within a Lisp program to +print out any PEARL construct onto the user's terminal +and it is also used by the default print function in the +PEARL prompt-read-eval-print loop. +Try typing the following and notice that they are the +same except that the second value is slightly indented. +.DS +(valprint Trip) +Trip +.DE +Like \fIsprint\fR, \fIvalprint\fR will accept a second integer +argument telling it which column to start printing in. +The default \fIpearlprintfn\fR uses a value of 4 for this argument +to make the items typed by the user more distinguisable from the +results typed by PEARL. +.PP +There is one other form of each of these two functions. +The functions \fBfullform\fR and \fBfullprint\fR are +like \fIvalform\fR and \fIvalprint\fR but they print +more complete information. +If you type +.DS +(fullprint Trip) +.DE +you will notice that the result has two mysterious +\fInil\fRs in each slot. +These represent other forms of information (predicates +and hooks or demons) which can be added to structures +and which will be described later. +At the moment therefore, \fIvalform\fR and \fIvalprint\fR +are all that the user need remember. +.PP +Note also from above that when a pattern with \fI?*any*\fR is printed, +only the name of that variable is printed, and not its value. +(Try typing JohnWentSomewhere and InformJohnGoingSomewhere +if you do not remember what this looked like.) +If a PEARL pattern-matching variable has not been bound, +PEARL indicates this by printing no value. +If a variable is bound, both the variable name and +its value are printed. +Later when you learn how to put your own variables +in slots, this will become more useful. +.PP +When given a data base, these functions assume that the user does +not really want the complete contents of the data base printed out +and so simply print \fI(database: )\fR. +To actually have the complete contents of a data base printed out, +use the function \fBprintdb\fR. +With no argument, it prints the default data base. +Otherwise, it expects its argument to evaluate to a data base. +A print function which prints all the internal information contained +in a structure or its definition is \fBdebugprint\fR. +.NH +Error Messages, Bugs, and Error Handling Abilities +.PP +Due to the complex implemention of PEARL and the lack +of facilities in Lisp for easily distinguishing between +types of input, a user's error in using PEARL will not +show up as soon as it occurs, but may instead cause some +unfathomable part of PEARL to bomb out sometime later. +If this should happen, the user might try using the Lisp +trace facilities, but will often find little useful information. +This sad state of affairs is currently unavoidable due to the +difficulty of catching user errors where they first occur. +This is partly due to our inability to predict what kinds of +errors users are most likely to make. +.PP +PEARL checks as much as it can, but many features are impossible +or prohibitively expensive to check. +The best strategy for the +user to follow is to examine his last interaction with PEARL. +If the error occurred in the bowels of \fIcreate\fR, then there is a +good chance that the user did something wrong in the details of +a slot description in the call to \fIcreate\fR, since gross structural +errors in such calls are checked for. +Inspect your call closely. +.PP +Other errors can be even more difficult, since a function call +may blow up or fail to produce the desired result due to bad +data passed to \fIcreate\fR several calls ago. +A general rule of thumb to use in tracking down mystifying +errors is to check out the definitions of the structures +involved in the function that failed. +Thus if \fIpath\fR blows up, one should determine the type of +the structure passed to \fIpath\fR, and then check the +\fIcreate\fR call that defined that type. +.PP +Sometimes PEARL may appear to the user to be doing the wrong thing, +but due to PEARL's complex semantics, the user is really at fault. +To make matters worse, there is of course always the chance that +the error really \fBis\fR in PEARL. +Every effort has been made to minimize this chance, and at the +moment there are no known major errors (except those indicated +in this documentation), but as with any complex evolving +software system there is always the chance of obscure errors. +It has been our experience that most errors +are due to the user (including the implementors) not completely +understanding the semantics of some PEARL feature. +This documentation is an effort to minimize this type of error. +For any error which you commit in which PEARL gives what +you consider an unreasonable response, feel free to report +it and we will consider trying to catch it. +These or any other complaints, bugs or suggestions should be +mailed to Joe Faletti via Arpanet or Unix mail +(Kim.Faletti@Berkeley or ucbvax!kim.faletti). +.NH +Short-Circuiting and Redirecting Create Using !, $ and Atoms +.PP +Sometimes, when creating an individual structure, +one may want to fill a slot with an already created structure +that is pointed to by some atom or returned by some function +(or with whatever type of value the slot requires). +In this case, one does not wish to (or cannot) describe the +value for a slot as a list of atoms. +To handle this situation, PEARL allows you to list a Lisp expression +which evaluates to the desired internal form (that is, a form +which needs no processing by \fIcreate\fR), preceding it with +an exclamation point \fB"!"\fR. +The structure (or other object) resulting from evaluating +the Lisp expression will be tested to ensure it is the right type +of value and, if it is, inserted in the newly created structure +as the value of that slot. +(The mnemonic idea of this symbol is as a sort +of "barrier" meaning \fIStop processing here!!! and take this +(almost) literally!!!\fR) For example, after using +.DS +(create individual PTrans Ptrans23 + (Actor John) + (Object John) + (To Home) ) +.DE +to create an individual PTrans, leaving it in internal form in the +atom Ptrans23, you can then insert this PTrans into a new MTrans +with: +.DS +(create individual MTrans + (Actor Bob) + (MObject ! Ptrans23) + (To Carol) ) +.DE +.PP +At other times the user may want to take the result of evaluating +some Lisp code and splice it into the Lisp expression describing the +structure being created at the point where the description of the +value of a slot would occur. +In this case, you wish some Lisp code to be evaluated and then +you wish \fIcreate\fR to build a value for this slot +by further processing (scanning) the result of this evaluation. +To this end, PEARL will evaluate any slot value preceded by a +\fB"$"\fR and insert its result into the \fIcreate\fR call, +proceeding to process it just as if +the user had typed it in directly. +So if one stores the atom Alice in Name with +.DS +(setq Name 'Alice) ; the atom Alice, not the symbol Alice + ; (or the value of s:Alice). +.DE +or possibly +.DS +(setq Name (read) ) +.DE +with the user having typed \fIAlice\fR, then \fI$ Name\fR in +.DS +(create individual PTrans + (Actor $ Name) + (Object $ Name) + (From Home) + (To NewYork) ) +.DE +is equivalent to having Alice typed as the Actor and Object +values: \fIcreate\fR evaluates Name and then processes its +value \fIAlice\fR as input. +Thus, the PTrans will be equivalent to +.DS +(create individual PTrans + (Actor Alice) + (Object Alice) + (From Home) + (To NewYork) ) +.DE +The power of this construct occurs when Name is a atom whose +value changes at run time (as when it is read above) or the +\fIcreate\fR call is within a loop in which Name takes on many +different values. +.PP +In summary, both ! and $ cause the evaluation of the Lisp +expression following them. +However, ! stops the usual processing and expects an +internal value, whereas $ continues the usual +processing and expects a Lisp description of the value. +When you need either ! or $, you will know it! +Until then, do not worry if you do not understand them very well! +.PP +If the expression you want evaluated is simply an atom +bound to a value of the appropriate type, you need not use the !. +Whenever \fIcreate\fR is looking for a value of a particular +type, and finds a bound atom instead, it evaluates the atom and +if it is bound to the correct type of value, that value is used. +This is only done in \fIsymbol\fR slots when the atom is not a +symbolname and in \fIinteger\fR slots if the atom is not from +the ordinal type (if any) associated with the slot. +.NH +More Flexible Hash Selection +.PP +The use of stars (asterisks *) to indicate useful slots for hashing +described earlier is only one of many hashing schemes that PEARL allows. +This section describes the others, and how the user can control them. +The first point to note is that even with the star hashing a single +structure can be hashed in several different ways. +Thus if one thinks that in a particular program PTrans will be +frequently fetched from the data base given only the +Actor \fBor\fR only the Object (that is, the program might only +know the Actor and desire the whole PTrans, or know only +the Object and desire the whole PTrans) the user should +star \fBboth\fR the Actor and Object slots within +the definition of PTrans. +When PEARL stores a PTrans into the data base, it will index +it under both (PTrans + Actor) and (PTrans + Object) in addition +to the usual indexing with all other PTranses. +In general, any number of slots can be starred. +.PP +Another type of hashing does not use the type of the structure in +creating a hash index. +If the symbol colon (:) is used before the +name of a slot, objects of that type will be hashed under that slot +value only. +Thus if the Actor slot of the PTrans definition was +preceded by a colon instead of a star, then instances of PTrans +would be hashed under the value of the Actor slot alone rather the +value of the (PTrans + Actor). +This would be useful in the case in which one were interested in +fetching any structure in which a particular value, say the +symbol John, appered in a coloned slot. +For example all structures in which John appeared in the Actor slot +could be fetched at once (and very efficiently). +.PP +A third type of hashing is \fBstar-star\fR or \fBdouble-star (**) +hashing\fR. +If a double star is used instead of a single star, +PEARL will use \fBtriple hashing\fR. +Only one triple hashing is allowed per structure. +Triple hashing requires that two, and only two slots be double starred. +If PTrans were to be defined in the following way: +.DS +(create base PTrans + (** Actor symbol) + (** Object symbol) + ( From symbol) + ( To symbol) ) +.DE +then when an instance of a PTrans is created, it will be hashed +into the data base under a combination of the three values +(PTrans + Actor + Object). +As with all hashing, if a slot is necessary to a particular type +of hashing but is unfilled (or filled with \fInilsym\fR or +\fInilstruct\fR) the hashing will not occur. +Triple hashing is used when one wants fast access to all +individuals of a particular type with two slots likely to have +fairly unique values. +In the case of PTrans, this would allow one fast access to all +PTranses in which John PTranses Mary somewhere. +Distinctions this fine are not usually necessary, and as it +is slightly more expensive at creation and fetching time, +it should only be used when the user is sure of the need for it. +.PP +A fourth type of hashing is \fBcolon-colon\fR or \fBdouble colon (::) +hashing\fR. +It has the same relation to colon hashing as double star +hashing has to star hashing. +If the **'s in the above are replaced with ::, the hashing will be +on (Actor + Object) ignoring the fact that the structure is a PTrans. +This might be useful in fetching all structures involving John and Mary. +As with double star hashing, double colon hashing should be used +sparingly and only one such hashing pair may be used in a type. +.PP +However, it is possible to combine the use of any of these +hashing methods in a single structure. +Thus one could have both double colon hashing and double star +hashing, as well as several * and : hashings as well. +Given several ways, PEARL uses the one +which the most complex one is used during +fetching, since that should provide the greatest degree of +discrimination between items (that is, most likely to narrow +down the choices). +If the value in a slot intended to take part in hashing is unbound +or otherwise not useful, then the next most specific method it used. +Given the values which are considered useful and the hashing +information for the type of structure, the hierarchy of buckets +to be chosen is as follows: +.DS +** hashing +:: hashing +* hashing +: hashing +.DE +.PP +In section 9 we discussed a problem that arises when the pattern +you are using is more specific than the structures in the data base. +In this case, \fIfetch\fR looks in the data base in the most +specific place and does not find what it is looking. +One alternative is to eliminate the hashing that causes this problem +but this will force \fIfetch\fR to look through a large number of items. +If you do not intend to look all the way through the stream +returned by \fIfetch\fR, there is a version of fetch which will +build the stream out of all the ways the pattern could be fetched. +This function is called \fBfetcheverywhere\fR and will return a +stream made up of the (up to five) hash buckets that its pattern +could be -- potentially expensive if you intend to process the +whole thing. +.PP +In addition to these four methods of hashing, and the simplest one +based on the type of structure only, there are several +hashing labels which are modifiers on these methods and +affect what values are used to compute the index. +.PP +The remaining hashing flags do not introduce any new types +of hashing, but rather modify the way the existing types work. +To motivate these, consider the implementation of Goal withing CD. +In early versions of CD, there were several different types of +goals, including Delta-Prox (goal of being near something), +Delta-Poss (goal of possessing something), and so on. +In general these delta goals were of the form +(Delta- (Actor ...) (Objective ...) ). +This lead to an explosion of Delta-goals +(e.g. Delta-Move-Fingers-Within-Telephone-Dial), +and a new way of handling goals was established. +This was simply that all Goals were to have the form: +.DS +(create base Goal + (Planner symbol) + (Objective struct) ) +.DE +where the Objective would be filled with the appropriate structure, +whether it was a simple Poss or the $DialPhone script. +This change makes CD much cleaner, but poses somewhat of +a problem for hashing. +One of the major uses of hashing within some AI programs +written in PEARL is to associate plans with goals. +So it is best if this process is efficient. +.PP +As an example of this problem (using the early form of Delta-goals): +.DS +; Declaration of PlanFor rules. +(create base PlanFor + (* Objective struct) + (* Plan struct) ) +.DE +.DS +(create base Delta-Prox + (Planner symbol) + (Location symbol) ) +.DE +.DS +(create base Walk-Plan + (Planner symbol) + (From symbol) + (To symbol) ) +.DE +.DS +; Store in the data base the fact that walking is a way of accomplishing +; a Delta-Prox goal. +(dbcreate individual PlanFor + (Goal (Delta-Prox (Planner ?X) + (Location ?Y) ) ) + (Plan (Walk-Plan (Planner ?X) + (From nilsym) + (To ?Y) ) ) ) +.DE +This structure simply says the fact that if one has a goal of being +somewhere, then one plan for doing this is to walk. +Or, using the rule in reverse, if you note that someone is +walking to some location, then you might infer that they had +a goal of being at that location. +Note that after being put into the data base, the rule can be easily +fetched by presenting either half of it as a pattern. +.PP +Thus if a planning program has a goal of doing the action in +the atom GoalAct, then it can query the data base for +any direct plans for doing Act by: +.DS +(fetchcreate individual PlanFor + (Goal ! GoalAct) + (Plan ?*any*) ) +.DE +So if GoalAct happened to be a Delta-Prox goal, then the +rule above would be fetched. +However the revised form of goals hides the unique nature of +the Delta-goal, and the best one could do is fetch all PlanFor rules +that have a structure of type Goal in their Goal slot. +This is a serious loss since \fIall PlanFors\fR have a Goal +in their Goal slot; +thus the system would have to look through all +PlanFors whenever it was trying to fetch one. +What is needed is a way of telling PEARL that when hashing on Goals, +never hash the structure type Goal, but rather use the +item that fills the Objective slot of the Goal. +This would solve our problem nicely, as now all +PlanFors would be hashed on the name of the Objective (Prox, +Dial-Phone, etc.), and a list of all PlanFors would not have to be +searched to find a particular one, rather the system could just hash +directly to it. +.PP +To indicate to PEARL that this \fBhash aliasing\fR is desired, +place an ampersand '&' before the slot name to be substituted +for the structure name when defining the structure. +Thus Goal would be declared: +.DS +(create base Goal + ( Planner symbol) + (& Objective struct) ) +.DE +Naturally only one slot can be selected for hash aliasing. +.PP +In this way, Goals change the way in which other structures +use them to index but the way in which Goals themselves +are indexed will not be affected. +Since many other types of structures are likely to contain Goals, +we must be careful about how this affects the hashing of all of them. +It might be the case that PlanFor was the only structure +indexed based on Goals which would benefit from hash aliasing +and that some structures would actually be hurt by this +because they expected Goals to be only one of many types +of values. +In this case, putting the control of how Goals get used by +other structures into the definition of Goal is a bad idea. +Instead, the control can be moved up into only the +problematic structures. +These structures can simply add the \fB">"\fR hash label to +a starred slot, causing PEARL to use the first starred +slot of the slot-filling structure instead of its type. +For example, when we put a both \fB"*"\fR and \fB">"\fR on the Goal +slot of PlanFor then it will always use the first starred +slot of the Goal in its Goal slot: +.DS +(create base Goal + ( Planner symbol) + (* Objective struct)) +.DE +.DS +(create base PlanFor + (* > Goal struct) + ( Plan struct)) +.DE +Thus, the use of \fB">"\fR hashing is called \fBforced aliasing\fR since +the structure filling a slot has very little control over it. +.PP +However, there is one way for a structure to affect +how forced aliasing happens. +If the user wanted to also star the Planner slot of Goal, +but wanted the Objective slot to be used in cases of forced +aliasing, then the use of an \fB"^"\fR on the Objective slot will +allow that: +.DS +(create base Goal + (* Planner symbol) + (* ^ Objective struct)) +.DE +thus allowing Goals inserted directly into the data base to be +indexed by the combinations \fIGoal + Planner\fR and +\fIGoal + Objective\fR while other objects containing Goals would +use the Objective slot rather than Goal \fIOtherObject + Objective\fR. +.PP +On the other hand, if most structures containing Goals would +benefit from the use of the hash aliasing label \fB"&"\fR in Goal, +but only one or two are hurt by it, the use of \fB"&"\fR in Goal +can be overridden by the structures which will contain Goals +by adding the \fB"<"\fR hash label to the starred slot to produce +\fBanti-aliasing\fR. +This gives the controlling structure the last word +over how it is hashed. +.DS +(create base Goal + ( Planner symbol) + (& Objective struct)) +.DE +.DS +(create base OffendedStructure + (* < Slot struct)) +.DE +Thus, the anti-aliasing \fB"<"\fR means \fIjust for this hashing, turn +off hash aliasing (if any) of any structure filling this slot\fR. +.PP +The proper use of hash aliasing and anti-aliasing, +like all the hashing specifiers is an art that must be learned by +applying them to real systems, and the correct hash directives +for a particular system rely critically upon the statistics of +that particular system operating upon a particular set of data. +The hashing mechanism was designed to give the user benefit in +proportion to the effort expended in determining hash labels. +With no effort, the structure type provides some help. +With the addition of each label or pair of labels, +an item to be inserted into the data base is indexed into +another location in the hash table. +Thus the cost of \fIextra\fR labels is simply the time to +find another hash bucket (a few adds and multiplies), and add +the item to the front of the list implying the time and +space incurred by one cons-cell. +.NH +Using Predicates to Constrain Fetching +.PP +Sometimes when you are creating a pattern to fetch a structure, +giving the overall form of the structure is not specific enough. +In particular, it is often desirable to restrict the value of a +slot to a subrange. +For example, using the structure Health: +.DS +(create base Health + (Actor symbol) + (Level int) ) +.DE +one might want to find out who is sick by creating a pattern +that only matches those Health structures in which the Level +is less than -1 (on a scale from -10 to 10 perhaps). +This can be done by simply writing a predicate (say Sick) +which expects to be given the value of the slot being matched +against as its one argument: +.DS +(de Sick (Num) + (lessp Num -1) ) +.DE +Then you simply add its name after the value +within the pair of the pattern: +.DS +(create pattern Health HealthPattern + (Actor ?Person) + (Level ?Level Sick) ) +.DE +Given these definitions, a (fetch HealthPattern) would pass +the Level slotfiller of each Health structure it +found in the data base to the predicate Sick. +If Sick returned true (non-\fInil\fR) then it would +consider the slot to have matched whereas a +\fInil\fR from Sick would be considered a mismatch. +There are no standard predicates for users to use for these +purposes, but they are relatively easy to create as needed. +.PP +However, one often has a predicate which has more than one +argument only one (or none) of which are the slot value. +For example, one might want to include a special variable +or the value of some other slot of the structure or the +structure itself. +To make this easy PEARL allows predicates to be arbitrary +s-expressions which may contain any of several special forms +for which PEARL substitutes the current slot or structure. +.PP +If a predicate includes an asterisk \fB*\fR, this is replaced by +the value of the current slot (in the structure being matched +against). +If it includes a double asterisk \fB**\fR, this is replaced +by the whole structure being matched against. +If you want the value of another slot in the current structure, +precede its name with an equal sign (as in \fB=SlotName\fR to +have the value of the slot named SlotName inserted). +There is a readmacro \fB"="\fR which converts \fI=S\fR into +\fI(*slot* S)\fR, just as the readmacro \fB"?"\fR converts ?X into +\fI(*var* X)\fR (or \fI(*global* X)\fR) for pattern-matching variables. +While processing predicates before executing them, PEARL will +look for these three constructs and replace any of them with the +appropriate value, so pattern-matching variables can also be +used in predicates. +.PP +If there are several predicates on a slot, they are run in +succession until one returns nil or they have all been run. +Thus, a list of predicates provides the effect of a conditional +\fIand\fR. +Thus, although PEARL knows nothing special about logical +connectives like \fIor\fR and \fIand\fR, the effect of a +the usual Lisp \fIand\fR is automatically implied and +the conditional \fIor\fR of Lisp can be had by using the +s-expression type of predicate. +If you wish things to run regardless of their results, +providing the effect of unconditional \fIand\fR, use hooks (demons). +.PP +The above was one of two types of predicates available. +To motivate the other type, consider the case of wanting +to fetch all MTranses about the occurence of a PTrans. +This could be accomplished in one of two ways. +The first is: +.DS +; In this pattern example, all slots are automatically filled +; with ?*any* except the MObject which must be a PTrans. +(create pattern MTrans + (MObject (PTrans) ) ) +.DE +Since this method actually results in \fI?*any*\fR being +matched against the fillers in each of the PTrans's +slots, it is a bit inefficient. +.PP +The second way uses \fBstructure predicates\fR +to avoid this matching by specifying merely that the filler +of the MObject slot must be a PTrans structure. +This is done by listing the name of a previously +defined structure after a pattern-matching variable: +.DS +(create pattern MTrans + (MObject ?Obj PTrans) ) +.DE +PEARL will then bind Obj to any structure that is a PTrans +(or expanded PTrans) and match successfully without +examining any of the slots of that PTrans. +PEARL can tell the difference between these two types of +predicates since one will have some sort of function declaration +and the other will be the name of a defined structure. +In the case of a function with the +same name as a structure (which the user should never do as it +invites errors) the name's structure role takes precedence. +.PP +Since a similar effect is sometimes desired on slots of type +\fIsymbol\fR, a similar but more complex mechanism is provided +with symbols and with structures which failed the above test. +If the name of a predicate on a slot of type symbol or structure +is the name of a type of structure, PEARL will assume that what +you want to know about the value in this slot is whether there +is anything in the data base of the type specified by the structure +predicate with the slot value in its first slot. +Thus, if the data base contains an item saying that the symbol +John represents a person: +.DS +(symbol John) +(dbcreate individual Person + (Identity John)) +.DE +then fetching a pattern with a symbol slot which has a Person +predicate on it: +.DS +(fetchcreate pattern Thing + (Slot ?X Person)) +.DE +will cause the equivalent of a fetch from the (default) data base +of the pattern (Person (Identity John)). +Note that this implies that the first slot of a structure enjoys +somewhat of a pre-eminence and that this means that one should +carefully choose which slot to put first. +For efficiency however, \fIfetch\fR is not actually used. +The function actually used is \fBdisguisedas\fR which expects +the slot filler, the structure definition (not default instance) +and an optional data base to look in. +Slot filler may be either a symbol or structure. +.PP +This second type of predicate can also result in a kind of +inefficiency which you might like to avoid. +By putting a variable in the MObject slot of the MTrans along with +a PTrans structure predicate, we preclude PEARL from hashing the +object in any useful way, forcing it to look through all MTranses +instead of only MTranses with PTranses in their MObject slot. +Since patterns are most often less specific than the objects in +the data base, this can make a big difference. +Another problem with a variable plus a structure predicate is that the +structure predicate is either based on fetches and the first slot or it +is limitted to matching the type only. +We might sometimes want a more complicated structure to be used +as a predicate. +However, if we opt instead for the more efficient fetching and +matching by putting a structure in the slot, we have lost the +ability to have a variable bound during the match. +.PP +To allow you both to help improve the hashing and matching of a +structure and also to bind a variable as a side effect, PEARL +provides a mechanism to attach an \fBadjunct variable\fR to the slot. +This adjunct variable in a slot is bound as a side effect whenever the +values in the slot of the two structures were already bound, have +already been matched successfully and all predicates and slot hooks +have been run. +Adjunct variables may be local, lexically scoped or global, just +as any other variable. +To use an adjunct variable, include the variable \fIafter\fR the +value preceded by a colon and preceding any predicates or slot hooks. +For example, +.DS +(create pattern MTrans + (MObject (PTrans (Actor John) ) : ?Obj) ) +.DE +would match any MTrans about John PTransing something, and also +bind the adjunct variable ?Obj to the actual PTrans structure +that applied. +.PP +Since PEARL uses hunks to create so many types of values of its +own, it also provides a set of predicates to test an item to see +what type it is. +Many of them are quite definitely kludges since they depend upon +certain bizarre structures existing only in PEARL-created items +and not in user-created items and thus should not be depended +upon totally. +These functions are \fBstreamp\fR, \fBdatabasep\fR, \fBblockp\fR, +\fBdefinitionp\fR, \fBpsymbolp\fR (to distinguish from Franz Lisp +\fIsymbolp\fR), \fBstructurep\fR, +\fBsymbolnamep\fR, and \fBstructurenamep\fR. +.NH +More Useful Slot Types +.PP +These last few examples begin to show the restricted nature of basic +integer values and of labelling slots as being of type \fIstruct\fR. +If the values in an integer slot will range between -10 and 10, +then you would like to say that. +If the values which will fill a slot of type structure will +be Events or Acts or States, you would like to specify that. +PEARL provides mechanisms to fill both of these needs. +.PP +In the case of an integer slot to be filled with values from a range +of -10 to 10, these integer values do not represent "levels of health" +very well either. +Rather than saying that a person's "health level" +is -2, you might like to say it was "Sick". +In fact, you would +probably like to say that the values of the slot will be one from +among the set of values "Dead, Critical, Sick, OK, Healthy and InThePink". +Moreover, you might like to specify that these values are to be +associated with integer values in such a way that the ordering +you specified holds and you may or may not want to specify precisely +what integer values should be associated with these atoms. +In other words, you would like a type which consists of a set of +values with a linear ordering on them, similar to the Pascal scalar or +enumeration type. +.PP +Such a type exists in PEARL and is created by a call to +the function \fBordinal\fR. +For example, to create an ordered set of values to represent +levels of various states when you want the actual +integer values to be created by PEARL, you would say: +.DS +(ordinal Levels (Low Middle High)) +.DE +which would associate the numbers 1, 2, and 3 with Low, Middle and +High respectively. +If you want to specify the values to be associated with each name, +you simply list the value after each name. +Thus, to create a set of values for use in the integer Level +slot of Health above, you might say the following (the values need +not be listed in order): +.DS +(ordinal HealthLevels (Dead -10 Critical -6 Sick -2 OK 2 + Healthy 6 InThePink 10)) +.DE +Among the actions that \fIordinal\fR performs are the following: +.IP 1. +The assoc-list of names and values for the ordinal type can be +accessed by evaluating the atom built by prepending \fBo:\fR to +the name of the ordinal type. +Given the name of an ordinal type, the function \fBordatom\fR builds +this atom. +Thus \fIo:Levels\fR contains (and \fI(eval (ordatom 'Levels))\fR returns) +the value \fI((Low . 1) (Middle . 2) (High . 3))\fR. +.IP 2. +Atoms consisting of the name of the ordinal type concatenated +with a colon and the value name are created and set to the value +they represent. +Thus \fILevels:Low\fR is set to 1, \fILevels:Middle\fR is set to 2, etc. +.IP 3. +Two atoms with \fB:min\fR and \fB:max\fR concatenated to the +name of the ordinal type are created and set to the lowest +and highest integer values in the type. +Thus \fIHealthLevels:min\fR is -10, and \fIHealthLevels:max\fR is 10. +.IP 4. +The name of the ordinal type is added the list of all ordinal type +names kept in the special variable \fB*ordinalnames\fR*. +.IP 5. +The name of the ordinal type is stored with the slot +so that the print functions can convert from the +integer value back into the name. +Since the default value for integers is zero but most +ordinals will not have a zero value, the print functions will +print \fB*zero-ordinal-value*\fR instead of zero. +.PP +Having created an ordinal type, it is then possible to declare in +a structure definition that a slot will contain values of that type. +The use of values from this type is \fBnot enforced\fR +by PEARL but allows the definitions of integer slots to be +more readable, allows the use of the names of values instead +of their associated integers when creating individuals and +allows PEARL to print the more readable information when +printing an integer slot. +The special atoms created allow predicates, hooks (demons) and +other functions to refer to these values without knowing +their associated integers. +We can now redefine Health to use HealthLevels: +.DS +(create base Health + (Actor symbol) + (Level HealthLevels) ) +.DE +and create an individual which says that John is in +the pink of health: +.DS +(create individual Health + (Actor John) + (Level InThePink) ) +.DE +.PP +Declaring a slot to be of type \fIstruct\fR is similarly +unenlightening, so PEARL will accept the name of a +structure type in its place. +For example, we can make the following definitions: +.DS +(create base Person + (* Identity symbol) ) +(create base Health + (Actor Person) + (Level HealthLevels) ) +.DE +and the Actor slot of Health will be of type \fIstruct\fR. +However, there is currently no extra type checking implied +by this declaration (although it is being considered), but +again it improves the readability of declarations tremendously. +.NH +Attaching Hooks to Structures (If-Added Demons) +.PP +A fairly old construct within AI is that of demons. +In their pure form they could be thought of as asynchronous +parallel processes that watch everything going on within a +system, lying in wait for a particular set of conditions to occur. +These conditions might be a block-manipulating program stacking +some blocks too high to be stable, or a data base program violating +a consistency constraint. +The main problem with classical demons was that in their most flexible +form they gobble up far too much system time, as well as being very +hard to program as it was hard to see just when they might pop up +during the execution of a program. +.PP +In an attempt to control the implementation of demons and at the same +time provide the user with increased control over the built-in PEARL +functions, PEARL allows the user to attach pieces of code to +structures that will be run when specific PEARL (or user) functions +access particular types of data or pieces of data at particular +places in the code. +Thus, PEARL provides a general but restricted and fairly efficient +ability to control the operation of specific functions on specific +pieces of data by providing \fBhooks\fR in the PEARL functions +which check for requests within structures that certain functions +be run when they are accessed in certain ways. +Thus PEARL has two useful sub-breeds of \fBhooks\fR which +watch over either +.IP a. +the value of a particular slot of a particular individual structure, +referred to as \fIslot hooks\fR. +.IP b. +operations upon all individuals of a particular base structure type +referred to as \fIbase hooks\fR. +.PP +Like predicates, hooks can either be the name of a function to +run or a Lisp s-expression to be evaluated. +If an s-expression, they can include the special forms +\fB**\fR representing the current structure or \fB*\fR representing +the value of the current slot on slot hooks and of the current +structure on base hooks. +Variables or slot names preceded by \fB=\fR are also allowed +(just as in predicates), referring to variables or slots in +the current structure. +If hooks are run by functions which take two items as arguments, +like \fImatch\fR, then the special form \fB>**\fR may +be used to represent the \fBother\fR structure (which \fB>\fR is +meant to suggest) and \fB>*\fR may be used for the value in this +slot of the other structure. +(In the case of functions of only one argument, \fI>*\fR and +\fI>**\fR are the same as \fI**\fR and \fI*\fR.) +In functions which take two arguments, the special form \fB?\fR +may be used to represent the result that the function intends to +return. +(This will be \fI*pearlunbound*\fR in hooks which run before the +function has done its job.) +.PP +When hooks run in the context of a call to \fIpath\fR, +two special variables are available: \fB*pathtop*\fR which +is the topmost structure passed to path and \fB*pathlocal*\fR +which is the current innermost structure whose slot is +being accessed. +When hooks are run in the context of a call to a function which +deals with a data base, then the special variable \fBdb\fR +will contain the data base currently being used. +.PP +The functions used to fill in the special forms like *, **, =slot, +and variables before evaluation come in two flavors and are +called \fBfillin1\fR and \fBfillin2\fR. +\fIFillin1\fR is designed for hooks which run on single structures +and expects as arguments: +.IP a. +the function (s-expression) to fill in, +.IP b. +the slot value (or item if a base hook) to use for \fI*\fR, +.IP c. +the structure to use for \fI**\fR, and +.IP d. +the definition for the item provided as the third argument +(for interpretation of \fI=slot\fR forms). +.PP +\fIFillin2\fR is designed for hooks which run on two structures and +produce a result and expects as arguments: +.IP a. +the function (s-expression) to fill in, +.IP b-c. +the slot values (or structures if a base hook) to use for \fI*\fR and \fI>*\fR, +.IP d-e. +the structures to use for \fI**\fR and \fI>**\fR, +.IP f. +the definition for the structure provided as the fourth argument, and +.IP g. +the result the function intends to return to use for \fI?\fR. +.PP +Four functions for running hooks are provided for the user, two +for running slot hooks and base hooks for single items and two for +running slot hooks and base hooks for pairs of items. +\fBRunslothooks1\fR expects to be given the invoking function's +name, the structure and name of the slot on which to run the slot +hooks, and the value to be used for \fI*\fR. +\fBRunslothooks2\fR expects to be given the invoking function's +name, the two structures and name of the slot in them on which to +run the slot hooks, and the values to be used for \fI*\fR and \fI>*\fR. +\fBRunbasehooks1\fR expects to be given the invoking function's name +and the structure whose base hooks are to be run. +\fBRunbasehooks2\fR expects the invoking function's name, the two +structures whose base hooks are to be run and the result the +calling function plans to return. +.PP +If present, base hooks are run by most major PEARL functions. +If a base hook is labelled with \fIfoo\fR then the function \fIfoo\fR +will execute the hook just before exitting. +Slot hooks are run by most major PEARL functions which look through +the slots of a structure. +If a slot hook is labelled with \fIfoo\fR then the function \fIfoo\fR +will execute the hook just after processing the slot. +.PP +However, hooks can be turned off selectively or completely. +By setting the atoms \fB*runallslothooks*\fR and +\fB*runallbasehooks*\fR to nil, you can completely disable +the running of all hooks. +This is useful for debugging and also helps improve efficiency +a bit if you do not use hooks at all. +There is also an atom to go with each PEARL function (of the form +\fB*run...hooks*\fR) which can be used to disable hooks for selected +functions. +The following is a complete table of what PEARL functions run hooks +and the names of the labels that invoke them and the atoms that +control their running: +.LD +Base hooks are run by: \kminvoked by hooks labelled: + create expanded \h'|\nmu'expanded + create individual \h'|\nmu'individual + create pattern \h'|\nmu'pattern + smerge \h'|\nmu'smerge + nextitem \h'|\nmu'nextitem + standardfetch * \h'|\nmu'fetch + expandedfetch * \h'|\nmu'fetch + fetcheverywhere * \h'|\nmu'fetch + insertdb \h'|\nmu'insertdb + removedb \h'|\nmu'removedb + nextequal \h'|\nmu'nextequal + indb \h'|\nmu'indb + standardmatch \h'|\nmu'match + basicmatch \h'|\nmu'match + strequal \h'|\nmu'strequal +_________ +* \fIfetch\fR does not run hooks on function structures. +.sp 2 +Slot hooks are run by: \h'|\nmu'invoked by hooks labelled: + standardmatch \h'|\nmu'match + basicmatch \h'|\nmu'match + strequal \h'|\nmu'strequal + path put \h'|\nmu'put + path clear \h'|\nmu'clear + path addset \h'|\nmu'addset + path delset \h'|\nmu'delset + path addpred \h'|\nmu'addpred + path delpred \h'|\nmu'delpred + path get \h'|\nmu'get + path getpred \h'|\nmu'getpred + path gethook \h'|\nmu'gethook + path apply \h'|\nmu'apply +.sp 2 +Hooks of both kinds are controlled by these atoms, initially t: + *runallslothooks* -- controls all slot hooks. + *runallbasehooks* -- controls all base hooks. + *runputpathhooks* \h'|\nmu'*runclearpathhooks* + *runaddsetpathhooks* \h'|\nmu'*rundelsetpathhooks* + *runaddpredpathhooks* \h'|\nmu'*rundelpredpathhooks* + *rungetpathhooks* \h'|\nmu'*rungetpredpathhooks* + *rungethookpathhooks* \h'|\nmu'*runapplypathhooks* + *runmatchhooks* \h'|\nmu'*runsmergehooks* + *runindividualhooks* \h'|\nmu'*runexpandedhooks* + *runpatternhooks* \h'|\nmu'*runnextitemhooks* + *runfetchhooks* \h'|\nmu'*runinsertdbhooks* + *runremovedbhooks* \h'|\nmu'*runindbhooks* + *runnextequalhooks* \h'|\nmu'*runstrequalhooks* +.DE +.PP +It is likely that hooks attached to a particular function would like to run +the same function in such a way that hooks will not be invoked. +Or in general, it is possible that you will want to run some PEARL function +in such a way that it is "hidden" from hooks. +To make this easy, a macro is provided called \fBhidden\fR which temporarily +sets the atom \fI*run...hooks*\fR to nil, runs a command and then restores +the former value of that atom. +For this to work correctly, you \fBmust\fR invoke the function you wish hidden +with the name corresponding to the "..." in its \fI*run...hooks*\fR atom. +Thus, you can hide the creation of an individual from hooks by executing: +.DS +(hidden (individual PTrans ....) ) +.DE +(see Section 27 for the macro \fIindividual\fR) but \fBnot\fR by executing: +.DS +(hidden (create individual PTrans ....) ) +.DE +A parallel function \fBvisible\fR temporarily sets the associated +atom to \fIt\fR before evaluating the function. +.PP +One of the reasons that hooks are checked for both before and after +a PEARL function does its job is to provide the user with the +opportunity to affect the result of the particular task. +In the simplest case, a hook simply executes a piece of code +and does not directly affect the function it is labelled with. +However, if the value returned by a hook is a list whose \fIcar\fR +is either \fB*done*\fR, \fB*fail*\fR, and \fB*use*\fR, then the action +of that function will be modified. +If the result of a hook which runs before the task starts with +\fI*done*\fR, then the hook is presumed to have accomplished what the +PEARL function was supposed to have done and the function will return +immediately with the \fIcadr\fR of the hook's result if there is +one, or else with the structure being operated on (for base hooks) +or the value in the slot (for slot hooks). +If the result of a hook which runs after the task starts with +\fI*done*\fR, then the function will return immediately with the +\fIcadr\fR of the hook's result if there is one, or else with +the result that was going to be return anyway. +.PP +If the result of a hook which runs before the task starts with +\fI*fail*\fR, then the hook is presumed to have determined that the +PEARL function should quit and the function will return +immediately with the \fIcadr\fR of the hook's result if there is one, +or else with the atom \fI*fail*\fR. +If the result of a hook which runs after the task starts with +\fI*fail*\fR, then the function will return immediately with the +\fIcadr\fR of the hook's result (which may be nil). +.PP +If the result of a hook which runs before the task starts with +\fI*use*\fR, then the hook is presumed to have determined that the +PEARL function should use a different value instead of the originally +provided one and the function will use the \fIcadr\fR of the hook's +result for the rest of the task. +If the result of a hook which runs after the task starts with +\fI*use*\fR, then the function will replace its intended result with +the \fIcadr\fR of the hook's result (which may be nil). +Thus, for example, a slot hook labelled with \fImatch\fR can modify the result of the +whole match. +.PP +Obviously, these all should be used with great care. +Note that \fIreturn immediately\fR means without even running +any other slot hooks on that slot for slot hooks or without +running any other base hooks on that structure for base hooks. +.PP +For example consider the case of a structure representing someone's +order in a Chinese restaurant. +As items are added to the order, it would be nice if there was a +magical slot TotalBill that contained the current +running total of the cost of the items ordered. +Demons, being such magical creatures, fill the bill nicely. +However, we only wish to have our demon-like hooks +activated when particular slots are filled (added to or accessed). +First consider the simple case in which an order consists of +three items only, the name of the soup and one or two entrees: +.DS +(create base Chinese-Food-Entree + (Name lisp) + (Price int) ) +.DE +.DS +(create base Chinese-Dinner-Order + (Soup Chinese-Food-Entree) + (Entree1 Chinese-Food-Entree) + (Entree2 Chinese-Food-Entree) + (TotalBill int) ) +.DE +.DS +(create individual Chinese-Food-Entree + (Name (Hot And Sour Soup) ) + (Price 323) ) +.DE +.DS +(create individual Chinese-Food-Entree + (Name (Sizzling Rice Soup) ) + (Price 349) ) +.DE +.DS +(create individual Chinese-Food-Entree + (Name (Lingnan Beef) ) + (Price 399) ) +.DE +.DS +(create individual Chinese-Food-Entree + (Name (Mandarin Chicken) ) + (Price 367) ) +.DE +.DS +(create individual Chinese-Food-Entree + (Name (Shrimp Cantonese) ) + (Price 479) ) +.DE +.DS +; an undetermined meal is created. +(create individual Chinese-Dinner-Order Meal + (Soup ^ if >put (Maintain-Total * ** =TotalBill) ) + (Entree1 ^ if >put (Maintain-Total * ** =TotalBill) ) + (Entree2 ^ if >put (Maintain-Total * ** =TotalBill) ) + (TotalBill 0) ) +.DE +Note that a slot hook is put after the value in a slot by using +the word \fBif\fR (or \fBhook\fR) followed by the appropriate label +for the invoking function followed by the function name or +s-expression to be evaluated. +Note also that when you want to put hooks on slots of an individual but +do not want to specify a value, the use of \fB"^"\fR will instruct +\fIcreate\fR to copy the default value instead. +If the Maintain-Total function is properly specified, whenever +one replaces one of the food slots with a real dish using +the \fIputpath\fR function, the Maintain-Total function would be +activated and would add the price of that meal to the running total +in the TotalBill slot. +If one changed one's mind a lot, it would be necessary to include +another hook Remove-Price which would be activated by a \fIclearpath\fR. +This would require adding the \fIif-cleared\fR hook +\fI"if >clear Remove-Price"\fR after the \fIif-put\fR hook: +.DS +(create individual Chinese-Dinner-Order ChangingMeal + (Soup ^ if >put (Maintain-Total * ** =TotalBill) + if >clear (Remove-Price * ** =TotalBill) ) + (Entree1 ^ if >put (Maintain-Total * ** =TotalBill) + if >clear (Remove-Price * ** =TotalBill) ) + (Entree2 ^ if >put (Maintain-Total * ** =TotalBill) + if >clear (Remove-Price * ** =TotalBill) ) + (TotalBill 0) ) +.DE +The code for the two hooks follows: +.DS +(de Maintain-Total (Food Meal CurrentMealTotal) + (putpath Meal '(TotalBill) + (*plus CurrentTotal + (getpath Food '(Price) ) ) ) ) +.DE +.DS +(de Remove-Price (Food Meal CurrentMealTotal) + (putpath Meal '(TotalBill) + (*plus CurrentTotal + (getpath Food '(Price) ) ) ) ) +.DE +.PP +A more flexible meal order structure would not have three slots +for food, but rather a single slot of type \fIsetof struct\fR. +Then entries would be added by the \fIaddsetpath\fR functions, +and the \fIif-put\fR hook would be an \fIif-addset\fR hook but the +code would essentially be the same. +.PP +To attach a base hook to a structure, the first "slot" in its definition +must start with one of the atoms \fBif\fR or \fBhook\fR. +The rest of the slot must then contain a sequence of labels for invoking +functions and function names or s-expressions to be evaluated. +For example, to invoke \fIvalprint\fR before and a user function called +\fIverify\fR afterwards whenever a PTrans is inserted into the data base, +you would define PTrans as follows: +.DS +(create base PTrans + (if insertdb (verify *)) + (* Actor symbol) + ( Object symbol) + ( From symbol) + ( To symbol) ) +.DE +.PP +Recall that PEARL provides a print function called \fBfullprint\fR +which for most structures seen so far printed two extra \fInil\fRs +in each slot. +If a slot has predicates, the first \fInil\fR will be replaced by +a list of them. +If the slot has hooks, the second \fInil\fR will be +replaced by a list of cons-cells with the invoking function in the +\fIcar\fR and the hook in the \fIcdr\fR. +.PP +The invocation of hooks labelled with other forms of \fIpath\fR are similar +except for \fIapply\fR. +If \fI(path apply Fcn ...)\fR is executed, +then any hooks which are labelled with Fcn will be run. +.PP +At this point the syntax of a slot in a definition or individual has become +quite complicated, so we summarize with the following BNF grammar: +.DS +{ a b c } means select one of a, b, or c. +[ XXX ] means optionally XXX. +XXX * means zero or more XXX's +x | y means x or y +.DE +.ID + ::= ( + + + + + + + ) + ::= ( + + + + + ) + ::= | +.sp 1 + ::= { "&" "^" "*" "**" ":" "::" ">" "<" } * + ::= { "struct" "symbol" "int" "lisp" } | + "setof" | | + + ::= | "^" | "nil" | + "==" | ":=" + ::= | | | + ::= [ ":" ] + ::= ? + ::= { | } * + ::= | + ::= "if" + ::= | +.DE +.NH +Creating and Manipulating Multiple Data Bases +.PP +Without any effort on the user's part, a single data base of a +default size exists in PEARL when it starts up. +It is called \fB*maindb*\fR and is pointed to by the special +variable \fB*db*\fR which is assumed by all functions which use a +data base to point to the default data base (that is, the data +base to be used when an expected data base argument is missing). +.PP +To build another data base, choose a name for it and call the +function \fBbuilddb\fR which is an nlambda (fexpr) expecting +the name of the new data base. +You may build as many as you wish and store whichever one you want +in \fI*db*\fR. +.PP +Sometimes one may wish to clear out the data base and start out with a +clean slate. +To make this easy, there is a special function \fBcleardb\fR +which expects either zero or one data bases as arguments +and does the job. +If it receives no arguments, then the default data base is cleared. +\fICleardb\fR removes everything from the data base, +but does not actually delete (or reclaim the storage space of) the +objects within the data base. +But if the objects inside are not pointed to by any program +variables, they are gone for good. +(\fICleardb\fR clears out \fIonly\fR the named data base and not +data bases that it may be built upon as described in the next section.) +.PP +Data bases contain two parts, referred to as \fIdb1\fR and \fIdb2\fR. +\fIDb1\fR contains items which are indexed under only their type +or using single-colon hashing. +Its default size is 29. +\fIDb2\fR contains items which are indexed under two or three +values. +Its default size is 127. +These sizes are chosen to be prime numbers which are just barely +smaller than a power of two. +(This choice was made to take full advantage of hunks in Franz Lisp +which are always allocated to be a power of two.) +The ratio between the two sizes is approximately 1 to 4. +The size for data bases may be chosen by specifying the +power of two that you wish \fIdb2\fR to close to. +.PP +The function \fBsetdbsize\fR expects an integer between 2 and 13 +representing the power to which two should be raised. +The default data base size is thus the result of calling +\fIsetdbsize\fR with an argument of 7. +To change the default size, you should call \fIsetdbsize\fR +in your \fI.init.prl\fR file, before creating any data bases of your +own. +\fISetdbsize\fR rebuilds \fI*maindb*\fR (without putting +anything into the new one) and releases all other data bases. +Thus, it should not \fInormally\fR be used at any time after the +processing of the \fI.init.prl\fR file. +(In the Franz Lisp version, although this full range of values is +accepted, the largest a data base in the 1 to 4 ratio can be +is 29 + 127 since hunks are limitted to 128 words. +However, an argument of 9 to \fIsetdbsize\fR will set the sizes +of both data bases to 127.) +Related special variables are \fB*db1size*\fR and +\fB*db2size*\fR which are set by \fIsetdbsize\fR and +\fB*availablesizes*\fR which contains the assoc-list used +to associate the power of two to a size. +.NH +Creating a Forest of Data Bases +.PP +Although having multiple data bases which are unconnected is often +enough, it is sometimes convenient to build onto an already +existing data base in a tree-like fashion. +For example, in a story understanding program, one might want +to have the default data base containing long-term knowledge +and then add a data base to contain the knowledge specific to a +particular story being processed. +In large applications, it can also help to split up special kinds +of knowledge to improve efficiency even more than PEARL's hashing +already does. +With only the ability to build separate data bases, searching for +a fact which might be either general knowledge or specific +knowledge learned from the story would require two fetches, one +from each data base. +However, if the story data base is built on top of the main data +base then simply fetching an item from the story data base will +also include fetching from the main data base. +To build another data base upon an existing one, use the function +\fBbuilddb\fR with two arguments, the name of the new data base +and the name of the old one to build onto: +.DS +(builddb *story* *maindb*) +(builddb *future* *maindb*) +.DE +These two statements will build two data bases on top of the main +one such that fetching from *story* will look both in it and in +*maindb* but not in *future*. +You can then build further upon any of these if you wish. +Note however, that the second argument must be \fIthe name of the +data base to build upon\fR and cannot be \fI*db*\fR to build upon +the default data base. +Also, if the second argument is missing, then the new data base is +isolated, not built on top of the default data base. +.PP +If your program builds many data bases, it is likely that some of +them will be temporary ones. +If this is so, it is possible to release a data base so that the +space can be garbage collected or reused for a later data base. +To release a data base, pass the actual data base (not its name) +to the function \fBreleasedb\fR. +If the data base is not a leaf of the data base tree, then the +space will not actually be released until all its children +are released also but PEARL will no longer accept it as a data +base argument. +.PP +A list of the names of the currently active data bases is +maintained by PEARL in the special variable \fB*activedbnames*\fR. +.NH +Creating Expanded Subtypes of Previously Defined Objects +.PP +Within CD, as in many applications, you may have many different structures +with some slots with the same name. +PEARL allows this, as it can always tell which type of structure +you are using, and thus it behaves just as if you had used +unique names for all slots. +But sometimes the fact that two different structure types have +slots with the same names is more than a coincidence: +there may be various semantic similarities +between the similar parts of the two structures. +PEARL has a mechanism for creating such structures using the +\fBexpanded\fR selector to \fIcreate\fR. +Basically, you must first define a base structure that contains +all the identical parts of two or more structures, and then you +must define the structures themselves as \fIthe base plus the differences\fR. +A good example of this from CD involves Acts. +All Acts within CD have an Actor slot, and all of +these slots have the same meaning. +That is, whatever is going on, the person in the actor slot is the +motivating force. +So we may first define this common part as a normal +base structure: +.DS +(create base Act + (* Actor symbol) ) +.DE +and then we can define the various acts as expansions upon this base: +.DS +(create expanded Act PTrans + (Object symbol) + (From symbol) + (To symbol) ) +.DE +.DS +(create expanded Act MTrans + (MObject struct) + (From symbol) + (To symbol) ) +.DE +.DS +(create expanded Act ATrans + (Object symbol) + (From symbol) + (To symbol) ) +.DE +.DS +(create expanded Act Injest + (Object symbol) + (Through symbol) ) +.DE +Note that we did \fBnot\fR have to list the Actor slot, +it was \fBinherited\fR from the base structure Act. +The structure to be expanded need not be a base structure, +but could itself be an \fIexpanded\fR structure. +Thus we can capture the similarities of the various Transfers with: +.DS +(create expanded Act Trans + (From symbol) + (To symbol) ) +.DE +followed by +.DS +(create expanded Trans PTrans + (Object symbol) ) +.DE +.DS +(create expanded Trans MTrans + (MObject symbol) ) +.DE +.DS +(create expanded Trans ATrans + (Object symbol) ) +.DE +In expanded definitions as in base definitions one can +specify hashing and default information in the usual way. +However one can selectively inherit some of this +information from the structure being expanded. +Thus in our first Act example, since we specified star hashing on the +Actor slot, all the structures that we defined in terms of Act +have star hashing on their Actor slot by default. +If we had not wanted this for ATrans, we could have specified this +simply by listing the Actor slot over again without the asterisk. +However, since PEARL requires old slots in expanded structures +to also provide a new value, we need some way to say \fIinherit the +same old value\fR. +This is done by putting an up-arrow \fB"^"\fR where PEARL expects +to find a value, just as when you want to inherit the default +value but add hooks or predicates when creating individuals. +.DS +(create expanded Act ATrans + (Actor ^) + (From symbol) ) +.DE +We also could have added colon hashing to the Actor slot by +listing it above as normal. +However, we cannot change the type of a slot and including a type +name after \fIActor\fR will cause PEARL to try to interpret that +type name as a value, (resulting in any of several errors, +depending on the type). +Thus, the hashing information for any slot is inherited from +above, \fIunless\fR it the slot appears in the expanded structure. +.PP +Default values are inherited in almost the same way. +The exception is that if in the original structure +the default is preceded by the symbol \fB":="\fR (rather than being +preceded by either nothing or the symbol \fB"=="\fR), expansions of that +structure will not inherit this value, but instead will get the +standard default for that type. +So if one defines: +.DS +(symbol Pandora) +.DE +.DS +(create base Act + (Actor symbol Pandora) ) + + or +.DE +.DS +(create base Act + (Actor symbol == Pandora) ) +.DE +.DS +(create expanded Act PTrans + (From symbol) ) +.DE +then all PTranses will have Pandora as their default Actor, whereas with: +.DS +(create base Act + (Actor symbol := Pandora) ) +.DE +.DS +(create expanded Act PTrans + (From symbol) ) +.DE +only the default instance of Act will have Pandora in its Actor +slot and the default Actor of PTrans will just be the usual +default for \fIsymbol\fR-valued slots which is \fInilsym\fR. +Which type of default inheritance to use depends upon the +application, and must be decided on a case by case basis. +.PP +Given this hierarchy, it is often useful to check whether an +object is of a certain type or an expanded version of it. +Two functions provide this ability with slightly different +arguments. +\fBIsa\fR expects an item and the name of the type you want to +check for. +\fBIsanexpanded\fR expects two instances. +Thus the following are always true for any structure X: +.DS +(isa X (pname X)) +(isanexpanded X X) +.DE +Two related functions are \fBnullstruct\fR and \fBnullsym\fR which +are functions for testing for \fInilstruct\fR and \fInilsym\fR +(similar to \fInull\fR for \fInil\fR). +.NH +Fetching Expanded Structures +.PP +To make the extra information that \fIexpanded\fR structures provide +more useful, a special version of \fIfetch\fR called \fBexpandedfetch\fR +is provided which takes the hierarchy of structures defined into +account when fetching. +For example, using the above hierarchical +definitions of Act, Trans, PTrans, MTrans, and ATrans, you can insert +three different Transes into the data base: +.DS +(dbcreate individual PTrans + (Actor Pandora) + (Object Pandora) ) +.DE +.DS +(dbcreate individual MTrans + (Actor Pandora) + (To Pandora) ) +.DE +.DS +(dbcreate individual ATrans + (Actor Pandora) + (From Pandora) ) +.DE +and then to fetch all Transes performed by Pandora, you could use: +.DS +(create pattern Trans TransPattern + (Actor Pandora) ) +.DE +.DS +(expandedfetch TransPattern) +.DE +Once you start using expanded structures, you usually want to be +able to use the function name \fIfetch\fR and mean \fIexpandedfetch\fR. +To this end, the standard fetch function is actually called +\fBstandardfetch\fR. +This leaves the function \fBfetch\fR to be bound to whichever +fetch function you wish. +It is initially given the same function definition as +\fIstandardfetch\fR. +.NH +How Two Objects Match +.PP +When a fetch from the data base is performed, the pattern provided +is only used to construct a stream containing that pattern and the +appropriate hash bucket from the data base; +no matching (comparing) +between the pattern and objects in the data base occurs. +Thus the stream contains pointers to all data base items in the +same hash bucket, regardless of their likelihood of +matching the pattern. +When elements are extracted from the stream with the function +\fInextitem\fR, the pattern is "matched" against successive +items from the hash bucket until one matches (and is returned) +or until the potential items run out (and \fInil\fR is returned). +.NH 2 +When Is a Pattern Not a Pattern? +.PP +To understand the process with which two objects are +matched, it is necessary to understand what is meant by +a \fIpattern\fR in the context of matching. +The term \fIpattern\fR has been used in two ways in PEARL. +It has been used previously in this documentation in +a specialized sense which is only relevant in the context +of creating a \fIpattern\fR. +The use of the \fIpattern\fR selector to \fIcreate\fR is simply a +variation on \fIcreate individual\fR which uses the match-anything +variable ?*any* as the default for unspecified slots instead +of the usual default values (either the one inherited from the +base definition or the default for the type of slot). +It is called creating a \fIpattern\fR because the +change of default is usually only useful for constructing a pattern. +.PP +However, the use of the function \fIcreate\fR with object +selector \fIpattern\fR is \fBnot\fR the only way to create a +pattern which can be matched; +in fact, it is only useful for +forming simple patterns. +\fBAny\fR individual structure in PEARL can be used as a pattern. +If a fully specified structure (that is, one with an actual value +in all of its slots) is used as a pattern for fetching, it will +only match objects which are equal to it in a manner similar to +\fIequal\fR (versus \fIeq\fR) in Lisp. +(An exception to this occurs when patterns with pattern-matching +variables are stored in the data base.) +Thus a fully specified pattern is only useful for +determining whether a particular fact (object) is in the data base. +Any object is a pattern but the interesting patterns will not +be fully specified; +rather, they will have unspecified slots +which contain pattern-matching variables instead of values. +The details of the matching process will now be described. +.NH 2 +The Matching Process +.PP +In general, the matching procedure takes two structures and either, +neither or both may contain pattern-matching variables. +So conceptually, both are patterns. +If the structures are not definitionally the same type +then the match fails automatically. +Otherwise, each structure is viewed as a sequence of slots +which are successively "matched" between the two structures. +Two structures of the same type match if and only if each of +their slots "matches" the corresponding slot of the other structure. +Each slot is of one of four types (\fIstruct\fR, \fIsymbol\fR, \fIint\fR, +or \fIlisp\fR), or is a \fIsetof\fR one of these types. +Regardless of its type, each slot is filled in one of four ways: +.IP (1) +The slot may contain an actual value of its type (for example, +a slot of type \fIstruct\fR may contain a PTrans). +.IP (2) +The slot may contain a variable which is local to the structure +(pattern-matching variables are local unless otherwise specified). +.IP (3) +The slot may contain a global variable, declared previously by a +call to the function \fIglobal\fR with the variable's name as argument. +.IP (4) +The slot may contain the special match-anything variable ?*any*. +.LP +If the slot contains a variable (other than ?*any*) which has not +been bound then it may become bound as a side effect of the +matching process. +All local pattern-matching variables are unbound at the start +of the matching process. +When a local variable is bound to a real +value during the matching process (it will never be bound to a +variable), it will not be unbound again but for the purposes of +matching will be treated as if the slot were filled with that value. +.PP +Let us now examine each of the pairings of slot values +which may occur and how they are matched. +If either of the two slots being matched contains the +special variable ?*any*, then the slots match by definition, +regardless of the contents of the other slot. +If both slots contain variables that are unbound, the slots +do not normally match, (even if the two variables are textually +the same name). +(Since some users want two unbound variables to match, +the value to be returned in this case is stored in the +special variable \fB*matchunboundsresult*\fR whose +initial value is \fInil\fR. +Setting this variable to non-\fInil\fR will cause two unbound +variables to match immediately but will not cause their +predicates to be run.) +If one slot contains an unbound variable (and the other +a bound variable or a value), then the predicates and +restrictions of the slot with the unbound variable are +tested, and hooks on that slot labelled +with \fImatch\fR are run to see if the unbound variable +should be bound to the bound value. +If so, then the unbound variable is bound to the value +of the other slot, and the two slots match. +Note that only the predicates and hooks on the +structure containing the unbound variable are run while +the symbols *, **, and = refer to the other +structure (with the bound value in it). +If the predicates or restrictions return \fInil\fR, +the two slots do not match, the variable +is not bound, and the entire match fails. +.PP +If both slots contain either bound variables or values, then the values +of the two slots are compared. If the slot is of type \fIstruct\fR, +then the entire matching algorithm is recursively applied. +If the slot is of types \fIint\fR or \fIlisp\fR, +then \fIequal\fR is used. +If the type is \fIsymbol\fR, then the two values must +be the same symbol. +Regardless of the type, restrictions associated with the slot +are executed until one fails or there are no more to run. +All must succeed for the match to succeed. +If the match succeeds, then any hooks +with the label \fImatch\fR are run. +.PP +The difference between the two types of variables is one of scope. +Normal variables (for PEARL) do not need to be declared, and +may be used in any structure by typing in \fI?\fR during a +\fIcreate\fR (note that \fIputpath\fR is incapable of +installing variables). +The scope of these variables is only over the structure +in which they are typed. +Thus the variable \fI?V\fR typed into two different creations of +structures are in no way connected (in the same manner as two +local variables V in different Pascal subroutines are unrelated.) +If one becomes bound, the other is unaffected. +On the other hand, if a variable name is previously declared +as \fBglobal\fR: +.DS +(global G) +.DE +then all instances of the variable name ?G are the same +(similar to global variables in Pascal). +The list of global variables is kept in the special variable \fB*globallist*\fR. +.PP +As mentioned before, when two structures are matched, all +normal (local) variables in both structures are unbound +(bound to the value \fI*pearlunbound*\fR) before any +slots are compared. +This is to ensure that any bindings induced by a previous +unsuccessful (or successful for that matter) match are removed. +This rule is useful because the type of matching that +early PEARL users have needed is in matching most +patterns against fully-specified values (that is, cases +in which one slot is always bound and the other either +bound or unbound). +Global variables are \fBnot\fR unbound before each match, +so they can be used to reflect global contexts. +They are given the value *\fIpearlunbound*\fR at the +time they are declared and remain bound thereafter unless +explicitly unbound by the user. +To unbind a global variable, you may use use the function +\fBunbind\fR, a fexpr which requires +the name of a (previously declared) global variable: +.DS +(unbind G) +.DE +or use \fIsetq\fR and the function \fBpunbound\fR which +simply returns the atom \fI*pearlunbound*\fR: +.DS +(setq G (punbound) ) +.DE +The function \fBpboundp\fR will test the value of a Lisp +(not PEARL) variable to see if it is \fI*pearlunbound*\fR. +The function \fBglobalp\fR will determine whether the variable +passed to it has been declared global. +.PP +Global variables should be used with care so that +they are not set by unsuccessful matches. +Generally this is achieved by first collecting the value +desired into a local variable via a series of matches +(only the last of which succeed), and then using the result of +this success to cause a further action which is guaranteed to +correctly bind the value of the global variable. +(These actions may be hooks which rebind the global +variable every time the local one is bound. +Effectively, this is a way to say \fIalways unbind this particular +global variable before matches\fR. +The action also could be performed by the user's program +when the right value is found.) +.PP +Each structure or tree of structures built by a call to \fIcreate\fR +constructs an individual assoc(association)-list of all the local +variables in that structure. +This assoc-list is stored with the root of the tree, thus +achieving local uniqueness of variables within a structure. +Global variables are bound values of the Lisp atom of +the same name and are accessed in the usual way. +To access the value of a local variable in a structure, +one uses either the function \fBvalueof\fR (which is an expr) +or the fexpr \fBvarvalue\fR both of which have two +arguments: the name of the variable whose value +you want and the structure it occurs in (evaluated internally by +\fIvarvalue\fR). +For example, to get the value of ?G in X, use either of: +.DS +(valueof 'G X) +(varvalue G X) +.DE +Thus PEARL uses both deep and shallow binding. +.PP +The match algorithm is available to the user as a +separate function by the name \fBstandardmatch\fR. +This function unbinds all local variables before +proceeding with the match (using the macro \fBunbindvars\fR) +and again afterwards if the match failed. +A function which assumes that all local variables have been +unbound already and proceeds just as \fIstandardmatch\fR +would is \fBbasicmatch\fR. +The function name used to access the matching function by +\fInextitem\fR and all other built-in PEARL functions is +\fBmatch\fR which is normally given the same function definition +as \fIstandardmatch\fR but can be bound to whichever match function +you wish. +A function which compares two structures for equality without +affecting the values of their variables is available as +\fBstrequal\fR. +Since it does not bind variables, it also does not execute +predicates although it does run base hooks and slot hooks labelled +with \fIstrequal\fR. +A function parallel to \fInextitem\fR which uses \fIstrequal\fR +instead of \fImatch\fR is available as \fBnextequal\fR. +.PP +This rest of this section covers other ways to access and affect +the values of variables. +It will make more sense after reading the next section on blocks +but fits in better here so you should probably leave it for your +second reading. +.PP +Recall that the question mark read macro expands into either +\fI(*var* )\fR or \fI(*global* )\fR. +These two forms are not normally meant to be evaluated. +However, for convenience, there are two functions \fB*var*\fR and +\fB*global*\fR which return the value of the variable whose name +is their argument. +That is, if \fI?X\fR expands into \fI(*global* X)\fR, executing it +will returned the value of the atom X. +Thus \fIX\fR and \fI?X\fR are equivalent for a global variable. +For a local or lexically scoped variable, in which \fI?X\fR +expands into \fI(*var* X), the function \fI*var*\fR looks in +three places for a variable with the name \fIX\fR. +.IP 1. +First it looks to see if the special variable +\fB*currentstructure*\fR has been bound to a structure by +the user, and if so, looks in its variable list. +.IP 2. +If this fails, it looks in the special variable +\fB*currentpearlstructure*\fR for a structure. +This variable is set by various PEARL functions like +\fIcreate\fR, \fIfetch\fR, \fIpath\fR, and \fInextitem\fR +to the top level structure they last operated on. +.IP 3. +If this fails, it looks in the currently open block on +top of \fI*blockstack*\fR if there is one. +.IP 4. +If this fails, it returns \fInil\fR. +.LP +Note that the atom \fI*currentstructure*\fR is there simply for +the use of the user and is never set by PEARL. +.PP +A related function is \fBsetv\fR which takes a question-mark +variable, a value and an optional environment and sets that +variable in that environment or else in the default environment +described above to that value. +The environment can be either a structure or a block. +This stops with an error message if it fails to find a variable +by that name in the specified or default environment. +.NH +Binding Blocks of Structures Together Via Common Variables +.PP +It is sometimes the case that you wish to create a group of +structures which are closely related in some way and which you +wish to tie together via pattern-matching variables. +For example, a \fIframe\fR might be considered such a loosely +connected group of structures. +In this case what is desired is for the pattern-matching variables +to \fIactually be the same\fR. +Normally however, if you create several structures in PEARL with +variables having the same name, each has its own local variable +with that name and they are totally unrelated. +If on the other hand, you declared them to be global, then all +structures having variables with that name would refer to the same +variable and it would no be unbound before matching. +For this purpose, PEARL provides variables of an intermediate +nature which are local to only a small group of structures and +which are all unbound before any one of the structures takes +parting in matching. +.PP +These variables are called \fBlexically scoped\fR (although if +the related functions \fIblock\fR and \fIendblock\fR are called +dynamically, they also provide a breed of dynamic scoping). +To declare a set of lexically-scoped variables, thus opening a +(nested) scope for them, use the function \fBblock\fR, +so named because of the similarity to the concept of a block +in Algol-like languages. +The function \fIblock\fR is a fexpr which in its simplest form +expects one argument which should be a list of new variables: +.DS +(block (A B C)) +.DE +Such a call to \fIblock\fR creates an unnamed block containing +these variables and any occurrences of variables with these +names in any structures \fIcreated\fR after this call will +refer to these lexically-scoped variables. +Thus, no structure created after the above call to \fIblock\fR +can contain a local variable called A, B, or C. +(However, if a variable has been previously declared to be global +this overrides \fBall\fR future declarations with \fIblock\fR. +Once again, global pattern-matching variables are to be +used with \fIextreme caution\fR.) +.PP +If you use several blocks, especially nested blocks, +it is helpful to give them names. +For this purpose, \fIblock\fR will accept two arguments, the first +an atom to name the block and the second the list of new variables. +For example: +.DS +(block Name (A B C)) +.DE +.PP +To end the most recent block, use the fexpr \fBendblock\fR. +This function accepts any of three types of arguments. +If last block was unnamed, simply use: +.DS +(endblock) +.DE +If the last block was named, you must provide \fIendblock\fR +with this name: +.DS +(endblock Name) +.DE +This is provided as a protection against unbalanced calls to +\fIblock\fR and \fIendblock\fR. +If you wish to end the most recent block, regardless of what +its name is, use +.DS +(endblock *) +.DE +To end several blocks at once, you can use the fexpr +\fBendanyblocks\fR which ends all blocks back through +the one whose name matches its argument. +Again no argument (\fInil\fR) means the last unnamed block. +An argument of \fB"*"\fR causes PEARL to end all currently +open blocks. +A shorthand for \fI(endanyblocks *)\fR is \fB(endallblocks)\fR. +.PP +The function \fIblock\fR builds an assoc-list of +the variables listed. +If the block is nested, the assoc-list of the enclosing block is +hooked to the end of its assoc-list, thus providing a complete +assoc-list of all the variables available in the block. +A side effect of \fIblock\fR is that this assoc-list is bound to +the name of the block. +The block itself (the block's name plus this assoc-list) is available +as \fIb:\fR so that the above call to block binds +\fIName\fR to +.DS L +((A . *pearlunbound*) (B . *pearlunbound*) (C . *pearlunbound*)) +.DE +and \fIb:Name\fR to +.DS +(Name (A . *pearlunbound*) (B . *pearlunbound*) + (C . *pearlunbound*)) +.DE +If a block is unnamed, PEARL calls it \fIunnamedblock\fR and the +corresponding variables are set. +The special variable \fB*blockstack*\fR contains a stack of all the +currently active blocks. +The effect of ending a block is to pop it off this stack. +Once a block is closed, it is still accessible through the Lisp +variable \fIb:\fR. +Given the name of a block, the function \fBblockatom\fR will build +this atom for you. +.PP +It is possible to return to the scope of an earlier block with the +fexpr \fBsetblock\fR which expects the name of a named block. +This will have the effect of ending all currently open blocks and +setting the current block stack to contain this block. +Note that this block will contain all the variables of any blocks +it is nested in but that it is not possible to close off these +block selectively. +Thus, the block stack will contain only one block with all the +variables in its complete assoc-list. +.NH +Controlling the Unbinding of Variables by Match +.PP +It is sometimes desireable to use the filled-in result pattern +of a \fIfetch\fR or \fImatch\fR as a pattern for a further +\fIfetch\fR (or \fImatch\fR) or to otherwise store and restore +the current values of variables (for example, to allow +backtracking algorithms and/or hypothetical assertions). +Since all bound local variables would normally be unbound during this +further fetching or matching, this would not be possible given the +mechanism described so far. +To accomplish this action, which can be considered as "pushing" +the context of the current assoc-list, +you should use one of several functions provided for this purpose. +The function \fBfreezebindings\fR takes a structure as argument +and moves all bound variables from its normal assoc-list to a +backup so that \fIfetch\fR will not unbind them. +The function \fBthawbindings\fR takes a structure as argument and +will undo this action, restoring the assoc-list to its complete state. +These two functions affect the structure plus any bound variables +in all enclosing blocks. +To freeze or thaw only a single structure, use \fBfreezestruct\fR +and \fBthawstruct\fR. +To freeze or thaw only a single block, use \fBfreezeblock\fR +and \fBthawblock\fR which expect the name of a block as an +argument. +.PP +Above it was mentioned that two structures will match if +and only if they both are of the same type. +Actually the system has been extended to allow the matching +of a structure of one type with another of a type derived +from the first via a \fIcreate expanded\fR. +The extra slots of the larger (expanded) +structure are ignored during the match. +.PP +Lastly it should be mentioned that the matching rules are +an evolving system, and may be amended as experience +with their use is accumulated. +The rules may seem a bit complex at first, but in use they +are fairly natural. +The rules are biased towards efficiency (like much of PEARL). +The designers felt that hiding exponential time-complexity +processing within the language would lead users to +construct inefficient programs without realizing it. +Thus several "features" of other complex AI matchers are not built in. +The user must implement these individually at a higher level. +It has been our experience that this leads to much cleaner designs. +.NH +Function Structures +.PP +In using PEARL, it is sometimes handy to escape into Lisp in +a "\fIstructure\fRd" way. +Although PEARL allows ad hoc escapes by way of its hooks +and the ! and $ evaluation operators defined above, +the philosophy in PEARL \fBfunction structures\fR +is to allow structured escapes that restrict the generality +of the escape to the minimum necessary for the task. +At times you may wish to equate Lisp functions with their expected +arguments with PEARL structures with their associated slots. +For example while you may wish to describe an action in a program +as fetching an item from the data base, you may actually be +unable to describe the item as a structure and/or be unable or +unwilling to actually store it in the data base. +Instead, you will sometimes want the value to be provided by +a function called at fetching time instead of a structure in the +data base. +.PP +Take as an example the case of keeping track of whether any two +objects are near each other. +One possible way to do this is to keep structures in the data base +which record for each pair of objects that are near each other the +fact that they are near each other: +.DS +(create base Near + (Object1 struct) + (Object2 struct)) +.DE +Then determining whether two objects are near each other would +require a simple fetch. +However, if you are dealing with a large number of objects which +are moving around quite a bit but only want to know about nearness +once in a while, it might be easier or more efficient to compute +whether two objects are near each other only on demand. +In this case, you might like to write a function called Near +which expects two arguments. +However, for consistency, you may not want to design your program +so that it knows what things can be fetched and what things need +computing. +So you would like to define a structure which looks like our +definition of Near above but which actually invokes the +function Near. +.PP +To do this, one may create the function Near (which must be an +expr) and also a structure of type \fIfunction\fR named Near: +.DS +(de Near (x y) + ... mechanism to actually determine nearness ... ) + +(create function Near + (Object1 struct) + (Object2 struct)) +.DE +and then can create an individual of it for fetching: +.DS +(create individual Near IsNear + (Object1 John) + (Object2 Office)) + +(fetch IsNear) +.DE +Note that the format of function structures within PEARL +is the same as that of structures. +However, the name of the actual Lisp function to be called must +match the type name of the \fIfunction\fR structure, and the +arguments must occur in the same order and be of the same types +as the slots which will contain the actual arguments to the function. +.PP +As another simple example, to define a \fIfunction\fR structure +to correspond to the function \fIgetpath\fR, we would use the following: +.DS +(create function getpath + (Item struct) + (Path lisp) ) +.DE +and then an actual instance: +.DS +(create individual getpath Minst + (Item ! Mtrans1) + (Path '(MObject) ) ) +.DE +This example is not too useful. +As a more realistic use, consider a program to return all +the MObjects of all MTranses that are in the data base: +.DS +(create function nextitem + (Stream lisp) ) +.DE +.DS +(create pattern MTrans MPat1 + (MObject ?X) ) +.DE +.DS +(global MStream) +(setq MStream (fetch MPat1) ) +.DE +.DS +(create individual getpath Minst2 + (Item (nextitem (Stream ?MStream) ) ) + (Path '(MObject) ) +.DE +.DS +(setq Stream1 (fetch Minst2) ) +.DE +Note the recursive use of the data base: the \fIfetch\fR of +Minst2 will cause a \fIgetpath\fR to be executed. +But PEARL must first get the two arguments to pass on to +\fIgetpath\fR which causes the function \fInextitem\fR +to be evaluated, getting the next MTrans in MStream to +pass to \fIgetpath\fR. +.PP +Thus, function structures provide a way to describe a function and +its arguments through a PEARL structure and then to include, +in a pattern to fetch or in a structure slot, +a function call which will provide the desired value +at fetching time. +However, this only works during fetching. +.PP +The function used by PEARL to execute a function +structure is \fBevalfcn\fR. +It takes an item as its argument and returns the result of +applying the associated expr to its slot values if the item +is a function structure. +If the item is a single structure it returns the item untouched. +If the item is a list of structures, it applies itself +recursively with \fImapcar\fR. +No other PEARL functions currently know about function structures +as being any different than other individual structures. +.NH +More About the PEARL Top Level Loop and History Mechanism +.PP +The PEARL prompt-read-eval-print loop includes two features which +make PEARL easier to work with than the usual top level of Lisp. +Both features were designed in imitation of the Berkeley Unix +shell program \fIcsh\fR. +.PP +The first is an aliasing mechanism which provides the ability to +use various atoms as aliases for commonly executed s-expressions. +If you type an atom to the top level and it has the property +\fBalias\fR, the value of its \fIalias\fR property will be +evaluated instead. +Thus, if you do a +.DS +(putprop 'dir '(dir) 'alias) ; in UCI Lisp + or +(putprop 'ls '(exec ls) 'alias) ; in Franz Lisp +.DE +then if you type the atom \fIdir\fR or \fIls\fR repectively +to the top level, you will get the contents of your +directory printed out. +Two such built-in atoms are \fBhistory\fR which will +run the function \fIhistory\fR and print out your last +64 commands (see below) and \fBh\fR which will print the last 22 +commands (one crt screenful). +The aliasing mechanism can be turned off (saving a \fIget\fR for +each atom you use at the top level) by setting the special +variable \fB*usealiases*\fR to \fInil\fR. +.PP +PEARL's top level also includes a simplified command-history mechanism. +As you type in expressions to the top level of PEARL, they are +stored away for future reference. +The results of evaluating each expression are also kept. +The commands and their results are kept in two hunks +whose default size is 64. +The hunk containing the commands is kept in the special +variable \fB*history*\fR and the hunk containing the results +is kept in the special variable \fB*histval*\fR +To change the number of commands remembered, set the special +variable \fB*historysize*\fR to something other than 64 +in your \fI.init.prl\fR. +It cannot be changed later. +(If you are a novice user of PEARL, we recommend that you not +change it to be smaller, since the history command can sometimes +be helpful to someone helping you to debug something after you +have fiddled with it a while.) +.PP +The commands you type are squirrelled away so that you can ask +PEARL to re-execute them, thus saving the pain of retyping +a complicated expression. +To access the previous commands, the readmacro \fB"!"\fR is +provided. +To access the results of the previous commands, +the readmacro \fB"$"\fR is provided. +(The exclamation point is in imitation of the cshell; +the dollar sign is meant to suggest "value".) +These readmacros peek at the next character to determine what to do. +We discuss the variations available on these two readmacros in +parallel, since many of them coincide. +.PP +The simplest and most useful forms are \fB"!!"\fR and \fB"$$"\fR +which effectively re-execute and reprint the last command or its result. +Actually, both forms are executed, but the dollard sign macro +always returns its value quoted so that its effect is usually to +just reprint the result of the previous command. +Note that since these are readmacros which simply return the +last s-expression typed or its value, you can use them to build up +more complex commands. +For example: +.DS +pearl> (fetch Item) + (*stream:* . . .) +pearl> (nextitem !!) +.DE +will cause the fetch to be repeated and then do a \fInextitem\fR on it. +However, it is much more efficient to use the \fI$$\fR form in +this case, since what you really want is to do a \fInextitem\fR +on the result of the \fIfetch\fR in the last command: +.DS +pearl> (fetch Item) + (*stream:* . . .) +pearl> (nextitem $$) +.DE +.PP +The commands are numbered as you type them, starting with zero. +Although the values wrap around in the hunks, the \fIhistory number\fR +continues to climb. +The current history number is available in the special +variable \fB*historynumber*\fR. +To access a particular command or its value, you may type you may +follow an exclamation point or dollar sign with the number of the +command. +Thus \fB!23\fR and \fB$23\fR are the 23rd command and its result. +If you don't remember the command's number you can use the +function name or a prefix of it. +Thus \fB!fetch\fR and \fB$fetch\fR will access the last \fIfetch\fR +or its value. +Or \fB!fe\fR and \fB$fe\fR will access the last command starting +with \fIfe\fR or its value. +If there was a reference to an atom (instead of a list) with that +name or with that as a prefix somewhere, then the atom will be +evaluated again. +For exclamation point, this is a waste of typing except for long +atom names. +For dollar sign, it provides you a way of recovering the value of +a variable that has since changed. +(As a side effect of implementing this, PEARL contains a function +\fBprefix\fR which expects two lists and determines whether the +first is a prefix of the second, considered as a list of atoms. +Thus, PEARL just calls \fIprefix\fR on the results of \fIexplode\fRing +two atoms.) +.PP +Here the parallel between the two macros ends. +.PP +There are five forms which work only with exclamation point and +refer only to the last s-expression typed. +They are essentially ways to pick individual top-level elements +out of the last command: +.DS +\fB!^\fR the first argument +\fB!$\fR the last argument +\fB!*\fR the complete set of arguments +\fB!:0\fR the function name +\fB!:n\fR the nth argument +.DE +Both macros are splicing macros so that their values may be +spliced into the current s-expression. +\fB!*\fR is designed so that the following will work: +.DS +pearl> (add 1 2 3 4) + 10 +pearl> (times !*) +(times 1 2 3 4) + 24 +.DE +.PP +To see the last 64 commands you gave printed out, use the function +\fBhistory\fR (or type the atom \fBhistory\fR). +If you don't want all 64 commands, \fIhistory\fR will accept an +integer argument telling how many you want. +Thus the aliases on \fIhistory\fR and \fIh\fR are: +.DS +(putprop 'history '(history) 'alias) +(putprop 'h '(history 22) 'alias) +.DE +If you use the command numbers often, you might like to have the +history number printed out before each command. +To have the history number printed just before the PEARL prompt, +set the special variable \fB*printhistorynumber*\fR to a +non-\fInil\fR value. +The default value is f\Inilf\R. +.PP +Whenever you use the ! or $ history mechanisms, the line you type in +will be reprinted in its expanded form on the next line using +the current \fIpearlprintfn\fR. +If you wish to modify your own read macros so that they also will +cause this reprinting, simply have them set the special +variable \fB*readlinechanged*\fR to a non-\fInil\fR value. +.PP +It is sometimes useful to have a function return no value. +That is, you often do not want the value of the function to be +printed by the top level loop. +In particular, functions which print values often return ugly +values afterward. +To get around this problem, the PEARL top level disables printing +of the value returned by a function if it returns the atom +\fB*invisible*\fR. +All of the PEARL print functions return this value. +.PP +It is sometimes useful to be able to save the current state of a +PEARL run for later. +There are two functions to allow this. +If you wish to save a version which will continue exactly where +you left off (at the top level), use the function +\fBsavecontinue\fR which expects zero, one or two arguments. +If you wish to save a version which will read in +the \fI.start.prl\fR file when it starts up, use \fBsavefresh\fR. +(If you also want \fI.init.prl\fR read in, change the value of the +special variable \fB*firststartup*\fR to \fIt\fR beforehand but +be careful not to put functions which may only be run once in it.) +Note however that you cannot save Franz PEARL on top of the file +you are running; +trying to will result in the \fIDumplisp failed\fR +error message from Franz Lisp. +Note also that a saved PEARL uses about 1500 blocks or 750kbytes on +the disk so this should be used sparingly. +(Exceeding the disk quota will result in the same error message.) +In the Franz Lisp version, if the number of arguments to either of +these functions is: +.IP 0: +It will be saved as \fIpearl\fR in the current directory. +.IP 1: +The argument is assumed to be a (relative) file name to save under. +.IP 2: +The result of concatenating the two arguments together with a +\fB/\fR between them will be the file name used. +(This is for UCI Lisp compatibility.) +.LP +In the UCI Lisp version, if the number of arguments is: +.IP 0: +It will be saved as \fIpearl\fR in the current directory. +.IP 1: +The argument is assumed to be a file name for the current directory. +.IP 2: +They must be a directory and a file name to save in. +.NH +Looping and Copying Functions +.PP +PEARL includes several loop macros. +The first two were included simply for use by the implementation but +might be useful to the user. +They are the \fBfor\fR and \fBwhile\fR macros which both expand +into a \fIprog\fR wrapped around a \fIprogn\fR. +A call to the \fIwhile\fR macro should be of the form: +.DS +(while + EXPR1 + EXPR2 + ... + EXPRn) +.DE +The is evaluated before each execution of the loop. +If it is non-\fInil\fR, the EXPRi are evaluated in sequence. +This continues until return nil in which case the last +value returned by EXPRn is returned. +Since the while expands into a \fIprog\fR, any of the EXPRi may +call the function \fIreturn\fR, terminating the loop prematurely +and returning the value given to \fIreturn\fR. +.PP +A call to the \fIfor\fR macro should be of the form: +.DS +(for + EXPR1 + EXPR2 + ... + EXPRn) +.DE + and should evaluate to integers. +The EXPRi are repeatedly evaluated in sequence with being +set to the values ascending from to . +If is greater than , nothing is done. + is a prog variable which disappears after the \fIfor\fR +executes. +The value returned is the last value of EXPRn and \fIreturn\fR +provides a premature exit with a value as in \fIwhile\fR. +.PP +The fexpr \fBforeach\fR expects a stream and a function (or macro) +and applies the function to each element returned by successive +calls to \fInextitem\fR on the stream. +Unfortunately it only returns \fInil\fR at this time. +Eventually, other useful looping structures may be provided. +.PP +Since PEARL provides several new types of values, it provides a +few functions to copy them. +In particular, the standard Lisp function \fBcopy\fR has been +redefined to avoid trying to copy anything that is not a cons-cell. +There are several ways to copy structures, described below. +The rest of PEARL values either are too complicated to copy +(data bases), can be copied with \fIcopy\fR (streams) or else +make no sense to copy (symbols, blocks). +.PP +For copying structures, there are currently two functions. +The one you are most likely to want is \fBscopy\fR which expects a +single structure argument and returns a new structure with the +same values in it. +However, the new structure will differ from the old in several +important ways. +First of all, copying a bound variable will result in the actual +value being inserted in the new copy. +When copying an unbound variable, the new structure will receive +a local variable with the same name and this variable will +be installed in the slot. +All variables so installed will be installed in the top level +structure regardless of where they came from in the original. +The only exception to this is lexically-scoped variables. +When the new structure is built, it will be built within any +currently open blocks and any of its unbound variables whose names +match variables from the current block(s) will be identified with +those block variables. +Global variables are similarly reinstalled only if they are unbound. +Adjunct variables are also installed \fIonly if\fR they are +unbound, since if they are bound their purpose will already have +been served and their bound values installed in other slots +referring to them. +.PP +A variation on \fIscopy\fR which replaces all unbound +variables from the original with \fI?*any*\fR is called +\fBpatternize\fR. +After (and during) the running of these copying functions, the +resulting top-level structure is kept in the special variable +\fB*currenttopcopy*\fR. +.PP +The situation sometimes arises where you have already built a +structure and have a new structure with information that should be +merged into the old one. +Rather than use \fIpath\fR to copy each relevant slot, you can use +\fBsmerge\fR which expects as arguments the old structure to merge +into and the new structure from which to take values. +All unfrozen variables in the old structure are unbound first and +then any unbound variable whose counterpart in the new structure +is bound gets replaced (\fBnot set\fR) with this value. +The old structure being merged into must be of the same type or +an expanded version of the new structure. +.NH +Miscellaneous Variations and Abbreviations +.PP +People very quickly get tired of typing the relatively long +function names that PEARL uses. +As a result, a large number of abbreviations and macros have +been included in PEARL. +We recommend that the shortest ones be used primarily at +the top level, since they are easily subject to typographic +errors. +Most the abbreviations are in \fIcreate\fR and are summarized by +the following table: +.DS + The function or atom: May \kmbe abbreviated: + create \h'|\nmu'cr + individual \h'|\nmu'ind + pattern \h'|\nmu'pat + expanded \h'|\nmu'exp + function \h'|\nmu'fn +.DE +Thus, \fI(cr pat ....)\fR is equivalent to +\fI(create pattern ....)\fR. +.PP +In addition, a large number of macros for popular combinations of +functions are included: +.ID + The s-expression: Is exp\kmanded into by the macro: +(create base ...) \h'|\nmu'(cb ...) + \h'|\nmu'(base ...) +(create individual ...) \h'|\nmu'(ci ...) + \h'|\nmu'(individual ...) + \h'|\nmu'(ind ...) +(create expanded ...) \h'|\nmu'(ce ...) + \h'|\nmu'(expanded ...) + \h'|\nmu'(pexp ...) +(create pattern ...) \h'|\nmu'(cp ...) + \h'|\nmu'(pattern ...) + \h'|\nmu'(pat ...) +(create function ...) \h'|\nmu'(cf ...) + \h'|\nmu'(pfunction ...) + \h'|\nmu'(fn ...) +.sp 1 +(insertdb (create ...) nil) \h'|\nmu'(dbcreate ...) + \h'|\nmu'(dbcr ...) +`(quote ,(create ...)) \h'|\nmu'(inlinecreate ...) +(fetch (create ...) nil) \h'|\nmu'(fetchcreate ...) +`(fetch (quote ,(create ...)) nil) \h'|\nmu'(inlinefetchcreate ...) +(nextitem (fetch ...) ) \h'|\nmu'(firstfetch ...) +.sp 1 +(valprint ...) \h'|\nmu'(vp ...) +(fullprint ...) \h'|\nmu'(fp ...) +.DE +(\fIpexp\fR and \fIpfunction\fR are so named to avoid conflict +with the exponential function \fIexp\fR and the function quoting +function \fIfunction\fR.) +.PP +The automatic setq feature of \fIcreate\fR that causes an atom +to be bound to the item created is available throughout +\fIcreate\fR. +In all cases, the special variable \fB*lastcreated*\fR is +set to the item. +In addition: +.DS +This combination: Causes \kmthis atom to be set: +(create base X ... \h'|\nmu'X +(create base X Y ... \h'|\nmu'Y +(create expanded X Y ... \h'|\nmu'Y +(create expanded X Y Z ... \h'|\nmu'Z +(create individual X ... \h'|\nmu'(none) +(create individual X Y ... \h'|\nmu'Y +(create individual X X ... \h'|\nmu'(none, the second X is ignored) +(create pattern X ... \h'|\nmu'(none) +(create pattern X Y ... \h'|\nmu'Y +(create pattern X X ... \h'|\nmu'(none, the second X is ignored) +.DE +.PP +When creating an object, wherever a recursive call to \fIcreate\fR +is implied by a structure in a slot of type structure, you may start +with one of the types \fIindividual\fR, \fIpattern\fR, \fIbase\fR, +\fIexpanded\fR, \fIfunction\fR to change the type of object +being created. +Whenever it isn't given, the type of the toplevel \fIcreate\fR, +which is kept in the special variable +\fB*currentcreatetype*\fR is used. +For example, in +.DS +(create pattern x + (a (individual y)) + (b (base z (s1 ...) ...)) + (c (w))) +.DE +where a, b, and c are all slots of type structure, slot a +will contain an individual y which the attendant defaults +filled in, slot b will contain the default instance of a +newly created type z, and slot c will contain a pattern w +with \fI?*any*\fR as defaults. +.PP +Since each Lisp stores its functions in a different place, PEARL +includes a macro \fBaliasdef\fR which expects the names of an new +and a old function name and copies the function definition of the +old one to the new one. +In the case of Lisps which store the function definition on the +property list, \fIaliasdef\fR requires a third argument which is +the name of the property that the definition is kept under. +.NH +Low Level Access Functions. +.PP +There are a large number of functions for setting and accessing +the various part of structures, symbols, and data bases which are +primarily intended for the use of PEARL. +In general, the access functions are called \fBget...\fR where +"..." is the name of the information about the structure. +The functions which change information are called \fBput...\fR. +It is not generally safe to use the \fIput...\fR functions but the +\fIget...\fR functions can sometimes be useful to the user. +For a complete list of the functions, see the index. +If you don't recognize the function by name, you don't need it so +we don't bother to further document them. +Since most of them expect a slot number, it is useful to know +about the macro \fBnumberofslot\fR which requires the name of a +slot and the definition of a structure (which can be accessed +with \fIdefatom\fR or \fId:\fR.) and returns the +corresponding slot number. +.bp +.NH +Appendix of UCI Lisp functions added to Franz PEARL +.PP +Since PEARL was originally written in UCI Lisp, there are many functions +from UCI Lisp that it needed. +We also wrote others to move our other programs. +The number is too great to document each one. +If the function is described with an equal sign, as in +\fI"fn = other"\fR then the function definition of the Franz Lisp +function \fIother\fR has been put under \fIfn\fR. +Thus it might not behave quite the same as in UCI Lisp. +If no equivalence is given, it was written from scratch which is +slightly more likely to mimic UCI Lisp. +In this case, see the UCI Lisp manual for details. +.PP +The functions used for the PEARL top level loop in the Franz Lisp +version plus changes to the fixit debugger and the trace package +are briefly described here also. +.PP +The Franz Lisp version of PEARL is normally loaded with both the Fixit +debugger and the trace package already loaded. +This is done to avoid getting the versions which do not know how to print +PEARL objects. +In addition, the Fixit debugger is attached to all available hooks for +going into the break package, since it is much more similar to the UCI Lisp +break package than the standard Franz Lisp break package is. +Both the debugger and trace package use the function +\fBbreakprintfn\fR to print values. +The \fImsg\fR function uses the function \fBmsgprintfn\fR +to print values. +Either can be bound to whatever function you wish. +To disengage the Fixit debugger, read the Franz manual chapter on exception +handling. +See Note 4 below for more on features added to the Fixit debugger. +.LP +.nf +Atoms and Variables: +*dskin* -- special variable -- initial value: t. See Note 1 below. +*file* -- special variable -- initial value: nil. Used by \fIdskin\fR + and function definition functions. +*invisible* -- special atom -- not printed by \fIdskin\fR if returned + by a value when it is evaluated. + +Functions: +*append = append +(breakprintfn value lmar rmar) -- used by \fItrace\fR and \fIdebug\fR. +*dif = diff +*eval = eval +*great = greaterp +*less = lessp +*max = max +(msgprintfn value lmar rmar) -- used by \fImsg\fR. +*nconc = nconc +*plus = plus +*times = times +(addprop 'id 'value 'prop) +(allsym itemorpair) -- fexpr +(apply* 'fcn 'args) -- macro -- This is provided to act like UCI Lisp's + \fIapply#\fR. The asterisk is used because of the special meaning + of # in Franz Lisp. Unlike Franz Lisp's \fIfuncall\fR and + \fIapply\fR, this does what you would expect with macros! +atcat = concat +(boundp 'item) +clrbfi = drain +consp = dtpr +(de fcnname arglist &rest body) -- macro -- See Note 2 below. +(debug-replace-function-name 'cmd 'frame) -- Used by the modified + Fixit debugger to handle the "> newfcnname" facility. +(defp 'to 'from [prop]) -- macro -- Ignores \fIprop\fR and just + copies the function definition. +(defv var val) -- fexpr +(df fcnname arglist &rest body) -- macro -- See Note 2 below. +(dm fcnname arglist &rest body) -- macro -- See Note 2 below. +(dremove 'elmt 'l) +(drm char lambda) -- macro -- See Note 2 below. +(dskin filename1 filename2 ....) -- See Note 1 below. +(dskin1 '*file*) +(dskin2 'port) +(dsm char lambda) -- macro -- See Note 2 below. +(enter 'v 'l) +(every 'fcn 'args) -- macro -- Potential problem when compiled. +expandmacro = macroexpand +(funl &rest body) -- macro -- Expands into (function (lambda ...)). +(ge 'x) -- macro +(gensym1 'ident 'val) +gt = > +(initsym atomorpair1 ...) -- fexpr +(intersection 'set1 'set2) +(islambda 'fcn) -- Is \fIfcn\fR a lambda (expr)? +(le 'x) -- macro +(length '*u*) +lineread = readl (below) +(litatom 'x) -- macro +lt = < +mapcl = mapcar +memb = member +(msg ...) -- macro -- Some features may be missing. The function + used to print is \fImsgprintfn\fR, initially bound to + (or (eq '*invisible* ...) + (patom (valform ...))) +(nconc1 'l 'elmt) +(nequal 'arg1 'arg2) +(newsym atom) -- fexpr +noduples = union (below) +(nth 'l 'num) +(oldsym atomorpair) -- fexpr +(pearl-break-err-handler) -- Should be tied to ER%tpl if you want the + standard Franz Lisp break (not much of a) package. + Same as standard Franz Lisp \fIbreak-err-handler\fR except + that it uses the function \fIbreakprintfn\fR. +(pearl-top-level) -- The PEARL top level loop. +(pearl-top-level-init) -- The initial function called when PEARL starts up. + This is the code that reads in the init files and sets any unset + PEARL parameters. +peekc = tyipeek +(pop q) -- macro +(push var 'val) -- macro +(readl ['flag]) -- fexpr +(readl1 'flag) +remove = delete +(remprops 'item 'proplist) +(remsym atomorpairlist) -- fexpr +(save fcnname) -- fexpr -- Saves function or macro definition under + the property \fIolddef\fR. Saves macro character definitions + under \fIoldmacro\fR. +(selectq ...) -- macro +(some 'fcn 'list) -- macro -- Potential problem when compiled. +(sprint 'item ['lmar ['rmar]]) -- See Note 3 below. +(subset 'fcn 'list) -- macro +(timer (defun timer fexpr (request)$? +(unbound) -- macro +(union 'list1 ['list2 ...]) +(unsave fcnname) -- fexpr -- See \fIsave\fR. +.fi +.PP +\fBNote 1:\fR A simplified but extended imitation of the UCI Lisp function +\fBdskin\fR is provided in PEARL. +It is an nlambda which requires the file extensions to be provided. +There is a special variable \fB*dskin*\fR which controls whether +the expression read in is printed and/or whether the result of +evaluating it is printed. +.DS L +*dskin* = nil means neither +*dskin* = t means result only +*dskin* = 'name means the name of the variable in setq \fIor\fR the name + of the function in de, df, dm, dsm, drm, defmacro, + defun, or def \fIor\fR the name of the type in create. +*dskin* = 'both means both t and 'name. +.DE +The default value of *dskin* is t. +.PP +File names are always printed before they are opened. +The print function used for values is the current function +definition of \fBdskprintfn\fR. +The default function definition in PEARL is: +.DS +(de dskprintfn (*printval*) + (cond ((atom *printval*) (patom *printval*)) + ( t (print (valform *printval*))))) +.DE +.PP +\fBNote 2:\fR For better compatibility with UCI Lisp, PEARL contains +macros for the function and read macro definition functions +\fBde, df, dm, dsm,\fR and \fBdrm\fR. +They have been defined to save the old definitions automatically +and to return \fI(fcnname Redefined)\fR when this is the case. +\fIDe, df,\fR and \fIdm\fR save the old definition under the +property '\fIolddef\fR. +\fIDsm\fR and \fIdrm\fR save the old definition under the +property '\fIoldmacro\fR. +(The current definition of a readmacro is kept by Franz under the +property '\fImacro\fR.) +If the function definition is read in by \fIdskin\fR, +then the current file name which is in the special variable +\fB*file*\fR is put under the property '\fIsourcefile\fR. +.PP +\fBNote 3:\fR A function similar to the UCI Lisp \fBsprint\fR is included, +including the printmacro facility and the optional second argument +saying which column to start in. +In addition, there is an optional third argument saying which column +to try not to go beyond (that is a right margin). +A slight addition has been made to the printmacro feature (feature 1 below). +During \fIsprinting\fR, if the atom in the function position in a list +has the printmacro property one of four things will happen during +\fIsprinting\fR: +.IP 1. +If the printmacro property value is a string and the item to be +printed has a nil \fIcdr\fR, then the string will be printed instead +of the item. +.IP 2. +If the printmacro property value is a string and the item to be +printed has two items in it, then the string will be printed followed +immediately by the \fIcadr\fR of the item. +.IP 3. +If the printmacro property value is a string but the item to be +printed is longer than two elements, then it will be \fIsprinted\fR in +the normal fashion (i.e., the printmacro will be ignored). +.IP 4. +Otherwise, the printmacro property value will be applied +to the rest of the arguments. +It should be a function which expects three arguments, the item +to be printed, a left column to start in and a right column to +try not to go beyond. +A good default value for the right column argument seems to be zero. +If the function under the printmacro property returns nil, +then \fIsprint\fR assumes that it decided not to print the item +and prints it in the usual way. +.PP +\fBNote 4:\fR The Fixit debugger now accepts a command of the +form \fB> newname\fR whenever either an undefined function or +unbound variable error occurs. As in UCI Lisp, newname is not +evaluated in the case of an undefined function but is evaluated +in the case of an unbound variable. +Note that the blank is required (unlike UCI Lisp). +This is not guaranteed to work if you move around the stack first. +.bp +.NH +Appendix of Franz Lisp functions added to UCI Lisp PEARL +.PP +The following is a summary of the functions added to the UCI Lisp +version of PEARL to make it compatible with Franz Lisp. +Where the details are not obvious, see the Franz Lisp manual. +\fBNote:\fR Most \fImacros\fR listed in the index which are +labelled with asterisks are not available in UCI Lisp PEARL, since +the implementor must specifically request that they stick around. +.PP +\fIDskin\fR, the break package, and \fImsg\fR have been changed +to use the functions \fBdskprintfn\fR, \fBbreakprintfn\fR, +\fBmsgprintfn\fRfor printing. +.LP +.nf +(addtoaddress 'n 'address) -- expr -- Used by \fIcxr\fR and + \fIrplacx\fR. Written in LAP code. +(apply* 'fcn 'args) -- macro -- Equivalent to \fIapply#\fR. +(buildalist ...) --- expr --- Used by \fIdefmacro\fR. +(combineskels ...) -- expr -- Used by \fIquasiquote\fR. +(convert ...) --- expr --- Used by \fIdefmacro\fR. +(cxr 'index 'hunk) -- expr -- A hunk is a block of memory. Provides + random access to a single cell of a hunk. (Uses + \fIaddtoaddress\fR and \fIeven\fR.) +(defmacro macroname arglist body) -- macro -- \fIDefmacro\fR provides + a slightly more intelligent macro facility. \fIBody\fR is + processed to look for occurrences of the arguments in + \fIarglist\fR which are replaced with the appropriate form + of \fIca..r\fR. If an argument is preceded by \fI&rest\fR, + then it gets the list of the rest of the arguments. + The Franz Lisp version has many more features not included + in the PEARL version. +(even 'x) -- expr -- Is \fIx\fR even? Used by \fIcxr\fR and + \fIrplacx\fR to determine which half of a cons-cell to use. +(isconst ...) -- expr -- Used by \fIquasiquote\fR. +(makhunk 'size) -- expr -- Calls the UCI Lisp function \fIgetblk\fR, + requesting a block of memory which is half of \fIsize\fR, since + each piece of a UCI Lisp block of core is a cons-cell. +(msg ...) -- fexpr -- Modified to use \fImsgprintfn\fR to print + values of evaluated elements of the print list. +(pearl-top-level) -- the PEARL top level loop. +(pearl-top-level-init) -- The initial function called when PEARL starts up. +(rplacx 'index 'hunk 'val) -- expr -- Provides random access storage into + a block of memory. (Uses \fIaddtoaddress\fR and \fIeven\fR.) +(quasiquote 'skel) -- expr -- called by the quasi-quote readmacro + character backquote \fB`\fR. Equivalent to the quasiquote + functions defined in Charniak[2] with different invoking + characters to match those of Franz Lisp. + Unquote is comma \fB","\fR and splice-unquote is \fB",@"\fR. + Uses \fIcombineskels\fR and \fIisconst\fR. +.fi +.bp +.NH +Bibliography +.SM +.IP [1] +Bobrow, D., and Winograd, T. "An Overview of KRL, a Knowledge +Representation Language." +\fICognitive Science\fR 1:1 (1977). +.IP [2] +Charniak, E., Riesbeck, C., and McDermott, D. +\fIArtificial Intelligence Programming\fR. +Hillsdale, New Jersey: Lawrence Erlbaum Associates, 1980. +.IP [3] +Faletti, J., and Wilensky, R. "The Implementation of PEARL: +A Package for Efficient Access to Representations In Lisp", +forthcoming ERL technical report, UCB. +.IP [4] +Greiner, R., and Lenat, D. "A Representation Language Language." +In \fIProc. First NCAI\fR. Stanford, CA, August, 1980, +165-169. +.IP [5] +Roberts, I., and Goldstein, R. +"NUDGE, A Knowledge-Based Scheduling Program." +In \fIProc. IJCAI-77\fR. Cambridge, MA, August, 1977, 257-263. +.IP [6] +Schank, R. \fIConceptual Information Processing\fR. +Amsterdam: North Holland, 1975. +.IP [7] +Wilensky, R. "Understanding Goal-Based Stories", +Technical Report 140, Computer Science Department, +Yale University, New Haven, CT, September 1978. +.IP [8] +Wilensky, R. +"Meta-Planning: Representing and Using Knowledge about Planning in Problem +Solving and Natural Language Understanding." +\fICognitive Science\fR 5:3 (1981). +.bp +.nr PS 9 +.nr VS 11p +.ps 9 +.vs 11p +.NH +Index of Global Variables and Functions With Their Arguments +.PP +All functions are exprs (or lexprs) unless otherwise listed. +Functions with one or more asterisks for a page number are not +documented other than in this index because they were not +actually intended for use by the PEARL user. +A single asterisk * means it is primarily intended for use by +PEARL but might be useful and will generally work right. +A double asterisk ** means it will generally only work +within PEARL's code, since it expects certain +external prog variables to exist and be set correctly. +A triple asterisk *** means it is dangerous to use. +Note that it is dangerous to redefine any functions in this list, +although it should be all right to redefine any macros. +.LP +.nr PS 8 +.nr VS 10p +.ps 8 +.vs 10p +.nf +*activedbnames* -- special variable -- initial value: nil \ki40 +*any*conscell* -- special variable -- value: '(*any* . *pearlunbound*) \h'|\niu'* +*availablesizes* -- special variable -- value: \h'|\niu'39 + ((-1. . 1.) (0. . 1.) (1. . 1.) (2. . 3.) (3. . 7.) + (4. . 13.) (5. . 29.) (6. . 61.) (7. . 127.) . . . . + Franz Lisp: . . . (8. . 127.) (9. . 127.) (10. . 127.) + (11. . 127.) (12. . 127.) (13. . 127.)) + UCI Lisp: . . . (8. . 251.) (9. . 509.) (10. . 1021.) + (11. . 2039.) (12. . 4093.) (13. . 8191.)) +*blockstack* -- special variable -- initial value: nil \h'|\niu'48 +*currentcreatetype* -- special variable -- initial value: base \h'|\niu'56 +*currentpearlstructure* -- special variable -- initial value: nil \h'|\niu'46 +*currentstructure* -- special variable -- initial value: nil \h'|\niu'46 +*currenttopcopy* -- special variable -- initial value: \h'|\niu'55 +*currenttopcreated* -- special variable -- initial value: (nilstruct) \h'|\niu'8 +.sp +db -- special variable -- default initial value: \h'|\niu'33 +*db* -- special variable -- default value: the *maindb* data base \h'|\niu'12 +*db1size* -- special variable -- default initial value: 29 \h'|\niu'39 +*db2size* -- special variable -- default initial value: 127 \h'|\niu'39 +*done* -- special atom \h'|\niu'35 +.sp +*fail* -- special atom \h'|\niu'35 +*file* -- special variable -- initial value: nil \h'|\niu'60 +*firstartup* -- special variable -- initial value: t \h'|\niu'53 +*function-stream:* -- special atom \h'|\niu'13 +*globallist* -- special variable -- initial value: nil \h'|\niu'45 +.sp +*history* -- special variable -- value: command history hunk \h'|\niu'51 +*historynumber* -- special variable -- initial value: 0 \h'|\niu'52 +*historysize* -- special variable -- default value: 64 \h'|\niu'51 +*histval* -- special variable -- value: value history hunk \h'|\niu'51 +*invisible* -- special atom \h'|\niu'53 +.sp +*lastcreated* -- special variable -- initial value: (nilstruct) \h'|\niu'8 +*lastsymbolnum* -- special variable -- initial value: -1 \h'|\niu'* +*maindb* -- special variable -- default value: the main data base \h'|\niu'11 +*matchunboundsresult* -- special variable -- initial value: nil \h'|\niu'44 +*ordinalnames* -- special variable -- initial value: nil \h'|\niu'31 +.sp +*pathlocal* -- special variable -- initial value: \h'|\niu'33 +*pathtop* -- special variable -- initial value: \h'|\niu'33 +*pearlprompt* -- special variable -- default value: "pearl> " \h'|\niu'3, 4 +*pearlunbound* -- special atom \h'|\niu'45 +*printhistorynumber* -- special variable -- initial value: nil \h'|\niu'53 +.sp +*readlinechanged* -- special variable -- initial value: nil \h'|\niu'53 +*runaddpredpathhooks* -- special variable -- initial value: t \h'|\niu'34 +*runaddsetpathhooks* -- special variable -- initial value: t \h'|\niu'34 +*runallbasehooks* -- special variable -- initial value: t \h'|\niu'33 +*runallslothooks* -- special variable -- initial value: t \h'|\niu'33 +.sp +*runapplypathhooks* -- special variable -- initial value: t \h'|\niu'34 +*runclearpathhooks* -- special variable -- initial value: t \h'|\niu'34 +*rundelpredpathhooks* -- special variable -- initial value: t \h'|\niu'34 +*rundelsetpathhooks* -- special variable -- initial value: t \h'|\niu'34 +*runexpandedhooks* -- special variable -- initial value: t \h'|\niu'34 +*runfetchhooks* -- special variable -- initial value: t \h'|\niu'34 +*rungethookpathhooks* -- special variable -- initial value: t \h'|\niu'34 +*rungetpathhooks* -- special variable -- initial value: t \h'|\niu'34 +*rungetpredpathhooks* -- special variable -- initial value: t \h'|\niu'34 +*runindbhooks* -- special variable -- initial value: t \h'|\niu'34 +*runindividualhooks* -- special variable -- initial value: t \h'|\niu'34 +*runinsertdbhooks* -- special variable -- initial value: t \h'|\niu'34 +*runmatchhooks* -- special variable -- initial value: t \h'|\niu'34 +*runnextequalhooks* -- special variable -- initial value: t \h'|\niu'34 +*runnextitemhooks* -- special variable -- initial value: t \h'|\niu'34 +*runpatternhooks* -- special variable -- initial value: t \h'|\niu'34 +*runputpathhooks* -- special variable -- initial value: t \h'|\niu'34 +*runremovedbhooks* -- special variable -- initial value: t \h'|\niu'34 +*runsmergehooks* -- special variable -- initial value: t \h'|\niu'34 +*runstrequalhooks* -- special variable -- initial value: t \h'|\niu'34 +.sp +*stream* -- special atom \h'|\niu'13 +*stream:* -- special atom \h'|\niu'13 +*toplevelp* -- special variable -- initial value: \h'|\niu'* +*unhashablevalues* -- special variable -- initial value: \h'|\niu'* + (0 unbound *pearlunbound* nilsym (nilstruct)) +*use* -- special atom \h'|\niu'35 +*usealiases* -- special variable -- initial value: t \h'|\niu'51 +*warn* -- special variable -- initial value: t \h'|\niu'17 +*zero-ordinal-value* -- special variable -- initial value: 0 \h'|\niu'31 +.sp +! -- splicing macro \h'|\niu'52 +$ -- splicing macro \h'|\niu'52 += -- read macro \h'|\niu'28 +? -- read macro \h'|\niu'16 +.sp +(addalist 'var 'inst) -- macro \h'|\niu'* +(addbasehook 'conscell 'item) -- macro \h'|\niu'* +(addhistory 'line) \h'|\niu'* +(addpredpath 'item 'path 'pred) \h'|\niu'10 +(addsetpath 'item 'path 'value) \h'|\niu'10 +.sp +(addtoexpansionlists) -- macro \h'|\niu'** +(adjvarset 'var 'val) -- macro \h'|\niu'* +(allocdef numofslots) -- macro \h'|\niu'* +(allocval numofslots) -- macro \h'|\niu'* +(applypath 'fcn 'item 'path) \h'|\niu'10 +.sp +(base name [storage] slot1 ...) -- macro \h'|\niu'56 +(basicmatch 'item1 'item2) \h'|\niu'46 +(block [blockname] varlist) -- fexpr \h'|\niu'47 +(blockatom 'symbol) \h'|\niu'48 +(blockp 'potblock) \h'|\niu'30 +.sp +(breakprintfn '*printval*) \h'|\niu'58, 59 +(builddb newdb [olddb]) -- fexpr \h'|\niu'38 +(buildintvalue 'intval 'bppset) -- macro \h'|\niu'* +(buildslot) -- macro \h'|\niu'** +(buildstructvalue 'structdesc) -- macro \h'|\niu'* +(buildsymbolvalue 'symname) -- macro \h'|\niu'* +(buildvalue 'value 'typenum 'ppset) \h'|\niu'* +.sp +(cb name [storage] slot1 ...) -- macro \h'|\niu'56 +(ce basename newname [storage] slot1 ...) -- macro \h'|\niu'56 +(cf name [storage] slot1 ...) -- macro \h'|\niu'56 +(checkandrunbasehooks2 'fcn 'item1 'item2) -- macro \h'|\niu'** +(checkandrunslothooks2 'fcn 'hooks 'val1 'val2 'item1 'item2) -- macro \h'|\niu'** +(checkrunhandlebasehooks1 'fcn 'runhooksatom) -- macro \h'|\niu'** +(checkrunhandleslothooks1 'fcn 'runhooksatom) -- macro \h'|\niu'** +(ci basename [storage] slot1 ...) -- macro \h'|\niu'56 +.sp +(cleardb ['db]) \h'|\niu'39 +(cleardb1 'db) \h'|\niu'39 +(cleardbactive 'db) -- macro \h'|\niu'* +(clearhashandformat 'slotnum 'defblock) -- macro \h'|\niu'* +(clearpath 'item 'path) \h'|\niu'10 +.sp +(compatible 'slotnum 'item1 'item2) -- macro \h'|\niu'* +(connectdb 'newdb 'olddb) \h'|\niu'* +(consistentvalue 'val 'predlist 'typenum 'item) -- macro \h'|\niu'* +(constructvalue) -- macro \h'|\niu'** +(convertpreds 'pred) \h'|\niu'* +(copy 'list) \h'|\niu'54 +(copypatternslot) -- macro \h'|\niu'** +(copyslice) -- macro \h'|\niu'** +(copyslot 'nameblock) -- macro \h'|\niu'** +.sp +(cp basename [storage] slot1 ...) -- macro \h'|\niu'56 +(cr selector ...) -- fexpr \h'|\niu'55 +(create selector ...) -- fexpr \h'|\niu'5 +(createbase 'newname 'slots) \h'|\niu'* +(createexpanded 'oldname 'newname 'slots) \h'|\niu'* +(createfunction 'fcnname 'slots) \h'|\niu'* +(createindividual 'basename 'slots) \h'|\niu'* +(createpattern 'basename 'slots) \h'|\niu'* +.sp +(databasep 'potdb) \h'|\niu'30 +(dbcr selector ...) -- macro \h'|\niu'56 +(dbcreate selector ...) -- macro \h'|\niu'12, 56 +(debugprint 'item) \h'|\niu'21 +(defatom 'symbol) \h'|\niu'7 +.sp +(defaultfortype 'typenum) -- macro \h'|\niu'* +(definitionp 'potdef) \h'|\niu'30 +(delpredpath 'item 'path 'pred) \h'|\niu'10 +(delsetpath 'item 'path 'value) \h'|\niu'10 +(disguisedas 'filler 'struct ['db]) \h'|\niu'29 +(disguisedas1 'filler 'struct 'db) \h'|\niu'29 +.sp +(dobasehooks2< 'fcn 'runhookatom) -- macro \h'|\niu'** +(dobasehooks2> 'fcn 'runhookatom) -- macro \h'|\niu'** +(doslothooks2< 'fcn 'runhookatom) -- macro \h'|\niu'** +(doslothooks2> 'fcn 'runhookatom) -- macro \h'|\niu'** +(dskprintfn '*printval*) \h'|\niu'60 +.sp +(endallblocks) \h'|\niu'48 +(endanyblocks blockname) -- fexpr \h'|\niu'48 +(endblock [blockname]) -- fexpr \h'|\niu'47 +(enforcetype 'value 'typenum) \h'|\niu'* +(equalvalue 'xval 'yval 'typenum) -- macro \h'|\niu'* +(evalfcn 'item) \h'|\niu'51 +.sp +(executehook1 fcn value item defblock) -- macro \h'|\niu'** +(executehook2 fcn val1 val2 item1 item2 defblock result) -- macro \h'|\niu'** +(expanded basename newname [storage] slot1 ...) -- macro \h'|\niu'56 +(expandedfetch 'item ['db]) \h'|\niu'42 +(expandedfetch1 'item 'db) \h'|\niu'42 +.sp +(fcnslot) -- macro \h'|\niu'** +(fetch 'item ['db]) \h'|\niu'12, 43 +(fetch1 'item 'db) \h'|\niu'12, 43 +(fetcheverywhere 'item ['db]) \h'|\niu'19, 25 +(fetcheverywhere1 'item 'db) \h'|\niu'19, 25 +(fetchcreate selector ...) -- macro \h'|\niu'14, 56 +(fillbaseslot) -- macro \h'|\niu'** +(fillin1 'fcn 'value 'item 'defblock) \h'|\niu'33 +(fillin2 'fcn 'val1 'val2 'item1 'item2 'defblock 'result) \h'|\niu'33 +(fillindivslot) -- macro \h'|\niu'** +.sp +(findnextblockstart) -- macro \h'|\niu'** +(findslotnum) -- macro \h'|\niu'** +(findstructsymbolpair 'defblock 'symbol) -- macro \h'|\niu'** +(firstfetch pattern) -- macro \h'|\niu'14, 56 +(fn name [storage] slot1 ...) -- macro \h'|\niu'56 +.sp +(followpath 'item 'path) \h'|\niu'* +(for val 'init 'final &rest 'body) -- macro \h'|\niu'54 +(foreach 'stream fcn) -- fexpr \h'|\niu'54 +(fp 'item ['lmar ['rmar]]) \h'|\niu'56 +(freezebindings 'struct) \h'|\niu'48 +(freezeblock 'blockname) \h'|\niu'49 +(freezestruct 'struct) \h'|\niu'49 +.sp +(fullform 'item) \h'|\niu'20 +(fullprint 'item ['lmar ['rmar]]) \h'|\niu'20, 37 +(fullprint1 'item 'lmar 'rmar) \h'|\niu'20, 37 +(fullslotform) -- macro \h'|\niu'** +.sp +(getalist 'inst) -- macro \h'|\niu'57 +(getalistcp 'inst) -- macro \h'|\niu'57 +(getbasehooks 'defblock) -- macro \h'|\niu'57 +(getdb1 'db) -- macro \h'|\niu'57 +(getdb2 'db) -- macro \h'|\niu'57 +(getdbactive 'db) -- macro \h'|\niu'57 +(getdbchildren 'db) -- macro \h'|\niu'57 +(getdbname 'db) -- macro \h'|\niu'57 +(getdbparent 'db) -- macro \h'|\niu'57 +(getdefaultinst 'defblock) \h'|\niu'57 +(getdefinition 'valblock) \h'|\niu'57 +(getenforce 'slotnum 'defblock) -- macro \h'|\niu'57 +(getexpansionlist 'defblock) -- macro \h'|\niu'57 +(getformatinfo 'slotnum 'defblock) -- macro \h'|\niu'57 +(gethash* 'slotnum 'defblock) -- macro \h'|\niu'57 +(gethash** 'slotnum 'defblock) -- macro \h'|\niu'57 +(gethash1 'num1 'db1) -- macro \h'|\niu'57 +(gethash2 'num1 'num2 'db2) -- macro \h'|\niu'57 +(gethash3 'num1 'num2 'num3 'db2) -- macro \h'|\niu'57 +(gethash: 'slotnum 'defblock) -- macro \h'|\niu'57 +(gethash:: 'slotnum 'defblock) -- macro \h'|\niu'57 +(gethash< 'slotnum 'defblock) -- macro \h'|\niu'57 +(gethash> 'slotnum 'defblock) -- macro \h'|\niu'57 +(gethashalias 'defblock) -- macro \h'|\niu'57 +(gethashinfo 'slotnum 'defblock) -- macro \h'|\niu'57 +(gethashvalue 'slotnum 'item 'defblock) \h'|\niu'* +.sp +(gethookpath 'item 'path) \h'|\niu'10 +(getisa 'valblock) -- macro \h'|\niu'57 +(getpath 'item 'path) \h'|\niu'10 +(getpname 'defblock) -- macro \h'|\niu'57 +(getppset 'slotnum 'defblock) -- macro \h'|\niu'57 +(getpred 'slotnum 'inst) -- macro \h'|\niu'57 +(getpredpath 'item 'path) \h'|\niu'10 +.sp +(getsinglevalue 'slotnum 'item) \h'|\niu'* +(getslot 'slotnum 'inst) -- macro \h'|\niu'57 +(getslothooks 'slotnum 'inst) -- macro \h'|\niu'57 +(getslotname 'slotnum 'defblock) -- macro \h'|\niu'57 +(getslottype 'slotnum 'defblock) -- macro \h'|\niu'57 +(getstructlength 'defblock) -- macro \h'|\niu'57 +(getstructorsymnum 'strsym) -- macro \h'|\niu'57 +.sp +(getsymbol 'symname) \h'|\niu'4 +(getsymbolpname 'symbolitem) -- macro \h'|\niu'57 +(getuniquenum 'defblock) -- macro \h'|\niu'57 +(getvalue 'slotnum 'inst) \h'|\niu'57 +(getvarandvalue 'slotnum 'inst 'var) \h'|\niu'57 +(getvarval 'slotnum 'inst) -- macro \h'|\niu'57 +.sp +(*global* varname) -- fexpr \h'|\niu'46 +(global variable) -- fexpr \h'|\niu'45 +(globalp 'variable) \h'|\niu'45 +(handlehookresult 'oldval 'newval) -- macro \h'|\niu'** +(hashablevalue 'slotnum 'item 'defblock) -- macro \h'|\niu'** +(hashslot) -- macro \h'|\niu'** +.sp +(hidden 'command) -- macro \h'|\niu'35 +(higheroreq 'item1 'item2) -- macro \h'|\niu'* +(history ['num]) \h'|\niu'53 +(ind basename [storage] slot1 ...) -- macro \h'|\niu'56 +(indb 'item ['db]) \h'|\niu'14 +(indb1 'item 'db) \h'|\niu'14 +(individual basename [storage] slot1 ...) -- macro \h'|\niu'56 +.sp +(inheritvalue 'structdef) -- macro \h'|\niu'** +(inlinecreate selector ...) -- macro \h'|\niu'14, 56 +(inlinefetchcreate selector ...) -- macro \h'|\niu'14, 56 +(insertdb 'item ['db]) \h'|\niu'12 +(insertdb1 'item 'db) \h'|\niu'12 +.sp +(insidecreate selector ...) -- fexpr \h'|\niu'** +(insidefetch patdef expdefs) -- macro \h'|\niu'** +(insidefetcheverywhere patdef expdefs) -- macro \h'|\niu'** +(insidepatternize 'item) \h'|\niu'** +(insidescopy 'item) \h'|\niu'** +(installadjunct 'adjunctvar) -- macro \h'|\niu'** +(installglobal 'globalvar) -- macro \h'|\niu'** +(installvar 'varname) -- macro \h'|\niu'** +.sp +(instatom 'symbol) \h'|\niu'7 +(isa 'item1 'name) \h'|\niu'42 +(isanexpanded 'item1 'item2) \h'|\niu'42 +(islambda 'fcnname) \h'|\niu'* +.sp +(match 'item1 'item2) \h'|\niu'46 +(msgprintfn '*printval*) \h'|\niu'58, 62 +(newnum) -- macro \h'|\niu'* +(nextequal 'stream) \h'|\niu'46 +(nextitem 'stream) \h'|\niu'13 +(noalias) -- macro \h'|\niu'** +.sp +(nullstruct 'item) \h'|\niu'42 +(nullsym 'item) \h'|\niu'42 +(numberofslot 'slotname 'defblock) -- macro \h'|\niu'57 +(onesymbol) -- macro \h'|\niu'** +(ordatom 'symbol) \h'|\niu'31 +(ordinal name vallist) -- fexpr \h'|\niu'30 +.sp +(pat basename [storage] slot1 ...) -- macro \h'|\niu'56 +(path fcn 'item 'pathlist ['val]) -- macro \h'|\niu'9 +(pattern basename [storage] slot1 ...) -- macro \h'|\niu'56 +(patternize 'item) -- macro \h'|\niu'55 +(patternizeslot) -- macro \h'|\niu'** +(pboundp 'a) \h'|\niu'45 +.sp +(pearlprintfn '*printval*) \h'|\niu'3, 4 +(pexp basename newname [storage] slot1 ...) -- macro \h'|\niu'56 +(pfunction name [storage] slot1 ...) -- macro \h'|\niu'56 +(pname 'item) \h'|\niu'4 +(ppsetform 'slotval 'ppsetname) \h'|\niu'* +.sp +(prefix 'item1 'item2) \h'|\niu'52 +(prefixcommandhistory) \h'|\niu'* +(prefixcommandvalue) \h'|\niu'* +(printdb ['db]) \h'|\niu'21 +(printdb1 'db) \h'|\niu'21 +(psymbolp 'potsymbol) \h'|\niu'30 +(punbound) \h'|\niu'45 +.sp +(punboundatomp 'yyy) \h'|\niu'* +(putalist 'alist 'inst) -- macro \h'|\niu'* +(putalistcp 'alist 'inst) -- macro \h'|\niu'* +(putbasehooks 'hooklist 'defblock) -- macro \h'|\niu'* +(putdb1 'db1 'db) -- macro \h'|\niu'*** +(putdb2 'db2 'db) -- macro \h'|\niu'*** +(putdbchildren 'childlist 'db) -- macro \h'|\niu'*** +(putdbname 'name 'db) -- macro \h'|\niu'* +(putdbparent 'parent 'db) -- macro \h'|\niu'*** +(putdef 'defblock 'valblock) -- macro \h'|\niu'*** +(putdefaultinst 'valblock 'defblock) -- macro \h'|\niu'*** +(putenforce 'slotnum 'defblock) -- macro \h'|\niu'*** +(putexpansionlist 'explist 'defblock) -- macro \h'|\niu'*** +(putformatinfo 'slotnum 'hashnum 'defblock) -- macro \h'|\niu'*** +(puthash* 'slotnum 'defblock) -- macro \h'|\niu'*** +(puthash** 'slotnum 'defblock) -- macro \h'|\niu'*** +(puthash1 'num1 'db1 'item) -- macro \h'|\niu'* +(puthash2 'num1 'num2 'db2 'item) -- macro \h'|\niu'* +(puthash3 'num1 'num2 'num3 'db2 'item) -- macro \h'|\niu'* +(puthash: 'slotnum 'defblock) -- macro \h'|\niu'*** +(puthash:: 'slotnum 'defblock) -- macro \h'|\niu'*** +(puthash< 'slotnum 'defblock) -- macro \h'|\niu'*** +(puthash> 'slotnum 'defblock) -- macro \h'|\niu'*** +(puthashalias 'hashnum 'defblock) -- macro \h'|\niu'*** +(puthashinfo 'slotnum 'hashnum 'defblock) -- macro \h'|\niu'*** +(putisa 'isa 'valblock) -- macro \h'|\niu'*** +.sp +(putpath 'item 'path 'value) \h'|\niu'10 +(putpname 'name 'defblock) -- macro \h'|\niu'*** +(putppset 'slotnum 'setname 'defblock) -- macro \h'|\niu'* +(putpred 'slotnum 'value 'inst) -- macro \h'|\niu'* +(putslot 'slotnum 'value 'inst) -- macro \h'|\niu'*** +(putslothooks 'slotnum 'slothooklist 'inst) -- macro \h'|\niu'* +(putslotname 'slotnum 'slotname 'defblock) -- macro \h'|\niu'*** +(putslottype 'slotnum 'typenum 'defblock) -- macro \h'|\niu'*** +(putstructlength 'size 'defblock) -- macro \h'|\niu'*** +(putsymbolpname 'name 'block) -- macro \h'|\niu'*** +(putuniquenum 'num 'defblock) -- macro \h'|\niu'*** +(putvarval 'slotnum 'value 'inst) -- macro \h'|\niu'*** +(reallitatom 'potatom) \h'|\niu'* +.sp +(releasedb 'db) \h'|\niu'38 +(removedb 'item ['db]) \h'|\niu'12 +(removedb1 'item 'db) \h'|\niu'12 +(removeslot) -- macro \h'|\niu'** +(revassq 'value 'alist) \h'|\niu'* +(runbasehooks1 'fcn 'item) \h'|\niu'33 +(runbasehooks2 'fcn 'item1 'item2 'result) \h'|\niu'33 +(runslothooks1 'fcn 'item 'slotname 'value) \h'|\niu'33 +(runslothooks2 'fcn 'item1 'item2 'slotname 'val1 'val2) \h'|\niu'33 +.sp +(savecontinue 'directory 'name) \h'|\niu'53 +(savefresh 'directory 'name) \h'|\niu'53 +(savepearl) \h'|\niu'* +(scopy 'item) -- macro \h'|\niu'55 +(scopyslot) -- macro \h'|\niu'** +(setblock blockname) -- fexpr \h'|\niu'48 +.sp +(setdbactive 'db) -- macro \h'|\niu'*** +(setdbsize 'poweroftwo) \h'|\niu'39 +(setv var 'val 'environment) -- fexpr \h'|\niu'47 +(slotequal 'slotnum 'item1 'item2) \h'|\niu'* +(slotnametonumber 'slotname 'defblock) -- macro \h'|\niu'** +(smerge 'build 'from) \h'|\niu'55 +.sp +(standardfetch 'item ['db]) \h'|\niu'43 +(standardfetch1 'item 'db) \h'|\niu'43 +(standardmatch 'item1 'item2) \h'|\niu'46 +(streamp 'potstream) \h'|\niu'30 +(streamtolist 'stream) \h'|\niu'14 +.sp +(strequal 'item1 'item2) \h'|\niu'46 +(structurenamep 'potname) \h'|\niu'30 +(structurep 'potstruct) \h'|\niu'30 +(symatom 'symbol) \h'|\niu'4 +(symbol name1 name2 ...) -- fexpr \h'|\niu'4 +(symbole 'symname) \h'|\niu'4 +(symbolnamep 'potname) \h'|\niu'30 +.sp +(thawbindings 'struct) \h'|\niu'49 +(thawblock 'blockname) \h'|\niu'49 +(thawstruct 'struct) \h'|\niu'49 +(unbind globalvar) -- fexpr \h'|\niu'45 +(unbindvars 'structure) -- macro \h'|\niu'46 +(unboundatomp 'yyy) \h'|\niu'* +.sp +(valform 'item) \h'|\niu'20 +(valprint 'item ['lmar ['rmar]]) \h'|\niu'20 +(valprint1 'item 'lmar) \h'|\niu'20 +(valslotform) -- macro \h'|\niu'** +(valueof 'var 'struct) \h'|\niu'17 +.sp +(*var* varname) -- fexpr \h'|\niu'46 +(varset 'var 'val) -- macro \h'|\niu'* +(varvalue var 'val) -- fexpr \h'|\niu'17 +(visible 'command) -- macro \h'|\niu'35 +(vp 'item ['lmar ['rmar]]) \h'|\niu'56 +(while 'val &rest 'body) -- macro \h'|\niu'54 +.fi +.bp +.nr PS 9 +.nr VS 11p +.ps 9 +.vs 11p +.NH +Concept Index +.LP +.nr PS 8 +.nr VS 10p +.ps 8 +.vs 10p +.nf +abbreviations \ki55-56 +accessing slots of structures \h'|\niu'8-10 +accessing structure default instances \h'|\niu'7 +accessing structure definitions \h'|\niu'7 +accessing symbols \h'|\niu'4 +.sp +adding slots to structures \h'|\niu'40 +adding to the data base \h'|\niu'12 +adjunct variables \h'|\niu'30 +affecting forced aliasing (^) \h'|\niu'27 +ako's (expanded structures) \h'|\niu'40-42 +.sp +aliasing of commands \h'|\niu'51 +aliasing in hashing \h'|\niu'27 +ampersand (&) hashing \h'|\niu'26 +and, in predicates \h'|\niu'28 +anti-aliasing in hashing (<) \h'|\niu'27 +*any* \h'|\niu'15 +automatic storing of structures \h'|\niu'8, 56 +.sp +base hooks \h'|\niu'32-37 +bases \h'|\niu'5 +blocks \h'|\niu'47-48 +building structures \h'|\niu'5 +building upon data bases \h'|\niu'38, 39 +.sp +changing slots of structures \h'|\niu'8 +clearing data bases \h'|\niu'39 +colon (:) hashing \h'|\niu'23 +colon-colon (::) hashing \h'|\niu'24 +.sp +command aliasing \h'|\niu'51 +command history \h'|\niu'51-53 +command history, printing \h'|\niu'53 +compatibility functions (UCI, Franz) \h'|\niu'58-62 +.sp +controlling running of hooks \h'|\niu'33-34 +controlling results with hooks \h'|\niu'35 +controlling unbinding of variables \h'|\niu'48-49 +converting from internal form \h'|\niu'20 +copy redefined \h'|\niu'54 +copying structures \h'|\niu'55 +.sp +creating data bases \h'|\niu'38, 39 +creating patterns \h'|\niu'15-16 +creating base structures \h'|\niu'5 +creating individual structures \h'|\niu'6 +creating symbols \h'|\niu'4 +.sp +data bases \h'|\niu'11 +data bases, building upon \h'|\niu'39 +data bases, clearing \h'|\niu'39 +data bases, creating \h'|\niu'38 +data bases, fetching from \h'|\niu'12, 19, 25, 42, 43, 46 +data bases, freeing \h'|\niu'40 +data bases, inserting into \h'|\niu'12 +data bases, printing \h'|\niu'21 +data bases, releasing \h'|\niu'40 +data bases, removing from \h'|\niu'12 +data bases, setting size of \h'|\niu'39 +.sp +debugging \h'|\niu'21 +debugging print \h'|\niu'21 +declaring global variables \h'|\niu'45 +.sp +default fetch function \h'|\niu'43 +default instance for a structure \h'|\niu'15 +default instance, accessing \h'|\niu'7 +default match function \h'|\niu'46 +default printing functions \h'|\niu'20, 58, 60-61, 62 +default values for slots \h'|\niu'14-15 +defaults, inherited \h'|\niu'41-42 +.sp +defining structures \h'|\niu'5 +defining symbols \h'|\niu'4 +definitions of structures, accessing \h'|\niu'7 +deleting from the data base \h'|\niu'12 +demons (hooks) \h'|\niu'32-37 +.sp +disguising in path \h'|\niu'10-11 +disguising in predicates \h'|\niu'29 +don't-care matching variable \h'|\niu'15 +double-colon (::) hashing \h'|\niu'24 +double-star (**) hashing \h'|\niu'24 +dumping PEARL for later \h'|\niu'53 +.sp +efficiency despite variables \h'|\niu'30 +enumerated (ordinal) types \h'|\niu'30 +environment for variable evaluation \h'|\niu'46-47 +environment, top level \h'|\niu'51-53 +environments, in hooks \h'|\niu'33 +.sp +equality of structures \h'|\niu'46 +equivalences of functions (UCI-Franz) \h'|\niu'58-62 +error messages \h'|\niu'21 +evaluating function structures \h'|\niu'51 +evaluating in create \h'|\niu'22 +expanded structures \h'|\niu'40 +expanded structures, fetching \h'|\niu'42 +.sp +feedback, sending \h'|\niu'21 +fetch, standard \h'|\niu'46 +fetching expanded structures \h'|\niu'42 +fetching from all buckets \h'|\niu'19, 25 +fetching from the data base \h'|\niu'12 , 19, 25, 42, 43, 46 +fetching with equality (not matching) \h'|\niu'46 +.sp +filling in special forms (in hooks) \h'|\niu'33 +for loop \h'|\niu'54 +forced aliasing (>) \h'|\niu'26 +forest of data bases \h'|\niu'39-40 +freeing data bases \h'|\niu'40 +freezing variables \h'|\niu'48-49 +.sp +function equivalences (UCI-Franz) \h'|\niu'58-62 +function structures \h'|\niu'49-51 +function structures, evaluating \h'|\niu'51 +getting symbols \h'|\niu'4 +global variables \h'|\niu'45 +greater-than (>) hashing \h'|\niu'26 +.sp +hash aliasing (&) \h'|\niu'26 +hash marking \h'|\niu'17, 23-27 +hashing problems \h'|\niu'18 +hashing with variables \h'|\niu'30 +hiding functions from hooks \h'|\niu'35 +hierarchy of structures \h'|\niu'40 +.sp +history mechanism \h'|\niu'51-3 +history number, printing in prompt \h'|\niu'53 +hooks \h'|\niu'32-37 +hooks, affecting result with \h'|\niu'35 +hooks, controlling running of \h'|\niu'33-34 +hooks, hiding functions from \h'|\niu'35 +hooks, making functions visible to \h'|\niu'35 +hooks, multi-argument \h'|\niu'28 +hooks, running \h'|\niu'33-34 +.sp +if-added functions (hooks) \h'|\niu'32-37 +indirection in path \h'|\niu'10-11 +individuals \h'|\niu'6 +inheritance in structures \h'|\niu'41-42 +(.)init.prl file \h'|\niu'2-3 +.sp +inserting in the data base \h'|\niu'12 +instances \h'|\niu'6 +integer slots \h'|\niu'30 +internal access functions \h'|\niu'57 +internal form printing \h'|\niu'21 +.sp +invisible functions to hooks \h'|\niu'35 +invisible results from functions \h'|\niu'53 +isa's (expanded structures) \h'|\niu'40-42 +less-than (<) hashing \h'|\niu'27 +lexically scoped variables \h'|\niu'47-48 +.sp +looping functions \h'|\niu'54 +low level access functions \h'|\niu'57 +macros, special \h'|\niu'56 +main data base \h'|\niu'11 +marking structures for hashing \h'|\niu'17, 23-27 +.sp +match, standard \h'|\niu'46 +match, without unbinding variables \h'|\niu'46 +match-anything variable \h'|\niu'15 +matching process \h'|\niu'44 +matching two structures \h'|\niu'43 +matching unbound variables \h'|\niu'44 +matching-variables \h'|\niu'16-17 +.sp +merging structures \h'|\niu'55 +modified input line, printing \h'|\niu'53 +multi-argument matching predicates \h'|\niu'28, 32 +next item in a stream \h'|\niu'13 +nilstruct(ure) \h'|\niu'14 +nilsym(bol) \h'|\niu'14 +.sp +or, in predicates \h'|\niu'28 +ordinal types \h'|\niu'30-31 +path functions \h'|\niu'10 +path indirection \h'|\niu'10-11 +pattern-matching variables \h'|\niu'16-17 +.sp +patterns \h'|\niu'12, 15, 43 +patterns in matching \h'|\niu'43 +predicates for object types \h'|\niu'30 +predicates in matching \h'|\niu'27-29 +predicates in matching, when run \h'|\niu'44 +predicates in matching, multi-argument \h'|\niu'28 +.sp +print names \h'|\niu'4 +printing PEARL objects \h'|\niu'20 +printing command history \h'|\niu'53 +printing data bases \h'|\niu'21 +printing functions \h'|\niu'20 +printing functions, standard \h'|\niu'3-4, 58, 60-61, 62 +printing history number in prompt \h'|\niu'53 +printing modified input line \h'|\niu'53 +printing warnings \h'|\niu'17 +.sp +processing a stream \h'|\niu'13 +prompt \h'|\niu'3-4 +prompt-read-eval-print loop \h'|\niu'2-3, 51 +read-eval-print loop \h'|\niu'2-3, 51 +redirecting in create (! and $) \h'|\niu'22 +releasing data bases \h'|\niu'40 +removing from the data base \h'|\niu'12 +.sp +reporting bugs \h'|\niu'21 +retrieving from the data base \h'|\niu'12 +returning invisible results \h'|\niu'53 +running hooks \h'|\niu'33-34 +running under Franz Lisp \h'|\niu'2 +running under UCI Lisp \h'|\niu'3 +.sp +saving PEARL for later \h'|\niu'53 +scalar types \h'|\niu'30 +short-circuiting in create \h'|\niu'22 +side effect setting of adjunct variables \h'|\niu'30 +size of data bases \h'|\niu'39 +.sp +slot hooks \h'|\niu'32-37 +slot names to numbers \h'|\niu'57 +slot types \h'|\niu'6 +slot types, more specific \h'|\niu'30 +slot values \h'|\niu'8-10 +slot values in hooks \h'|\niu'32 +slot values in predicates \h'|\niu'28 +.sp +special forms in hooks \h'|\niu'32 +special forms in predicates \h'|\niu'28 +special forms, filling in \h'|\niu'33 +special macros \h'|\niu'56 +standard fetch function \h'|\niu'43 +standard match function \h'|\niu'46 +.sp +star (*) hashing \h'|\niu'17, 23 +star-star (**) hashing \h'|\niu'24 +(.)start.prl file \h'|\niu'2-3 +startup files \h'|\niu'2-3 +storing structures in the data base \h'|\niu'12 +storing of structures in atoms \h'|\niu'8, 56 +streams \h'|\niu'13 +.sp +structure equality \h'|\niu'46 +structure matching \h'|\niu'44-45 +structure predicates \h'|\niu'28-29 +structure slots, further typing \h'|\niu'30 +structured escapes to Lisp \h'|\niu'49-51 +structures \h'|\niu'5 +structures, copying \h'|\niu'55 +structures, expanded \h'|\niu'40 +structures, function \h'|\niu'49-51 +structures, merging \h'|\niu'55 +.sp +symbols \h'|\niu'4 +testing for nilstruct \h'|\niu'42 +testing for nilsym \h'|\niu'42 +testing for object types \h'|\niu'30 +thawing variables \h'|\niu'48-49 +.sp +top level loop \h'|\niu'2-3, 51 +top level loop functions \h'|\niu'59, 62 +triple (**) hashing \h'|\niu'24 +type tests for objects \h'|\niu'30 +types in structure slots \h'|\niu'31-2 +.sp +unbinding global variables by match (lack of) \h'|\niu'45 +unbinding global variables by user \h'|\niu'45 +unbinding local variables by match \h'|\niu'45-6 +unbinding local variables by user \h'|\niu'46 +unbinding of variables, controlling \h'|\niu'48-49 +up-arrow (^) hashing \h'|\niu'27 +.sp +values of variables \h'|\niu'17, 46 +values of variables, setting \h'|\niu'47 +variables in hooks \h'|\niu'32 +variables in predicates \h'|\niu'28 +variables with hashing \h'|\niu'30 +variable, accessing values \h'|\niu'17, 46 +variables, adjunct \h'|\niu'30 +variables, controlling unbinding \h'|\niu'48-49 +variables, freezing \h'|\niu'48-49 +variables, global \h'|\niu'45 +variables, lexically scoped \h'|\niu'47-48 +variable, setting values \h'|\niu'47 +variables, side effects \h'|\niu'30 +variables, thawing \h'|\niu'48-49 +variables, unbinding \h'|\niu'46 +.sp +visible functions to hooks \h'|\niu'35 +warnings \h'|\niu'17 +while loop \h'|\niu'54 +.fi +.nr PS 10 +.nr VS 12p +.ps 10 +.vs 12p +.bp 0 +.DS C +.LG +\fBTable of Contents\fR +.SM +.DE +.DS L +1. Introduction \ka 1 +2. Running PEARL \h'|\nau' 2 + 2.1. Under Franz Lisp \h'|\nau' 2 + 2.2. Under UCI Lisp \h'|\nau' 3 +3. Creating Simple Objects \h'|\nau' 4 + 3.1. Defining Symbols \h'|\nau' 4 + 3.2. Defining Structures \h'|\nau' 5 +4. Creating Individual Instances of Defined Structures \h'|\nau' 6 +5. Accessing Slots of Structures \h'|\nau' 8 +6. Storing In and Retrieving From the Data Base -- The Simplest Way \h'|\nau'11 + 6.1 Storing In the Data Base: \fIInsertdb\fR and \fIRemovedb\fR\h'|\nau'11 + 6.2 Retrieving Hash Buckets From the Data Base: \fIFetch\fR \h'|\nau'12 + 6.3 Accessing the Results of \fIFetch\fR: \fINextitem\fR \h'|\nau'13 +7. The Default Values for Unspecified Slots \h'|\nau'14 +8. Using \fIPattern\fRs For More Flexible and Powerful Retrieval \h'|\nau'15 +9. Marking Structures During Creation For More Efficient Retrieval \h'|\nau'17 +10. Printing Structures, Symbols and Other PEARL Objects \h'|\nau'20 +11. Error Messages, Bugs, and Error Handling Abilities \h'|\nau'21 +12. Short-Circuiting and Redirecting \fICreate\fR Using !, $ and Atoms \h'|\nau'22 +13. More Flexible Hash Selection \h'|\nau'23 +14. Using Predicates to Constrain Fetching \h'|\nau'27 +15. More Useful Slot Types \h'|\nau'30 +16. Attaching Hooks to Structures (If-Added Demons) \h'|\nau'32 +17. Creating and Manipulating Multiple Data Bases \h'|\nau'38 +18. Creating a Forest of Data Bases \h'|\nau'39 +19. Creating Expanded Subtypes of Previously Defined Objects \h'|\nau'40 +20. Fetching Expanded Structures \h'|\nau'42 +21. How Two Objects \fIMatch\fR \h'|\nau'43 + 21.1 When Is a Pattern not a \fIPattern\fR? \h'|\nau'43 + 21.2 The Matching Process \h'|\nau'44 +22. Binding Blocks of Structures Together Via Common Variables \h'|\nau'47 +23. Controlling the Unbinding of Variables by \fIMatch\fR \h'|\nau'48 +24. Function Structures \h'|\nau'49 +25. More About the PEARL Top Level Loop and History Mechanism \h'|\nau'51 +26. Looping and Copying Functions \h'|\nau'54 +27. Miscellaneous Variations and Abbreviations \h'|\nau'55 +28. Low Level Access Functions \h'|\nau'57 +29. Appendix of UCI Lisp functions added to Franz PEARL \h'|\nau'58 +30. Appendix of Franz Lisp functions added to UCI Lisp PEARL \h'|\nau'62 +31. Bibliography \h'|\nau'63 +32. Index of Global Variables and Functions With Their Arguments \h'|\nau'64 +33. Concept Index \h'|\nau'71 +.DE diff --git a/usr/src/usr.bin/lisp/pearl/match.l b/usr/src/usr.bin/lisp/pearl/match.l new file mode 100644 index 0000000000..b884f7112d --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/match.l @@ -0,0 +1,564 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; match.l ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Functions for matching, comparing, and testing structures. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. +; Unification added by David Chin. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Functions which accomplish unification of two variables. + +; Turns on unification (irrevocably). +(de useunification () + (setq *unifyunbounds* t) + 'UsingUnification) + +; sets all variables in the var list of the equiv class (first arg) which are +; still bound to the equiv class to the new value (second arg). +(defmacro setequivclass (equiv value) + `(mapc (funl (var) + (cond ((dtpr var) ; a local var cell + ; If bound to equiv class, then save the old value + ; and set the var to value. + (and (eq (cdr var) ,equiv) + (push (cons var (cdr var)) *equivsavestack*) + (rplacd var ,value))) + ( t ; otherwise a global var. + (and (eq (eval var) ,equiv) + (push (cons var (eval var)) *equivsavestack*) + (set var ,value))))) + (cdr ,equiv))) + +; unifies two unbound variables (0, one or both may already be equiv classes). +(dm unifytwovars (none) + '(progn (setq xval (cond ((dtpr xvar) (cdr xvar)) + ( t (eval xvar)))) + (setq yval (cond ((dtpr yvar) (cdr yvar)) + ( t (eval yvar)))) + (cond ((eq xvar yvar) + ; Same variable, so leave xvar and yvar alone. + (setq newval nil)) + ; Both values are unbound so create a new equiv class. + ((and (eq xval (punbound)) + (eq yval (punbound))) + (setq newval (cons (equivclass) (list xvar yvar)))) + ; Same equiv class (not "unbound"), so leave xvar & yvar alone. + ((eq xval yval) + (setq newval nil)) + ; Both are equiv classes, so merge into a new equiv class. + ((and (pboundp xval) + (pboundp yval)) + (setq newval + (cons (equivclass) + (cond ((<& (length (cdr xval)) + (length (cdr yval))) + (append (cdr xval) (cdr yval))) + ( t (append (cdr yval) (cdr xval)))))) + ; And change the equiv class for the other vars in the list. + (setequivclass xval newval) + (setequivclass yval newval)) + ((punboundatomp xval) ; xvar is not an equiv class. + (cond ((memq xvar (cdr yval)) ; but used to be in yvar's. + (setq newval yval)) + ( t ; else build a new equiv class with yvar added. + (setq newval (cons (equivclass) + (cons xvar (cdr yval)))) + (setequivclass yval newval)))) + ( t ; otherwise yvar is not an equiv class. + (cond ((memq yvar (cdr xval)) ; but used to be in xvar's. + (setq newval xval)) + ( t ; else build a new equiv class with xvar added. + (setq newval (cons (equivclass) + (cons yvar (cdr xval)))) + (setequivclass xval newval))))) + ; Set the variables to a new equiv class created above. + (and newval + (progn + ; Save the old values in case match fails + (push (cons xvar xval) *equivsavestack*) + (push (cons yvar yval) *equivsavestack*) + ; And set variables (either local or global). + (cond ((dtpr xvar) (rplacd xvar newval)) + ( t (set xvar newval))) + (cond ((dtpr yvar) (rplacd yvar newval)) + ( t (set yvar newval))))) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Low level macros for matching. + +; Fast macro for minimum of two lengths. +(defmacro min& (n1 n2) + `(let ((min ,n1) + (other ,n2)) + (and (>& min other) + (setq min other)) + min)) + +; Unbind all vars on the item's assoc list +(defmacro unbindvars (item) + `(mapc (funl (cell) (rplacd cell (punbound))) (getalist ,item))) + +; Set the GLOBAL or VAR variable to the value. +(defmacro varset (var val) + `(let ((localvar ,var) + (localval ,val) + savevarval) + (cond ((dtpr localvar) + (setq savevarval (cdr localvar)) + (rplacd localvar localval)) + ( t (push localvar *globalsavestack*) + (setq savevarval (eval localvar)) + (set localvar localval))) + (and *unifyunbounds* + (equivclassp savevarval) + (setequivclass savevarval localval)))) + +; Set the GLOBAL or VAR adjunct variable to the value. +(defmacro adjvarset (var val) + `(let ((localvar ,var) + (localval ,val) + savevarval) + (and localvar + (progn (cond ((dtpr localvar) + (setq savevarval (cdr localvar)) + (rplacd localvar localval)) + ( t (push localvar *globalsavestack*) + (setq savevarval (eval localvar)) + (set localvar localval))) + (and *unifyunbounds* + (equivclassp savevarval) + (setequivclass savevarval localval)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Macros for matching individual values. + +; Check whether VAL is consistent with the predicates in PREDLIST. +(defmacro consistentvalue (val predlist type item defblock) + `(prog (restriction) + loop + (cond ((null ,predlist) (return t)) ; all predicates were true. + ; Otherwise, execute the next one. + ((cond ((reallitatom (setq restriction (pop ,predlist))) + ; The name of a function to be applied. + (apply* restriction (ncons ,val))) + ; An s-expression predicate -- fill in and execute. + ((dtpr restriction) + (eval (fillin1 restriction ,val ,item ,defblock))) + ; Otherwise, a value. + ( t + (selectq ,type + (0 (or (let ((def (getdefinition ,val))) + (eq restriction def)) + (disguisedas ,val restriction))) + (1 (disguisedas ,val restriction)) + (2 (\=& restriction ,val)) + (3 (eq restriction ,val)) + (otherwise + ; A better way needed ?? Never done???? + (eq restriction (car ,val)))))) + (go loop)) + ; Otherwise this predicate failed, so we fail. + ( t (return nil))))) + +; Check two values for "equality". +(defmacro equalvalue (xval yval type) + `(selectq ,type + (0 (basicmatch ,xval ,yval)) + (1 (eq ,xval ,yval)) + (2 (\=& ,xval ,yval)) + (3 (equal ,xval ,yval)) + (otherwise + ; A better way needed!!!!!!!!!!!!!!!!!!! something like: + ; (apply (function and) + ; (mapcar (function equalvalue) ,xval ,yval (strip ,type))) + t))) + +; Check to see if two slots whose number is passed are matchable, +; binding any variables and running any predicates. +; Assumes slotnum, item1, item2, def1, def2 already set and others declared +; in main PROG. The local PROG is necessary for slothooks processing. +(dm compatible (none) + '(prog () + ; *val and *var are both set by these calls. + ; *var are set to nil if no local, global, or adjunct variable. + (setq xval (getvarandvalue slotnum item1 'xvar)) + (setq yval (getvarandvalue slotnum item2 'yvar)) + ; + ; *ANY* => always match + (and (or (eq xvar *any*conscell*) + (eq yvar *any*conscell*)) + (return t)) + ; + ; If both are unbound, return *matchunboundsresult* (initially nil). + (setq xvalunbound (punboundatomp xval)) + (setq yvalunbound (punboundatomp yval)) + (setq bothunbound (and xvalunbound yvalunbound)) + (and bothunbound + (or *unifyunbounds* + (return *matchunboundsresult*))) + ; + ; Get the slots' common type and individual predicates. + (setq slottype (getslottype slotnum def1)) + (setq xpredlist (getpred slotnum item1)) + (setq ypredlist (getpred slotnum item2)) + (doslothooks2< ' '>match *runmatchhooks*) + (return result))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Principle match functions. + +; Match two structures slot by slot, WITHOUT unbinding variables first, +; but binding along the way. +(de basicmatch (item1 item2) + (prog (newitem1 newitem2 result slottype xvar yvar xval yval def1 def2 + xvalunbound yvalunbound length + newxval newyval xpredlist ypredlist xhooks yhooks + newval bothunbound) + (setq def1 (getdefinition item1)) + (setq def2 (getdefinition item2)) + (setq length (getstructlength def1)) + (dobasehooks2< ' t. + ; Not even related -> nil. + ((not (eq def1 def2)) (setq result nil)) + ; No slots -> t. + ((\=& 0 length) (setq result t)) + ; Otherwise, compare slot by slot. + ( t (setq result + (for slotnum 1 length + (or (compatible) + (return nil)))))) + (dobasehooks2> '>match *runmatchhooks*) + (return result))) + +; Match two structures slot by slot, unbinding variables first. +(de standardmatch (item1 item2) + (prog (newitem1 newitem2 result slottype xvar yvar xval yval def1 def2 + xvalunbound yvalunbound length *globalsavestack* + newxval newyval xpredlist ypredlist xhooks yhooks + newval bothunbound *equivsavestack*) + (unbindvars item1) + (unbindvars item2) + (setq def1 (getdefinition item1)) + (setq def2 (getdefinition item2)) + (setq length (getstructlength def1)) + (dobasehooks2< ' t. + ; Not even related -> nil. + ((not (eq def1 def2)) (setq result nil)) + ; No slots -> t. + ((\=& 0 length) (setq result t)) + ; Otherwise, compare slot by slot. + ( t (setq result + (for slotnum 1 length + (or (compatible) + (return nil)))))) + (dobasehooks2> '>match *runmatchhooks*) + (or result + ; Clean up the variables because of the failure. + (progn (unbindvars item1) + (unbindvars item2) + (and *globalsavestack* + (mapc (funl (var) + (set var (punbound))) + *globalsavestack*)) + ; *equivsavestack* is only non-nil when *unifyunbounds* is t. + (and *equivsavestack* + (mapc (funl (pair) + (cond ((dtpr (car pair)) + (rplacd (car pair) (cdr pair))) + ( t (set (car pair) (cdr pair))))) + *equivsavestack*)))) + (return result))) + +(aliasdef 'match 'standardmatch) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Functions similar to above but for expanded structures. + +; Check to see either defblock is an expansion of the other. +(defmacro relatedhier (defblock1 defblock2) + `(or (eq ,defblock1 ,defblock2) + (memq ,defblock2 (getexpansionlist ,defblock1)) + (memq ,defblock1 (getexpansionlist ,defblock2)))) + +; Check whether VAL is consistent with the predicates in PREDLIST. +(defmacro expconsistentvalue (val predlist type item defblock) + `(prog (restriction) + loop + (cond ((null ,predlist) (return t)) ; all predicates were true. + ; Otherwise, execute the next one. + ((cond ((reallitatom (setq restriction (pop ,predlist))) + ; The name of a function to be applied. + (apply* restriction (ncons ,val))) + ; An s-expression predicate -- fill in and execute. + ((dtpr restriction) + (eval (fillin1 restriction ,val ,item ,defblock))) + ; Otherwise, a value. + ( t + (selectq ,type + (0 (or (let ((def (getdefinition ,val))) + (relatedhier restriction def)) + (disguisedas ,val restriction))) + (1 (disguisedas ,val restriction)) + (2 (\=& restriction ,val)) + (3 (eq restriction ,val)) + (otherwise + ; A better way needed ?? Never done???? + (eq restriction (car ,val)))))) + (go loop)) + ; Otherwise this predicate failed, so we fail. + ( t (return nil))))) + +; Check two values for "equality". +(defmacro expequalvalue (xval yval type) + `(selectq ,type + (0 (basicexpandedmatch ,xval ,yval)) + (1 (eq ,xval ,yval)) + (2 (\=& ,xval ,yval)) + (3 (equal ,xval ,yval)) + (otherwise + ; A better way needed!!!!!!!!!!!!!!!!!!! something like: + ; (apply (function and) + ; (mapcar (function expequalvalue) ,xval ,yval (strip ,type))) + t))) + +; Check to see if two slots whose number is passed are matchable, +; binding any variables and running any predicates. +; Assumes slotnum, item1, item2, def1, def2 already set and others declared +; in main PROG. The local PROG is necessary for slothooks processing. +(dm expcompatible (none) + '(prog () + ; *val and *var are both set by these calls. + ; *var are set to nil if no local, global, or adjunct variable. + (setq xval (getvarandvalue slotnum item1 'xvar)) + (setq yval (getvarandvalue slotnum item2 'yvar)) + ; + ; *ANY* => always match + (and (or (eq xvar *any*conscell*) + (eq yvar *any*conscell*)) + (return t)) + ; + ; If both are unbound, return *matchunboundsresult* (initially nil). + (setq xvalunbound (punboundatomp xval)) + (setq yvalunbound (punboundatomp yval)) + (setq bothunbound (and xvalunbound yvalunbound)) + (and bothunbound + (or *unifyunbounds* + (return *matchunboundsresult*))) + ; + ; Get the slots' common type and individual predicates. + (setq slottype (getslottype slotnum def1)) + (setq xpredlist (getpred slotnum item1)) + (setq ypredlist (getpred slotnum item2)) + (doslothooks2< ' '>match *runmatchhooks*) + (return result))) + +; Match two structures slot by slot, WITHOUT unbinding variables first, +; but binding along the way. +(de basicexpandedmatch (item1 item2) + (prog (newitem1 newitem2 result slottype xvar yvar xval yval def1 def2 + xvalunbound yvalunbound length + newxval newyval xpredlist ypredlist xhooks yhooks + newval bothunbound) + (setq def1 (getdefinition item1)) + (setq def2 (getdefinition item2)) + (setq length (min& (getstructlength def1) + (getstructlength def2))) + (dobasehooks2< ' t. + ; Not even related hierarchically -> nil. + ((not (relatedhier def1 def2)) (setq result nil)) + ; No slots -> t. + ((\=& 0 length) (setq result t)) + ; Otherwise, compare slot by slot. + ( t (setq result + (for slotnum 1 length + (or (expcompatible) + (return nil)))))) + (dobasehooks2> '>match *runmatchhooks*) + (return result))) + +; Match two structures slot by slot, unbinding variables first. +(de standardexpandedmatch (item1 item2) + (prog (newitem1 newitem2 result slottype xvar yvar xval yval def1 def2 + xvalunbound yvalunbound length *globalsavestack* + newxval newyval xpredlist ypredlist xhooks yhooks + newval bothunbound *equivsavestack*) + (unbindvars item1) + (unbindvars item2) + (setq def1 (getdefinition item1)) + (setq def2 (getdefinition item2)) + (setq length (min& (getstructlength def1) + (getstructlength def2))) + (dobasehooks2< ' t. + ; Not even related hierarchically -> nil. + ((not (relatedhier def1 def2)) (setq result nil)) + ; No slots -> t. + ((\=& 0 length) (setq result t)) + ; Otherwise, compare slot by slot. + ( t (setq result + (for slotnum 1 length + (or (expcompatible) + (return nil)))))) + (dobasehooks2> '>match *runmatchhooks*) + (or result + ; Clean up the variables because of the failure. + (progn (unbindvars item1) + (unbindvars item2) + (and *globalsavestack* + (mapc (funl (var) + (set var (punbound))) + *globalsavestack*)) + ; *equivsavestack is only non-nil when *unifyunbounds* is t. + (and *equivsavestack* + (mapc (funl (var) + (cond ((dtpr (car var)) + (rplacd (car var) (cdr var))) + ( t (set (car var) (cdr var))))) + *equivsavestack*)) + )) + (return result))) + +(aliasdef 'expandedmatch 'standardexpandedmatch) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Functions for testing for equality and other comparisons. + +; Check to see if two slots passed (with a type number) are EQUAL, +; NOT binding any variables OR checking any predicates. +(dm slotequal (none) + '(prog () + ; *val and *var are both set by these calls. + ; *var are set to nil if no local, global, or adjunct variable. + (setq xval (getvarandvalue slotnum item1 'xvar)) + (setq yval (getvarandvalue slotnum item2 'yvar)) + ; + ; If the slot of the first ITEM is unbound, fail + (and (punboundatomp xval) + (progn (msg t "Unbound variables not allowed in STREQUAL" t) + (pearlbreak))) + ; If the slot of the second ITEM is unbound, fail + (and (punboundatomp yval) + (progn (msg t "Unbound variables not allowed in STREQUAL" t) + (pearlbreak))) + ; + ; Get the slots' common type. + (setq slottype (getslottype slotnum def1)) + (doslothooks2< ' '>strequal *runstrequalhooks*) + (return result))) + +; Test two structures for "EQUAL"ity slot by slot, without unbinding +; variables first, and NOT binding along the way. +(de strequal (item1 item2) + (prog (newitem1 newitem2 result slottype xvar yvar xval yval + def1 def2 length newxval newyval xhooks yhooks) + (setq def1 (getdefinition item1)) + (setq def2 (getdefinition item2)) + (setq length (getstructlength def1)) + (dobasehooks2< ' t. + ; Not even same type -> nil. + ((neq def1 def2) (setq result nil)) + ; No slots -> t. + ((\=& 0 length) (setq result t)) + ; Otherwise, compare slot by slot. + ( t (setq result + (for slotnum 1 length + (or (slotequal) + (return nil)))))) + (dobasehooks2> '>strequal *runmatchhooks*) + (return result))) + +; Check to see if ITEM1 is an expansion of ITEM2. +(de isanexpanded (item1 item2) + (let ((defblock1 (getdefinition item1)) + (defblock2 (getdefinition item2))) + (or (eq defblock1 defblock2) + (memq defblock1 (getexpansionlist defblock2))))) + +; Check to see if ITEM1 is (an expansion of) the base with name NAME. +(de isa (item1 name) + (let ((defblock (getdefinition item1)) + (typedef (eval (defatom name)))) + (or (eq defblock typedef) + (memq defblock (getexpansionlist typedef))))) + +; Test item to see if it's a nilstruct. +(de nullstruct (item) + (eq (getdefinition item) + (eval (defatom 'nilstruct)))) + +; Test item to see if it's a nilsym. +(de nullsym (item) + (eq item + (eval (symatom 'nilsym)))) + +(de memmatch (item list) + (cond ((null list) nil) + ((not (dtpr list)) nil) + ((match item (car list)) list) + ( t (memmatch item (cdr list))))) + +(de memstrequal (item list) + (cond ((null list) nil) + ((not (dtpr list)) nil) + ((strequal item (car list)) list) + ( t (memstrequal item (cdr list))))) + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/path.l b/usr/src/usr.bin/lisp/pearl/path.l new file mode 100644 index 0000000000..22c1771d87 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/path.l @@ -0,0 +1,252 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; path.l ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Functions for accessing and changing information associated with +; slots of structures via a path. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +; The PATH functions provide methods for adding and accessing information +; in a structure. The PATH macro takes as a first argument the function +; to be performed and simply expands to the function. The functions +; available are: +; 1. PUTPATH -- replaces the value in the slot with one provided. +; 2. CLEARPATH -- replaces the value of the slot with the default. +; 3. ADDSETPATH -- adds the value provided to a SETOF slot (only one +; level of adding is currently available). +; 4. DELSETPATH -- deletes the value provided from a SETOF slot (note +; that this requires one to know the actual +; value to delete). +; 5. ADDPREDPATH -- adds a predicate (function, STRUCT, or hook) to +; the PREDLIST. +; 6. DELPREDPATH -- deletes a predicate from the PREDLIST. +; 7. GETPATH -- returns a pointer to the value in the slot. +; 8. GETPREDPATH -- returns the list of function and STRUCT +; predicates for the slot. +; 9. GETHOOKPATH -- returns the list of (dotted pair) hook +; functions for the slot. +; 10. APPLYPATH -- returns the result of APPLYing the function +; provided to the value for the slot. +; +; During a PATH operation, the global variable *PATHTOP* contains the +; top level item which is being accessed and *PATHLOCAL* is the most +; local item being accessed. These are most handy for use by hooks +; and predicates. + +(defmacro path (fcn item pathlist &optional val) + (selectq fcn + (put `(putpath ,item ,pathlist ,val)) + (clear `(clearpath ,item ,pathlist)) + (addset `(addsetpath ,item ,pathlist ,val)) + (delset `(delsetpath ,item ,pathlist ,val)) + (addpred `(addpredpath ,item ,pathlist ,val)) + (delpred `(delpredpath ,item ,pathlist ,val)) + (get `(getpath ,item ,pathlist)) + (getpred `(getpredpath ,item ,pathlist)) + (gethook `(gethookpath ,item ,pathlist)) + (apply `(applypath ,item ,pathlist ,val)) + (otherwise (msg t "PATH: Illegal function selector: " fcn + ". Rest of call was: " item " " pathlist " " val t) + (pearlbreak)))) + +(de putpath (item path value) + (prog (numitempair slotnum result) + (setq *pathtop* item) + (setq *currentpearlstructure* item) + (and (null (setq numitempair (followpath item path))) + (return nil)) + (setq slotnum (car numitempair)) + (setq *pathlocal* (setq item (cdr numitempair))) + (checkrunhandleslothooks1 'put *runputpathhooks*) + (return value))) + +(de clearpath (item path) + (prog (numitempair slotnum value result) + (setq *pathtop* item) + (setq *currentpearlstructure* item) + (and (null (setq numitempair (followpath item path))) + (return nil)) + (setq slotnum (car numitempair)) + (setq *pathlocal* (setq item (cdr numitempair))) + (setq value (defaultfortype (getslottype slotnum (getdefinition item)))) + (checkrunhandleslothooks1 'clear *runclearpathhooks*) + (return value))) + +(de addsetpath (item path value) + (prog (numitempair slotnum result) + (setq *pathtop* item) + (setq *currentpearlstructure* item) + (and (null (setq numitempair (followpath item path))) + (return nil)) + (setq slotnum (car numitempair)) + (setq *pathlocal* (setq item (cdr numitempair))) + (checkrunhandleslothooks1 'addset *runaddsetpathhooks*) + (return value))) + +(de delsetpath (item path value) + (prog (numitempair slotnum result) + (setq *pathtop* item) + (setq *currentpearlstructure* item) + (and (null (setq numitempair (followpath item path))) + (return nil)) + (setq slotnum (car numitempair)) + (setq *pathlocal* (setq item (cdr numitempair))) + (checkrunhandleslothooks1 'delset *rundelsetpathhooks*) + (return value))) + +(de addpredpath (item path value) + (prog (numitempair slotnum result) + (setq *pathtop* item) + (setq *currentpearlstructure* item) + (and (null (setq numitempair (followpath item path))) + (return nil)) + (setq slotnum (car numitempair)) + (setq *pathlocal* (setq item (cdr numitempair))) + (checkrunhandleslothooks1 'addpred *runaddpredpathhooks*) + (return value))) + +(de delpredpath (item path value) + (prog (numitempair slotnum result) + (setq *pathtop* item) + (setq *currentpearlstructure* item) + (and (null (setq numitempair (followpath item path))) + (return nil)) + (setq slotnum (car numitempair)) + (setq *pathlocal* (setq item (cdr numitempair))) + (checkrunhandleslothooks1 'delpred *rundelpredpathhooks*) + (return value))) + +(de getpath (item path) + (prog (numitempair slotnum value result) + (setq *pathtop* item) + (setq *currentpearlstructure* item) + (and (null (setq numitempair (followpath item path))) + (return nil)) + (setq slotnum (car numitempair)) + (setq *pathlocal* (setq item (cdr numitempair))) + (setq value (punbound)) + (checkrunhandleslothooks1 'get *rungetpathhooks*) + (return value))) + +(de getpredpath (item path) + (prog (numitempair slotnum value result) + (setq *pathtop* item) + (setq *currentpearlstructure* item) + (and (null (setq numitempair (followpath item path))) + (return nil)) + (setq slotnum (car numitempair)) + (setq *pathlocal* (setq item (cadr numitempair))) + (setq value (punbound)) + (checkrunhandleslothooks1 'getpred *rungetpredpathhooks*) + (return value))) + +(de gethookpath (item path value) + (prog (numitempair slotnum result) + (setq *pathtop* item) + (setq *currentpearlstructure* item) + (and (null (setq numitempair (followpath item path))) + (return nil)) + (setq slotnum (car numitempair)) + (setq *pathlocal* (setq item (cadr numitempair))) + (setq value (punbound)) + (checkrunhandleslothooks1 'gethook *rungethookpathhooks*) + (return value))) + +(de applypath (fcn item path) + (prog (numitempair slotnum value result) + (setq *pathtop* item) + (setq *currentpearlstructure* item) + (and (null (setq numitempair (followpath item path))) + (return nil)) + (setq slotnum (car numitempair)) + (setq *pathlocal* (setq item (cdr numitempair))) + (setq value (getvalue slotnum item)) + (checkrunhandleslothooks1 'apply *runapplypathhooks*) + (return value))) + +; This does indirection. If the path is longer and we come to a +; symbol, we try to find something of the type with the name +; that is next on the path and with the symbol in its first slot. +; Unfortunately, this always uses the data base in *db*. +(defmacro findstructsymbolpair (defblock symbol) + `(progn (and (setq bucket (gethash2 (getuniquenum ,defblock) + (getuniquenum ,symbol) + ; **** FIX to use different dbs (how?) + (getdb2 *db*) + )) + (while (and (setq potential (pop bucket)) + (not (and (eq (getdefinition potential) ,defblock) + (eq (getvalue 1 potential) + ,symbol)))) + potential)) + potential)) + +; Follow the path down through the structures starting at item. +(de followpath (item path) + (or (structurep item) + (progn (msg t "PATH: only works on structures, not on " item + ". Requested path was: " path t) + (pearlbreak))) + (let (slotnum type slotname bucket potential slotlocation) + (and (atom path) + (setq path (ncons path))) + (while (setq slotname (pop path)) + (and (\=& 0 + (setq slotnum + (slotnametonumber slotname + (getdefinition item)))) + (progn (msg t "PATH: illegal slotname " slotname "requested " + "from " item ". Remaining path is: " path t) + (pearlbreak))) + (and (null path) + (return (cons slotnum item))) + ; If a symbol slot (and more path), do indirection. + (cond ((\=& 1 + (setq type (getslottype slotnum + (getdefinition item)))) + (and (null (setq item + (findstructsymbolpair + (eval (defatom (pop path))) + (getvalue slotnum item)))) + (return nil))) + ((\=& 0 type) (setq item (getvalue slotnum item))) + ( t (msg t "PATH: Unable to follow path. " + "Bad slotname is " slotname t) + (pearlbreak)))))) + + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/pearl.1 b/usr/src/usr.bin/lisp/pearl/pearl.1 new file mode 100644 index 0000000000..52fed3c085 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/pearl.1 @@ -0,0 +1,41 @@ +.TH PEARL 1 "29 March 1983" +.UC 4 +.SH NAME +pearl \- P\s-2EARL\s0 AI programming language +.SH SYNOPSIS +.B pearl +.SH DESCRIPTION +.I Pearl +is an AI programming language built on top of F\s-2RANZ\s0\ L\s-2ISP\s0. +P\s-2EARL\s0 (Package for Efficient Access to Representations in Lisp) +was developed with space and time efficiencies in mind. +In addition to providing the usual AI facilities such as slot-filler +objects, demons and associative data bases, +P\s-2EARL\s0 introduces stronger typing on slots, +user-assisted hashing mechanisms, +and a forest of data bases. +.LP +There are too many functions to list here; one should refer to the +reports listed below. +.SH AUTHORS +P\s-2EARL\s0 was implemented at Berkeley by Joseph Faletti and Michael Deering +under the direction of Robert Wilensky. +P\s-2EARL\s0 was originally implemented under UCILisp on a DEC 2040, moved +without modification to a PDP 10 under TOPS 10, and then (with +significant modification) to a VAX 11/780 under F\s-2RANZ\s0\ L\s-2ISP\s0. +.SH SEE ALSO +Deering, M., Faletti, J., and Wilensky, R. 1981. +P\s-2EARL\s0: An Efficient Language for Artificial Intelligence Programming. +In the +.I +Proceedings of the Seventh International Joint Conference on Artificial Intelligence. +.R +Vancouver, British Columbia. August, 1981. +.br +.sp 1 +Deering, M., Faletti, J., and Wilensky, R. 1982. +.I +The P\s-2EARL\s0 Users Manual. +.R +Berkeley Electronic Research Laboratory Memorandum No. +UCB/ERL/M82/19. March, 1982. diff --git a/usr/src/usr.bin/lisp/pearl/pearl.l b/usr/src/usr.bin/lisp/pearl/pearl.l new file mode 100644 index 0000000000..5b9433d11e --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/pearl.l @@ -0,0 +1,62 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; pearl.l ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; This file is the file that should be handed to Liszt for compiling. +; It "includes" all of the files that need to be used to make +; a complete PEARL object file. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +; After compiling this file with the -r option, +; run it, +; and then run the function +; (savepearl) to save a version in the current directory +; under the name "pearl" +; or +; (savepearl ) to save a version under that name +; This will then give you a (very large) runnable version of +; Franz plus PEARL. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(eval-when (compile) + ; To cut down on the number of garbage collects during compilation. + (allocate 'list 800) + (allocate 'symbol 200) + (declare (special defmacro-for-compiling)) + (setq defmacro-for-compiling t)) + +(declare (macros t)) +(declare (localf enforcetype buildvalue + insidescopy insidepatternize insidevarreplace + followpath convertpreds revassq + recursetoinsidestandardfetch gethashvalue insertbyfocus + removebyfocus + prefix addhistory read-in-startprl-file read-in-initprl-file)) + +(include ucisubset.l) +; Version numbers are in here. +(include franz.l) +(include lowlevel.l) +(include db.l) +(include vars.l) +(include symord.l) +(include hook.l) +(include create.l) +(include scopy.l) +(include path.l) +(include print.l) +(include hash.l) +(include match.l) +(include history.l) +(include toplevel.l) + +; This is a version of the usual library file fix.l +; with "print"s changed to "pearlfixprintfn". +; It should only be left out after changing the toplevel stuff to +; not call the fixit debugger. +(include fix.l) + +(include alias.l) +(include inits.l) + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/pearlbase.l b/usr/src/usr.bin/lisp/pearl/pearlbase.l new file mode 100644 index 0000000000..b24194fb43 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/pearlbase.l @@ -0,0 +1,35 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;; pearlbase.l ;;;;;;;;;;;;;;;;;;;;;;;;;;; +; This file is the first half of PEARL for compiling in two steps. +; After it is compiled, it can be loaded into a liszt that is +; compiling pearlbulk.l +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +(eval-when (compile) + ; To cut down on the number of garbage collects during compilation. + (allocate 'list 800) + (allocate 'symbol 200) + (declare (special defmacro-for-compiling)) + (setq defmacro-for-compiling t)) + +(declare (macros t)) +(declare (localf enforcetype buildvalue + insidescopy insidepatternize insidevarreplace + followpath convertpreds revassq + recursetoinsidestandardfetch gethashvalue insertbyfocus + removebyfocus + prefix addhistory read-in-startprl-file read-in-initprl-file)) + +(include ucisubset.l) +; Version numbers are in here. +(include franz.l) +(include lowlevel.l) +(include db.l) +(include vars.l) +(include symord.l) +(include hook.l) + + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/pearlbulk.l b/usr/src/usr.bin/lisp/pearl/pearlbulk.l new file mode 100644 index 0000000000..645e770fba --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/pearlbulk.l @@ -0,0 +1,45 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;; pearlbulk.l ;;;;;;;;;;;;;;;;;;;;;;;;;;; +; This file is the second half of PEARL for compiling in two pieces. +; It loads "pearlbase.o" and then "includes" the rest of PEARL. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +(eval-when (compile) + ; To cut down on the number of garbage collects during compilation. + (allocate 'list 800) + (allocate 'symbol 200) + (allocate 'fixnum 10) + (fasl 'pearlbase) + (load 'franz.l) + (declare (special defmacro-for-compiling)) + (setq defmacro-for-compiling t)) + +(declare (macros t)) +(declare (localf enforcetype buildvalue + insidescopy insidepatternize insidevarreplace + followpath convertpreds revassq + recursetoinsidestandardfetch gethashvalue insertbyfocus + removebyfocus + prefix addhistory read-in-startprl-file read-in-initprl-file)) + +(include create.l) +(include scopy.l) +(include path.l) +(include print.l) +(include hash.l) +(include match.l) +(include history.l) +(include toplevel.l) + +; This is a version of the usual library file fix.l +; with "print"s changed to "pearlfixprintfn". +; It should only be left out after changing the toplevel stuff to +; not call the fixit debugger. +(include fix.l) + +(include alias.l) +(include inits.l) + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/pearllib.l b/usr/src/usr.bin/lisp/pearl/pearllib.l new file mode 100644 index 0000000000..5cfac1de8f --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/pearllib.l @@ -0,0 +1,14 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;; pearllib.l ;;;;;;;;;;;;;;;;;;;;;;;;;;; +; This file loads the two halves of PEARL from /usr/lib/lisp when it +; was compiled in two pieces on a machine with small memory +; and/or tempfile space. It is renamed "pearl.o" in /usr/lib/lisp. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +(eval-when (load) + (fasl '/usr/lib/lisp/pearlbase.o) + (fasl '/usr/lib/lisp/pearlbulk.o)) + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/pearlsmall.l b/usr/src/usr.bin/lisp/pearl/pearlsmall.l new file mode 100644 index 0000000000..4c699d8cf4 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/pearlsmall.l @@ -0,0 +1,13 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;; pearlsmall.l ;;;;;;;;;;;;;;;;;;;;;;;;;; +; This file loads the two halves of PEARL when it is compiled in +; two pieces on a machine with small memory and/or tempfile space. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +(eval-when (load) + (fasl 'pearlbase.o) + (fasl 'pearlbulk.o)) + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/print.l b/usr/src/usr.bin/lisp/pearl/print.l new file mode 100644 index 0000000000..36e065999b --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/print.l @@ -0,0 +1,396 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; print.l ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Functions for converting from internal form to a printable form. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +; Convert a predicate, which might be a structure, to printable form. +(de convertpreds (pred) + (cond ((or (litatom pred) + (dtpr pred) + (numberp pred)) + pred) + ((structurep pred) (allform pred)) + ((definitionp pred) (getpname pred)) + ( t pred))) + +; Reverse assoc through a list of cons-cells -- look at the CDRs +; for value and return the first cons-cell that matches. +(de revassq (value alist) + (while alist ; is not NIL + (and (eq value (cdar alist)) + (return (car alist))) + (setq alist (cdr alist)))) + +; Convert an ordinal to printable form. +(defmacro ppsetform (slotval ppset) + `(cond ((eq 'int ,ppset) ,slotval) + ( t (let ((assqlist (eval (ordatom ,ppset))) + assqresult) + (cond ((setq assqresult (revassq ,slotval assqlist)) + (car assqresult)) + ((\=& 0 ,slotval) '*zero-ordinal-value*) + ( t (list ,ppset ,slotval))))))) + +; Convert a stream to printable form. +(defmacro streamform (item) + `(cond ((eq t (cadr ,item)) (list '*function-stream:* + (structureform (cddr ,item)))) + ((or *fullprint* + (not *streamprintlength*)) + (list '*stream:* + (structureform (cadr ,item)) + (mapcan (funl (struct) + (cond ((eq '*db* struct) nil) + ( t (ncons (structureform struct))))) + (cddr ,item)))) + ( t + (list + '*stream:* + (structureform (cadr ,item)) + (let + ((rest (cddr ,item)) + (result (ncons nil)) + next) + (cond ((dtpr (car rest)) + ; stream built by expandedfetch. + (let ((itemnum 1) + bucket) + (while (setq bucket (pop rest)) + (mapc + (funl (next) + (or (eq '*db* next) + (progn + (and (>& itemnum *streamprintlength*) + (progn + (tconc result '|...|) + (return (car result)))) + (tconc result (structureform next)) + (setq itemnum (1+ itemnum)) + ))) + bucket) + (or rest + (return (car result)))))) + ( t (for itemnum 1 *streamprintlength* + (while (and (setq next (pop rest)) + (eq '*db* next)) + ) ; do nothing + (or next + (return (car result))) + (tconc result (structureform next))))) + (and rest + (tconc result '|...|)) + (car result)))))) + +; Convert a symbol to printable form. +(defmacro symbolform (item) + `(getsymbolpname ,item)) + +; Convert an equivalence class list to printable form. +(defmacro equivclassform (equiv) + `(let ((equivclass ,equiv)) + (mapcan (funl (var) + (cond ((dtpr var) ; a local var + ; filter out variables which are no longer + ; members of the equivalence class + (and (eq (cdr var) equivclass) + (ncons (list '*var* (car var))))) + ( t ; otherwise a global var + (and (eq (eval var) equivclass) + (ncons (list '*global* var)))))) + (cdr equivclass)))) + +; Convert a definition to printable form. +(defmacro defform (item) + `(cons 'definition-of: + (structureform (getdefaultinst ,item)))) + +; Convert the constant portion of a slot +(defmacro slotconstform (item typenum ppset) + `(selectq ,typenum + (0 (or (and *abbrevprint* + (getabbrev ,item)) + (structureform ,item))) + (1 (symbolform ,item)) + (2 (ppsetform ,item ,ppset)) + (3 (allform ,item)) + (otherwise + (let ((newtypenum (- ,typenum 4.))) + (cond ((dtpr ,item) + (mapcar + (funl (singleitem) + (listitemform singleitem newtypenum ,ppset)) + ,item)) + ; otherwise, in case value is somehow not a list, + ; do your best. + (t (allform ,item))))))) + +; Makes a function out of slotconstform for mapping on a setof slot. +(de listitemform (item typenum ppset) + (slotconstform item typenum ppset)) + +; Macro version of slotconstform for normal use on a slot's value. +(defmacro slotitemform (printval) + `(let ((item ,printval) + (typenum (getslottype slotnum defblock)) + (ppset (getppset slotnum defblock))) + (slotconstform item typenum ppset))) + +; Convert a slot from internal form to a list form. +(dm slotform (none) ; but assumes SLOTNUM, ITEM, PRINTVAL and PRINTVAR. + '(progn + (setq printval (getslotvalue slotnum item)) + (selectq (getslotvaluetype slotnum item) + (CONSTANT (slotitemform printval)) + (LOCAL (cond ((eq (punbound) (cdr printval)) + (list '*var* (car printval))) + ((equivclassp (cdr printval)) + (list (list '*var* (car printval)) + ; Unfortunate kludge to get rid of \'s. + (ncons 'pearlequals) + (equivclassform (cdr printval)))) + ( t (list (list '*var* (car printval)) + ; Unfortunate kludge to get rid of \'s. + (ncons 'pearlequals) + (slotitemform (cdr printval)))))) + (ADJUNCT (list (slotitemform (car printval)) + (ncons 'pearlequals) + (let ((var (cdr printval))) + (cond ((dtpr var) + (list '*var* (car var))) + ( t (list '*global* var)))))) + (GLOBAL (cond ((eq (punbound) (eval printval)) + (list '*global* printval)) + ((equivclassp (eval printval)) + (list (list '*global* printval) + ; Unfortunate kludge to get rid of \'s. + (ncons 'pearlequals) + (equivclassform (eval printval)))) + ( t (list (list '*global* printval) + ; Unfortunate kludge to get rid of \'s. + (ncons 'pearlequals) + (slotitemform (eval printval))))))))) + +(de structureform (item) + (let* ((curlist (ncons nil)) + (defblock (getdefinition item)) + (basehooks (getbasehooks defblock)) + ppset + printvar + printval) + (cond ((and *uniqueprint* + ; if there then return it. + (cdr (assq item *uniqueprintlist*)))) + ( t (tconc curlist (getpname defblock)) + (and *fullprint* + basehooks + (tconc curlist (cons 'if basehooks))) + (and *uniqueprint* + (push (cons item (car curlist)) + *uniqueprintlist*)) + (for slotnum 1 (getstructlength defblock) + (tconc curlist + (nconc (ncons (car + (getslotname slotnum defblock))) + (ncons (slotform)) + (and *fullprint* + (mapcar (function convertpreds) + (getpred slotnum item))) + (and *fullprint* + (getslothooks slotnum item))))) + (car curlist))))) + +; Convert any combination of PEARL and Lisp items (possibly from internal +; form) to a printable list structure. +(de allform (item) + (cond ((hunkp item) + (selectq (gettypetag item) + (*pearlinst* (structureform item)) + (*pearlsymbol* (symbolform item)) + (*pearldef* (defform item)) + (*pearldb* (list 'database: (getdbname item))) + (*pearlinactivedb* (list 'Inactive 'Database)) + (otherwise item))) ; arbitrary hunk?. + ((streamp item) (streamform item)) + ((equivclassp item) (equivclassform item)) + ((atom item) item) + ((dtpr item) (cons (allform (car item)) + (allform (cdr item)))) + ; Else return item (arbitrary pieces of core?). + ( t item))) + +; Convert a PEARL item in full detail and SPRINT the result. +(de fullform (item) + (let ((*fullprint* t) + (*abbrevprint* nil) + (*uniqueprintlist* nil)) + (allform item))) + +; Convert a PEARL item using abbreviations and SPRINT the result. +(de abbrevform (item) + (let ((*abbrevprint* t) + (*fullprint* nil) + (*uniqueprintlist* nil)) + (allform item))) + +; Normal function to convert a PEARL item and SPRINT the result. +(de valform (item) + (let ((*fullprint* nil) + (*abbrevprint* nil) + (*uniqueprintlist* nil)) + (allform item))) + +; Convert any PEARL item using whatever the current settings of +; *abbrevprint*, *fullprint* and *uniqueprint* are, +; and SPRINT the result. +; BUT, don't bother if *quiet* is non-nil. +(de allprint (item &optional (lmar 0) (rmar 0)) + (or *quiet* + (sprint (allform item) lmar rmar)) + '*invisible*) + +(de structureprint (item &optional (lmar 0) (rmar 0)) + (or *quiet* + (sprint (structureform item) lmar rmar)) + '*invisible*) + +(de symbolprint (item &optional (lmar 0) (rmar 0)) + (or *quiet* + (sprint (symbolform item) lmar rmar)) + '*invisible*) + +(de streamprint (item &optional (lmar 0) (rmar 0)) + (or *quiet* + (sprint (streamform item) lmar rmar)) + '*invisible*) + +(de fullprint (item &optional (lmar 0) (rmar 0)) + (or *quiet* + (sprint (fullform item) lmar rmar)) + '*invisible*) + +(de valprint (item &optional (lmar 0) (rmar 0)) + (or *quiet* + (sprint (valform item) lmar rmar)) + '*invisible*) + +(de abbrevprint (item &optional (lmar 0) (rmar 0)) + (or *quiet* + (sprint (abbrevform item) lmar rmar)) + '*invisible*) + +; Run some commands but silence any printing it normally does. +(df quiet (command) + (let ((*quiet* t)) + (eval `(progn ,@command)))) + +; Print out a data base, printing only buckets that have something in them. +(de printdb (&optional (db *db*)) + (let ((db1 (getdb1 db)) + (db2 (getdb2 db)) + bucket) + (or (databasep db) + (progn (msg t "PRINTDB: Argument is not a database." t) + (pearlbreak))) + (msg t "DB-Name: " (getdbname db)) + (msg t "Active: " (getdbactive db)) + (msg t "Children: " (mapcar (function pname) (getdbchildren db))) + (msg t "Parent: " (pname (getdbparent db))) + (msg t "DB1:") + (and db1 + (for slotnum 0 (1- *db1size*) + (and (setq bucket (remq '*db* (cxr slotnum db1))) + (progn (msg t " " slotnum ": ") + (pearlprintfn bucket))))) + + (msg t "DB2:") + (and db2 + (for slotnum 0 (1- *db2size*) + (and (setq bucket (remq '*db* (cxr slotnum db2))) + (progn (msg t " " slotnum ": ") + (pearlprintfn bucket))))) + '*invisible*)) + +; Print complete information on the internal values stored in a structure +; and its definition (or a definition and its default instance). +(de debugprint (item) + (let (def name) + (cond ((definitionp item) + (setq def item) + (setq item (getdefaultinst def))) + ( t (setq def (getdefinition item)))) + (and (setq name (getabbrev item)) + (msg t "******** " name " ********")) + (msg t "Definition:") + (msg t " Unique\#: " (getuniquenum def)) + (msg " Length: " (getstructlength def)) + (msg " DefaultInst: " (getdefaultinst def)) + (msg t " Isa: " (getisa def)) + (msg t " Pname: " (getpname def)) + (msg " HashAlias: " (gethashalias def)) + (msg " ExpansionList: " (getexpansionlist def)) + (msg t " BaseIfs: " (getbasehooks def)) + (msg t "Individual:") + (msg " Abbrev: " (getabbrev item)) + (msg t " AList: " (getalist item)) + (msg " AListcp: " (getalistcp item)) + (for slotnum 1 (getstructlength def) + (msg t t "***Slotnum " slotnum + " : " (getslotname slotnum def)) + (msg t "Formatinfo: " (getformatinfo slotnum def)) + (msg " HashInfo: " (gethashinfo slotnum def)) + (msg " Enforce: " (getenforce slotnum def)) + (msg " Type: " (getslottype slotnum def)) + (msg " PPSet: " (getppset slotnum def)) + (msg t "ValueType: " (getslotvaluetype slotnum item)) + (msg " Internal Value: " (getslotvalue slotnum item)) + (msg t "Value: " (getvalue slotnum item)) + (msg " Preds: " (getpred slotnum item)) + (msg " SlotIfs: " (getslothooks slotnum item))) + '*invisible*)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; the print functions for use with the top level, msg, and the +; trace, break, etc. packages. + +; standard trace print should use allform after turning off tracing. +(de pearltraceprintfn (*traceval*) + ; Set the $tracemute flag to t so that tracing won't be done + ; inside allform. + (let ((\$tracemute t)) + (print (allform *traceval*)))) + +; standard showstack print should use allform. +(de pearlshowstackprintfn (*showstackval*) + (print (allform *showstackval*))) + +; standard break print should use allform. +(de pearlbreakprintfn (*breakval*) + (print (allform *breakval*))) + +; standard fix print should use allform. +(de pearlfixprintfn (*fixval*) + (print (allform *fixval*))) + +; msg should allform, unless *invisible*. +(de msgprintfn (*msgval*) + (or (eq '*invisible* *msgval*) + (patom (allform *msgval*)))) + +; printing in a trace-break should allprint. +(de pearltracebreakprintfn (*printval*) + (allprint *printval* 3)) + +; standard print should allprint. +(de pearlprintfn (*printval*) + (allprint *printval* 3)) + +; standard dskin print should use allform unless an atom. +(de dskprintfn (*dskval*) + (cond ((atom *dskval*) (patom *dskval*)) + ( t (print (allform *dskval*))))) + + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/ptags b/usr/src/usr.bin/lisp/pearl/ptags new file mode 100644 index 0000000000..a2eb9801f2 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/ptags @@ -0,0 +1,45 @@ +/^\(de / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(df / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(dm / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(drm / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(dsm / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(def/ { print $2 " " FILENAME " /^" $0 "$/" } +/^\(putd / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(setsyntax / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(setq / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(aliasdef / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(create base / { print $3 " " FILENAME " /^" $0 "$/" } +/^\(create individual / { print $4 " " FILENAME " /^" $0 "$/" } +/^\(create pattern / { print $4 " " FILENAME " /^" $0 "$/" } +/^\(create expanded / { print $4 " " FILENAME " /^" $0 "$/" } +/^\(create function / { print $3 " " FILENAME " /^" $0 "$/" } +/^\(dbcreate base / { print $3 " " FILENAME " /^" $0 "$/" } +/^\(dbcreate individual / { print $4 " " FILENAME " /^" $0 "$/" } +/^\(dbcreate pattern / { print $4 " " FILENAME " /^" $0 "$/" } +/^\(dbcreate expanded / { print $4 " " FILENAME " /^" $0 "$/" } +/^\(dbcreate function / { print $3 " " FILENAME " /^" $0 "$/" } +/^\(cr base / { print $3 " " FILENAME " /^" $0 "$/" } +/^\(cr ind / { print $4 " " FILENAME " /^" $0 "$/" } +/^\(cr pat / { print $4 " " FILENAME " /^" $0 "$/" } +/^\(cr exp / { print $4 " " FILENAME " /^" $0 "$/" } +/^\(cr fn / { print $3 " " FILENAME " /^" $0 "$/" } +/^\(dbcr base / { print $3 " " FILENAME " /^" $0 "$/" } +/^\(dbcr ind / { print $4 " " FILENAME " /^" $0 "$/" } +/^\(dbcr pat / { print $4 " " FILENAME " /^" $0 "$/" } +/^\(dbcr exp / { print $4 " " FILENAME " /^" $0 "$/" } +/^\(dbcr fn / { print $3 " " FILENAME " /^" $0 "$/" } +/^\(cb / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(ci / { print $3 " " FILENAME " /^" $0 "$/" } +/^\(cp / { print $3 " " FILENAME " /^" $0 "$/" } +/^\(ce / { print $3 " " FILENAME " /^" $0 "$/" } +/^\(cf / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(base / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(ind / { print $3 " " FILENAME " /^" $0 "$/" } +/^\(pat / { print $3 " " FILENAME " /^" $0 "$/" } +/^\(exp / { print $3 " " FILENAME " /^" $0 "$/" } +/^\(fn / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(individual / { print $3 " " FILENAME " /^" $0 "$/" } +/^\(pattern / { print $3 " " FILENAME " /^" $0 "$/" } +/^\(expanded / { print $3 " " FILENAME " /^" $0 "$/" } +/^\(pfunction / { print $2 " " FILENAME " /^" $0 "$/" } +/^\(ordinal / { print $2 " " FILENAME " /^" $0 "$/" } diff --git a/usr/src/usr.bin/lisp/pearl/scopy.l b/usr/src/usr.bin/lisp/pearl/scopy.l new file mode 100644 index 0000000000..843ba056ab --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/scopy.l @@ -0,0 +1,308 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; scopy.l ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Functions for copying structures in various ways. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +; Internal slot processor of SCOPY. +(dm scopyslot (none) + '(progn + (setq slotvalue (getslotvalue slotnum oldvalblock)) + (selectq (setq valuetype (getslotvaluetype slotnum oldvalblock)) + (CONSTANT (setq slotvalue (insidescopy slotvalue))) + (LOCAL (and (equivclassp (cdr slotvalue)) + (progn + (setq oldvarcell (cdr slotvalue)) + (setq slotvalue (cons (car slotvalue) (punbound))))) + (cond ((eq *any*conscell* slotvalue) nil) + ; Bound variable. + ((neq (cdr slotvalue) (punbound)) + (setq valuetype 'CONSTANT) + (setq slotvalue (insidescopy (cdr slotvalue)))) + ; Test for previously seen unbound variable. + ((setq newvarcell + (assq (car slotvalue) + (getalist *currenttopcopy*))) + (setq slotvalue newvarcell)) + ; Otherwise it is a new unbound variable. + ( t (setq slotvalue + (addalist (car slotvalue) + *currenttopcopy*)) + (and (equivclassp oldvarcell) + (progn + (rplacd slotvalue oldvarcell) + (rplacd oldvarcell + (cons slotvalue + (cdr oldvarcell)))))))) + (ADJUNCT (setq oldvarcell (cdr slotvalue)) + (setq slotvalue (insidescopy (car slotvalue))) + (cond ((eq *any*conscell* oldvarcell) + (setq slotvalue (cons slotvalue *any*conscell*))) + ((atom oldvarcell) + (setq slotvalue (cons slotvalue oldvarcell))) + ; Used to throw away bound adjunct variables. + ;((neq (cdr oldvarcell) (punbound)) + ; (setq valuetype 'CONSTANT) + ; (setq slotvalue (insidescopy (car slotvalue))) + ; ) + ; Test for previously seen variable. + ((setq newvarcell + (assq (car oldvarcell) + (getalist *currenttopcopy*))) + (setq slotvalue (cons slotvalue newvarcell))) + ; Otherwise it is a new variable. + ( t (setq newvarcell + (addalist (car oldvarcell) + *currenttopcopy*)) + (setq slotvalue (cons slotvalue newvarcell))))) + (GLOBAL nil)) + (putslotvaluetype slotnum valuetype valblock) + (putslotvalue slotnum slotvalue valblock) + (putpred slotnum (copy (getpred slotnum oldvalblock)) valblock) + (putslothooks slotnum (copy (getslothooks slotnum oldvalblock)) valblock))) + + +; Internal item processor of SCOPY. +(de insidescopy (item) + (let + (defblock valblock length slotvalue valuetype oldvalblock + oldvarcell newvarcell abbrev) + (cond ((null item) nil) + ((numberp item) item) ; Integer + ((dtpr item) ; Lisp or Setof + (mapcar (function insidescopy) item)) + ((psymbolp item) item) ; Symbol + ((atom item) item) ; Lisp Atom + ; Otherwise, an instance of a structure + ((structurep item) + (cond ((setq valblock (cdr (assq item *scopieditems*))) valblock) + ( t (setq oldvalblock item) + (setq defblock (getdefinition oldvalblock)) + (setq valblock + (allocval (setq length (getstructlength defblock)))) + (puttypetag '*pearlinst* valblock) + (push (cons item valblock) *scopieditems*) + (cond (*toplevelp* + (setq *currenttopcopy* valblock) + (setq *currentpearlstructure* valblock) + (initbothalists valblock) + (setq *currenttopalists* (getbothalists valblock)) + ; Include the current environment in + ; the variable assoc-list. + (and *blockstack* + (putalist (cdar *blockstack*) valblock)) + (setq *toplevelp* nil)) + ( t (putbothalists *currenttopalists* valblock))) + + (putdef defblock valblock) + (and (setq abbrev (getabbrev oldvalblock)) + ; Make new abbrev and store struct in abbrev. + (setq abbrev (eval `(newsym ,abbrev))) + (set abbrev valblock) + ; and abbrev in struct. + (putabbrev abbrev valblock)) + (for slotnum 1 length + (scopyslot)) + valblock)))))) + +; Copy a structure. Bound variables are replaced by their values. +; Unbound variables are installed as new local variables in the +; copy, subject to overruling by the current open blocks. +(de scopy (item) + (setq *scopieditems* nil) + (setq *toplevelp* t) + (insidescopy item)) + + + +; Internal slot processor of PATTERNIZE. +(dm patternizeslot (none) + '(progn + (setq slotvalue (getslotvalue slotnum oldvalblock)) + (selectq (setq valuetype (getslotvaluetype slotnum oldvalblock)) + (CONSTANT (setq slotvalue (insidepatternize slotvalue))) + (LOCAL (cond ((eq *any*conscell* slotvalue) nil) + ; Bound variable. + ((and (neq (cdr slotvalue) (punbound)) + (not (equivclassp (cdr slotvalue)))) + (setq valuetype 'CONSTANT) + (setq slotvalue (insidepatternize (cdr slotvalue)))) + ; Otherwise it is an unbound variable to + ; be replaced by ?*any*. + ( t (setq slotvalue *any*conscell*)))) + (ADJUNCT (setq slotvalue (insidepatternize (car slotvalue))) + (setq valuetype 'CONSTANT)) + (GLOBAL nil)) + (putslotvaluetype slotnum valuetype valblock) + (putslotvalue slotnum slotvalue valblock) + (putpred slotnum (copy (getpred slotnum oldvalblock)) valblock) + (putslothooks slotnum (copy (getslothooks slotnum oldvalblock)) valblock))) + +; Internal item processor of PATTERNIZE. +(de insidepatternize (item) + (let + (defblock valblock length slotvalue valuetype oldvalblock abbrev) + (cond ((null item) nil) + ((numberp item) item) ; Integer + ((dtpr item) ; Setof + (mapcar (function insidepatternize) item)) + ((psymbolp item) item) ; Symbol + ((atom item) item) ; Lisp Atom + ; Otherwise, an instance of a structure + ((structurep item) + (cond ((setq valblock (cdr (assq item *scopieditems*))) valblock) + ( t (setq oldvalblock item) + (setq defblock (getdefinition oldvalblock)) + (setq valblock + (allocval (setq length (getstructlength defblock)))) + (puttypetag '*pearlinst* valblock) + (push (cons item valblock) *scopieditems*) + (cond (*toplevelp* + (setq *currenttopcopy* valblock) + (setq *currentpearlstructure* valblock) + (initbothalists valblock) + (setq *currenttopalists* (getbothalists valblock)) + ; Include the current environment in + ; the variable assoc-list. + (and *blockstack* + (putalist (cdar *blockstack*) valblock)) + (setq *toplevelp* nil)) + ( t (putbothalists *currenttopalists* valblock))) + + (putdef defblock valblock) + (and (setq abbrev (getabbrev oldvalblock)) + ; Make new abbrev and store struct in abbrev. + (setq abbrev (eval `(newsym ,abbrev))) + (set abbrev valblock) + ; and abbrev in struct. + (putabbrev abbrev valblock)) + (for slotnum 1 length + (patternizeslot)) + valblock)))))) + +; Do an scopy but replace all local variables with ?*any*. +(de patternize (item) + (setq *scopieditems* nil) + (setq *toplevelp* t) + (insidepatternize item)) + +; Internal environment Scopy. +; Do an scopy of as if it were a recursive call within +; an scopy of . +(de intscopy (item outer) + (let + (defblock valblock length slotvalue valuetype oldvalblock + newvarcell oldvarcell abbrev) + (setq *scopieditems* nil) + (cond ((null item) nil) + ((numberp item) item) ; Integer + ((dtpr item) ; Lisp or Setof + (mapcar (function insidescopy) item)) + ((psymbolp item) item) ; Symbol + ((atom item) item) ; Lisp Atom + ; Otherwise, an instance of a structure + ((structurep item) + (setq oldvalblock item) + (setq defblock (getdefinition oldvalblock)) + (setq valblock (allocval (setq length (getstructlength defblock)))) + (puttypetag '*pearlinst* valblock) + (push (cons item valblock) *scopieditems*) + (initbothalists valblock) + (setq *currenttopcopy* outer) + (setq *currentpearlstructure* outer) + (setq *toplevelp* nil) + (putdef defblock valblock) + (and (setq abbrev (getabbrev oldvalblock)) + ; Make new abbrev and store struct in abbrev. + (setq abbrev (eval `(newsym ,abbrev))) + (set abbrev valblock) + ; and abbrev in struct. + (putabbrev abbrev valblock)) + (for slotnum 1 length + (scopyslot)) + valblock)))) + +; Internal slot processor of VARREPLACE +(dm varreplaceslot (none) + '(progn + (setq slotvalue (getslotvalue slotnum item)) + (selectq (setq valuetype (getslotvaluetype slotnum item)) + (CONSTANT (insidevarreplace slotvalue)) + (LOCAL (cond ((eq *any*conscell* slotvalue) nil) + ; Bound variable, so replace with value. + ((and (neq (cdr slotvalue) (punbound)) + (not (equivclassp (cdr slotvalue)))) + (putslotvaluetype slotnum 'CONSTANT item) + ; Should the value be varreplaced like this? + (putslotvalue slotnum + (insidevarreplace (cdr slotvalue)) + item)) + ; Otherwise an unbound variable. + ( t nil))) + (ADJUNCT (insidevarreplace (car slotvalue))) + (GLOBAL (and (neq (setq slotvalue (eval slotvalue)) (punbound)) + (not (equivclassp slotvalue)) + (progn (putslotvaluetype slotnum 'CONSTANT item) + (putslotvalue slotnum + (insidevarreplace slotvalue) + item))))))) + +; Internal item processor of VARREPLACE +(de insidevarreplace (item) + (let + (length slotvalue valuetype) + (cond ((null item) nil) + ((numberp item) item) ; Integer + ((dtpr item) ; Lisp or Setof + (mapcar (function insidevarreplace) item)) + ((psymbolp item) item) ; Symbol + ((atom item) item) ; Lisp Atom + ; Otherwise, an instance of a structure + ((structurep item) + (cond ((memq item *scopieditems*) item) + ( t (setq length (getstructlength (getdefinition item))) + (cond (*toplevelp* + (setq *currentpearlstructure* item) + (setq *toplevelp* nil))) + (push item *scopieditems*) + (for slotnum 1 length + (varreplaceslot)) + item)))))) + +; Go through a structure replacing bound variables by their values. +(de varreplace (item) + (setq *scopieditems* nil) + (setq *toplevelp* t) + (insidevarreplace item)) + + +; Merge ITEM2 into ITEM1 by copying all bound slots of ITEM2 into +; any unfrozen slots of ITEM1. +(de smerge (item1 item2) + (let ((defblock1 (getdefinition item1)) + (defblock2 (getdefinition item2))) + (and (neq defblock1 defblock2) + (not (memq defblock1 (getexpansionlist defblock2))) + (progn (msg t "SMERGE: Values not mergeable: " item2 + t " and " item1) + (pearlbreak))) + (prog (length oldvalue potential result newitem1 newitem2) + ; unbind all non-frozen vars first. + (mapc (funl (cell) (rplacd cell (punbound))) (getalist item1)) + (setq length (getstructlength defblock2)) + (setq result (punbound)) + (dobasehooks2< ' '>smerge *runsmergehooks*) + (return result)))) + + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/symord.l b/usr/src/usr.bin/lisp/pearl/symord.l new file mode 100644 index 0000000000..0ccc6100b2 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/symord.l @@ -0,0 +1,91 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; symord.l ;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Functions for defining symbols and ordinal types. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +; Define one SYMBOL in a hunk for easy identification. +; This will not work independently (for some reason). +(dm onesymbol (none) + '(funl (symname) + (or (and (not (litatom symname)) + (not (msg t "SYMBOL: Symbols can only be simple names, not:" + symname t))) + (and (eq symname 'nilsym) + (boundp (symatom 'nilsym)) + (not (msg t "SYMBOL: Cannot redefine nilsym." t))) + (and (null symname) + (not (msg t "SYMBOL: Cannot name a symbol nil." t))) + (and (symbolnamep symname) + ; but okay to do. + (and *warn* + (msg t "SYMBOL: Warning: Redefining symbol: " + symname t))) + (let ((block (set (symatom symname) (makhunk 3)))) + (putuniquenum (newnum) block) + (puttypetag '*pearlsymbol* block) + (putsymbolpname symname block) + block)))) + +; Define a bunch of SYMBOLS. +(df symbol (l) + (mapcar (onesymbol) l)) + +; An EXPR which allows the defining of one SYMBOL. +(de symbole (symname) + (cond ((not (litatom symname)) + (msg t "SYMBOLE: symbols can only be simple names, not: " + symname t) + (pearlbreak)) + ( t (apply* (onesymbol) (ncons symname)) symname))) + +(de getsymbol (symname) + (cond ((symbolnamep symname) + (eval (symatom symname))) + ( t (msg t "GETSYMBOL: " symname " is not the name of a symbol." t) + (pearlbreak)))) + +; (ordinal name (x y z)) or (ordinal name (x 1 y 3 z 8)). +; Define a set of integer constants for readability in input and output. +; Also define o:name, name:max and name:min, and name:x, name:y and name:z. +(df ordinal (l) + (let ((ordinalname (car l)) + (ordinalelements (cadr l)) + (alist (ncons nil)) + (count 0) + (min 0) + max + name + value) + (push ordinalname *ordinalnames*) + (set (ordatom ordinalname) + (cond ((not (numberp (cadr ordinalelements))) + ; generate numbers. + (while ordinalelements + (setq count (1+ count)) + (tconc alist (cons (setq name (pop ordinalelements)) + count)) + (set (concat ordinalname ":" name) count)) + (or (\=& 0 count) + (setq min 1)) + (setq max count) + (car alist)) + ; use numbers provided by user. + ( t (setq min (setq max (cadr ordinalelements))) + (while ordinalelements + (tconc alist + (cons (setq name (pop ordinalelements)) + (setq value (pop ordinalelements)))) + (set (concat ordinalname ":" name) value) + (and (<& value min) + (setq min value)) + (and (>& value max) + (setq max value))) + (car alist)))) + (set (concat ordinalname ":min") min) + (set (concat ordinalname ":max") max) + (cons ordinalname (car alist)))) + + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/template b/usr/src/usr.bin/lisp/pearl/template new file mode 100644 index 0000000000..7f2cc61b70 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/template @@ -0,0 +1,97 @@ + TTTTTTTTT EEEEEEE M M PPPPP L AA TTTTTTTTT EEEEEEE + T E MM MM P P L A A T E + T EEEEE M M M M PPPPP L AAAAAA T EEEEE + T E M M M P L A A T E + T EEEEEEE M M P LLLLLL A A T EEEEEEE + + Structure Definition Information Template + + Header + ||=========================================|| + || 0 unique number (integer) || + || 1 *pearldefinition* tag (atom ptr) || + || 2 length (integer) || + || 3 default instance (core ptr) || + || 4 isa (core ptr) || + || 5 print name (atom ptr) || + || 6 hash alias (integer) || + || 7 hash focus (integer) || + || 8 expansion list (list ptr) || + || 9 base hooks (lisp ptr) || + ||=========================================|| + + and for each slot (multiply slot number by 4 and add): + ||=========================================|| + || +6 free (28)! enforce (1) ! hash (6) || + || +7 type number (integer) || + || +8 slot print name (atom ptr) || + || +9 pp set info (atom ptr) || + ||=========================================|| + + + + + Structure Instance Template + + Header + ||=========================================|| + || 0 definition (core ptr) || + || 1 *pearlinst* tag (atom ptr) || + || 2 a-list and alist copy (conscell) || + || 3 abbreviation (atom ptr) || + ||=========================================|| + + and for each slot (multiply slot number by 4 and add): + ||=========================================|| + || +0 value type (integer) || + || +1 value ( ? ptr) || + || +2 predicate list (list ptr) || + || +3 slothook list (list ptr) || + ||=========================================|| + + + + symbol template + + ||=========================================|| + || 0 unique number (integer) || + || 1 *pearlsymbol* tag (atom ptr) || + || 2 print name (atom ptr) || + ||=========================================|| + + + + data bases + + header + ||=========================================|| + || 0 name (atom ptr) || + || 1 *pearldb* tag (atom ptr) || + || 2 children (lisp ptr) || + || 3 active (t or nil) || + || 4 parent (lisp ptr) || + || 5 db1 (core ptr) || + || 6 db2 (core ptr) || + ||=========================================|| + + and for each hash slot i (a small 1 hash db and then a large 2/3 hash db): + ||=========================================|| + || i hash bucket (lisp ptr) || + ||=========================================|| + + + block template (3 cons-cells) + + b:Name ---+ + | + ||========V================================|| + || Name (atom) | ptr to vars part || + ||==========================|==============|| + | + ||==========V==============================|| + Name ---> || ptr to 2nd conscell | ptr to free vars || + ||==========|==============================|| + | + ||==========V==============================|| + || ptr to frozen vars | *pearlunbound* || + ||=========================================|| diff --git a/usr/src/usr.bin/lisp/pearl/toplevel.l b/usr/src/usr.bin/lisp/pearl/toplevel.l new file mode 100644 index 0000000000..ffc1afe5f6 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/toplevel.l @@ -0,0 +1,341 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; toplevel.l ;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Franz and UCI Lisp top level functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering and John Foderaro. + +;------------------------------------------------------------------------- +; Top level functions for PEARL Joe Faletti, December 1981 +; modified from +; Top level function for franz jkf, march 1980 +; +; The following function contains the top-level read, eval, print +; loop. With the help of the usual error handling functions, +; pearl-break-err-handler and debug-err-handler, pearl-top-level provides +; a reasonable environment for working with PEARL. +; + +(defvar \$ldprint) + +; Handle ^C with fixit. +(de pearl:int-serv (x) + (fixit nil)) + +; Before Opus 38.31: +; (setq pearl-title (concat " plus PEARL " (status ctime))) +; Moved to franz.l: +; (setq pearl-title (concat " plus PEARL " (time-string))) + +(de read-in-initprl-file () + (setq break-level-count 0 ; do this in case break + debug-level-count 0) ; occurs during readin + (*catch '(break-catch top-level-catch) + (do ((dirs `("." ,(getenv 'HOME)) (cdr dirs)) + ; prevent warnings (from setdbsize in particular). + (*warn* nil *warn*) + (\$ldprint nil \$ldprint)) ; prevent messages + ((null dirs)) + (cond ((do ((name '(".init.prl" "init.prl") (cdr name))) + ((null name)) + (cond ((do ((ext '(".o" ".l" "") (cdr ext)) + (file)) + ((null ext)) + (cond ((probef + (setq file (concat (car dirs) + "/" + (car name) + (car ext)))) + (cond ((atom (errset (load file))) + (patom + "Error loading init.prl file ") + (print file) + (terpr) + (return 'error))) + (return t)))) + (return t)))) + (return t)))))) + +(de read-in-startprl-file () + (setq break-level-count 0 ; do this in case break + debug-level-count 0) ; occurs during readin + (*catch '(break-catch top-level-catch) + (do ((dirs `("." ,(getenv 'HOME)) (cdr dirs)) + (\$ldprint nil \$ldprint)) ; prevent messages + ((null dirs)) + (cond ((do ((name '(".start.prl" "start.prl") (cdr name))) + ((null name)) + (cond ((do ((ext '(".o" ".l" "") (cdr ext)) + (file)) + ((null ext)) + (cond ((probef + (setq file (concat (car dirs) + "/" + (car name) + (car ext)))) + (cond ((atom (errset (load file))) + (patom + "Error loading start.prl file ") + (print file) + (terpr) + (return 'error))) + (return t)))) + (return t)))) + (return t)))))) + +; For the implementor who wishes to dump a PEARL. +(df savepearl (name) + (sstatus ignoreeof nil) ; to undo ~/.lisprc + (setq franz-not-virgin nil) + (aliasdef 'top-level 'pearl-top-level-init) + (setq \$gcprint nil) + (gc) ; garbage collect before dumping lisp + (cond (name (eval (list 'dumplisp (car name)))) + ( t (dumplisp pearl))) + t) + +; For the user who wishes to dump a PEARL that starts with .init.prl. +(de savefresh n + (prog (name) + ; (INITFN 'STARTUPPEARL) + (setq franz-not-virgin nil) + (aliasdef 'top-level 'pearl-top-level-init) + (setq \$gcprint nil) + (gc) ; garbage collect before dumping lisp + (cond ((\=& n 1) (setq name (arg 1))) + ((\=& n 2) (setq name (concat (arg 1) '|/| (arg 2)))) + ( t (setq name 'pearl))) + (eval (list 'dumplisp name)) + (return t))) + +; For the user who wishes to dump a PEARL that continues with the +; read-eval-print loop. +(de savecontinue n + (prog (name) + ; (INITFN 'PEARL-REP-LOOP) + (aliasdef 'top-level 'pearl-top-level) + (setq \$gcprint nil) + (gc) ; garbage collect before dumping lisp + (cond ((\=& n 1) (setq name (arg 1))) + ((\=& n 2) (setq name (concat (arg 1) '|/| (arg 2)))) + ( t (setq name 'pearl))) + (eval (list 'dumplisp name)) + (return t))) + +(de pearlreploop () + (prog (*pval*) + *pearlloop* + (terpri) + (and *printhistorynumber* + (patom (1+ *historynumber*))) + (patom *pearlprompt*) + (setq *readlinechanged* nil) + (cond ((eq (unbound) + (setq *pval* + (car (errset (eval (addhistory (read))))))) + (rplacx (\\ *historynumber* *historysize*) + *histval* + (unbound)) + (prin 'unbound)) + ( t (rplacx (\\ *historynumber* *historysize*) + *histval* + *pval*) + (pearlprintfn *pval*))) + (go *pearlloop*))) + +(de pearl () + (read-in-initprl-file) + (cond ((not (boundp '*db1size*)) + (setdbsize 7.))) + (cond ((not (boundp '*db*)) + (builddb *maindb*) + (setq *db* *maindb*))) + (cond ((not (boundp '*pearlprompt*)) + (setq *pearlprompt* '|pearl> |)) + ((null *pearlprompt*) + (setq *pearlprompt* '|-> |))) + (cond ((not (boundp '*historysize*)) + (setq *historysize* 64.))) + (setq *historynumber* -1.) + (setq *history* (makhunk *historysize*)) + (setq *histval* (makhunk *historysize*)) + (read-in-startprl-file) + (terpri) + (pearlreploop)) + +(de initpearl () + (cond ((not (boundp '*db1size*)) + (setdbsize 7.))) + (cond ((not (boundp '*db*)) + (builddb *maindb*) + (setq *db* *maindb*)))) + +(de pearl-top-level-init () + (aliasdef 'reset 'franz-reset) + (aliasdef 'top-level 'pearl-top-level) + (signal 2 'pearl:int-serv) + (*catch '(top-level-catch break-catch) + (cond ((or (not (boundp 'franz-not-virgin)) + (null franz-not-virgin)) + (setq franz-not-virgin t + + nil ++ nil +++ nil + * nil ** nil *** nil) + ; This is changed because fixit is included now. + ; (setq ER%tpl 'pearl-break-err-handler) + (setq ER%tpl 'fixit) + (setq ER%brk 'fixit) + (setq ER%err 'fixit) + + ; The rest of the code should be within this + ; cond if autorunlisp existed + ; (cond ((not (autorunlisp)))) + ; + (patom (status version)) + (cond ((boundp 'franz-minor-version-number) + (patom franz-minor-version-number))) + (patom pearl-title) + (terpr) + (cond (*firststartup* (setq *firststartup* nil) + (read-in-initprl-file))) + (or *pearlprompt* + (setq *pearlprompt* '|-> |)) + (and (not (\=& 64 *historysize*)) + (setq *history* (makhunk *historysize*)) + (setq *histval* (makhunk *historysize*))) + (read-in-startprl-file)))) + (reset)) + +(de pearl-top-level () + ; loop forever + (do ((+*) (-) (retval)) + (nil) + (setq retval + (*catch + '(top-level-catch break-catch) + ; begin or return to top level + (progn + (setq debug-level-count 0 break-level-count 0 + evalhook nil funcallhook nil) + (cond (tpl-errlist (mapc 'eval tpl-errlist))) + (do ((^w nil nil)) + (nil) + (cond (user-top-level (funcall user-top-level)) + ( t ; Print prompt. + (and *printhistorynumber* + (patom (1+ *historynumber*))) + (patom *pearlprompt*) + (setq *readlinechanged* nil) + + (cond ((eq top-level-eof + ; read and add to history. + (setq - + (car (errset + (addhistory + (read nil + top-level-eof)))))) + (cond ((not (status isatty)) + (exit))) + (cond ((null (status ignoreeof)) + (terpr) + (print 'Goodbye) + (terpr) + (exit)) + ( t (terpr) + (setq - ''EOF))))) + ; Eval and story result in history. + (setq +* (eval -)) + (rplacx (\\ *historynumber* *historysize*) + *histval* + +*) + ; update list of old forms + (let ((val -)) + (let ((o+ +) (o++ ++)) + (setq + val + ++ o+ + +++ o++))) + ; update list of old values + (let ((val +*)) + (let ((o* *) (o** **)) + (setq * val + ** o* + *** o**))) + ; Don't print *invisible*. + (and (neq '*invisible* +*) + (pearlprintfn +*)) + (terpr)))) + (terpr) + (patom "[Return to top level]") + (terpr) + (cond ((eq 'reset retval) (old-reset-function)))))))) + +; this is the break handler, it should be tied to +; ER%tpl always. +; it is entered if there is an error which no one wants to handle. +; We loop forever, printing out our error level until someone +; types a ^D which goes to the next break level above us (or the +; top-level if there are no break levels above us.) +; a (return n) will return that value to the error message +; which called us, if that is possible (that is if the error is +; continuable) +; +(def pearl-break-err-handler + (lexpr + (n) + ((lambda + (message break-level-count retval rettype ^w piport) + (cond ((>& n 0) + (print 'error:) + (mapc '(lambda (a) (patom " ") (patom a) ) + (cdddr (arg 1))) + (terpr) + (cond ((caddr (arg 1)) (setq rettype 'contuab)) + ( t (setq rettype nil)))) + ( t (setq rettype 'localcall))) + + (do nil (nil) + (cond ((dtpr + (setq retval + (*catch + 'break-catch + (do ((form)) (nil) + (patom "<") + (patom break-level-count) + (patom ">: ") + (cond ((eq top-level-eof + (setq form (read nil top-level-eof))) + (cond ((null (status isatty)) + (exit))) + (eval 1) ; force interrupt check + (return (1- break-level-count))) + ((and (dtpr form) + (eq 'return (car form))) + (cond ((or (eq rettype 'contuab) + (eq rettype 'localcall)) + (return (ncons (eval (cadr form))))) + ( t (patom + "Can't continue from this error") + (terpr)))) + ((and (dtpr form) (eq 'retbrk (car form))) + (cond ((numberp (setq form + (eval (cadr form)))) + (return form)) + ( t (return (1- break-level-count))))) + ( t (pearlbreakprintfn (eval form)) + (terpr))))))) + (return (cond ((eq rettype 'localcall) + (car retval)) + ( t retval)))) + ((<& retval break-level-count) + (setq tpl-errlist errlist) + (*throw 'break-catch retval)) + ( t (terpr))))) + nil + (1+ break-level-count) + nil + nil + nil + nil))) + +(aliasdef 'break-err-handler 'pearl-break-err-handler) + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/ucisubset.l b/usr/src/usr.bin/lisp/pearl/ucisubset.l new file mode 100644 index 0000000000..64e04ebd00 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/ucisubset.l @@ -0,0 +1,917 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ucisubset.l ;;;;;;;;;;;;;;;;;;;;;;;;; +; Functions for a subset of UCI Lisp that are either used by PEARL +; or were needed by PEARL users at Berkeley. +; This was purposely designed to interfere as little as necessary +; with Franz Lisp, so things like the standard UCI do macro +; and the Charniak (et al) let macro are not provided. +; Includes what used to be sprint.l (at the end). +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +(eval-when (compile) + (declare (special defmacro-for-compiling *savedefs*)) + (setq defmacro-for-compiling t) + (setq *savedefs* nil)) + +(declare (macros t)) + +(defvar poport) +(defvar pparm1 50) +(defvar pparm2 100) +(defvar lpar) +(defvar rpar) +(defvar form) +(defvar linel) +(defvar *outport* nil) +(defvar *fileopen*) +(defvar prettyprops '((comment . pp-comment) + (function . pp-function) + (value . pp-value))) + +(declare (localf *patom1)) + +(defvar *file* nil) +(defvar *oldfunctiondefinition*) +(defvar *savedefs* t) + +(defmacro funl (&rest rest) + `(function (lambda .,rest))) + +; +; ucilisp (de df dm) declare function macros. +; +; (DE name args body) -> declare exprs and lexprs. +; If *savedefs* is t and function has previous definition, +; save it under the property OLDDEF, and return '(name Redefined). +; Otherwise, just do a defun and return name (as with defun). +; +(defun de macro (l) + (cond (*savedefs* + `(progn 'compile + (setq *oldfunctiondefinition* (getd ',(cadr l))) + (defun .,(cdr l)) + (and *file* + (putprop ',(cadr l) *file* 'sourcefile)) + (cond (*oldfunctiondefinition* + (putprop ',(cadr l) *oldfunctiondefinition* 'olddef) + (list ',(cadr l) 'Redefined)) + ( t ',(cadr l))))) + ( t `(defun .,(cdr l))))) + +; +; (df name args body) -> declare fexprs. +; +(defun df macro (l) + (cond (*savedefs* + `(progn 'compile + (setq *oldfunctiondefinition* (getd ',(cadr l))) + (defun ,(cadr l) fexpr .,(cddr l)) + (and *file* + (putprop ',(cadr l) *file* 'sourcefile)) + (cond (*oldfunctiondefinition* + (putprop ',(cadr l) *oldfunctiondefinition* 'olddef) + (list ',(cadr l) 'Redefined)) + ( t ',(cadr l))))) + ( t `(defun ,(cadr l) fexpr .,(cddr l))))) + +; +; macro's are not compiled except under the same +; conditions as in franz lisp. +; (usually just do (declare (macros t)) +; to have macros also compiled). +; +; +; (dm name args body) -> declare macros. same as (defun name 'macro body) +; +(defun dm macro (l) + (cond (*savedefs* + `(progn 'compile + (setq *oldfunctiondefinition* (getd ',(cadr l))) + (defun ,(cadr l) macro .,(cddr l)) + (and *file* + (putprop ',(cadr l) *file* 'sourcefile)) + (cond (*oldfunctiondefinition* + (putprop ',(cadr l) *oldfunctiondefinition* 'olddef) + (list ',(cadr l) 'Redefined)) + ( t ',(cadr l))))) + ( t `(defun ,(cadr l) macro .,(cddr l))))) + +; UCI Lisp character macros are non-separating when occurring in +; the middle of atoms. +(eval-when (compile load eval) + (add-syntax-class 'vucisplicemacro + '(csplicing-macro escape-when-first)) + (add-syntax-class 'vucireadmacro + '(cmacro escape-when-first))) + +; +; ucilisp functions which declare character macros. +; +; +; dsm - declare splicing read macro. +; +(defun dsm macro (l) + (cond (*savedefs* + `(progn 'compile + (setq *oldfunctiondefinition* + (and (memq (getsyntax ',(cadr l)) + '(vucireadmacro vucisplicemacro + vsplicing-macro vmacro)) + (get ',(cadr l) readtable))) + (eval-when (compile load eval) + (setsyntax ',(cadr l) 'vucisplicemacro ',(caddr l))) + + (and *file* + (putprop ',(cadr l) *file* 'sourcefile)) + (cond (*oldfunctiondefinition* + (putprop ',(cadr l) *oldfunctiondefinition* 'oldmacro) + (list ',(cadr l) 'Redefined)) + ( t ',(cadr l))))) + ( t `(eval-when (compile load eval) + (setsyntax ',(cadr l) 'vucisplicemacro ',(caddr l)))))) + +; +; drm - declare read macro. +; +(defun drm macro (l) + (cond (*savedefs* + `(progn 'compile + (setq *oldfunctiondefinition* + (and (memq (getsyntax ',(cadr l)) + '(vucireadmacro vucisplicemacro + vsplicing-macro vmacro)) + (get ',(cadr l) readtable))) + (eval-when (compile load eval) + (setsyntax ',(cadr l) 'vucireadmacro ',(caddr l))) + + (and *file* + (putprop ',(cadr l) *file* 'sourcefile)) + (cond (*oldfunctiondefinition* + (putprop ',(cadr l) *oldfunctiondefinition* 'oldmacro) + (list ',(cadr l) 'Redefined)) + ( t ',(cadr l))))) + ( t `(eval-when (compile load eval) + (setsyntax ',(cadr l) 'vucireadmacro ',(caddr l)))))) + +; +; ucilisp selectq function. (written by jkf) +; +(defun selectq* macro (form) + ((lambda (x) + `((lambda (,x) + (cond + ,@(maplist + (function + (lambda (ff) + (cond ((null (cdr ff)) + `( t ,(car ff))) + ((atom (caar ff)) + `((eq ,x ',(caar ff)) + . ,(cdar ff))) + (t + `((memq ,x ',(caar ff)) + . ,(cdar ff)))))) + (cddr form)))) + ,(cadr form))) + (gensym 'z))) + +(defun some macro (l) + `((lambda (f a) + (prog () + loop + (cond ((null a) (return nil)) + ((funcall f (car a)) + (return a)) + ( t (setq a (cdr a)) + (go loop))))) + ,(cadr l) + ,(caddr l))) + +(defmacro subset (fun lis) + `(mapcan (function (lambda (ele) + (cond ((funcall ,fun ele) (ncons ele))))) + ,lis)) + +(defun length (l) + (prog (n) + (setq n 0) + loop + (and (atom l) + (return n)) + (setq l (cdr l)) + (setq n (1+ n)) + (go loop))) + +(defmacro apply* (fcn args) + `(prog (fcndef) + (return + (cond ((atom ,fcn) + (or (and (eq 'binary (type ,fcn)) + (setq fcndef ,fcn)) + (setq fcndef (getd ,fcn))) + (cond ((or (and (eq 'binary (type fcndef)) + (eq 'macro (getdisc fcndef))) + (and (dtpr fcndef) + (eq 'macro (car fcndef)))) + (funcall ,fcn (cons ,fcn ,args))) + ( t (apply ,fcn ,args)))) + ( t (apply ,fcn ,args)))))) + +(defmacro every (fcn args) + `(prog (kkkk) + (setq kkkk ,args) + loop + (cond ((null kkkk) + (return t)) + ((apply* ,fcn (list (pop kkkk))) + (go loop))) + (return nil))) + +(defun timer fexpr (request) + (let ((timein (ptime)) timeout result cpu garbage) + (prog () + loop + (setq result (eval (car request))) + (and (setq request (cdr request)) + (go loop))) + (setq timeout (ptime)) + (setq cpu (quotient (fix (times 1000 + (quotient (difference (car timeout) + (car timein)) + 60.0))) + 1000.0)) + (setq garbage (quotient (fix (times 1000 + (quotient (difference (cadr timeout) + (cadr timein)) + 60.0))) + 1000.0)) + (print (cons cpu garbage)) + (terpri) + result)) + +(putd 'consp (getd 'dtpr)) + +(putd 'msgprintfn (getd 'patom)) + +; +; ucilisp msg function. (written by jkf) +; +(defmacro msg ( &rest body) + `(progn ,@(mapcar + (function + (lambda (form) + (cond ((eq form t) '(line-feed 1)) + ((numberp form) + (cond ((>& form 0) + `(msg-space ,form)) + ( t `(line-feed ,(minus form))))) + ((atom form) `(msgprintfn ,form)) + ((eq (car form) t) '(msgprintfn '\ )) + ((eq (car form) 'e) + `(msgprintfn ,(cadr form))) + ( t `(msgprintfn ,form))))) + body) + nil)) ; return nil! + +; +; this NEED NOT be fixed to not use do. +; +(defmacro msg-space (n) + (cond ((eq 1 n) '(patom '" ")) + ( t `(do i ,n (1- i) (<& i 1) (patom '\ ))))) + +(defmacro line-feed (n) + (cond ((eq 1 n) '(terpr)) + ( t `(do i ,n (1- i) (<& i 1) (terpr))))) + +; compatability functions: functions required by uci lisp but not +; present in franz +; +; union uses the franz do loop (not the ucilisp one). + +(defvar membfn 'member) + +(defun union n + (and (> n 0) + (do ((res (ncons nil)) + (i 1 (1+ i))) + ((eq i (1+ n)) (car res)) + (mapc (function + (lambda (arg) + (or (apply* membfn (list arg (car res))) + (tconc res arg)))) + (arg i))))) + +(defun enter (v l) + (cond ((apply* membfn (list v l)) l) + ( t (cons v l)))) + +(defun append2 (a b &aux (c (ncons nil))) + (do ((a a (cdr a))) + ((null a)) + (tconc c (car a))) + (rplacd (cdr c) b) + (car c)) + +(putd 'noduples (getd 'union)) +(putd 'append* (getd 'append)) +(putd '*append (getd 'append)) +(putd '*dif (getd 'diff)) +(putd '*eval (getd 'eval)) +(putd '*great (getd 'greaterp)) +(putd '*less (getd 'lessp)) +(putd '*max (getd 'max)) +(putd '*nconc (getd 'nconc)) +(putd '*plus (getd 'plus)) +(putd '*times (getd 'times)) +(putd 'expandmacro (getd 'macroexpand)) +(putd 'mapcl (getd 'mapcar)) +(putd 'memb (getd 'member)) + +(dm clrbfi () + '(drain piport)) + +(defun save fexpr (l) + (let ((fcnname (car l))) + (putprop fcnname (getd fcnname) 'olddef))) + +(defun unsave fexpr (l) + (let* ((name (car l)) + (old (get name 'olddef))) + (and old + (putprop name (getd name) 'olddef) + (putd name old)) + old)) + +(putd 'atcat (getd 'concat)) + +(putd 'gt (getd '>)) +(putd 'lt (getd '<)) + +(defun le macro (x) + `(not (> .,(cdr x)))) + +(defun ge macro (x) + `(not (< .,(cdr x)))) + +(defun litatom macro (x) + `(and (atom .,(cdr x)) + (not (numberp .,(cdr x))))) + +(putd 'peekc (getd 'tyipeek)) + +; +; unbound - (setq x (unbound)) will unbind x. +; "this [code] is sick" - jkf. +; +(defun unbound macro (l) + `(fake -4)) + +(or (getd 'franzboundp) + (putd 'franzboundp (getd 'boundp))) + +(defun boundp (item) + (cond ((arrayp item)) + ((franzboundp item)))) + +(defvar *dskin* t) +(defvar piport) + +;(eval-when (load eval compile) +; (or (boundp '*dskin*) +; (setq *dskin* t))) + +(eval-when (load eval) + (or (getd 'dskprintfn) + (putd 'dskprintfn (getd 'patom)))) + +(defun dskin fexpr (l) + (mapc 'dskin1 l) + (terpri) t ) + +(defun dskin1 (*file*) + (prog (port) + (terpri) + (patom '|>>>|) + (cond ((null (setq port (car (errset (infile *file*) nil)))) + (patom '|couldn't open file |) + (patom *file*)) + ( t (patom *file*) + (patom '| |) + (dskin2 port) + (close port))))) + +(defun dskin2 (port) + (prog (expr value) + loop + (cond ((null (setq expr (read port))) nil) + ( t (cond ((memq (car expr) '(de df defmacro dm drm + dsm setq def defun)) + (cond ((memq *dskin* '(name both)) + (patom (cadr expr)) + (patom '|: |)))) + ((eq (car expr) 'create) + (cond ((memq *dskin* '(name both)) + (patom (caddr expr)) + (patom '|: |))))) + (setq value (eval expr)) + (and (memq *dskin* '(t both)) + (or (eq value '*invisible*) + (progn (dskprintfn value) + (patom '| |)))) + (go loop))))) + +(defun nequal (arg1 arg2) + (not (equal arg1 arg2))) + +(defun readl fexpr (l) + (cond ((null l) (readl1 nil)) + ( t (readl1 (eval (car l)))))) + +(putd 'lineread (getd 'readl)) + +(defun readl1 (flag) + (cond ((not (and flag + (eq (tyipeek) 10) + (tyi))) + (prog (input) + (setq input (ncons nil)) ; initialize for tconc. + loop + (cond ((not (eq (tyipeek) 10)) + (tconc input (read)) + (go loop)) + ( t ; the actual list is in the CAR. + (tyi) + (return (car input)))))))) + +(defun defv fexpr (l) + (set (car l) (cadr l))) + +(defun remprops (item proplist) + (mapc (funl (prop) + (remprop item prop)) + proplist) + nil) + +(defun addprop (id value prop) + (putprop id (enter value (get id prop)) prop)) + +(defun nconc1 (l elmt) + (rplacd (last l) (cons elmt nil))) + +(defun dremove (elmt l) + (let (newl) + (cond ((dtpr l) + (cond ((eq elmt (car l)) + (setq newl (delq elmt l)) + (rplaca l (car newl)) + (rplacd l (cdr newl))) + ( t (delq elmt l)))) + ( t l)))) + +(defun intersection (set1 set2) + (prog (inter) + (mapc (funl (elt) (putprop elt t '*inter*)) set1) + (mapc (funl (elt) (and (get elt '*inter*) + (setq inter (cons elt inter)))) + set2) + (mapc (funl (elt) (remprop elt '*inter*)) set1) + (return inter))) + +(defun initsym1 expr (l) + (prog (num) + (cond ((dtpr l) + (setq num (cadr l)) + (setq l (car l))) + ( t (setq num 0))) + (putprop l num 'symctr) + (return (concat l num)))) + +(defun initsym fexpr (l) + (mapcar (function initsym1) l)) + +(defun newsym fexpr (l) + (let ((name (car l))) + (concat name + (putprop name + (1+ (or (get name 'symctr) + -1)) + 'symctr)))) + +(defun oldsym fexpr (l) + (let ((sym (car l))) + (concat sym (get sym 'symctr)))) + +(defun allsym fexpr (l) + (prog (num symctr syms) + (cond ((dtpr (car l)) + (setq num (cadar l)) + (setq l (caar l))) + ( t (setq num 0) + (setq l (car l)))) + (or (setq symctr (get l 'symctr)) + (return)) + loop + (and (>& num symctr) + (return syms)) + (setq syms (cons (concat l symctr) syms)) + (setq symctr (1- symctr)) + (go loop))) + +(defun remsym1 expr (l) + (prog1 (funcall (function oldsym) + (cond ((dtpr (car l)) (car l)) + ( t l))) + (mapc (function remob) (apply (function allsym) l)) + (cond ((dtpr (car l)) (putprop (caar l) (1- (cadar l)) 'symctr)) + ( t (remprop (car l) 'symctr))))) + +(defun remsym fexpr (l) + (maplist (function remsym1) l)) + +(defun symstat fexpr (l) + (mapcar (funl (k) + (list k (get k 'symctr))) + l)) + +(defun suflist (itemlist num) + (cond ((dtpr itemlist) (nth (1+ num) itemlist)))) + +;;;;;;;;;;;;;;;;;;;;;;; (formerly sprint.l) ;;;;;;;;;;;;;;;;;;;;;;;; +; A few additions to the library file ucbpp.l, mostly to add +; a UCI Lisp-like "sprint" including some modifications for +; more flexible printmacros. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +; Moved to front and converted to defvar. +; (declare (special poport pparm1 pparm2 lpar rpar form linel)) +; (declare (localf *patom1)) +; (declare (special *outport* *fileopen* prettyprops)) + +; ======================================= +; pretty printer top level routine pp +; +; +; calling form- (pp arg1 arg2 ... argn) +; the args may be names of functions, atoms with associated values +; or output descriptors. +; if argi is: +; an atom - it is assumed to be a function name, if there is no +; function property associated with it,then it is assumed +; to be an atom with a value +; (P port)- port is the output port where the results of the +; pretty printing will be sent. +; poport is the default if no (P port) is given. +; (F fname)- fname is a file name to write the results in +; (A atmname) - means, treat this as an atom with a value, dont +; check if it is the name of a function. +; (E exp)- evaluate exp without printing anything +; other - pretty-print the expression as is - no longer an error +; +; Also, rather than printing only a function defn or only a value, we will +; let prettyprops decide which props to print. Finally, prettyprops will +; follow the CMULisp format where each element is either a property +; or a dotted pair of the form (prop . fn) where in order to print the +; given property we call (fn id val prop). The special properties +; function and value are used to denote those "properties" which +; do not actually appear on the plist. +; +; [history of this code: originally came from Harvard Lisp, hacked to +; work under franz at ucb, hacked to work at cmu and finally rehacked +; to work without special cmu macros] +; THEN, hacked to use for PEARL. + +; moved to front. +;(setq prettyprops '((comment . pp-comment) +; (function . pp-function) +; (value . pp-value))) + +; printret is like print yet it returns the value printed, this is used +; by pp +(def printret + (macro (*l*) + `(progn (print ,@(cdr *l*)) ,(cadr *l*)))) + +(def pp + (nlambda (*xlist*) + (prog (*outport* *cur* *fileopen* *prl* *atm*) + + (setq *outport* poport) ; default port + ; check if more to do, if not close output file if it is + ; open and leave + + + toploop (cond ((null (setq *cur* (car *xlist*))) + (condclosefile) + (terpr) + (return t))) + + (cond ((dtpr *cur*) + (cond ((equal 'P (car *cur*)) ; specifying a port + (condclosefile) ; close file if open + (setq *outport* (eval (cadr *cur*)))) + + ((equal 'F (car *cur*)) ; specifying a file + (condclosefile) ; close file if open + (setq *outport* (outfile (cadr *cur*)) + *fileopen* t)) + + + ((equal 'E (car *cur*)) + (eval (cadr *cur*))) + + ( t (terpri *outport*) + (*prpr *cur*))) ;-DNC inserted + (go botloop))) + + + (mapc (function + (lambda (prop) + (prog (printer) + (cond ((dtpr prop) + (setq printer (cdr prop)) + (setq prop (car prop))) + ( t (setq printer 'pp-prop))) + (cond ((eq 'value prop) + (cond ((boundp *cur*) + (apply printer + (list *cur* + (eval *cur*) + 'value))))) + ((eq 'function prop) + (cond ((and (getd *cur*) + (not (bcdp (getd *cur*)))) + (apply printer + (list *cur* + (getd *cur*) + 'function))))) + ((get *cur* prop) + (apply printer + (list *cur* + (get *cur* prop) + prop))))))) + prettyprops) + + + botloop (setq *xlist* (cdr *xlist*)) + + (go toploop)))) + +; moved to front. +;(setq pparm1 50 pparm2 100) + +; -DNC These "prettyprinter parameters" are used to decide when we should +; quit printing down the right margin and move back to the left - +; Do it when the leftmargin > pparm1 and there are more than pparm2 +; more chars to print in the expression + +; cmu prefers dv instead of setq + +#+cmu +(def pp-value (lambda (i v p) + (terpri *outport*) (*prpr (list 'dv i v)))) + +#-cmu +(def pp-value (lambda (i v p) + (terpr *outport*) (*prpr `(setq ,i ',v)))) +(def pp-function (lambda (i v p) + (terpri *outport*) (*prpr (list 'def i v)))) +(def pp-prop (lambda (i v p) + (terpri *outport*) (*prpr (list 'defprop i v p)))) + +(def condclosefile + (lambda nil + (cond (*fileopen* + (terpr *outport*) + (close *outport*) + (setq *fileopen* nil))))) + +; +; these routines are meant to be used by pp but since +; some people insist on using them we will set *outport* to nil +; as the default (moved to front). +;(setq *outport* nil) + + +(def *prpr + (lambda (x) + (cond ((not (boundp '*outport*)) (setq *outport* poport))) + (terpr *outport*) + (*prdf x 0 0))) + +; This is the principle addition for PEARL. +; SPRINT simply calls *prdf after filling in any missing parameters. +(defun sprint (value &optional (lmar 0) (rmar 0)) + (cond ((not (boundp '*outport*)) (setq *outport* poport))) + (*prdf value lmar rmar)) + +(defvar rmar) ; -DNC this used to be m - I've tried to + ; to fix up the pretty printer a bit. It + ; used to mess up regularly on (a b .c) types + ; of lists. Also printmacros have been added. + + + +; Used to be $prdf but added a bit and changed to * to avoid +; PEARL's history read macro $. +(def *prdf + (lambda (l lmar rmar) + (prog (pmac) +; +; - DNC - Here we try to fix the tendency to print a +; thin column down the right margin by allowing it +; to move back to the left if necessary. +; + (cond ((and (>& lmar pparm1) (>& (flatc l (1+ pparm2)) pparm2)) + (terpri *outport*) + (princ '"; <<<<< start back on the left <<<<<" *outport*) + (*prdf l 5 0) + (terpri *outport*) + (princ '"; >>>>> continue on the right >>>>>" *outport*) + (terpri *outport*) + (return nil))) + (tab lmar *outport*) + a (cond ((and (dtpr l) + (atom (car l)) + (setq pmac (get (car l) 'printmacro)) + (cond ((stringp pmac) + ; Added for PEARL (and UCI Lisp compatibility). + ; a string printmacro means print this + ; string and then the cadr of l if + ; it's not nil, and only if l is + ; a one- or two-element list. + (cond ((cddr l) ; more than two elements. + nil) + ((null (cdr l)) ; only one element. + (patom pmac) + t) + ( t (patom pmac) ; two elements. + (patom (cadr l)) + t))) + ( t (apply pmac (list l lmar rmar))))) + (return nil)) +; +; -DNC - a printmacro is a lambda (l lmar rmar) +; attached to the atom. If it returns nil then +; we assume it did not apply and we continue. +; Otherwise we assume it did the job. +; + ((or (not (dtpr l)) +; (*** at the moment we just punt hunks etc) + (and (atom (car l)) (atom (cdr l)))) + (return (printret l *outport*))) + ((<& (+ rmar (flatc l (chrct *outport*))) + (chrct *outport*)) +; +; This is just a heuristic - if print can fit it in then figure that +; the printmacros won't hurt. Note that despite the pretentions there +; is no guarantee that everything will fit in before rmar - for example +; atoms (and now even hunks) are just blindly printed. - DNC +; + (printaccross l lmar rmar)) + ((and (*patom1 lpar) + (atom (car l)) + (not (atom (cdr l))) + (not (atom (cddr l)))) + (prog (c) + (printret (car l) *outport*) + (*patom1 '" ") + (setq c (nwritn *outport*)) + a (*prd1 (cdr l) c) + (cond + ((not (atom (cdr (setq l (cdr l))))) + (terpr *outport*) + (go a))))) + (t + (prog (c) + (setq c (nwritn *outport*)) + a (*prd1 l c) + (cond + ((not (atom (setq l (cdr l)))) + (terpr *outport*) + (go a)))))) + b (*patom1 rpar)))) + +(def *prd1 + (lambda (l n) + (prog nil + (*prdf (car l) + n + (cond ((null (setq l (cdr l))) (|1+| rmar)) + ((atom l) (setq n nil) (+ 4 rmar (pntlen l))) + ( t rmar))) + (cond + ((null n) (*patom1 '" . ") (return (printret l *outport*)))) +; (*** setting n is pretty disgusting) +; (*** the last arg to *prdf is the space needed for the suffix) +; ;Note that this is still not really right - if the prefix +; takes several lines one would like to use the old rmar +;( until the last line where the " . mumble)" goes. + ))) + +; -DNC here's the printmacro for progs - it replaces some hackery that +; used to be in the guts of *prdf. + +(def printprog + (lambda (l lmar rmar) + (prog (col) + (cond ((cdr (last l)) (return nil))) + (setq col (1+ lmar)) + (princ '|(| *outport*) + (princ (car l) *outport*) + (princ '| | *outport*) + (print (cadr l) *outport*) + (mapc '(lambda (x) + (cond ((atom x) + (tab col *outport*) + (print x *outport*)) + ( t (*prdf x (+ lmar 6) rmar)))) + (cddr l)) + (princ '|)| *outport*) + (return t)))) + +(putprop 'prog 'printprog 'printmacro) + +; Here's the printmacro for def. The original *prdf had some special code +; for lambda and nlambda. + +(def printdef + (lambda (l lmar rmar) + (cond ((and (\=& 0 lmar) ; only if we're really printing a defn + (\=& 0 rmar) + (cadr l) + (atom (cadr l)) + (caddr l) + (null (cdddr l)) + (memq (caaddr l) '(lambda nlambda macro lexpr)) + (null (cdr (last (caddr l))))) + (princ '|(| *outport*) + (princ 'def *outport*) + (princ '| | *outport*) + (princ (cadr l) *outport*) + (terpri *outport*) + (princ '| (| *outport*) + (princ (caaddr l) *outport*) + (princ '| | *outport*) + (princ (cadaddr l) *outport*) + (terpri *outport*) + (mapc '(lambda (x) (*prdf x 4 0)) (cddaddr l)) + (princ '|))| *outport*) + t)))) + +(putprop 'def 'printdef 'printmacro) + +; There's a version of this hacked into the printer (where it don't belong!) +; Note that it must NOT apply to things like (quote a b). + +(def printquote + (lambda (l lmar rmar) + (cond ((or (null (cdr l)) (cddr l)) nil) + ( t (princ '|'| *outport*) + (*prdf (cadr l) (1+ lmar) rmar) + t)))) + +(putprop 'quote 'printquote 'printmacro) + + + + +(def printaccross + (lambda (l lmar rmar) + (prog nil +; (*** this is needed to make sure the printmacros are executed) + (princ '|(| *outport*) ;) + l: (cond ((null l)) + ((atom l) (princ '|. | *outport*) (princ l *outport*)) + ( t (*prdf (car l) (nwritn *outport*) rmar) + (setq l (cdr l)) + (cond (l (princ '| | *outport*))) + (go l:)))))) + + + +(def tab (lexpr (n) + (prog (nn prt) (setq nn (arg 1)) + (cond ((>& n 1) (setq prt (arg 2)))) + (cond ((>& (nwritn prt) nn) (terpri prt))) + (printblanks (- nn (nwritn prt)) prt)))) + +; ======================================== +; +; (charcnt port) +; returns the number of characters left on the current line +; on the given port +; +; ======================================= + + +(def charcnt + (lambda (port) (- linel (nwritn port)))) + +(putd 'chrct (getd 'charcnt)) + +(def *patom1 (lambda (x) (patom x *outport*))) + +; vi: set lisp: diff --git a/usr/src/usr.bin/lisp/pearl/update.ms b/usr/src/usr.bin/lisp/pearl/update.ms new file mode 100644 index 0000000000..413c1e8dfe --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/update.ms @@ -0,0 +1,471 @@ +.ND +.nr LL 75n +.nr LT 80n +.rm CF +.ds LH PEARL Documentation +.ds CH Update +.ds RH Page % +.po 1.50i +.ls 1 +.hy 14 +.LP +.bp 76 +.DS C +.LG +\fBUpdate of Changes +Through +PEARL 3.9 +April 1983\fR +.SM +.DE +.SH +1. Introduction +.PP +This appendix describes the changes that have been made to PEARL since +the original manual was produced. +It is designed to parallel the sections of the manual so that the +original index can be used to find changes. +.PP +PEARL is now distributed with Franz Lisp (starting with Opus 38.58). +The earliest version of PEARL distributed (with 38.58) was PEARL 3.6. +The current update corresponds to version 3.9 and is being distributed +with the Franz Opus 38.69 available with 4.2 BSD Unix. +The current major and minor version numbers for PEARL are stored in +the special variables \fIpearlmajorversion\fR and \fIpearlminorversion\fR +respectively. +.PP +With the change in mail protocols and addition of new machines at +Berkeley, the form of addresses for bugs and suggestions have been +simplified. +Bugs, suggestions or queries should be sent to +\fIPearl\-Bugs@Berkeley\fR or \fIucbvax!pearl\-bugs\fR. +.SH +2. Running PEARL +.PP +PEARL is currently only maintained under Franz Lisp. +The current version could be moved back to UCI Lisp (or to other +Lisps) fairly easily but has not been for lack of need. +Lisp Machine Lisp is the most likely Lisp that PEARL will be moved +to next but it has not been done, mostly because of conflicts in the +use of the colon character and lack of access to a Lisp Machine. +.SH +2.1 Under Franz Lisp +.PP +Since PEARL is now part of Franz Lisp, it should be available as +\fI/usr/ucb/pearl\fR or wherever you find \fIlisp\fR on your system. +.PP +The \fI.start.pearl\fR and \fI.init.pearl\fR files are actually +called \fIstart.prl\fR and \fIinit.prl\fR and may optionally be +prefixed with a dot "." and/or suffixed with either ".o" or ".l" just +as in Franz. +The use of the dot prefix and of the ".o" or ".l" is preferred +and fastest. +Thus PEARL will read the first file found in the following +sequence: \fI.init.prl.o\fR, \fI.init.prl.l\fR, \fI.init.prl\fR, +\fIinit.prl.o\fR, \fIinit.prl.l\fR, or \fIinit.prl\fR and similarly +for \fIstart.prl\fR. +Franz's special variable \fI$ldprint\fR is lambda-bound to \fInil\fR during +the reading of these two files to disable the printing of +"[load .init.prl]". +.SH +5. Accessing Slots of Structures +.PP +Doing a "\fIpath \fBput\fR" on a slot containing a variable will +not set the variable. +Rather it replaces the variable with the value provided. +.SH +10. Printing Structures, Symbols and Other PEARL Objects +.PP +The various printing functions still exist but all call a single +formatting function with various options controlled by special atoms. +The principle functions are \fBallform\fR which does the building of a +printable list form for internal PEARL structures and \fBallprint\fR +which calls \fIallform\fR. +\fIAllform\fR uses the following global variables to determine what +form to build: +.IP 1. +\fB*abbrevprint*\fR -- a non-\fInil\fR value causes abbreviations +to be used whenever possible for any structure except the top level +structure passed to a print function. +Abbreviations are described at the end of this section. +The new functions \fBabbrevform\fR and \fBabbrevprint\fR +lambda-bind this to \fIt\fR and then call \fIallform\fR. +\fIfullform\fR binds this to \fInil\fR. +.IP 2. +\fB*fullprint*\fR -- a non-\fInil\fR value causes complete information +including hooks and predicates to be given when present. +\fIFullform\fR (and thus \fIfullprint\fR) lambda-binds this to \fIt\fR +and calls \fIallform\fR. +\fIAbbrevform\fR binds this to \fInil\fR. +.LP +\fIValform\fR lambda-binds both to \fInil\fR. +The default value of both is are also \fInil\fR, so that the default action of +\fIallform\fR when used by itself will be like \fIvalform\fR unless these +special variables are changed. +All the default print functions automatically use \fIallprint\fR so that +they can all be changed by changes to the default values of +\fI*abbrevprint*\fR and \fI*fullprint*\fR. +.LP +Two other special atoms which affect the behavior of all the printing +functions are: +.IP 3. +\fB*uniqueprint*\fR -- a non-\fInil\fR value causes a structure which is +encountered more than once during the same top-level call to a +print function to be translated into exactly the same cons-cells. +This saves on cons-cells and also makes it possible for the \fI\-\-form\fR +functions to handle circular structures, although \fIsprint\fR and thus +the \fI\-\-print\fR functions cannot handle the result. +Since most people seldom have duplications within a structure, +the default is \fInil\fR (off). +The assoc\-list of already translated structures is stored in the +special atom \fB*uniqueprintlist*\fR. +.IP 4. +\fB*quiet*\fR -- a non-\fInil\fR value disables all printing by any of +PEARL's print functions, providing an easy way to disable printing +all at once. +There is also a function called \fBquiet\fR which behaves like +\fIprogn\fR, except that it lambda-binds \fI*quiet*\fR to \fIt\fR +during the evaluation of its arguments, providing a local island +of "quiet". +.PP +The standard print functions are designed to handle any Lisp structure. +Thus, they spend a significant amount of time determining what kind of +object they have been passed. +For situations in which you know exactly what type of object you want +printed, the functions +\fBstructureform/structureprint\fR, \fBsymbolform/symbolprint\fR, +and \fBstreamform/streamprint\fR are provided. +They assume you know what you are doing and do not ensure that +you give them the right type of value. +.PP +Adapting PEARL to fit an improvement in Franz, the atoms +\fIshowstack-printer\fR and \fItrace-printer\fR are bound to +the functions \fBpearlshowstackprintfn\fR and \fBpearltraceprintfn\fR. +\fBNote\fR the addition of "pearl" to the beginning of these. +The name of \fIbreakprintfn\fR was also changed to +\fBpearlbreakprintfn\fR but it is not currently lambda-bindable. +.SH +10.1. Abbreviations +.PP +As people build larger deeper structures it becomes useful to have +some of them abbreviated during printing if they are internal to the +structure being printed. +When an individual (including default instance) structure is created, +an abbreviation atom is stored in it. +This abbreviation is chosen as follows: +.IP 1. +If the option in \fIcreate\fR of having a structure automatically +stored in an atom is used, then that atom is the one used as an +abbreviation. +Thus the structure created by \fI(create individual x Pete)\fR will +be given the abbreviation \fIPete\fR. +.IP 2. +If that option is not used, then default instances will be +given the abbreviation \fIi:x\fR (where x is the structure type name) +and individuals at the top level will be given a name \fInewsym\fR-ed +from the name of their type. +Thus \fI(create base x)\fR will make a default instance abbreviated +\fIi:x\fR and the first structure created with \fI(create individual x)\fR +will be abbreviated \fIx0\fR. +.IP 3. +\fIScopy\fR and related functions that create new structures from old +ones \fIgensym\fR the new structure's abbreviation from that of the +old structure. +.SH +11. Error Messages, Bugs, and Error Handling Abilities +.PP +Bugs, complaints and suggestions of useful features (to be added to +the current list of 30 or so things on the wish list) should be +mailed by electronic mail to \fBPearl\-Bugs@Berkeley\fR or +\fBucbvax!pearl\-bugs\fR. +.SH +12. Short-Circuiting and Redirecting Create Using !, $ and Atoms +.PP +If an atom is encountered where a value-description was expected in +any type of slot, and it is bound to a value of the right type, +its value is inserted into the slot. +For \fIsymbols\fR, this is done if the atom is not a symbol name. +For \fIstructures\fR, the atom must evaluate to a structure. +For \fILisp\fR slots, it must simply be bound. +For \fIsetof\fR slots, its value is checked for being of the appropriate +type, including depth of nesting. +.PP +Note also that a change in the internal representation has made it possible +to allow \fBeven atoms\fR in slots of type \fIlisp\fR. +.SH +13. More Flexible Hash Selection +.PP +Because we have never gotten around to adding fetch functions to take +advantage of colon and colon-colon hashing and these two methods +really are not useful in normal fetching, they are currently ignored. +.PP +For situations in which you wish to create an expanded structure and +add new hashing marks to an old slot (rather than replace them), +preceding new hash marks with a plus ("+") will cause the old +hashing information to be copied before processing the new hashing. +.PP +Thus, the sequence +.DS +(cb x (* a int)) +(ce x y (a ^)) +(ce x z (+ : a ^)) +(ce x w (: + a ^)) ; anomalous use of + +.DE +will result in: +.DS +* hashing in x, +no hashing in y, +both * and : hashing in z, and +only * hashing in w (because of misplacement of +). +.DE +.PP +Several new hashing methods have been added to PEARL. +.PP +A hashing mechanism using the label \fB***\fR has been added called +"triple-star hashing". +If slots are labeled with *** and \fBall\fR slots so marked are filled +with useful values, then the item is hashed under the type of structure +plus the values of all these slots. +During fetching, this is considered the most useful (that is, +specific) hash method. +.PP +A hashing mechanism using the label \fB&&\fR has been added called +"hash focusing". +It is designed for people using a data base all of +whose entries are of the same type (not required, just common +for this application) and enables the contents of a single slot +to be used to better discriminate them. +Examples of such structures are "planfors", inference rules, +or almost any other such extremely-common binary predicates. +If a slot labeled && is found when inserting into the database then +the item is hashed as if it were the item in the slot so labeled. +At fetching time, && is considered less useful than *** or ** +and more useful than * or nothing. +.PP +This differs from & (hash aliasing) in that hash focusing +affects how a structure itself is inserted and fetched, while +& simply affects how structures containing this type of +structure are treated. +For example, suppose the unique numbers of A, B, and C +respectively are 1, 2, and 3. +C is a symbol. +A has one slot X with * and && hashing. +B has one slot Y of type symbol with * hashing. +Then a structure like (A (X (B (Y C)))) will be indexed the +following ways and \fIfetcheverywhere\fR (see below) will find +it in the following order: the && method will be used first +which uses the 2 and 3 from B and its C, (ignoring the 1 of A), +and also simply 2 from B; +the * on A uses the type of B thus using 1 and 2; +it is also looked for under the 1 of A without using 2 or 3. +If B had an & in its slot then the * on A is affected by & on B thus +using 1 and 3 (ignoring the 2 of B). +.PP +Thus, if you consider A, B, and C to be three levels of information +in the structure, an item can be hashed under any combination of two +of those levels. +The normal * method uses levels 1 and 2, +the aliasing & method ignores level 2 and uses levels 1 and 3, +and the new focussing && method ignores level 1 and uses levels 2 and 3. +In addition, the item can be put under 1, 2 or 3 individually by +various combinations of marks (1 = none, 2 = :, 3 = :+&). +The only unavailable combination of the three is all of them. +.SH +16. Attaching Hooks to Structures (If-Added Demons) +.PP +Slot hooks are now always inherited and added to, rather than replaced. +If the hooks and predicates of a slot are preceded by \fBinstead\fR +then inheriting does not happen and hooks and predicates are replaced. +.PP +The atoms for path hooks were misnamed in such a way that you could not +use \fIhidden\fR and \fIvisible\fR. +Instead of \fI*rungethooks*\fR, and other \fI*run...hooks*\fR forms, +they are now \fB*rungetpathhooks*\fR and other \fB*run...pathhooks*\fR. +Note that they must be called as (\fIXXX\fRpath ...) and not +(path\ \fIXXX\fR ...) when used with \fIhidden\fR and \fIvisible\fR. +.SH +17. Creating and Manipulating Multiple Data Bases +.PP +The function \fIsetdbsize\fR can now be done at any time and +will remove all current databases before changing the size, +warn the user (if \fI*warn*\fR is set) and recreate \fI*maindb*\fR +with the special variable \fI*db*\fR pointing to it. +.PP +The function \fIcleardb\fR is now a local database clearer +and its effects do not extend up the database hierarchy. +.SH +19. Creating Expanded Subtypes of Previously Defined Objects +.PP +Hashing in old slots inherited by new expanded structures can now be +added to by preceding the new hash marks with plus ("+"). +See section 13 above. +.PP +The name of an old slot inherited by a new expanded structure may be +changed by following the new name by the old slotname preceded with +an equal sign. +Thus for example: +.DS +pearl> (create base X (A struct)) + (X (A (nilstruct))) +pearl> (create expanded X Y (B =A) (C .....)) + (Y (B (nilstruct)) (C .....))) +.DE +Note that there may not be a space between the equal sign and the slot +name since \fI=\fR is a read macro which expands \fI=A\fR into +\fI(*slot* A)\fR but leaves a single space-surrounded equal sign alone. +The actual effect is to add another name to the slot so that it can be +later referenced with either name. +.SH +20. Fetching Expanded Structures +.PP +A fetching function called \fBfetcheverywhere\fR exists which gathers +\fBall\fR the buckets the object could have been hashed into and +builds a stream out of all of them (potentially five buckets). +There is currently no "expanded" counterpart, since it has the potential +of returning \fI5 times the-depth-of-the-hierarchy\fR buckets. +.SH +21.2 The Matching Process +.PP +During matching, if an unbound global variable is set and +the match later fails, the value is restored to \fI*pearlunbound*\fR. +The names of variables that are set are saved in the special variable +\fB*globalsavestack*\fR. +.PP +Formerly, there was only one match function which was used by both +\fIstandardfetch\fR and \fIexpandedfetch\fR and which therefore would +match two structures if they were hierarchically related. +This is really inappropriate for the standard fetching, so +there are now two regular match functions, \fIstandardmatch\fR and +\fIbasicmatch\fR, which will only match two structures of the same type, +and two expanded match functions, \fIstandardexpandedmatch\fR and +\fIbasicexpandedmatch\fR, which will match two structures which are +related hierarchically (one above the other) on the slots they have +in common. +Streams built by \fIstandardfetch\fR use the regular versions and +and streams built by \fIexpandedfetch\fR use the expanded versions. +.PP +There are now two functions \fBmemmatch\fR and \fBmemstrequal\fR which +are like \fImemq\fR except that they use \fImatch\fR and \fIstrequal\fR +respectively instead of \fIeq\fR. +.PP +As of version 3.8, PEARL will now do \fBunification\fR of variables in +pattern matching. +To turn it on, call the function \fBuseunification\fR. +(The current implementation precludes turning it off once it is on but +this may be remedied in later versions if we can figure out what it +means to stop unifying.) +.SH +26. Looping and Copying Functions +.PP +The function \fIscopy\fR no longer deletes bound adjunct variables. +.PP +The standard Franz function \fIcopy\fR is no longer redefined since +the standard version now avoids the copying of hunks. +.PP +The functions \fIscopy\fR and \fIpatternize\fR are now exprs rather +than macros. +.PP +The new function \fBvarreplace\fR permanently "freezes" the values +of slots containing bound variables by replacing all bound variables +in an item with their values. +.PP +A variation on \fIscopy\fR called \fBintscopy\fR ("internal scopy") +is designed to do the copying as if the copied item were internal to +another outer item, thus sharing its local and block variables. +Its arguments are the item to be copied and the outer item in whose +scopy the copying should be done. +.SH +29. Appendix of UCI Lisp functions added to Franz PEARL +.PP +The definitions of \fIde\fR, \fIdf\fR, \fIdm\fR, \fIdrm\fR and \fIdsm\fR +have been modified so that if the special variable \fB*savedefs*\fR +is \fInil\fR then old definitions of functions are not saved. +This is especially useful in compiling (and as a result, assembly +and loading) since it will speed them up quite a bit. +This also disables the saving of the name of the file that the +definition was in. +The variable \fI*savedefs*\fR is normally \fIt\fR which causes these +macros to act as before, saving the definition, etc. +If \fI*savedefs*\fR is \fInil\fR, then they simply expand into the +appropriate \fIdefun\fR or \fIsetsyntax\fR. +The following lines should be included in a file to have this effect +only at compile time: +.DS +(eval-when (compile) + (declare (special *savedefs*)) + (setq *savedefs* nil)) +.DE +.LP +If you also want to permanently disable this feature in a lisp, that +loads \fIucisubset.l\fR, simply put a \fI(setq *savedefs* nil)\fR +in your \fI.lisprc\fR file AFTER the loading of \fIucisubset.l\fR. +.PP +The function \fIremove\fR is no longer made equivalent to Franz's +\fIdelete\fR so that Franz's \fIremove\fR can be used. +The functions \fInth\fR, \fIpush\fR and \fIpop\fR are no longer +defined by PEARL, since the new Franz versions are better. +(UCI Lisp users note: This switches the arguments to \fIpush\fR.) +.SH +32. Index of Global Variables and Functions With Their Arguments +.PP +All special variables in PEARL are now defined with \fIdefvar\fR so +that \fIfasl\fR'ing in \fIpearl.o\fR at compile time will automatically +declare them special again. +.PP +All the exprs whose names were of the form \fIXXXX1\fR where +\fIXXXX\fR was the name of a lexpr which was a principle function +of PEARL were eliminated (i.e., absorbed by the other form). +.SH +34. Compiling Lisp+PEARL Files. +.PP +To compile a file of mixed Lisp and PEARL functions with \fIliszt\fR, +you must first load in the function definitions and special +declarations of PEARL by loading the object code. +This is the file \fIpearl.o\fR which is normally kept in the +\fI/usr/lib/lisp\fR directory and will found automatically by +\fIload\fR. +.PP +Thus, the following should normally be included at the +beginning of a PEARL file you wish to compile: +.DS +(eval-when (compile) + (declare (special defmacro-for-compiling)) + (setq defmacro-for-compiling t) + (load 'pearl.o)) +(declare (macros t)) +.DE +.rm CF +.rm LH +.rm CH +.rm RH +.bp +.DS C +.LG +\fBUpdate of Changes +Through +PEARL 3.9 +April 1983 +.sp 1 +Table of Contents\fR +.SM +.DE +.DS L +1. Introduction \ka76 +2. Running PEARL \h'|\nau'76 + 2.1. Under Franz Lisp \h'|\nau'76 +5. Accessing Slots of Structures \h'|\nau'76 +10. Printing Structures, Symbols and Other PEARL Objects \h'|\nau'76 + 10.1. Abbreviations \h'|\nau'77 +11. Error Messages, Bugs, and Error Handling Abilities \h'|\nau'78 +12. Short-Circuiting and Redirecting \fICreate\fR Using !, $ and Atoms \h'|\nau'78 +13. More Flexible Hash Selection \h'|\nau'78 +16. Attaching Hooks to Structures (If-Added Demons) \h'|\nau'79 +17. Creating and Manipulating Multiple Data Bases \h'|\nau'80 +19. Creating Expanded Subtypes of Previously Defined Objects \h'|\nau'80 +20. Fetching Expanded Structures \h'|\nau'80 +21.2 The Matching Process \h'|\nau'80 +26. Looping and Copying Functions \h'|\nau'81 +29. Appendix of UCI Lisp functions added to Franz PEARL \h'|\nau'81 +32. Index of Global Variables and Functions With Their Arguments \h'|\nau'81 +34. Compiling Lisp+PEARL Files \h'|\nau'82 +.DE diff --git a/usr/src/usr.bin/lisp/pearl/vars.l b/usr/src/usr.bin/lisp/pearl/vars.l new file mode 100644 index 0000000000..40c07a74b0 --- /dev/null +++ b/usr/src/usr.bin/lisp/pearl/vars.l @@ -0,0 +1,380 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; vars.l ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Functions for declaring and creating pattern-matching variables +; and blocks and for freezing and thawing them. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (c) 1983 , The Regents of the University of California. +; All rights reserved. +; Authors: Joseph Faletti and Michael Deering. + +; Convert a question mark variable ?var to either (*global* var) if "var" +; is in *globallist* or else make it local (*var* var). +(drm \? + (lambda () + (let ((nextchar (tyipeek)) + var) + (cond ((\=& 9. nextchar) '\?) + ((\=& 10. nextchar) '\?) + ((\=& 13. nextchar) '\?) + ((\=& 32. nextchar) '\?) + ((\=& 41. nextchar) '\?) + ( t (setq var (read)) + (cond ((memq var *globallist*) + (list '*global* var)) + ( t (list '*var* var)))))))) + +; VALUEOF and VARVALUE are EXPR and FEXPR versions of a function to +; get the value of the variable VAR in the structure STRUCT. +(de valueof (var struct) + (getvalofequivorvar + (cdr (or (assq var (getalist struct)) + (assq var (getalistcp struct)) + (progn (msg t "VALUEOF: Variable " var + " does not occur in structure:" struct t) + (pearlbreak)))))) + +; This is a FEXPR version of valueof (above). +(df varvalue (l) ; (VAR STRUCT) + (let ((var (car l)) + (struct (eval (cadr l)))) + (getvalofequivorvar + (cdr (or (assq var (getalist struct)) + (assq var (getalistcp struct)) + (progn (msg t "VARVALUE: Variable " var + " does not occur in structure:" struct t) + (pearlbreak))))))) + +; Set the given variable, in the given environment (if present) to +; the value given. If no environment given, look first at +; *currentstructure*, then at *currentpearlstructure*, then at +; *blockstack*, else complain. +(df setv (l) ; (var 'val 'environment) + (let* + ((var (car l)) + (type (car var)) + (name (cadr var)) + (val (eval (cadr l))) + (environment (eval (caddr l))) + varcell + oldvarval) + (cond ((eq '*global* type) ; global variable. + (setq oldvarval (eval name)) + (set name val)) + ((eq '*var* type) ; local or block variable. + (cond (environment + ; optional 3rd argument given for environment. + (cond ((structurep environment) + (setq varcell + (or (assq name (getalist environment)) + (assq name (getalistcp environment)) + (progn (msg t "SETV: No variable named: " name + " in structure: " t environment t) + (pearlbreak))))) + ((blockp environment) + (setq varcell + (or (assq name environment) + (progn (msg t "SETV: No variable named: " name + " in block: " t environment t) + (pearlbreak))))) + ( t (msg t "SETV: Given environment is neither " + "a block nor a structure: " t environment) + (pearlbreak)))) + ; otherwise, try to find in standard environment. + ((setq varcell + (or (and (structurep *currentstructure*) + (or (assq name (getalist *currentstructure*)) + (assq name (getalistcp *currentstructure*)) + )) + (and (structurep *currentpearlstructure*) + (or (assq name + (getalist *currentpearlstructure*)) + (assq name + (getalistcp *currentpearlstructure*)) + )) + (and *blockstack* + (assq name (cdar *blockstack*)))))) + ( t ; Else if not there either, blow up. + (msg t "SETV: No variable in the current" + " environment named: " name t) + (pearlbreak))) + ; Successfully found the variable. + (and varcell + (setq oldvarval (cdr varcell)) + (rplacd varcell val))) + ( t (msg t "SETV: " var " is not a variable." t) + (pearlbreak))) + (and (equivclassp oldvarval) + (mapc (funl (newvar) (cond ((dtpr newvar) ; a local var cell. + (and (eq (cdr newvar) oldvarval) + (rplacd newvar val))) + ( t ; otherwise a global var's name. + (and (eq (eval newvar) oldvarval) + (set newvar val))))) + (cdr oldvarval))) + val)) + +; Get the value of a local variable. Look in the same places as +; SETV above but return nil if not found. +(df *var* (l) + (let ((var (car l))) + (getvalofequivorvar + (cdr (or (and (structurep *currentstructure*) + (or (assq var (getalist *currentstructure*)) + (assq var (getalistcp *currentstructure*)))) + (and (structurep *currentpearlstructure*) + (or (assq var (getalist *currentpearlstructure*)) + (assq var + (getalistcp *currentpearlstructure*)))) + (and *blockstack* + (assq var (cdar *blockstack*)))))))) + +; Get the value of a global variable. +(df *global* (l) + (getvalofequivorvar + (eval (car l)))) + +; Declare a variable to be GLOBAL by entering it on the *GLOBALLIST* +; and PEARL-unbinding it. +(df global (l) + (let ((variable (car l))) + (set variable (punbound)) + (push variable *globallist*) + variable)) + +; PEARL-unbind a global variable. ("unbindvars" does the local variables +; in an entire structure (see match.l)). +(df unbind (l) + (let ((var (car l))) + (cond ((memq var *globallist*) + (set var (punbound))) + ( t (set var (punbound)) + (and *warn* + (msg t "UNBIND: Warning: " var + " is not a global variable but unbound it anyway." + t)))))) + +; Determine if the variable is GLOBAL, i.e., on the *GLOBALLIST* +(de globalp (variable) + (memq variable *globallist*)) + +; (BLOCK ()) starts a (possibly embedded) +; set of variables accessible to all structure CREATEd within +; the block. Terminated by a call to (ENDBLOCK ). +; The name is optional. If used, then the block may be reaccessed +; with b:. + +(df block (l) + (let ((name (car l)) + varlist + alist) + (cond ((reallitatom name) (setq varlist (cadr l))) + ( t (setq varlist name) + (setq name 'unnamedblock))) + (setq alist + (nconc (ncons (cons nil (punbound))) ; Cell for Frozen vars. + (mapcar (funl (varname) (cons varname (punbound))) + varlist) + (cond (*blockstack* (cdar *blockstack*)) + ( t nil)))) + (and name + (set name alist)) + ; Create a special cons cell, point b: at it and push it. + (push (set (blockatom name) + (cons name alist)) + *blockstack*) + name)) + +; (ENDBLOCK ) ends the block with name . +; If is * then close one block, regardless of name. +; If is nil then close one unnamed block only. +(df endblock (l) + (let ((name (car l))) + (and (null name) + (setq name 'unnamedblock)) + (cond ((not *blockstack*) + (msg t "ENDBLOCK: No blocks to end") + (msg ", not even named: " name t) + (pearlbreak)) + ((or (eq name '*) + (eq name (caar *blockstack*))) + (prog1 (caar *blockstack*) + (setq *blockstack* (cdr *blockstack*)))) + ( t (msg t "ENDBLOCK: Block to be ended, " + name " doesn't match innermost block, named: " + (caar *blockstack*) t) + (pearlbreak))))) + +; (ENDANYBLOCKS ) ends all blocks back through the block +; with name . +; If is * then end all blocks. +; If is nil then end all blocks back through the +; last unnamed block. +(df endanyblocks (l) + (let ((name (car l)) + (block *blockstack*)) + (cond ((not *blockstack*) nil) + ((eq name '*) (setq *blockstack* nil)) + ((null (while (and block + (neq (caar block) name)) + (setq block (cdr block)))) + (msg t "ENDANYBLOCKS: No currently open block named " + name " to end blocks back to." t) + (pearlbreak)) + ( t (setq *blockstack* (pop block)) + (caar *blockstack*))) + t)) + +; (ENDALLBLOCKS ) ends any open blocks, regardless of name. +(de endallblocks () + (setq *blockstack* nil) + t) + +; (SETBLOCK ) changes the current scope to that of +; , BUT doesn't allow ending former blocks! +(df setblock (l) + (let ((blockname (car l))) + (cond ((and (boundp (blockatom blockname)) + (blockp (eval (blockatom blockname)))) + (setq *blockstack* (eval (blockatom blockname)))) + ( t (msg t "SETBLOCK: There is no block named: " blockname t) + (pearlbreak))))) + +; Take all the bound variables off the STRUCT'S ALIST, and put them on +; the ALISTCP, preserving unique alist pairs. Also take care of all the +; BLOCK alists. WARNING: This code is tough so be careful with it! +(de freezebindings (struct) + (let ((oldalist (getalist struct)) ; to be frozen. + (unboundalist (ncons nil)) ; to still unbound variables. + (boundalist (getalistcp struct)) ; already frozen. + rest + currentblock) + ; While there are more variables to process, and we haven't reached + ; a block, add either to "unboundalist" or "boundalist". + (while (and oldalist + (reallitatom (caar oldalist))) + (setq rest (cdr oldalist)) + (cond ((eq (cdar oldalist) (punbound)) + (tconc unboundalist (car oldalist))) + ( t (setq boundalist (rplacd oldalist boundalist)))) + (setq oldalist rest)) + (and oldalist + (rplaca unboundalist + (nconc (car unboundalist) + oldalist))) ; pointer to the enclosing blocks. + ; Store new lists. + (putalist (car unboundalist) struct) + (putalistcp boundalist struct) + ; Process blocks one at a time. + (while oldalist + (setq currentblock oldalist) + (setq oldalist (cdr oldalist)) + (setq unboundalist (ncons nil)) + (setq boundalist (caar currentblock)) + (while (and oldalist + (reallitatom (caar oldalist))) + (setq rest (cdr oldalist)) + (cond ((eq (cdar oldalist) (punbound)) + (tconc unboundalist (car oldalist))) + ( t (setq boundalist (rplacd oldalist boundalist)))) + (setq oldalist rest)) + (and oldalist + (rplaca unboundalist + (nconc (car unboundalist) + oldalist))) ; pointer to the enclosing blocks. + ; store frozen vars. + (rplaca (car currentblock) boundalist) + (rplacd currentblock (car unboundalist))) + t)) + +; Take all the bound variables off the STRUCT's ALIST, and put them on +; the ALISTCP, preserving unique alist pairs. +(de freezestruct (struct) + (let ((oldalist (getalist struct)) + (unboundalist (ncons nil)) + (boundalist (getalistcp struct)) + rest) + (while (and oldalist ; is not NIL, and + (reallitatom (caar oldalist))) ; have not reached block + (setq rest (cdr oldalist)) + (cond ((eq (cdar oldalist) (punbound)) + (tconc unboundalist (car oldalist))) + ( t (setq boundalist (rplacd oldalist boundalist)))) + (setq oldalist rest)) + (and oldalist + (rplaca unboundalist + (nconc (car unboundalist) + oldalist))) ; pointer to the enclosing blocks. + (putalist (car unboundalist) struct) + (putalistcp boundalist struct) + t)) + +(df freezeblock (blockname) + (let (block + oldalist + unboundalist + boundalist + rest) + (cond ((and (boundp (blockatom (car blockname))) + (setq block (eval (blockatom (car blockname)))) + (blockp block))) + ( t (msg t "FREEZEBLOCK: " blockname + " is not the name of a block." t) + (pearlbreak))) + (setq oldalist (cddr block)) + (setq unboundalist (ncons nil)) + (setq boundalist (caadr block)) + (while (and oldalist + (reallitatom (caar oldalist))) + (setq rest (cdr oldalist)) + (cond ((eq (cdar oldalist) (punbound)) + (tconc unboundalist (car oldalist))) + ( t (setq boundalist (rplacd oldalist boundalist)))) + (setq oldalist rest)) + (and oldalist + (rplaca unboundalist + (nconc (car unboundalist) + oldalist))) ; pointer to the enclosing blocks. + (rplaca (cadr block) boundalist) ; store frozen vars. + (rplacd (cdr block) (car unboundalist)) + t)) + +(dm findnextblockstart (none) ; But expects ALIST + '(while (and alist + (reallitatom (caar alist))) + (setq alist (cdr alist)))) + +; This is for JUST THE STRUCT. +(de thawstruct (struct) + (let ((alist (getalist struct))) + (putalist (nconc (getalistcp struct) alist) struct) + (putalistcp nil struct) + t)) + +; Restore the Alist to include all values. (Undo FREEZEBINDINGS) +; This is done for ALL BLOCKs that STRUCT is a member of. +(de thawbindings (struct) + (let ((alist (getalist struct))) + (putalist (nconc (getalistcp struct) alist) struct) + (putalistcp nil struct) + (while (findnextblockstart) + (rplacd alist (nconc (caar alist) (cdr alist))) + (rplaca (car alist) nil)) + t)) + +; This is for JUST ONE BLOCK. +(df thawblock (blockname) + (let (alist + block) + (cond ((and (boundp (blockatom (car blockname))) + (setq block (eval (blockatom (car blockname)))) + (blockp block)) + block) + ( t (msg t "THAWBLOCK: " blockname + " is not the name of a block." t) + (pearlbreak))) + (setq alist (cddr block)) + (rplacd (cdr block) (nconc (caadr block) alist)) + (rplaca (cadr block) nil) + t)) + + +; vi: set lisp: -- 2.20.1