diff options
Diffstat (limited to 'lang/lisp')
| -rw-r--r-- | lang/lisp/1.7.2/src/lisp.1 | 1305 | ||||
| -rw-r--r-- | lang/lisp/1.7.2/src/lisp.2 | 550 | ||||
| -rw-r--r-- | lang/lisp/1.7.2/src/lisp.3 | 142 | ||||
| -rw-r--r-- | lang/lisp/1.7.2/src/lisp.4 | 766 | ||||
| -rw-r--r-- | lang/lisp/1.7.2/src/lisp.bootstrap | 117 | ||||
| -rw-r--r-- | lang/lisp/1.8.7/doc/lisp handbuch | 2260 | ||||
| -rw-r--r-- | lang/lisp/1.8.7/source-disk | 1 | ||||
| -rw-r--r-- | lang/lisp/1.8.7/src/"15"TAB2"14" | bin | 0 -> 22528 bytes | |||
| -rw-r--r-- | lang/lisp/1.8.7/src/lisp.1 | 1306 | ||||
| -rw-r--r-- | lang/lisp/1.8.7/src/lisp.2 | 584 | ||||
| -rw-r--r-- | lang/lisp/1.8.7/src/lisp.3 | 767 | ||||
| -rw-r--r-- | lang/lisp/1.8.7/src/lisp.4 | 143 | ||||
| -rw-r--r-- | lang/lisp/1.8.7/src/lisp.bootstrap | 118 |
13 files changed, 8059 insertions, 0 deletions
diff --git a/lang/lisp/1.7.2/src/lisp.1 b/lang/lisp/1.7.2/src/lisp.1 new file mode 100644 index 0000000..6851947 --- /dev/null +++ b/lang/lisp/1.7.2/src/lisp.1 @@ -0,0 +1,1305 @@ +PACKET lisp heap and oblist management (* Autor: J.Durchholz *)
+ (* Datum: 09.05.1984 *)
+ DEFINES (* Version 1.7.2 *)
+ (* hey 25.2.83 *)
+ initialize lisp system,
+ dump lisp heap,
+ lisp storage,
+ collect lisp heap garbage,
+ SYM,
+ :=,
+ nil,
+ pname,
+ head,
+ set head,
+ tail,
+ set tail,
+ cons,
+ eq,
+ equal,
+ null,
+ atom,
+ is named atom,
+ begin oblist dump,
+ next atom,
+ new atom,
+ create atom,
+ delete atom,
+ begin property list dump,
+ next property,
+ add property,
+ alter property,
+ property,
+ delete property,
+ property exists,
+ add flag,
+ flag,
+ delete flag,
+ text,
+ is text,
+ character,
+ is character,
+ sym character,
+ int 1,
+ int 2,
+ is int pair,
+ sym:
+
+
+(* NOTE: All internal routines are prefixed by x *)
+
+
+(***************************** heap management ****************************)
+
+LET
+ max size = 32767,
+ NODE = STRUCT (INT status,
+ head, tail);
+LET HEAP = STRUCT (INT size,
+ ROW max size NODE node);
+
+
+BOUND HEAP VAR heap;
+
+
+PROC initialize lisp system (DATASPACE CONST ds):
+ IF type (ds) < 0 THEN
+ heap := ds;
+ x initialize oblist and heap size;
+ create atom ("NIL");
+ create atom ("PNAME");
+ ELSE
+ heap := ds
+ FI
+END PROC initialize lisp system;
+
+
+PROC dump lisp heap (FILE VAR f):
+ put line (f, "Groesse :" + text (CONCR (heap).size));
+ line (f);
+ put (CONCR (heap).size);
+ BOOL VAR is char := FALSE;
+ INT VAR i;
+ FOR i FROM 1 UPTO CONCR (heap).size REP
+ cout (i);
+ dump ith node
+ PER.
+
+dump ith node:
+ put (f, text (i, 6));
+ put (f, status);
+ put (f, head);
+ put (f, tail);
+ line (f).
+
+status:
+ SELECT ith node.status OF
+ CASE atomic : "ATOMIC............"
+ CASE non atomic : "NON ATOMIC........"
+ CASE oblist bone : "OBLIST BONE......."
+ CASE property indicator : "PROPERTY INDICATOR"
+ CASE property root : "PROPERTY ROOT....."
+ CASE flag indicator : "FLAG INDICATOR...."
+ CASE text data : "TEXT DATA........."
+ CASE character data : is char := TRUE; "CHARACTER DATA...."
+ CASE int data : "INT DATA.........."
+ OTHERWISE "????." + text (ith node.status, 6) + ".????"
+ END SELECT.
+
+head:
+ maybe a code + text (ith node.head, 6).
+
+maybe a code:
+ IF is char THEN
+ is char := FALSE;
+ IF ith node.head > 31 AND 128 > ith node.head THEN
+ " " + code (ith node.head) + " "
+ ELSE
+ " "
+ FI
+ ELSE
+ " "
+ FI.
+
+tail:
+ text (ith node.tail, 6).
+
+ith node:
+ CONCR (heap).node (i).
+
+END PROC dump lisp heap;
+
+
+PROC lisp storage (INT VAR size, used):
+ size := max size;
+ used := CONCR (heap).size
+END PROC lisp storage;
+
+
+PROC collect lisp heap garbage:
+ mark all used nodes;
+ transfer all used high address nodes to unused low address nodes;
+ adjust all pointers to cleared high address area and unmark all nodes;
+ adjust size.
+
+mark all used nodes:
+ INT VAR i;
+ FOR i FROM 2 UPTO 28 REP
+ x mark (i)
+ PER.
+
+transfer all used high address nodes to unused low address nodes:
+ INT VAR high address :: CONCR (heap).size + 1,
+ low address :: 0;
+ REP
+ find next lower used high address node;
+ IF no used high address node found THEN
+ LEAVE transfer all used high address nodes to unused low address nodes
+ FI;
+ find next higher unused low address node;
+ IF no unused low address node found THEN
+ LEAVE transfer all used high address nodes to unused low address nodes
+ FI;
+ transfer high address node to low address node
+ PER.
+
+find next lower used high address node:
+ REP
+ high address DECR 1
+ UNTIL high address node marked PER.
+
+high address node marked:
+ high address node.status < 0.
+
+no used high address node found:
+ low address = high address.
+
+find next higher unused low address node:
+ REP
+ low address INCR 1
+ UNTIL low address node not marked OR low address = high address PER.
+
+low address node not marked:
+ low address node.status > 0.
+
+no unused low address node found :
+ low address = high address.
+
+transfer high address node to low address node:
+ low address node.status := high address node.status;
+ low address node.head := high address node.head;
+ low address node.tail := high address node.tail;
+ high address node.head := low address.
+
+adjust all pointers to cleared high address area and unmark all nodes:
+ (* 'high address' should now point to the last node of the used area *)
+ FOR low address FROM 1 UPTO high address REP
+ unmark low address node;
+ SELECT low address node.status OF
+ CASE oblist bone: adjust head
+ CASE atomic,
+ non atomic,
+ property indicator,
+ property root,
+ flag indicator: adjust head; adjust tail
+ CASE text data, character data: adjust tail
+ CASE int data:
+ OTHERWISE x lisp error ("Status " + text (low address node.status) +
+ " gefunden bei pointer Justage")
+ END SELECT
+ PER.
+
+unmark low address node:
+ low address node.status := - low address node.status.
+
+adjust head:
+ IF low address node.head > high address THEN
+ low address node.head := node (low address node.head).head
+ FI.
+
+adjust tail:
+ IF low address node.tail > high address THEN
+ low address node.tail := node (low address node.tail).head
+ FI.
+
+adjust size:
+ CONCR (heap).size := high address.
+
+low address node:
+ node (low address).
+
+high address node:
+ node (high address).
+
+node:
+ CONCR (heap).node.
+
+END PROC collect lisp heap garbage;
+
+
+PROC x mark (INT CONST ptr):
+ IF node not yet marked THEN
+ mark node;
+ SELECT - ptr node.status OF
+ CASE oblist bone: x mark (ptr node.head)
+ CASE atomic,
+ non atomic,
+ property indicator,
+ property root,
+ flag indicator: x mark (ptr node.head); x mark (ptr node.tail)
+ CASE text data, character data: x mark (ptr node.tail)
+ CASE int data:
+ OTHERWISE error stop ("Status " + text (- ptr node.status) +
+ " gefunden beim Markieren")
+ END SELECT
+ FI.
+
+
+node not yet marked:
+ ptr node.status > 0.
+
+mark node:
+ ptr node.status := - ptr node.status.
+
+ptr node:
+ CONCR (heap).node (ptr)
+
+END PROC x mark;
+
+
+TYPE SYM = INT;
+
+
+OP := (SYM VAR left, SYM CONST right):
+ CONCR (left) := CONCR (right)
+END OP :=;
+
+
+LET atomic = 1,
+ non atomic = 2,
+ oblist bone = 3,
+ property indicator = 4,
+ property root = 5,
+ flag indicator = 6,
+ text data = 7,
+ character data = 8,
+ int data = 9;
+
+SYM CONST nil :: SYM :(35), (* 'x initialize oblist and heap size' will *)
+ pname :: SYM :(44); (* place the atom NIL at node 35 and PNAME *)
+ (* at node 44 *)
+
+
+(***************************** basic functions ****************************)
+
+
+SYM PROC head (SYM CONST sym):
+ SELECT status of sym OF
+ CASE atomic: error stop ("Atome haben keinen head"); nil
+ CASE non atomic: SYM :(head of sym)
+ CASE oblist bone,
+ property indicator,
+ property root,
+ flag indicator : x lisp error ("Versteckter Knoten, Type:" +
+ text (status of sym));
+ nil
+ CASE text data,
+ character data,
+ int data : error stop ("Daten haben keinen head"); nil
+ OTHERWISE x lisp error ("Illegaler Status " + text (status of sym));
+ nil
+ END SELECT.
+
+status of sym:
+ sym node.status.
+
+head of sym:
+ sym node.head.
+
+sym node:
+ CONCR (heap).node (CONCR (sym))
+
+END PROC head;
+
+
+SYM PROC x head (SYM CONST sym):
+ SYM :(CONCR (heap).node (CONCR (sym)).head)
+END PROC x head;
+
+
+PROC set head (SYM CONST sym, new head):
+ SELECT status of sym OF
+ CASE atomic: errorstop ("Atome haben keinen head")
+ CASE non atomic: head of sym := CONCR (new head)
+ CASE oblist bone,
+ property indicator,
+ property root,
+ flag indicator : x lisp error ("Versteckter Knoten, Type:" +
+ text (status of sym))
+ CASE text data,
+ character data,
+ int data : error stop ("Daten haben keinen head")
+ OTHERWISE x lisp error ("Illegaler Status " + text (status of sym))
+ END SELECT.
+
+status of sym:
+ sym node.status.
+
+head of sym:
+ sym node.head.
+
+sym node:
+ CONCR (heap).node (CONCR (sym)).
+
+END PROC set head;
+
+
+PROC x set head (SYM CONST sym, new head):
+ CONCR (heap).node (CONCR (sym)).head := CONCR (new head)
+END PROC x set head;
+
+
+SYM PROC tail (SYM CONST sym):
+ SELECT status of sym OF
+ CASE atomic: error stop ("Atome haben keinen tail"); nil
+ CASE non atomic: SYM :(tail of sym)
+ CASE oblist bone,
+ property indicator,
+ flag indicator : x lisp error ("Versteckter Knoten:" +
+ text (status of sym));
+ nil
+ CASE text data,
+ character data,
+ int data : error stop ("Daten haben keinen tail"); nil
+ OTHERWISE x lisp error ("Illegaler Status: "+ text (status of sym));
+ nil
+ END SELECT.
+
+status of sym:
+ sym node.status.
+
+tail of sym:
+ sym node.tail.
+
+sym node:
+ CONCR (heap).node (CONCR (sym)).
+
+END PROC tail;
+
+
+SYM PROC x tail (SYM CONST sym):
+ SYM :(CONCR (heap).node (CONCR (sym)).tail)
+END PROC x tail;
+
+
+PROC set tail (SYM CONST sym, new tail):
+ SELECT status of sym OF
+ CASE atomic: error stop ("Atome haben keinen tail")
+ CASE non atomic: tail of sym := CONCR (new tail)
+ CASE oblist bone,
+ property indicator,
+ property root,
+ flag indicator : x lisp error ("Versteckter Knoten, Type: " +
+ text (status of sym))
+ CASE text data,
+ character data,
+ int data : error stop ("Daten tails sind unveraenderbar")
+ OTHERWISE x lisp error ("Illegaler Status: " + text (status of sym))
+ END SELECT.
+
+status of sym:
+ sym node.status.
+
+tail of sym:
+ sym node.tail.
+
+sym node:
+ CONCR (heap).node (CONCR (sym)).
+
+END PROC set tail;
+
+
+PROC x set tail (SYM CONST sym, new tail):
+ CONCR (heap).node (CONCR (sym)).tail := CONCR (new tail)
+END PROC x set tail;
+
+
+SYM PROC cons (SYM CONST head, tail):
+ SYM VAR result;
+ search free node;
+ result node.status := non atomic;
+ result node.head := CONCR (head);
+ result node.tail := CONCR (tail);
+ result.
+
+search free node:
+ IF CONCR (heap).size = max size THEN
+ error stop ("LISP Heap Ueberlauf");
+ LEAVE cons WITH nil
+ ELSE
+ CONCR (heap).size INCR 1;
+ CONCR (result) := CONCR (heap).size; cout(CONCR(result))
+ FI.
+
+result node:
+ CONCR (heap).node (CONCR (result)).
+
+END PROC cons;
+
+
+BOOL PROC eq (SYM CONST sym 1, sym 2):
+ CONCR (sym 1) = CONCR (sym 2)
+END PROC eq;
+
+
+BOOL PROC equal (SYM CONST sym 1, sym 2):
+ eq (sym 1, sym 2) COR have same value.
+
+have same value:
+ IF sym 1 node.status <> sym 2 node.status THEN
+ FALSE
+ ELSE
+ SELECT sym 1 node.status OF
+ CASE atomic: FALSE
+ CASE non atomic: equal (head (sym 1), head (sym 2)) CAND
+ equal (tail (sym 1), tail (sym 2))
+ CASE oblist bone,
+ property indicator,
+ property root,
+ flag indicator: x lisp error ("Versteckter Knoten, Type: " +
+ text (x status (sym 1))); FALSE
+ CASE text data: equal texts
+ CASE character data: sym 1 node.head = sym 2 node.head
+ CASE int data: sym 1 node.head = sym 2 node.head AND
+ sym 1 node.tail = sym 2 node.tail
+ OTHERWISE x lisp error ("Ilegaler Status " + text (x status (sym 1)));
+ FALSE
+ END SELECT
+ FI.
+
+equal texts:
+ equal length CAND equal character sequence.
+
+equal length:
+ eq (x head (sym 1), x head (sym 2)).
+
+equal character sequence:
+ SYM VAR actual sym 1 character :: sym 1,
+ actual sym 2 character :: sym 2;
+ INT VAR i;
+ FOR i FROM 1 UPTO sym 1 node. head REP
+ actual sym 1 character := x tail (actual sym 1 character);
+ actual sym 2 character := x tail (actual sym 2 character);
+ IF eq (actual sym 1 character, actual sym 2 character) THEN
+ LEAVE equal character sequence WITH TRUE
+ FI;
+ IF x status (actual sym 1 character) <> character data OR
+ x status (actual sym 2 character) <> character data THEN
+ x lisp error ("Ungueltiges Zeichen im text");
+ LEAVE equal character sequence WITH FALSE
+ FI;
+ IF CONCR (x head (actual sym 1 character)) <>
+ CONCR (x head (actual sym 2 character)) THEN
+ LEAVE equal character sequence WITH FALSE
+ FI
+ PER;
+ TRUE.
+
+sym 1 node:
+ CONCR (heap).node (CONCR (sym 1)).
+
+sym 2 node:
+ CONCR (heap).node (CONCR (sym 2)).
+
+END PROC equal;
+
+
+BOOL PROC null (SYM CONST sym):
+ CONCR (sym) = CONCR (nil)
+END PROC null;
+
+
+BOOL PROC atom (SYM CONST sym):
+ SELECT x status (sym) OF
+ CASE atomic,
+ text data,
+ character data,
+ int data: TRUE
+ CASE non atomic: FALSE
+ CASE oblist bone,
+ property indicator,
+ property root,
+ flag indicator : x lisp error ("Versteckter Knoten, Type:" +
+ text (x status (sym))); TRUE
+ OTHERWISE x lisp error ("Illegaler Status " +
+ text (x status (sym))); TRUE
+ END SELECT
+END PROC atom;
+
+
+BOOL PROC is named atom (SYM CONST sym):
+ x status (sym) = atomic
+END PROC is named atom;
+
+
+(*------------------- internal heap management routines ------------------*)
+
+
+SYM PROC x new node (INT CONST status, head, tail):
+ IF CONCR (heap).size = max size THEN
+ error stop ("LISP Heap Ueberlauf"); nil
+ ELSE
+ CONCR (heap).size INCR 1;
+ new node.status := status;
+ new node.head := head;
+ new node.tail := tail;
+ SYM :(CONCR (heap).size)
+ FI.
+
+new node:
+ node (CONCR (heap).size).
+
+node:
+ CONCR (heap).node.
+
+END PROC x new node;
+
+
+INT PROC x status (SYM CONST sym):
+ CONCR (heap).node (CONCR (sym)).status
+END PROC x status;
+
+
+(**************************** oblist management ***************************)
+
+
+(* Oblist organization:
+
+(NOTE:
+
+ +-----------------+
+ l <status> l
+ All nodes are represented as +--------+--------+ in all comments
+ l <head> l <tail> l of this packet.
+ +--------+--------+
+
+END OF NOTE)
+
+
+The 'oblist' (object list) is organized as follows:
+
+ +-------------+
+ l oblist bone l
+ +------+------+ +--> list of all atoms whose print names begin with "@"
+ l o l XXXX l l
+ +---+--+------+ l
+ +------------+
+ +-------------+
+ l oblist bone l
+ +------+------+ +--> list of all atoms whose print names begin with "A"
+ l o l XXXX l l
+ +---+--+------+ l
+ +------------+
+ .
+ .
+ .
+
+ +-------------+
+ l oblist bone l
+ +------+------+ +--> list of all atoms whose print names begin with "Z"
+ l o l XXXX l l
+ +---+--+------+ l
+ +------------+
+
+
+These nodes with status 'oblist bone' form the oblist skeleton. As long as
+the lisp heap exists, they are stored contiguously in nodes 2 - 28; they
+cannot be changed directly by the user. This way of storing the oblist
+skeleton allows a hashing scheme to be applied when searching for an atom
+with a given name. The hash width of 27 is the smallest one thas distributes
+all atoms according to their character; with a smaller hash size, two or
+more lists would be merged, with the effect that some of the atom lists
+would contain atoms beginning with different characters.
+
+
+The list of all atoms whose print names begin with a certain character
+is organized as follows:
+
+ +-------------+
+ l atomic l
+ +------+------+
+ l o l o---+--> property list of first atom
+ +---+--+------+
+ l
+ V
+ +-------------+
+ l atomic l
+ +------+------+
+ l o l o---+--> property list of 2nd atom
+ +---+--+------+
+ l
+ V
+ .
+ .
+ .
+
+ l
+ V
+ +-------------+
+ l atomic l
+ +------+------+
+ l o l o---+--> property list of last atom
+ +---+--+------+
+ l
+ V
+ oblist bone where the atom list began
+
+
+These lists cannot be acessed directly by the user, too.
+*)
+
+
+
+PROC x initialize oblist and heap size:
+ node (1).status := text data;
+ node (1).head := 32 (* blank *);
+ node (1).tail := 1;
+ INT VAR i;
+ FOR i FROM 2 UPTO 28 REP
+ node (i).status := oblist bone;
+ node (i).head := i
+ PER;
+ CONCR (heap).size := 28.
+
+node:
+ CONCR (heap).node.
+
+END PROC x initialize oblist and heap size;
+
+
+(*++++++++++++++++++++++++++++++ oblist dump +++++++++++++++++++++++++++++*)
+
+
+SYM VAR actual oblist bone :: SYM :(0),
+ actual atom :: SYM :(0);
+
+
+PROC begin oblist dump:
+ actual oblist bone := SYM :(2);
+ actual atom := SYM :(2)
+END PROC begin oblist dump;
+
+
+SYM PROC next atom:
+ actual atom := x head (actual atom);
+ WHILE no more atoms in this atom list REP
+ try next oblist bone
+ PER;
+ actual atom.
+
+no more atoms in this atom list:
+ (* NIL is given as last atom when 'next atom' is called repeatedly, so *)
+ (* it can serve as a terminator. So NIL "does not count" if it is *)
+ (* encountered during one of the calls. *)
+ IF null (actual atom) THEN
+ actual atom := x head (actual atom)
+ FI;
+ eq (actual atom, actual oblist bone).
+
+try next oblist bone:
+ IF actual oblist bone is last oblist bone THEN
+ actual atom := SYM :(2);
+ LEAVE next atom WITH nil
+ FI;
+ CONCR (actual oblist bone) INCR 1;
+ actual atom := x head (actual oblist bone).
+
+actual oblist bone is last oblist bone:
+ CONCR (actual oblist bone) = 28.
+
+END PROC next atom;
+
+
+(*+++++++++++++++++++++++ atom search and creation +++++++++++++++++++++++*)
+
+
+SYM VAR predecessor, result;
+ (* Variables used for communication between the internal search *)
+ (* procedures and the procedures calling them. *)
+
+
+SYM PROC atom (TEXT CONST name):
+ x search atom (name);
+ IF atom not already existing THEN
+ nil
+ ELSE
+ result
+ FI.
+
+atom not already existing:
+ x status (result) = oblist bone.
+
+END PROC atom;
+
+
+SYM PROC new atom (TEXT CONST name):
+ x search atom (name);
+ IF atom not already existing THEN
+ x create new atom (name);
+ FI;
+ result.
+
+atom not already existing:
+ x status (result) = oblist bone.
+
+END PROC new atom;
+
+
+PROC create atom (TEXT CONST name):
+ x search atom (name);
+ IF atom already existing THEN
+ error stop ("Atom " + name + " existiert bereits")
+ ELSE
+ x create new atom (name)
+ FI.
+
+atom already existing:
+ x status (result) <> oblist bone.
+
+END PROC create atom;
+
+
+PROC delete atom (SYM CONST atom):
+ IF is named atom (atom) THEN
+ IF null (atom) OR eq (atom, pname) THEN
+ error stop ("Dies Atom darf nicht geloescht werden")
+ ELSE
+ search predecessor;
+ delete atom from atom list
+ FI
+ ELSE
+ error stop ("Nur benannte Atome k”nnen geloescht werden")
+ FI.
+
+search predecessor:
+ predecessor := x head (atom);
+ WHILE NOT eq (x head (predecessor), atom) REP
+ predecessor := x head (predecessor)
+ PER.
+
+delete atom from atom list:
+ x set head (predecessor, x head (atom)).
+
+END PROC delete atom;
+
+
+PROC x search atom (TEXT CONST name):
+ CONCR (result) := (code (name SUB 1) + 17) MOD 27 + 2;
+ (* This formula places the list of atoms beginning with "@" at the *)
+ (* first oblist bone, the list of atoms beginning with "A" at the *)
+ (* at the second one, and so on. (See also the big comment in lines *)
+ (* 600 - 700) *)
+ REP
+ predecessor := result;
+ result := x head (predecessor);
+ UNTIL end of atom list reached COR right atom found PER.
+
+end of atom list reached:
+ x status (result) = oblist bone.
+
+right atom found:
+ SYM VAR actual character node := property (result, pname);
+ IF NOT is text (actual character node) THEN
+ x lisp error ("Namen erwartet");
+ LEAVE right atom found WITH FALSE
+ FI;
+ IF CONCR (x head (actual character node)) <> length (name) THEN
+ FALSE
+ ELSE
+ INT VAR i;
+ FOR i FROM 1 UPTO length (name) REP
+ to next character node;
+ check wether is character data node;
+ check wether character matches;
+ PER;
+ TRUE
+ FI.
+
+to next character node:
+ actual character node := x tail (actual character node).
+
+check wether is character data node:
+ IF x status (actual character node) <> character data THEN
+ x lisp error ("Zeichenkette erwartet");
+ LEAVE right atom found WITH FALSE
+ FI.
+
+check wether character matches:
+ IF code (name SUB i) <> CONCR (x head (actual character node)) THEN
+ LEAVE right atom found WITH FALSE
+ FI.
+
+END PROC x search atom;
+
+
+PROC x create new atom (TEXT CONST name):
+ (* It is necessary that 'x search atom' has been executed before *)
+ (* calling 'x create new atom' because this procedure relies on the *)
+ (* value of 'predecessor'. *)
+ enable stop;
+ SYM CONST sym name :: sym (name);
+ IF CONCR (heap).size + 3 > max size THEN
+ error stop ("LISP Heap Ueberlauf")
+ FI;
+ result := newly created atom;
+ x set head (predecessor, result).
+
+newly created atom:
+ x new node (atomic, CONCR (oblist bone node), CONCR (property list)).
+
+oblist bone node:
+ x head (predecessor).
+
+property list:
+ x new node (property indicator, CONCR (pname), property root node).
+
+property root node:
+ CONCR (x new node (property root, CONCR (sym name), CONCR (nil))).
+
+END PROC x create new atom;
+
+
+(************************* property list handling *************************)
+
+(*
+The property lists consist of chained units of the structure
+
+ +--------------------+ +---------------+
+ l property indicator l l property root l
+ +----------+---------+ +-------+-------+
+ l o l o----+-->l o l o---+--> . . .
+ +----+-----+---------+ +---+---+-------+
+ l l
+ V V
+ property id property
+
+
+or
+
+ +----------------+
+ l flag indicator l
+ +--------+-------+
+ l o l o---+--> . . .
+ +---+----+-------+
+ l
+ V
+ flag id
+
+
+
+The property lists cannot be altered or read directly, too.
+
+For property list handling there exist procedures that insert, change, read
+and delete properties resp. flags. Thus, the only thing that can be done
+with any property of an atom without using these special procedures, is
+comparing to or 'cons'ing with some other S-expression.
+At any given time the property list of any atom (including 'NIL') contains
+the property 'PNAME' giving the print name of the atom, stored as a list of
+characters. This special property cannot be altered, overwritten by 'add
+property' or deleted.
+*)
+
+
+(*++++++++++++++++++++++++++ property list dump ++++++++++++++++++++++++++*)
+
+
+SYM VAR actual property list node :: nil;
+
+
+PROC begin property list dump (SYM CONST atom):
+ actual property list node := x tail (atom)
+END PROC begin property list dump;
+
+
+PROC next property (SYM VAR property id, property):
+ IF null (actual property list node) THEN
+ property id := nil;
+ property := nil
+ ELSE
+ SELECT x status (actual property list node) OF
+ CASE flag indicator: get flag id
+ CASE property indicator: get property id and property
+ OTHERWISE x lisp error ("Flagge oder Eigenschaft erwartet und nicht: "
+ + text (x status (actual property list node)))
+ END SELECT
+ FI.
+
+get flag id:
+ property id := x head (actual property list node);
+ actual property list node := x tail (actual property list node);
+ property := nil.
+
+get property id and property:
+ property id := x head (actual property list node);
+ actual property list node := x tail (actual property list node);
+ IF x status (actual property list node) = property root THEN
+ property := x head (actual property list node);
+ actual property list node := x tail (actual property list node)
+ ELSE
+ x lisp error ("Eigenschaftswurzel erwartet, nicht:" +
+ text (x status (actual property list node)));
+ property := nil
+ FI.
+
+END PROC next property;
+
+
+(*+++++++++++++++++++++++++++++ properties +++++++++++++++++++++++++++++++*)
+
+
+SYM VAR last atom :: SYM :(0),
+ p list predecessor,
+ p list result;
+
+
+PROC add property (SYM CONST atom, property id, property):
+ IF eq (property id, pname) THEN
+ errorstop ("Der PNAME eines Atoms darf nicht versteckt sein")
+ ELSE
+ IF CONCR (heap).size + 2 > max size THEN
+ error stop ("LISP Heap Ueberlauf");
+ LEAVE add property
+ FI;
+ x set tail (atom, new property plus old property list);
+ IF eq (atom, last atom) AND
+ eq (property id, x head (p list result)) THEN
+ p list predecessor := atom;
+ p list result := x tail (atom)
+ FI
+ FI.
+
+new property plus old property list:
+ x new node (property indicator,
+ CONCR (property id), CONCR (property root plus old property list)).
+
+property root plus old property list:
+ x new node (property root, CONCR (property), CONCR (old property list)).
+
+old property list:
+ x tail (atom)
+
+END PROC add property;
+
+
+PROC alter property (SYM CONST atom, property id, new property):
+ IF eq (property id, pname) THEN
+ error stop ("Namen kann man nicht aendern")
+ ELSE
+ x search property id (atom, property id);
+ IF null (p list result) THEN
+ error stop ("Eigenschaft existiert nicht")
+ ELSE
+ x set head (x tail (p list result), new property)
+ FI
+ FI
+END PROC alter property;
+
+
+SYM PROC property (SYM CONST atom, property id):
+ x search property id (atom, property id);
+ IF null (p list result) THEN
+ nil
+ ELSE
+ x head (x tail (p list result))
+ FI
+END PROC property;
+
+
+PROC delete property (SYM CONST atom, property id):
+ IF eq (property id, pname) THEN
+ errorstop ("Der Name eines Atoms darf nicht geloescht werden")
+ ELSE
+ x search property id (atom, property id);
+ IF NOT null (p list result) THEN
+ x set tail (p list predecessor, x tail (x tail (p list result)));
+ last atom := SYM :(0)
+ FI
+ FI
+END PROC delete property;
+
+
+BOOL PROC property exists (SYM CONST atom, property id):
+ x search property id (atom, property id);
+ NOT null (p list result)
+END PROC property exists;
+
+
+PROC x search property id (SYM CONST atom, property id):
+ IF eq (last atom, atom) AND eq (x head (p list result), property id) THEN
+ LEAVE x search property id
+ FI;
+ last atom := atom;
+ p list predecessor := atom;
+ REP
+ p list result := x tail (p list predecessor);
+ IF end of property list THEN
+ last atom := SYM :(0);
+ LEAVE x search property id
+ FI;
+ SELECT x status (p list result) OF
+ CASE flag indicator: p list predecessor := p list result
+ CASE property indicator: check wether property root node follows;
+ IF correct property id found THEN
+ LEAVE x search property id
+ ELSE
+ p list predecessor := xtail (p list result)
+ FI
+ CASE property root: xlisperror("Unordentliche Eigenschaftwurzel");
+ p list result := nil;
+ last atom := SYM :(0);
+ LEAVE x search property id
+ OTHERWISE x lisp error ("Eigenschaften erwartet und nicht: " +
+ text (x status (p list result)));
+ p list result := nil;
+ last atom := SYM :(0);
+ LEAVE x search property id
+ END SELECT
+ PER.
+
+end of property list:
+ null (p list result).
+
+check wether property root node follows:
+ IF x status (x tail (p list result)) <> property root THEN
+ x lisp error ("Eigenschaftswurzel erwartet");
+ p list result := nil;
+ last atom := SYM :(0);
+ LEAVE x search property id
+ FI.
+
+correct property id found:
+ eq (x head (p list result), property id).
+
+END PROC x search property id;
+
+
+(*++++++++++++++++++++++++++++++++ flags +++++++++++++++++++++++++++++++++*)
+
+
+PROC add flag (SYM CONST atom, flag id):
+ enable stop;
+ x set tail (atom, new flag plus old property list).
+
+new flag plus old property list:
+ x new node (flag indicator, CONCR (flag id), old property list).
+
+old property list:
+ CONCR (x tail (atom))
+
+END PROC add flag;
+
+
+BOOL PROC flag (SYM CONST atom, flag id):
+ x search flag id (atom, flag id);
+ NOT null (result)
+END PROC flag;
+
+
+PROC delete flag (SYM CONST atom, flag id):
+ x search flag id (atom, flag id);
+ IF NOT (is error COR null (result)) THEN
+ x set tail (predecessor, x tail (result))
+ FI
+END PROC delete flag;
+
+
+PROC x search flag id (SYM CONST atom, flag id):
+ predecessor := atom;
+ REP
+ result := x tail (predecessor);
+ IF end of property list THEN
+ LEAVE x search flag id
+ FI;
+ SELECT x status (result) OF
+ CASE property root, property indicator: predecessor := result
+ CASE flag indicator: IF correct flag id found THEN
+ LEAVE x search flag id
+ ELSE
+ predecessor := result
+ FI
+ OTHERWISE x lisp error ("Eigenschaften erwartet und nicht:" +
+ text (x status (result)));
+ result := nil;
+ LEAVE x search flag id
+ END SELECT
+ PER.
+
+end of property list:
+ null (result).
+
+correct flag id found:
+ eq (x head (result), flag id).
+
+END PROC x search flag id;
+
+
+(****** Conversion of non-LISP data to LISP structures and vice versa *****)
+
+
+TEXT PROC text (SYM CONST sym):
+ IF is text (sym) THEN
+ TEXT VAR result := "";
+ SYM VAR actual node :: sym;
+ INT VAR i;
+ FOR i FROM 1 UPTO CONCR (x head (sym)) REP
+ actual node := x tail (actual node);
+ result CAT actual character
+ PER;
+ result
+ ELSE
+ error stop ("ist kein text");
+ ""
+ FI.
+
+actual character:
+ IF x status (actual node) <> character data THEN
+ x lisp error ("Zeichenfolge erwartet");
+ LEAVE text WITH result
+ FI;
+ code (CONCR (x head (actual node))).
+
+END PROC text;
+
+
+BOOL PROC is text (SYM CONST sym):
+ x status (sym) = text data
+END PROC is text;
+
+
+SYM PROC sym (TEXT CONST text):
+ SYM VAR result :: x new node (text data,
+ length (text), CONCR (nil)),
+ actual character node :: result;
+ INT VAR length of text;
+ ignore blanks at end of text;
+ INT VAR i;
+ FOR i FROM 1 UPTO length of text REP
+ x set tail (actual character node, new next character node);
+ actual character node := x tail (actual character node)
+ PER;
+ result.
+
+ignore blanks at end of text:
+ FOR length of text FROM length (text) DOWNTO 0 REP
+ IF (text SUB length of text) <> " " THEN
+ LEAVE ignore blanks at end of text
+ FI
+ PER;
+ length of text := 0.
+
+new next character node:
+ x new node (character data, code (text SUB i), 1).
+
+END PROC sym;
+
+
+INT PROC character (SYM CONST sym):
+ IF x status (sym) = character data THEN
+ CONCR (x head (sym))
+ ELSE
+ error stop ("ist kein Charakter");
+ -1
+ FI
+END PROC character;
+
+
+BOOL PROC is character (SYM CONST sym):
+ x status (sym) = character data
+END PROC is character;
+
+
+SYM PROC sym character (INT CONST char):
+ x new node (character data, char MOD 256, 1)
+END PROC sym character;
+
+
+INT PROC int 1 (SYM CONST sym):
+ IF x status (sym) = int data THEN
+ CONCR (x head (sym))
+ ELSE
+ error stop ("ist keine Zahl");
+ -1
+ FI
+END PROC int 1;
+
+
+INT PROC int 2 (SYM CONST sym):
+ IF x status (sym) = int data THEN
+ CONCR (x tail (sym))
+ ELSE
+ error stop ("ist keine Zahl");
+ -1
+ FI
+END PROC int 2;
+
+
+BOOL PROC is int pair (SYM CONST sym):
+ x status (sym) = int data
+END PROC is int pair;
+
+
+SYM PROC sym (INT CONST int 1, int 2):
+ x new node (int data, int 1, int 2)
+END PROC sym;
+
+
+(********************* internal error routine *****************************)
+
+
+PROC x lisp error (TEXT CONST error message):
+ error stop (""13"LISP SYSTEM FEHLER: " + error message )
+END PROC x lisp error;
+
+
+END PACKET lisp heap and oblist management;
+
+
+
+PACKET name (* Autor: J.Durchholz *)
+ (* Datum: 15.06.1982 *)
+ DEFINES (* Version 1.1.1 *)
+
+ name:
+
+TEXT PROC name (SYM CONST sym):
+ IF is named atom (sym) THEN
+ text (property (sym, pname))
+ ELSE
+ ""15"IST_KEIN_ATOM"14""
+ FI
+END PROC name;
+
+
+END PACKET name;
+
+
+
+PACKET lisp storage info (* Autor: J.Durchholz *)
+ (* Datum: 23.08.1982 *)
+ DEFINES (* Version 1.1.1 *)
+
+ lisp storage info:
+
+
+PROC lisp storage info:
+ INT VAR size, used;
+ lisp storage (size, used);
+ out (""13""10" ");
+ put (used);
+ put ("Knoten von");
+ put (size);
+ put line ("Knoten des LISP-Heaps sind belegt!")
+END PROC lisp storage info;
+
+
+END PACKET lisp storage info;
diff --git a/lang/lisp/1.7.2/src/lisp.2 b/lang/lisp/1.7.2/src/lisp.2 new file mode 100644 index 0000000..956aa5c --- /dev/null +++ b/lang/lisp/1.7.2/src/lisp.2 @@ -0,0 +1,550 @@ +PACKET character buffer (* Autor : J.Durchholz *)
+ (* Datum : 09.05.1984 *)
+ DEFINES (* Version 1.7.2 *)
+ (* 21.2.83. hey 293, 450,97,361 *)
+ get char,
+ line nr,
+ init char buffer:
+
+
+TEXT VAR buffer;
+INT VAR pointer,
+ line;
+
+
+INT PROC line nr:
+ line
+END PROC line nr;
+
+
+PROC init char buffer:
+ buffer := "";
+ pointer := 1;
+ line := 0;
+END PROC init char buffer;
+
+
+PROC get char (FILE VAR f, TEXT VAR char):
+ IF buffer empty THEN
+ try to find nonempty line and put it into buffer;
+ char := " ";
+ pointer := 1
+ ELSE
+ char := buffer SUB pointer;
+ pointer INCR 1
+ FI.
+
+buffer empty:
+ pointer > length (buffer).
+
+try to find nonempty line and put it into buffer:
+ REP
+ IF eof (f) THEN
+ char := "";
+ LEAVE get char
+ FI;
+ get line (f, buffer);
+ line INCR 1
+ UNTIL buffer <> "" PER.
+
+END PROC get char;
+
+
+END PACKET character buffer;
+
+
+
+
+PACKET lisp io (* Autor: J.Durchholz *)
+ (* Datum: 10.09.1982 *)
+ DEFINES (* Version 4.1.3 *)
+
+ put,
+ verbose lisp output,
+ get,
+ get all:
+
+
+BOOL VAR verbose :: FALSE;
+
+
+PROC verbose lisp output (BOOL CONST b):
+ verbose := b
+END PROC verbose lisp output;
+
+BOOL PROC verbose lisp output:
+ verbose
+END PROC verbose lisp output;
+
+
+PROC put (FILE VAR f, SYM CONST sym):
+ IF atom (sym) THEN
+ put atom
+ ELSE
+ put structure
+ FI.
+
+put atom:
+ IF is named atom (sym) THEN
+ put (f, name (sym))
+ ELIF is int pair (sym) THEN
+ put (f, int 1 (sym))
+ ELIF is text (sym) THEN
+ IF verbose THEN
+ TEXT VAR buffer :: text (sym);
+ change all (buffer, """", """""");
+ buffer CAT """";
+ put (f, """" + buffer)
+ ELSE
+ write (f, text (sym))
+ FI
+ ELIF is character (sym) THEN
+ IF verbose THEN
+ buffer := "'";
+ buffer CAT code (character (sym));
+ buffer CAT "'";
+ put (f, buffer)
+ ELSE
+ write (f, code (character (sym)))
+ FI
+ ELSE
+ put (f, ""15"UNBEKANNTER_ATOM_TYP"14"")
+ FI.
+
+put structure:
+ put (f, "(");
+ SYM VAR actual node := sym;
+ REP
+ put (f, head (actual node));
+ actual node := tail (actual node)
+ UNTIL atom (actual node) PER;
+ IF NOT null (actual node) THEN
+ put (f, ".");
+ put (f, actual node)
+ FI;
+ put (f, ")").
+
+END PROC put;
+
+
+PROC put (SYM CONST sym):
+ IF atom (sym) THEN
+ put atom
+ ELSE
+ put structure
+ FI.
+
+put atom:
+ IF is named atom (sym) THEN
+ put (name (sym))
+ ELIF is int pair (sym) THEN
+ put (int 1 (sym))
+ ELIF is text (sym) THEN
+ IF verbose THEN
+ TEXT VAR buffer :: text (sym);
+ change all (buffer, """", """""");
+ buffer CAT """";
+ put ("""" + buffer)
+ ELSE
+ write (text (sym))
+ FI
+ ELIF is character (sym) THEN
+ IF verbose THEN
+ buffer := "'";
+ buffer CAT code (character (sym));
+ buffer CAT "'";
+ put (buffer)
+ ELSE
+ out (code (character (sym)))
+ FI
+ ELSE
+ put (""15"UNBEKANNTER_ATOM_TYP"14"")
+ FI.
+
+put structure:
+ put ("(");
+ SYM VAR actual node := sym;
+ REP
+ put (head (actual node));
+ actual node := tail (actual node)
+ UNTIL atom (actual node) PER;
+ IF NOT null (actual node) THEN
+ put (".");
+ put (actual node)
+ FI;
+ put (")").
+
+END PROC put;
+
+
+PROC get (FILE VAR f, SYM VAR s):
+ initialize scanner (f);
+ IF NOT get s expression (s) THEN
+ error ("LISP-Ausdruck erwartet")
+ FI;
+ scanner postprocessing (f)
+END PROC get;
+
+
+(**************************** parser for 'get' ****************************)
+
+
+LET end of file type = 0,
+ name type = 1,
+ text type = 2,
+ character type = 3,
+ int type = 4,
+ other char type = 5;
+
+
+BOOL PROC get s expression (SYM VAR s):
+ (* The boolean result indicates wether the error has not occurred that *)
+ (* 'get next symbol' was called, but then the symbol was not expected *)
+ (* and thus could not be processed. *)
+ get next symbol;
+ SELECT symbol type OF
+ CASE end of file type: FALSE
+ CASE name type: s := new atom (symbol); TRUE
+ CASE text type: s := sym (symbol); TRUE
+ CASE character type: s := sym character (code (symbol)); TRUE
+ CASE int type: s := sym (int (symbol), -1); TRUE
+ CASE other char type: get structure
+ OTHERWISE error ("EINLESEFEHLER: unbekannter Symboltyp: " +
+ text (symbol type)); TRUE
+ END SELECT.
+
+get structure:
+ IF symbol <> "(" THEN
+ FALSE
+ ELSE
+ get list;
+ IF symbol type <> other char type OR symbol <> ")" THEN
+ error (">> ) << erwartet");
+ FALSE
+ ELSE
+ TRUE
+ FI
+ FI.
+
+get list:
+ SYM VAR father, son;
+ IF get s expression (son) THEN
+ get list elements;
+ ELSE
+ s := nil
+ FI.
+
+get list elements:
+ father := cons (son, nil);
+ s := father;
+ WHILE get s expression (son) REP
+ set tail (father, cons (son, nil));
+ father := tail (father)
+ PER;
+ IF symbol type = other char type AND symbol = "." THEN
+ IF get s expression (son) THEN
+ set tail (father, son);
+ get next symbol
+ ELSE
+ error ("LISP-Ausdruck nach dem Punkt erwartet")
+ FI
+ FI.
+
+END PROC get s expression;
+
+
+(********************* scanner for 'get x espression' *********************)
+
+
+FILE VAR infile;
+
+
+PROC initialize scanner (FILE CONST f):
+ infile := f;
+ no input errors := TRUE;
+ init char buffer;
+ get char (infile, actual char)
+END PROC initialize scanner;
+
+
+PROC scanner postprocessing (FILE VAR f):
+ f := infile
+END PROC scanner postprocessing;
+
+
+TEXT VAR symbol; INT VAR symbol type;
+
+
+PROC get next symbol:
+ skip blanks;
+ IF actual char = "" THEN
+ symbol := "DATEIENDE";
+ symbol type := end of file type
+ ELIF is letter THEN
+ get name
+ ELIF is digit or sign THEN
+ get integer
+ ELIF is double quote THEN
+ get text
+ ELIF is single quote THEN
+ get character
+ ELSE
+ get other char
+ FI .
+
+is letter:
+ IF "a" <= actual char AND actual char <= "z" THEN
+ actual char := code (code (actual char) - code ("a") + code ("A"));
+ TRUE
+ ELSE
+ "@" <= actual char AND actual char <= "Z"
+ FI.
+
+get name:
+ symbol type := name type;
+ symbol := actual char;
+ REP
+ get char (infile, actual char);
+ IF is neither letter nor digit THEN
+ LEAVE get name
+ FI;
+ symbol CAT actual char
+ PER.
+
+is neither letter nor digit:
+ NOT (is letter OR is digit OR is underscore).
+
+is digit:
+ "0" <= actual char AND actual char <= "9".
+
+is underscore:
+ actual char = "_".
+
+is digit or sign:
+ is digit OR actual char = "+" OR actual char = "-".
+
+get integer:
+ symbol type := int type;
+ IF actual char = "+" THEN
+ get char (infile, actual char);
+ skip blanks;
+ symbol := actual char
+ ELIF actual char = "-" THEN
+ symbol := "-";
+ get char (infile, actual char);
+ skip blanks;
+ symbol CAT actual char
+ ELSE
+ symbol := actual char
+ FI;
+ REP
+ get char (infile, actual char);
+ IF NOT is digit THEN
+ LEAVE get integer
+ FI;
+ symbol CAT actual char
+ PER.
+
+is double quote:
+ actual char = """".
+
+get text:
+ symbol := "";
+ symbol type := text type;
+ REP
+ get char (infile, actual char);
+ IF is double quote THEN
+ get char (infile, actual char);
+ IF NOT is double quote THEN LEAVE get text
+ FI
+ ELIF actual char = "" THEN LEAVE get text (*hey*)
+ FI;
+ symbol CAT actual char
+ PER.
+
+is single quote:
+ actual char = "'".
+
+get character:
+ symbol type := character type;
+ get char (infile, symbol);
+ get char (infile, actual char);
+ IF actual char <> "'" THEN
+ error (">> ' << erwartet")
+ ELSE
+ get char (infile, actual char)
+ FI.
+
+get other char:
+ symbol type := other char type;
+ symbol := actual char;
+ get char (infile, actual char).
+
+END PROC get next symbol;
+
+
+TEXT VAR actual char;
+
+
+PROC skip blanks:
+ INT VAR comment depth :: 0;
+ WHILE is comment OR actual char = " " REP
+ get char (infile, actual char)
+ PER.
+
+is comment:
+ IF actual char = "{" THEN
+ comment depth INCR 1;
+ TRUE
+ ELIF actual char = "}" THEN
+ IF comment depth = 0 THEN
+ error (">> { << fehlt")
+ ELSE
+ comment depth DECR 1
+ FI;
+ TRUE
+ ELSE
+ IF comment depth > 0 THEN
+ IF actual char = "" THEN
+ error ("DATEIENDE im Kommentar");
+ FALSE
+ ELSE
+ TRUE
+ FI
+ ELSE
+ FALSE
+ FI
+ FI.
+
+END PROC skip blanks;
+
+
+BOOL VAR no input errors;
+FILE VAR errors;
+
+
+PROC error (TEXT CONST error message):
+ out ("FEHLER in Zeile ");
+ out (text (line nr));
+ out (" bei >> ");
+ out (symbol);
+ out (" << : ");
+ out (error message);
+ line;
+ IF no input errors THEN
+ no input errors := FALSE;
+ errors := notefile; modify(errors);
+ headline (errors, "Einlesefehler"); output(errors)
+ FI;
+ write (errors, "FEHLER in Zeile ");
+ write (errors, text (line nr));
+ write (errors, " bei >> ");
+ write (errors, symbol);
+ write (errors, " << : ");
+ write (errors, error message);
+ line (errors)
+END PROC error;
+
+
+PROC get (SYM VAR sym): (*hey*)
+ disable stop;
+ FILE VAR in :: sequential file (modify, "LISP INPUT"),
+ out :: notefile; modify (out);
+ headline (out,"LISP OUTPUT");
+ headline (in, "LISP INPUT");
+ editable (out,in); output(out);
+ input (in);
+ get (in, sym);
+ WHILE NOT no input errors AND NOT is error REP
+ modify (errors);
+ headline (errors, " LISP-Fehlermeldungen");
+ headline (in, " Bitte KORREKTEN LISP-Ausdruck");
+ editable (errors, in);
+ headline (errors, "notebook");
+ output (errors);
+ input (in);
+ get (in, sym)
+ PER;
+END PROC get;
+
+
+PROC editable (FILE VAR a,b): (*hey*)
+ enable stop; edit (a,b); to line (a,lines(a)); remove(a,lines(a))
+END PROC editable;
+
+PROC edit (FILE VAR a,b):
+ open editor (1, b, write acc, 1, 1, 79, 24);
+ open editor (2, a, write acc, 1,13, 79, 12);
+ edit (1)
+ END PROC edit;
+
+LET write acc = TRUE;
+
+PROC get all (FILE VAR f, SYM VAR sym):
+ get (f, sym);
+ skip blanks;
+ IF NOT eof (infile) THEN
+ error ("Hinter dem letzten Symbol des LISP-Ausdruck stehen noch Zeichen")
+ FI
+END PROC get all;
+
+
+END PACKET lisp io;
+
+
+
+PACKET lisp integer (* Autor: J.Durchholz *)
+ (* Datum: 30.08.1982 *)
+ DEFINES (* Version 1.1.2 *)
+
+ sum,
+ difference,
+ product,
+ quotient,
+ remainder:
+
+SYM PROC sum (SYM CONST summand list):
+ INT VAR result := 0;
+ SYM VAR list rest := summand list;
+ WHILE NOT atom (list rest) REP
+ result INCR int 1 (head (list rest));
+ list rest := tail (list rest)
+ PER;
+ IF NOT null (list rest) THEN
+ error stop ("Summandenliste endet falsch")
+ FI ;
+ sym (result, -1)
+END PROC sum;
+
+
+SYM PROC difference (SYM CONST minuend, subtrahend):
+ sym (int 1 (minuend) - int 1 (subtrahend), -1)
+END PROC difference;
+
+
+SYM PROC product (SYM CONST factor list):
+ INT VAR result := 1;
+ SYM VAR list rest := factor list;
+ WHILE NOT atom (list rest) REP
+ result := result * int 1 (head (list rest));
+ list rest := tail (list rest)
+ PER;
+ IF NOT null (list rest) THEN
+ error stop ("Faktorenliste endet falsch")
+ FI;
+ sym (result, -1)
+END PROC product;
+
+
+SYM PROC quotient (SYM CONST dividend, divisor):
+ sym (int 1 (dividend) DIV int 1 (divisor), -1)
+END PROC quotient;
+
+
+SYM PROC remainder(SYM CONST dividend, divisor):
+ sym (int 1 (dividend) MOD int 1 (divisor), -1)
+END PROC remainder;
+
+
+END PACKET lisp integer;
+
diff --git a/lang/lisp/1.7.2/src/lisp.3 b/lang/lisp/1.7.2/src/lisp.3 new file mode 100644 index 0000000..dfde6db --- /dev/null +++ b/lang/lisp/1.7.2/src/lisp.3 @@ -0,0 +1,142 @@ +PACKET lisp (* Autor: J.Durchholz , P. Heyderhoff *)
+ (* Datum: 09.05.1984 *)
+ DEFINES (* Version 1.7.2 *)
+
+ start lisp system,
+ lisp heap,
+ insert lisp,
+ run lisp,
+ run lisp again,
+ lisp:
+
+SYM VAR run again pointer :: nil;
+DATASPACE VAR insert heap :: nil space;
+
+PROC start lisp system (DATASPACE CONST heap):
+ enable stop;
+ initialize lisp system (heap);
+ forget (insert heap);
+ insert heap := heap
+END PROC start lisp system;
+
+
+PROC start lisp system (DATASPACE CONST heap, FILE VAR f):
+ start lisp system (heap);
+ input (f);
+ WHILE NOT eof (f) REP
+ TEXT VAR name;
+ get (f, name);
+ SYM CONST s :: new atom (name);
+ get (f, name);
+ SYM CONST property name :: new atom (name);
+ IF NOT null (property name) THEN
+ SYM VAR property;
+ get (f, property);
+ add property (s, property name, property)
+ FI;
+ PER
+END PROC start lisp system;
+
+
+PROC start lisp system (FILE VAR f):
+ create lisp system (f, insert heap)
+END PROC start lisp system;
+
+
+DATASPACE PROC lisp heap:
+ insert heap
+END PROC lisp heap;
+
+
+DATASPACE VAR run heap :: nil space;
+
+
+PROC insert lisp:
+ insert lisp (last param)
+END PROC insert lisp;
+
+
+PROC insert lisp (TEXT CONST file name):
+ interpret (insert heap, file name)
+END PROC insert lisp;
+
+
+PROC run lisp:
+ run lisp (last param)
+END PROC run lisp;
+
+
+PROC run lisp (TEXT CONST file name):
+ forget (run heap);
+ run heap := insert heap;
+ interpret (run heap, file name)
+END PROC run lisp;
+
+
+DATASPACE VAR do heap :: nil space,
+ do file :: nil space;
+
+
+
+PROC interpret (DATASPACE CONST heap, TEXT CONST file name):
+ enable stop;
+ FILE VAR f :: sequential file (input, file name);
+ interpret (heap, f)
+END PROC interpret;
+
+
+PROC interpret (DATASPACE CONST heap, FILE VAR f):
+ initialize lisp system (heap);
+ get (f, run again pointer);
+ add property (new atom ("program"), new atom ("APVAL"), run again pointer);
+ put (evalquote (run again pointer))
+END PROC interpret;
+
+PROC run lisp again:
+ put (evalquote (run again pointer))
+END PROC run lisp again;
+
+
+PROC get ausdruck:
+ enable stop; get (ausdruck)
+END PROC get ausdruck;
+
+SYM VAR ausdruck;
+
+PROC lisp:
+
+(* HAUPT TESTPROGRAMM FUER LISP Heyderhoff 25.1.83 *)
+IF NOT exists ("LISP HEAP") THEN
+ FILE VAR bootstrap :: sequential file (input, "lisp.bootstrap");
+ create lisp system (bootstrap, new ("LISP HEAP"));
+ verbose lisp output (TRUE);
+FI;
+FILE VAR out :: notefile; output (out);
+SYM VAR work;
+command dialogue(FALSE); forget ("LISP INPUT"); command dialogue(TRUE);
+(* bildlaenge(23); *) (* EUMEL 1.65 *)
+disable stop;
+REP
+ get (ausdruck);
+ IF is error THEN
+ handle error
+ ELSE
+ output (out);
+ work := evalquote (ausdruck);
+ IF is error THEN handle error
+ ELSE put (out, work)
+ FI
+ FI
+PER .
+
+handle error:
+ IF text (error message, 18) = "halt from terminal" THEN
+ enable stop
+ ELSE
+ put (out, error message);
+ put ( error message); pause(20);
+ clear error;
+ FI .
+END PROC lisp;
+END PACKET lisp;
+
diff --git a/lang/lisp/1.7.2/src/lisp.4 b/lang/lisp/1.7.2/src/lisp.4 new file mode 100644 index 0000000..f36706d --- /dev/null +++ b/lang/lisp/1.7.2/src/lisp.4 @@ -0,0 +1,766 @@ +PACKET lisp heap maintenance (* Autor: J.Durchholz *)
+ (* Datum: 09.05.1984 *)
+ DEFINES (* Version 1.7.2 *)
+ (* Testhilfe *)
+ create lisp system, (* hey, 02.3.83 : 121,334,542,732 *)
+ dump oblist:
+
+
+PROC create lisp system (FILE VAR f, DATASPACE CONST new heap):
+ initialize lisp system (new heap);
+ input (f);
+ WHILE NOT eof (f) REP
+ TEXT VAR name;
+ get (f, name);
+ SYM CONST s :: new atom (name);
+ get (f, name);
+ SYM CONST property name :: new atom (name);
+ IF NOT null (property name) THEN
+ SYM VAR property;
+ get (f, property);
+ add property (s, property name, property)
+ FI
+ PER
+END PROC create lisp system;
+
+
+PROC dump oblist (FILE VAR f):
+ begin oblist dump;
+ REP
+ SYM CONST actual atom :: next atom;
+ put line (f, name (actual atom));
+ dump property list
+ UNTIL null (actual atom) PER.
+
+dump property list:
+ begin property list dump (actual atom);
+ REP
+ SYM VAR id, value;
+ next property (id, value);
+ write (f, " ");
+ write (f, name (id));
+ write (f, " ");
+ write (f, name (value));
+ line (f)
+ UNTIL null (id) AND null (value) PER.
+
+END PROC dump oblist;
+
+
+PROC dump oblist:
+ begin oblist dump;
+ REP
+ SYM CONST actual atom :: next atom;
+ put line (name (actual atom));
+ dump property list
+ UNTIL null (actual atom) PER.
+
+dump property list:
+ begin property list dump (actual atom);
+ REP
+ SYM VAR id, value;
+ next property (id, value);
+ out (" ");
+ out (name (id));
+ out (" ");
+ put line (name (value));
+ UNTIL null (id) AND null (value) PER.
+
+END PROC dump oblist;
+
+
+END PACKET lisp heap maintenance;
+
+
+
+PACKET lisp interpreter (* Autor: J.Durchholz *)
+ (* Datum: 27.12.1982 *)
+ DEFINES (* Version 3.1.7 *)
+ evalquote,
+ apply,
+ eval,
+ try:
+
+
+(* SYM-objects used by the interpreter. They all point to constant structure
+ within the heap. As their address may change during garbage collection,
+ it must be possible to correct the references to them made by the
+ SYM-objects. That is the reason why they are declared VAR instead of CONST*)
+SYM VAR lambda constant,
+ label constant,
+ quote constant,
+ function constant,
+ indefinite constant,
+ apval constant,
+ true constant,
+ false constant;
+
+SYM VAR errors;
+BOOL VAR trace :: FALSE;
+
+PROC initialize constants:
+ lambda constant := new atom ("LAMBDA");
+ label constant := new atom ("LABEL");
+ quote constant := new atom ("QUOTE");
+ function constant := new atom ("FUNCTION");
+ indefinite constant := new atom ("INDEFINITE");
+ apval constant := new atom ("APVAL");
+ true constant := new atom ("T");
+ false constant := new atom ("F");
+ errors := new atom ("ERRORS")
+END PROC initialize constants;
+
+
+SYM PROC evalquote (SYM CONST expr): (*hey*)
+ enable stop;
+ initialize constants;
+ x apply ( head (expr), quote (tail (expr)), nil )
+END PROC evalquote;
+
+
+SYM PROC quote (SYM CONST x):
+ IF eq (x,nil) THEN nil
+ ELSE set head (x, new head); set tail (x, quote (tail(x))); x
+ FI .
+new head:
+ cons (quote constant, cons (head(x), nil) )
+END PROC quote;
+
+
+SYM PROC apply (SYM CONST function, argument list, alist):
+ enable stop;
+ initialize constants;
+ x apply (function, argument list, alist)
+END PROC apply;
+
+
+SYM PROC x apply (SYM CONST function, argument list, alist):
+ IF trace THEN line;
+ put ("a p p l y :"); put (function); line;
+ put ("arguments :"); put (argument list); line;
+ FI;
+ SYM VAR new alist;
+ initialize for alist insertion;
+ reduce actual fn to lambda expression;
+ insert parameter evaluated argument pairs in reversed order in new alist;
+ function body evaluation.
+
+reduce actual fn to lambda expression:
+ SYM VAR actual fn :: function;
+ REP
+ IF is named atom (actual fn) THEN
+ get function from property list of actual fn
+ or from functional alist entry
+ ELIF atom (actual fn) THEN
+ error stop ("Eine Funktion darf kein unbenanntes Atom sein")
+ ELSE
+ IF eq (head (actual fn), lambda constant) THEN
+ LEAVE reduce actual fn to lambda expression
+ ELIF eq (head (actual fn), label constant) THEN
+ get function from label expression and update alist
+ ELSE
+ error stop ("Funktion ist weder Atom noch LAMBDA-/LABEL-Ausdruck")
+ FI
+ FI
+ PER.
+
+get function from property list of actual fn or from functional alist entry:
+ IF property exists (actual fn, function constant) THEN
+ get function from property list of actual fn
+ ELSE
+ get function from functional alist entry
+ FI.
+
+get function from property list of actual fn:
+ actual fn := property (actual fn, function constant).
+
+get function from functional alist entry:
+ SYM VAR actual alist entry;
+ begin alist retrieval;
+ REP
+ IF end of alist THEN
+ error stop ("Die Funktion " + name (actual fn) +
+ " ist nicht definiert")
+ FI;
+ search for next functional alist entry;
+ UNTIL eq (head (actual functional alist entry), actual fn) PER;
+ actual fn := tail (actual functional alist entry).
+
+get function from label expression and update alist:
+ actual fn := tail (actual fn);
+ IF atom (actual fn) COR
+ (NOT atom (head (actual fn)) OR atom (tail (actual fn))) COR
+ NOT null (tail (tail (actual fn))) THEN
+ error stop ("Ungueltiger LABEL-Ausdruck")
+ FI;
+ SYM VAR new alist entry;
+ prepare new functional alist entry;
+ set head (new alist entry, head (actual fn));
+ actual fn := head (tail (actual fn));
+ set tail (new alist entry, actual fn).
+
+insert parameter evaluated argument pairs in reversed order in new alist:
+ actual fn := tail (actual fn);
+ IF atom (actual fn) THEN
+ error stop ("Ungueltiger LAMBDA-Ausdruck")
+ FI;
+ SYM VAR parameter list rest :: head (actual fn),
+ argument list rest :: argument list;
+ actual fn := tail (actual fn);
+ WHILE NOT null (parameter list rest) REP
+ add next parameter argument pair to alist
+ PER;
+ check wether no arguments are left over.
+
+add next parameter argument pair to alist:
+ IF atom (parameter list rest) THEN
+ error stop ("Parameterliste endet falsch")
+ FI;
+ SYM VAR param pointer :: head (parameter list rest);
+ parameter list rest := tail (parameter list rest);
+ IF is named atom (param pointer) AND NOT null (param pointer) THEN
+ add parameter evaluated argument pair to alist;
+ advance argument list rest
+ ELIF atom (param pointer) THEN
+ error stop ("Unbenannte Atome und NIL koennen nicht Parameter sein")
+ ELSE
+ IF eq (head (param pointer), indefinite constant) THEN
+ check wether is last param;
+ advance param pointer;
+ IF eq (head (param pointer), quote constant) THEN
+ advance param pointer;
+ move param pointer to parameter;
+ add parameter indefinite quoted argument pair to alist
+ ELSE
+ move param pointer to parameter;
+ add parameter indefinite evaluated argument pair to alist
+ FI;
+ argument list rest := nil
+ ELIF eq (head (param pointer), quote constant) THEN
+ advance param pointer;
+ move param pointer to parameter;
+ add parameter quoted argument pair to alist;
+ advance argument list rest
+ ELIF eq (head (param pointer), function constant) THEN
+ advance param pointer;
+ move param pointer to parameter;
+ add parameter functional argument pair to alist;
+ advance argument list rest
+ ELSE
+ error stop ("Ungueltiger Parameter")
+ FI
+ FI.
+
+advance param pointer:
+ param pointer := tail (param pointer);
+ IF atom (param pointer) THEN
+ error stop ("Ungueltiger Parameter")
+ FI.
+
+move param pointer to parameter:
+ IF NOT null (tail (param pointer)) THEN
+ error stop ("Ungueltiger Parameter")
+ FI;
+ param pointer := head (param pointer);
+ IF NOT atom (param pointer) OR null (param pointer) THEN
+ error stop ("Unbenannte Atome und NIL koennen nicht Parameter sein")
+ FI.
+
+advance argument list rest:
+ argument list rest := tail (argument list rest).
+
+add parameter evaluated argument pair to alist:
+ prepare new alist entry;
+ set head (new alist entry, param pointer);
+ set tail (new alist entry, x eval (actual argument, alist)).
+
+check wether is last param:
+ IF NOT null (parameter list rest) THEN
+ error stop ("Ein INDEFINITE-Parameter muss der letzte sein")
+ FI.
+
+add parameter indefinite quoted argument pair to alist:
+ prepare new alist entry;
+ set head (new alist entry, param pointer);
+ set tail (new alist entry, argument list rest);
+ WHILE NOT atom (argument list rest) REP
+ argument list rest := tail (argument list rest)
+ PER;
+ IF NOT null (argument list rest) THEN
+ error stop ("Argumentliste endet falsch")
+ FI.
+
+add parameter indefinite evaluated argument pair to alist:
+ prepare new alist entry;
+ set head (new alist entry, param pointer);
+ last evaluated argument := new alist entry;
+ WHILE NOT atom (argument list rest) REP
+ set tail (last evaluated argument,
+ cons (x eval (head (argument list rest), alist), nil));
+ last evaluated argument := tail (last evaluated argument);
+ advance argument list rest
+ PER;
+ IF NOT null (argument list rest) THEN
+ error stop ("Argumentliste endet falsch")
+ FI.
+
+last evaluated argument:
+ param pointer.
+(* The value of param pointer is not used further, so the *)
+(* variable can be "reused" in this manner. *)
+
+add parameter quoted argument pair to alist:
+ prepare new alist entry;
+ set head (new alist entry, param pointer);
+ set tail (new alist entry, actual argument).
+
+add parameter functional argument pair to alist:
+ prepare new functional alist entry;
+ set head (new alist entry, param pointer);
+ set tail (new alist entry, actual argument).
+
+actual argument:
+ IF atom (argument list rest) THEN
+ IF null (argument list rest) THEN
+ error stop ("Zuwenig Argumente")
+ ELSE
+ error stop ("Argumentliste endet falsch")
+ FI
+ FI;
+ head (argument list rest).
+
+check wether no arguments are left over:
+ IF NOT null (argument list rest) THEN
+ error stop ("Zuviele Argumente")
+ FI.
+
+function body evaluation:
+ IF is int pair (actual fn) THEN
+ predefined function evaluation
+ ELIF atom (actual fn) COR NOT null (tail (actual fn)) THEN
+ error stop ("Ungueltiger LAMBDA-Ausdruck"); nil
+ ELSE
+ x eval (head (actual fn), new alist)
+ FI.
+
+predefined function evaluation:
+ SELECT int 1 (actual fn) OF
+ CASE 0: call eval cond
+ CASE 1: call begin oblist dump
+ CASE 2: call next atom
+ CASE 3: call add property
+ CASE 4: call alter property
+ CASE 5: call delete property
+ CASE 6: call property exists
+ CASE 7: call property
+ CASE 8: call add flag
+ CASE 9: call flag
+ CASE 10: call delete flag
+ CASE 11: call begin property list dump
+ CASE 12: call next property
+ CASE 13: call apply
+ CASE 14: call eval
+ CASE 15: call try
+ CASE 16: give association list
+ CASE 17: call error stop
+ CASE 18: call head
+ CASE 19: call set head
+ CASE 20: call tail
+ CASE 21: call set tail
+ CASE 22: call cons
+ CASE 23: call eq
+ CASE 24: call get sym
+ CASE 25: call put sym
+ CASE 26: call null
+ CASE 27: call is atom
+ CASE 28: call is named atom
+ CASE 29: call get named atom
+ CASE 30: call put named atom
+ CASE 31: call is text
+ CASE 32: call get text
+ CASE 33: call put text
+ CASE 34: call is character
+ CASE 35: call get character
+ CASE 36: call put character
+ CASE 37: call is int
+ CASE 38: call get int
+ CASE 39: call put int
+ CASE 40: call sum
+ CASE 41: call difference
+ CASE 42: call product
+ CASE 43: call quotient
+ CASE 44: call remainder
+ CASE 45: call equal
+ CASE 46: call trace
+ CASE 47: call define
+ CASE 48: call set
+ OTHERWISE error stop("Es gibt (noch) keine LISP-Funktion mit der Nummer"
+ + text (int 1 (actual fn)) ); nil
+ END SELECT.
+
+call eval cond:
+ x eval condition (arg 1, alist).
+
+call begin oblist dump:
+ begin oblist dump; nil.
+
+call next atom:
+ next atom.
+
+call add property:
+ add property (arg 3, arg 2, arg 1); arg 1.
+
+call alter property:
+ alter property (arg 3, arg 2, arg 1); arg 1.
+
+call delete property:
+ delete property (arg 2, arg 1); nil.
+
+call property exists:
+ IF property exists(arg 2,arg 1) THEN true constant ELSE false constant FI.
+
+call property:
+ property (arg 2, arg 1).
+
+call add flag:
+ add flag (arg 2, arg 1); nil.
+
+call flag:
+ IF flag (arg 2, arg 1) THEN true constant ELSE false constant FI.
+
+call delete flag:
+ delete flag (arg 2, arg 1); nil.
+
+call begin property list dump:
+ begin property list dump (arg 1); nil.
+
+call next property:
+ SYM VAR s1, s2; next property (s1, s2); cons (s1, s2).
+
+call apply:
+ x apply (arg 3, arg 2, arg 1).
+
+call eval:
+ x eval (arg 2, arg 1).
+
+call try:
+ x try (arg 4, arg 3, arg 2, arg 1).
+
+give association list:
+ alist.
+
+call error stop:
+ error stop (text (arg 1)); nil.
+
+call head:
+ head (arg 1).
+
+call set head:
+ set head (arg 2, arg 1); arg 2.
+
+call tail:
+ tail (arg 1).
+
+call set tail:
+ set tail (arg 2, arg 1); arg 2.
+
+call cons:
+ cons (arg 2, arg 1).
+
+call eq:
+ IF eq (arg 2, arg 1) THEN true constant ELSE false constant FI.
+
+call get sym:
+ get (s1); s1.
+
+call put sym:
+ put (arg 1); arg 1.
+
+call null:
+ IF null (arg 1) THEN true constant ELSE false constant FI.
+
+call is atom:
+ IF atom (arg 1) THEN true constant ELSE false constant FI.
+
+call is named atom:
+ IF is named atom (arg 1) THEN true constant ELSE false constant FI.
+
+call get named atom:
+ TEXT VAR t; get (t); new atom (t).
+
+call put named atom:
+ put (name (arg 1)); arg 1.
+
+call is text:
+ IF is text (arg 1) THEN true constant ELSE false constant FI.
+
+call get text:
+ get (t); sym (t).
+
+call put text:
+ put (text (arg 1)); arg 1.
+
+call is character:
+ IF is character (arg 1) THEN true constant ELSE false constant FI.
+
+call get character:
+ inchar (t); sym character (code (t)).
+
+call put character:
+ out (code (character (arg 1))); arg 1.
+
+call is int:
+ IF is int pair (arg 1) THEN true constant ELSE false constant FI.
+
+call get int:
+ INT VAR i; get (i); sym (i, -1).
+
+call put int:
+ put (int 1 (arg 1)); arg 1.
+
+call sum:
+ sum (arg 1).
+
+call difference:
+ difference (arg 2, arg 1).
+
+call product:
+ product (arg 1).
+
+call quotient:
+ quotient (arg 2, arg 1).
+
+call remainder:
+ remainder(arg 2, arg 1).
+
+call equal:
+ IF equal (arg 2, arg 1) THEN true constant ELSE false constant FI.
+
+call trace:
+ trace := NOT trace;
+ IF trace THEN true constant ELSE false constant FI .
+
+call define: (*hey*)
+ define (arg 1) .
+
+call set: (*hey*)
+ add property (new atom ( name (arg 2)), apval constant, arg 1); arg 1 .
+
+arg 1:
+ tail (head (new alist)).
+
+arg 2:
+ tail (head (tail (new alist))).
+
+arg 3:
+ tail (head (tail (tail (new alist)))).
+
+arg 4:
+ tail (head (tail (tail (tail (new alist))))).
+
+END PROC x apply;
+
+SYM PROC define (SYM CONST x): (*hey*)
+ IF eq (x, nil) THEN nil
+ ELSE add property (new atom (name (head (head (x)))),
+ function constant, tail (head (x)) );
+ cons (head (head (x)), define (tail (x)) )
+ FI .
+END PROC define;
+
+SYM VAR old alist :: nil;
+
+SYM PROC eval (SYM CONST expression, alist):
+ enable stop;
+ initialize constants;
+ x eval (expression, alist)
+END PROC eval;
+
+
+SYM PROC x eval (SYM CONST expression, alist): (*hey*)
+ IF trace THEN line;
+ put ("e v a l :"); put (expression); line;
+ IF NOT equal (alist, old alist) THEN
+ put ("bindings :"); old alist := alist; put (alist); line FI
+ FI;
+ IF atom (expression) THEN
+ IF is named atom (expression) THEN
+ value from property list of expression or from alist entry
+ ELSE
+ expression
+ FI
+ ELSE
+ x apply (head (expression), tail (expression), alist)
+ FI.
+
+value from property list of expression or from alist entry:
+ IF property exists (expression, apval constant) THEN
+ value from property list of expression
+ ELSE
+ value from alist entry
+ FI.
+
+value from property list of expression:
+ property (expression, apval constant).
+
+value from alist entry:
+ SYM VAR actual alist entry;
+ begin alist retrieval;
+ REP
+ IF end of alist THEN
+ error stop ("Das Atom " + name (expression) + " hat keinen Wert")
+ FI;
+ search for next alist entry
+ UNTIL eq (head (actual alist entry), expression) PER;
+ tail (actual alist entry).
+
+END PROC x eval;
+
+
+SYM PROC try (SYM CONST expression list, alist,
+ error output, break possible):
+ enable stop;
+ initialize constants;
+ x try (expression list, alist, error output, break possible)
+END PROC try;
+
+
+SYM PROC x try (SYM CONST expression list, alist,
+ error output, break possible):
+ BOOL CONST output :: bool (error output),
+ halt enabled :: bool (break possible);
+ SYM VAR expr list rest :: expression list;
+ REP
+ IF null (expr list rest) THEN
+ LEAVE x try WITH nil
+ ELIF atom (expr list rest) THEN
+ error stop ("Ausdrucksliste fuer 'try' endet falsch")
+ ELSE
+ try evaluation of actual expression
+ FI;
+ expr list rest := tail (expr list rest)
+ PER;
+ nil.
+
+try evaluation of actual expression:
+ disable stop;
+ SYM VAR result :: x eval (head (expr list rest), alist);
+ IF is error THEN
+ IF error message = "halt from terminal" AND halt enabled THEN
+ enable stop
+ ELIF output THEN
+ put error
+ FI;
+ add property (errors, apval constant, sym (error message));
+ clear error
+ ELSE
+ LEAVE x try WITH result
+ FI;
+ enable stop.
+
+END PROC x try;
+
+
+SYM PROC x eval condition (SYM CONST pair list, alist):
+ enable stop;
+ SYM VAR cond pair list rest :: pair list;
+ REP
+ IF atom (cond pair list rest) THEN
+ error stop ("Keine 'T'-Bedingung in bedingtem Ausdruck gefunden")
+ FI;
+ check wether is correct pair;
+ IF true condition found THEN
+ LEAVE x eval condition WITH x eval (head (tail (actual pair)), alist)
+ FI;
+ cond pair list rest := tail (cond pair list rest)
+ PER;
+ nil.
+
+check wether is correct pair:
+ IF atom (actual pair) COR
+ atom (tail (actual pair)) COR
+ NOT null (tail (tail (actual pair))) THEN
+ error stop ("Ungueltiges Paar im bedingten Ausdruck")
+ FI.
+
+true condition found:
+ bool (x eval (head (actual pair), alist)).
+
+actual pair:
+ head (cond pair list rest).
+
+END PROC x eval condition;
+
+
+BOOL PROC bool (SYM CONST sym):
+ IF eq (sym, true constant) THEN
+ TRUE
+ ELIF eq (sym, false constant) THEN
+ FALSE
+ ELSE
+ error stop ("'T' oder 'F' erwartet"); TRUE
+ FI
+END PROC bool;
+
+
+(******* a-list handling refinements used in 'x apply' and 'x eval' *******)
+
+(* declared within 'x apply' and 'x eval': 'actual alist entry' *)
+
+.
+
+initialize for alist insertion:
+ new alist := alist.
+
+begin alist retrieval:
+ SYM VAR actual alist pos :: alist.
+
+search for next alist entry:
+ WHILE NOT end of alist REP
+ IF atom (actual alist pos) THEN
+ error stop ("Bindeliste endet falsch")
+ FI;
+ actual alist entry := head (actual alist pos);
+ actual alist pos := tail (actual alist pos);
+ UNTIL is non functional alist entry PER.
+
+is non functional alist entry:
+ NOT is functional alist entry.
+
+search for next functional alist entry:
+ WHILE NOT end of alist REP
+ IF atom (actual alist pos) THEN
+ error stop ("Bindeliste endet falsch")
+ FI;
+ actual alist entry := head (actual alist pos);
+ actual alist pos := tail (actual alist pos);
+ UNTIL is functional alist entry PER;
+ actual alist entry := tail (actual alist entry).
+
+is functional alist entry:
+ check wether is alist entry;
+ null (head (actual alist entry)).
+
+check wether is alist entry:
+ IF atom (actual alist entry) THEN
+ error stop ("Bindelisteneintrag ist kein Paar")
+ FI.
+
+end of alist:
+ null (actual alist pos).
+
+actual functional alist entry:
+ actual alist entry.
+
+prepare new alist entry:
+ new alist := cons (cons (nil, nil), new alist);
+ new alist entry := head (new alist).
+
+prepare new functional alist entry:
+ new alist := cons (cons (nil, cons (nil, nil)), new alist);
+ new alist entry := tail (head (new alist)).
+
+
+END PACKET lisp interpreter;
+
+
diff --git a/lang/lisp/1.7.2/src/lisp.bootstrap b/lang/lisp/1.7.2/src/lisp.bootstrap new file mode 100644 index 0000000..f28aae8 --- /dev/null +++ b/lang/lisp/1.7.2/src/lisp.bootstrap @@ -0,0 +1,117 @@ +NIL APVAL
+NIL
+T APVAL
+T
+F APVAL
+F
+COND FUNCTION
+(LAMBDA ((INDEFINITE QUOTE X)) . 0)
+BEGINOBLISTDUMP FUNCTION
+(LAMBDA () . 1)
+NEXTATOM FUNCTION
+(LAMBDA () . 2)
+ADDPROPERTY FUNCTION
+(LAMBDA (X X X) . 3)
+ALTERPROPERTY FUNCTION
+(LAMBDA (X X X) . 4)
+DELETEPROPERTY FUNCTION
+(LAMBDA (X X) . 5)
+PROPERTYEXISTS FUNCTION
+(LAMBDA (X X) . 6)
+PROPERTY FUNCTION
+(LAMBDA (X X) . 7)
+ADDFLAG FUNCTION
+(LAMBDA (X X) . 8)
+FLAG FUNCTION
+(LAMBDA (X X) . 9)
+DELETEFLAG FUNCTION
+(LAMBDA (X X) . 10)
+BEGINPROPERTYLISTDUMP FUNCTION
+(LAMBDA (X) . 11)
+NEXTPROPERTY FUNCTION
+(LAMBDA () . 12)
+APPLY FUNCTION
+(LAMBDA (X X X) . 13)
+EVAL FUNCTION
+(LAMBDA (X X) . 14)
+TRY FUNCTION
+(LAMBDA (X X X X) . 15)
+ASSOCIATIONLIST FUNCTION
+(LAMBDA () . 16)
+ERRORSTOP FUNCTION
+(LAMBDA (X) . 17)
+HEAD FUNCTION
+(LAMBDA (X) . 18)
+SETHEAD FUNCTION
+(LAMBDA (X X) . 19)
+TAIL FUNCTION
+(LAMBDA (X) . 20)
+SETTAIL FUNCTION
+(LAMBDA (X X) . 21)
+CONS FUNCTION
+(LAMBDA (X X) . 22)
+EQ FUNCTION
+(LAMBDA (X X) . 23)
+GET FUNCTION
+(LAMBDA () . 24)
+PUT FUNCTION
+(LAMBDA (X) . 25)
+NULL FUNCTION
+(LAMBDA (X) . 26)
+ATOM FUNCTION
+(LAMBDA (X) . 27)
+NAMEDATOM FUNCTION
+(LAMBDA (X) . 28)
+GETATOM FUNCTION
+(LAMBDA () . 29)
+PUTATOM FUNCTION
+(LAMBDA (X) . 30)
+TEXT FUNCTION
+(LAMBDA (X) . 31)
+GETTEXT FUNCTION
+(LAMBDA () . 32)
+PUTTEXT FUNCTION
+(LAMBDA (X) . 33)
+CHARACTER FUNCTION
+(LAMBDA (X) . 34)
+GETCHARACTER FUNCTION
+(LAMBDA () . 35)
+PUTCHARACTER FUNCTION
+(LAMBDA (X) . 36)
+INT FUNCTION
+(LAMBDA (X). 37)
+GETINT FUNCTION
+(LAMBDA () . 38)
+PUTINT FUNCTION
+(LAMBDA (X) . 39)
+SUM FUNCTION
+(LAMBDA ((INDEFINITE X)) . 40)
+DIFFERENCE FUNCTION
+(LAMBDA (X X). 41)
+PRODUCT FUNCTION
+(LAMBDA ((INDEFINITE X)). 42)
+QUOTIENT FUNCTION
+(LAMBDA (X X).43)
+REMAINDER FUNCTION
+(LAMBDA (X X).44)
+EQUAL FUNCTION
+(LAMBDA (X X) . 45)
+TRACE FUNCTION
+(LAMBDA () . 46 )
+DEFINE FUNCTION
+(LAMBDA ((INDEFINITE X)) . 47 )
+SET FUNCTION
+(LAMBDA (X X) . 48 )
+QUOTE FUNCTION
+(LAMBDA ((QUOTE X)) X)
+LIST FUNCTION
+(LAMBDA ((INDEFINITE X)) X)
+DO FUNCTION
+(LAMBDA ((INDEFINITE X)) NIL)
+PUTLIST FUNCTION
+(LAMBDA ((INDEFINITE X))
+ (COND
+ ((NULL X) NIL)
+ (T (DO (PUT (HEAD X)) (PUTLIST (TAIL X))))
+ )
+)
diff --git a/lang/lisp/1.8.7/doc/lisp handbuch b/lang/lisp/1.8.7/doc/lisp handbuch new file mode 100644 index 0000000..022c561 --- /dev/null +++ b/lang/lisp/1.8.7/doc/lisp handbuch @@ -0,0 +1,2260 @@ +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#Lisp + + + + +#off("b")# +#center#Lizenzfreie Software der +#on ("b")# + +#center#Gesellschaft fĂ¼r Mathematik und Datenverarbeitung mbH, +#center#5205 Sankt Augustin + + +#off("b")# +#center#Die Nutzung der Software ist nur im Schul- und Hochschulbereich fĂ¼r +#center#nichtkommerzielle Zwecke gestattet. + +#center#Gewährleistung und Haftung werden ausgeschlossen + + +____________________________________________________________________________ +#page# +#free(7.0)# +#center#LISP - Handbuch +#free(2.0)# +Stand: 08.08.86 + +Installation von LISP + +begin ("LISP") +reserve ("sprachen",archive) +fetch all(archive) +insert ("lisp.1") +insert ("lisp.2") +insert ("lisp.3") +insert ("lisp.4") +global manager +begin ("lisp","LISP") +fetch ("lisp.bootstrap") +lisp +#page# +#start(2.5,1.5)# +#block# +#pageblock# +#head# +#center#LISP-Handbuch +#center#% + + +#end# + + +#center#L I S P H a n d b u c h + + +#center#Autor: John Mc.Carthy (M.I.T.1962) +#center#Ă¼bersetzt und angepaĂŸt von J.Durchholz, P.Heyderhoff +#center#Gesellschaft fĂ¼r Mathematik und Datenverarbeitung Sankt Augustin + + + +Inhaltsverzeichnis + + + +1. Die Sprache LISP #right##topage("p1")# + +1.1 Symbolische AusdrĂ¼cke #right##topage("p1.1")# +1.2 Elementare Funktionen #right##topage("p1.2")# +1.3 Listen Notation #right##topage("p1.3")# +1.4 Syntax und Semantik der Sprache #right##topage("p1.4")# + +2. Das LISP-Interpreter-System #right##topage("p2")# + +2.1 Die universelle LISP-Funktion "evalquote" #right##topage("p2.1")# +2.2 Anwendungsregeln und Beispiele #right##topage("p2.2")# +2.3 Variablen #right##topage("p2.3")# +2.4 Konstanten #right##topage("p2.4")# +2.5 Funktionen #right##topage("p2.5")# + +3. Erweitertes LISP #right##topage("p3")# + +3.1 Gequotete Parameter #right##topage("p3.1")# +3.2 Funktionen mit beliebig vielen Parametern #right##topage("p3.2")# +3.3 Funktionale Parameter #right##topage("p3.3")# +3.4 Prädikate und boolesche Konstanten #right##topage("p3.4")# +3.5 Unbenannte Atome #right##topage("p3.5")# +3.6 Aufruf von EUMEL aus #right##topage("p3.6")# + +4. Detailbeschreibungen #right##topage("p4")# + +4.1 Grundfunktionen #right##topage("p4.1")# +4.2 Weitere Funktionen sowie Eingabe und Ausgabe #right##topage("p4.2")# +4.3 Interpreter #right##topage("p4.3")# +4.4 Kommandoprozeduren #right##topage("p4.4")# +#page# + +1. Die Sprache LISP#goalpage("p1")# + + + +Die Sprache LISP ist primär fĂ¼r die Symbolmanipulation entworfen. Sie wurde fĂ¼r +symbolische Berechnungen in verschiedenen Gebieten der kĂ¼nstlichen Intelligenz +eingesetzt, u.a. fĂ¼r Differential- und Integralrechnung, Schaltkreistheorie, Mathemati +sche Logik, Spiele, etc.. + +LISP ist eine formale mathematische Sprache. Daher ist es möglich, eine genaue und +vollständige Beschreibung zu geben. Das ist der Sinn des ersten Abschnitts dieses +Handbuchs. Andere Abschnitte werden Möglichkeiten zum vorteilhaften Einsatz von +LISP und die Erweiterungen, die die Benutzung erleichtern, beschreiben. + +LISP unterscheidet sich von den meisten Programmiersprachen in drei Punkten. + +Der erste Punkt liegt in der Natur der Daten. In der Sprache LISP haben alle Daten +die Form symbolischer AusdrĂ¼cke, die wir verkĂ¼rzend LISP-AusdrĂ¼cke nennen wer +den. LISP-AusdrĂ¼cke haben keine Längenbegrenzung und eine verzweigte Baum +struktur, so daĂŸ UnterausdrĂ¼cke leicht isoliert werden können. In LISP wird der meiste +Speicherplatz fĂ¼r das Abspeichern der LISP-AusdrĂ¼cke in Form von Listenstruktu +ren gebraucht. + +Der zweite wichtige Teil der Sprache LISP ist die Quellsprache, die festlegt, wie die +LISP-AusdrĂ¼cke verarbeitet werden sollen. + +Drittens kann LISP als LISP-AusdrĂ¼cke geschriebene Programme interpretieren und +ausfĂ¼hren. Deshalb kann man die Sprache analog zu Assemblersprachen und im +Gegensatz zu den meisten anderen höheren Programmiersprachen einsetzen, um +Programme zu generieren, die gleich ausgefĂ¼hrt werden sollen. + + +#page# + +1.1 Symbolische AusdrĂ¼cke #goalpage("p1.1")# + + + +Ein elementarer Ausdruck ist ein Atom. + +Definition: Ein Atom ist eine Zeichenkette bestehend aus GroĂŸbuchstaben und + Ziffern. + + +Beispiele: A + APFEL + TEIL2 + EXTRALANGEZEICHENKETTEAUSBUCHSTABEN + A4B66XYZ2 + + +Diese Symbole werden atomar genannt, weil sie als Ganzes aufgefaĂŸt werden, das +durch die LISP-Funktionen nicht weiter geteilt werden kann. A, B, und AB haben +keinerlei Beziehung zueinander, auĂŸer der, daĂŸ sie alle verschiedene Atome sind. + +Alle LISP-AusdrĂ¼cke werden aus Atomen und den Satzzeichen "(", ")" und "." +aufgebaut. Die grundlegende Operation zum Aufbau von LISP-AusdrĂ¼cken ist die, +zwei LISP-AusdrĂ¼cke zusammenzufassen, um einen grĂ¶ĂŸeren herzustellen. Aus den +zwei Atomen A und B kann man so den LISP-Ausdruck (A.B) bilden. + +Definition: Ein LISP-Ausdruck ist entweder ein Atom, oder aus folgenden Elemen + ten in dieser Reihenfolge aufgebaut: Eine öffnende Klammer, ein + LISP-Ausdruck, ein Punkt, ein LISP-Ausdruck, eine schlieĂŸende + Klammer. Zwischen den Bestandteilen eines nichtatomaren LISP-Aus + druck können beliebig viele Leerzeichen eingestreut sein. + +Diese Definition ist rekursiv. + + +Beispiele: ATOM + (A . B) + (A . (B . C)) + ((A1 . A2) . B) + ((U . V) . (X . Y)) + ((U . V) . (X . (Y . Z))) + + +Um die Struktur solcher AusdrĂ¼cke zu verdeutlichen, wird in diesem Handbuch oft +eine graphische Darstellung gewählt. In dieser Darstellung sind die Atome weiterhin +Zeichenketten, statt der Paare steht jetzt aber ein Kasten + + + +-----+-----+ + | o | o | + +-----+-----+ + + +von dem zwei Zeiger ausgehen, die auf die graphische Darstellung des ersten bzw. +zweiten Elements des Paars zeigen. + + + +Beispiele: (A . B) +-----+-----+ + | o | o | + +--+--+--+--+ + | | + V V + A B + + (A . (B . C)) +-----+-----+ + | o | o | + +--+--+--+--+ + | | + V V + A +-----+-----+ + | o | o | + +--+--+--+--+ + | | + V V + B C + + ((U . V) . (X . (Y . Z))) +-----+-----+ + | o | o | + +--+--+--+--+ + | | + V V + +-----+-----+ +-----+-----+ + | o | o | | o | o | + +--+--+--+--+ +--+--+--+--+ + | | | | + V V V V + U V X +-----+-----+ + | o | o | + +--+--+--+--+ + | | + V V + Y Z + + + + + + +#page# + +1.2 Elementare Funktionen #goalpage("p1.2")# + + +Wir werden einige elementare Funktionen auf LISP-AusdrĂ¼cken einfĂ¼hren. Um die +Funktionen von den LISP-AusdrĂ¼cken zu unterscheiden, werden wir Funktionsnamen +mit Klein- statt GroĂŸbuchstaben schreiben. AuĂŸerdem steht der Funktionsname +gefolgt von den Argumenten, auf die die Funktion angewendet werden soll, in Klam +mern eingeschlossen in einer Liste. Dabei sind die Argumente durch Blanks vonein +ander getrennt. + +Die erste Funktion, die wir einfĂ¼hren, heiĂŸt "cons". Sie hat zwei Argumente und wird +dafĂ¼r benutzt, LISP-AusdrĂ¼cke aus kleineren LISP-AusdrĂ¼cken aufzubauen. + + + Funktionsaufruf: Ergebnis: + +Beispiele: (cons A B) = (A . B) + (cons (A . B) C) = ((A . B) . C) + (cons (cons A B) C) = ((A . B) . C) + + +Die Beispiele zeigen Funktionsaufrufe. Ein Funktionsaufruf ist eine Liste beginnend +mit einem Funktionsnamen, gefolgt von Argumenten. Alle Funktionsaufrufe haben ein +Ergebnis, das im Fall von LISP-Funktionen immer ein LISP-Ausdruck ist. + +In diesen Beispielen kommt nur die Funktion "cons" vor. Das letzte Beispiel ist ein +Fall von Funktionsverkettung, das heiĂŸt, als Argument steht ein Funktionsaufruf. Um +das Ergebnis eines Funktionsaufrufs zu berechnen, das Funktionsaufrufe als Argu +mente enthält, muĂŸ man statt dieser Argumente die Ergebnisse dieser Funktionsaufru +fe einsetzen, so daĂŸ man den äuĂŸeren Funktionsaufruf in einen Aufruf ohne Funk +tionsaufrufe als Argumente umwandelt. + + +Beispiel: (cons (cons A B) C) = (cons (A . B) C) = ((A . B) . C) + + +Es ist möglich, durch Verkettung der Funktion "cons" jeden LISP-Ausdruck aus +seinen atomaren Komponenten aufzubauen. + +Die folgenden beiden Funktionen tun das genaue Gegenteil von "cons": sie liefern +die UnterausdrĂ¼cke eines gegebenen LISP-Ausdrucks. + +Die Funktion "head" hat ein Argument. Ihr Wert ist der erste Unterausdruck des +zusammengesetzen Arguments. Der "head" eines Atoms ist nicht definiert. + + +Beispiele: (head (A . B)) = A + (head (A . (B1 . B2))) = A + (head ((A1 . A2) . B)) = (A1 . A2) + (head A) ist nicht definiert + + +Die Funktion "tail" hat ebenfalls ein Argument, und sie liefert das Argument bis auf +dessen "head". + + +Beispiele: (tail (A . B)) = B + (tail (A . (B1 . B2))) = (B1 . B2) + (tail ((A1 . A2) . B)) = B + (tail A) ist nicht definiert + (head (tail (A . (B1 . B2)))) = B1 + (head (tail (A . B))) ist nicht definiert + (head (cons A B)) = A + + +Es ist bei jedem LISP-Ausdruck möglich, durch eine geeignete Verkettung von +"head" und "tail" zu jedem Atom im Ausdruck zu gelangen. + +Wenn "x" und "y" irgendwelche LISP-AusdrĂ¼cke repräsentieren, gelten die folgen +den Gleichungen immer: + + + (head (cons x y)) = x + (tail (cons x y)) = y + + +AuĂŸerdem gilt die folgende Gleichung fĂ¼r jeden nichtatomaren LISP-Ausdruck "z": + + + (cons (head z) (tail z)) = z +9 + +Die Symbole "x", "y" und "z", die wir in diesen Gleichungen benutzt haben, nennt +man Variablen. In LISP werden Variable benutzt, um LISP-AusdrĂ¼cke zu repräsentie +ren, und zwar repräsentiert eine Variable in einer Gleichung immer denselben +LISP-Ausdruck. Variablennamen werden wie Funktionsnamen gebildet, d.h. sie +können Kleinbuchstaben und Ziffern enthalten. + +Eine Funktion, deren Wert "wahr" oder "falsch" sein kann, wird Prädikat genannt. In +LISP werden die Werte "wahr" und "falsch" durch die Atome "T" (true) und "F" +(false) vertreten. Ein LISP-Prädikat ist also eine Funktion, deren Wert entweder "T" +oder "F" ist. + +Das Prädikat "eq" ist ein Gleichheitstest fĂ¼r Atome. Es ist bei nicht atomaren Argu +menten nicht definiert. + + +Beispiele: (eq A A) = T + (eq A B) = F + (eq A (A . B)) ist nicht definiert + (eq (A . B) B) ist nicht definiert + (eq (A . B) (A . B)) ist nicht definiert + + +Das Prädikat "atom" hat das Ergebnis ("liefert") "T", wenn sein Argument atomar ist, +und "F", wenn sein Argument zusammengesetzt ist. + + +Beispiele: (atom EXTRALANGEZEICHENKETTE) = T + (atom (U . V)) = F + (atom (head (U . V))) = T + +#page# + +1.3 Listen-Notation #goalpage("p1.3")# + + + +Alle LISP-AusdrĂ¼cke, die wir bisher gesehen haben, waren in Punkt-Notation +geschrieben. Normalerweise ist es allerdings einfacher, statt der vielen Punkte und +Klammern Listen von LISP-AusdrĂ¼cken zu schreiben, etwa in der Art (A B C XYZ). + +LISP bietet eine solche Alternative zur Punkt-Notation an: + +Definition: Die Liste (a1 a2 ... an) ist äquivalent zum LISP-Ausdruck + (a1 . (a2 . (... . (an . NIL) ... ))). + +Graphisch ausgedrĂ¼ckt heiĂŸt das: + + + +-----+-----+ + | o | o | + +--+--+--+--+ + | | + V V + a1 +-----+-----+ + | o | o | + +--+--+--+--+ + | | + V V + a2 + . + . + . + + +-----+-----+ + | o | o | + +--+--+--+--+ + | | + V V + an NIL + + + +Oft werden wir fĂ¼r Listen auch die graphische Form + + + +-----+-----+ +-----+-----+ +-----+-----+ + | o | o--+-->| o | o--+--> . . . | o | o--+--> NIL + +--+--+-----+ +--+--+-----+ +--+--+-----+ + | | | + V V V + a1 a2 an + + +benutzen. + +Aus der Graphik wird deutlich, daĂŸ NIL als eine Art AbschluĂŸmarkierung fĂ¼r Listen +dient. + +Eine leere Liste wird durch das Atom NIL dargestellt. Das Prädikat "null" liefert "T", +wenn sein Argument eine leere Liste ist, sonst "F". + + +Beispiele: (null NIL) = T + (null () ) = T + (null (A B)) = F + + +Die Listenelemente können selbst wieder Listen oder Paare in Punkt-Notation sein, +so daĂŸ Listen- und Punkt-Notation beliebig kombinierbar sind. + + + Beispiele: (A B C) = (A . (B . (C . NIL))) + + +-----+-----+ +-----+-----+ +-----+-----+ + | o | o--+-->| o | o--+-->| o | o--+--> NIL + +--+--+-----+ +--+--+-----+ +--+--+-----+ + | | | + V V V + A B C + + ((A . B) C) = ((A . B) . (C . NIL)) + + +-----+-----+ +-----+-----+ + | o | o--+-->| o | o--+--> NIL + +--+--+-----+ +--+--+-----+ + | | + V V + +-----+-----+ C + | o | o | + +--+--+--+--+ + | | + V V + A B + + ((A B) C) = ((A . (B . NIL)) . (C . NIL)) + + +-----+-----+ +-----+-----+ + | o | o--+--------------->| o | o--+--> NIL + +--+--+-----+ +--+--+-----+ + | | + | V + V C + +-----+-----+ +-----+-----+ + | o | o--+-->| o | o--+--> NIL + +--+--+-----+ +--+--+-----+ + | | + V V + A B + + (A) = (A . NIL) + + +-----+-----+ + | o | o--+--> NIL + +--+--+-----+ + | + V + A + + ((A)) = ((A . NIL) . NIL) + + +-----+-----+ + | o | o--+--> NIL + +--+--+-----+ + | + V + +-----+-----+ + | o | o--+--> NIL + +--+--+-----+ + | + V + A + + + + + +Es ist sehr hilfreich, mit den Ergebnissen der elementaren Funktionen vertraut zu +sein, wenn diese Listen als Argumente erhalten. Zwar können die Ergebnisse notfalls +immer durch Ăœbersetzung in Punkt-Notation bestimmt werden, aber ein direktes +Verständnis ist einfacher. + + +Beispiele: (head (A B C)) = A + (tail (A B C)) = (B C) + + + (Daher auch die Namen "head" und "tail"! Frei Ă¼bersetzt heiĂŸen die + beiden Funktionen "anfang" und "rest".) + + + (cons A (B C)) = (A B C) + +#page# + +1.4 Syntax und Semantik der Sprache #goalpage("p1.4")# + + + +Wir haben bisher einen Datentyp (LISP-AusdrĂ¼cke) und fĂ¼nf elementare Funktionen +eingefĂ¼hrt. AuĂŸerdem haben wir die folgenden Eigenschaften der Sprache beschrie +ben: + +1. Funktions- und Variablennamen werden wie die Namen von Atomen geschrie + ben, auĂŸer, daĂŸ dafĂ¼r Klein- statt GroĂŸbuchstaben verwendet werden. +2. Die Argumente einer Funktion folgen dieser in der Liste. Eine solche Liste von + Funktion und folgenden Argumenten heiĂŸt Funktionsaufruf und hat einen LISP- + Ausdruck als Ergebnis. +3. Funktionen können dadurch verkettet werden, daĂŸ ein Argument aus einem Funk + tionsaufruf selbst wieder ein Funktionsaufruf ist, dessen Argumente selbst wieder + Funktionsaufrufe sein können, usw. + +Diese Regeln erlauben es, Funktionsdefinitionen wie + + + (third x) = (head (tail (tail x))) + + +zu schreiben. "third" holt das dritte Element aus einer Liste. + +Die Klasse der Funktionen, die man auf diese Weise bilden kann, ist ziemlich be +schränkt und nicht sehr interessant. Eine viel grĂ¶ĂŸere Funktionenklasse kann man mit +Hilfe des bedingten Ausdrucks schreiben; es handelt sich dabei um eine Möglichkeit, +Verzweigungen in Funktionsdefinitionen einzubauen. + +Ein bedingter Ausdruck hat die Form + + + (cond (p1 a1) (p2 a2) ... (pn an) ) + + +Jedes pi ist ein Ausdruck, dessen Wert "T" oder "F" ist, also ein Prädikat. Die ai +sind beliebige LISP-AusdrĂ¼cke. + +Die Bedeutung eines bedingten Ausdrucks ist folgende: Wenn p1 wahr ist, ist a1 der +Wert des ganzen Ausdrucks. Wenn p1 falsch ist, wird getestet, ob p2 wahr ist; wenn +das der Fall ist, ist a2 der Wert des Ausdrucks. Die pi werden also von links nach +rechts durchgegangen, bis ein wahrer Ausdruck gefunden ist; das zugehörige ai ist +dann der Wert des bedingten Ausdrucks. Wenn kein wahres pi gefunden ist, ist der +bedingte Ausdruck nicht definiert. +Jedes pi oder ai kann selbst wieder ein LISP-Ausdruck, ein Funktionsaufruf oder ein +bedingter Ausdruck sein. + + +Beispiel: (cond ((eq (head x) A) (cons B (tail x))) (T x) ) + + +Das Prädikat "T" ist immer wahr. Man liest es am besten als "SONST". Den Wert +dieses Ausdruck erhält man, wenn man "head" von x durch B ersetzt, wenn der +gerade gleich mit A ist, und sonst erhält man x. + +Der Hauptzweck von bedingten AusdrĂ¼cken ist die rekursive Definition von Funktio +nen. + + +Beispiel: (firstatom x) = (cond ((atom x) x) + ( T (firstatom (head x))) + ) + + +Dies Beispiel definiert die Funktion "firstatom", die das erste Atom jedes LISP-Aus +drucks bestimmt. Diesen Ausdruck kann man so lesen: wenn "x" ein Atom ist, ist "x" +selbst die Antwort; sonst muĂŸ "firstatom" auf "head" von "x" angewandt werden. + +Wenn also "x" ein Atom ist, wird der erste Zweig gewählt, der "x" liefert; sonst wird +der zweite Zweig "firstatom (head x)" gewählt, weil "T" immer wahr ist. + +Die Definition von "firstatom" ist rekursiv, d.h. "firstatom" ist mit durch sich selbst +definiert. Allerdings, wenn man immerzu den "head" von irgendeinem LISP-Aus +druck nimmt, errreicht man irgendwann ein Atom, so daĂŸ der ProzeĂŸ immer wohlde +finiert ist. + +Es gibt rekursive Funktionen, die nur fĂ¼r bestimmte Argumente wohldefiniert sind, fĂ¼r +bestimmte andere dagegen unendlich rekursiv. Wenn das EUMEL-LISP-System +einen Funktionsionsaufruf mit einer solchen Funktion und "kritischen" Argumenten +interpretiert, gerät es in unendliche Rekursion, bis entweder der zur VerfĂ¼gung ste +hende Platz im LISP-Heap ausgeschöpft ist (im Heap werden die LISP-AusdrĂ¼cke +gespeichert) oder bis der Laufzeitstack Ă¼berläuft (der Laufzeitstack ist ein normaler +weise unsichtbarer Bestandteil des ELAN-Systems). +Wir werden jetzt die Berechnung von "(firstatom ((A . B) . C))" durchfĂ¼hren. Zunächst +ersetzen wir die Variable x in der Funktionsdefinition durch ((A . B) . C) und erhalten + + + (firstatom ((A . B) . C)) = + (cond ( (atom ((A . B) . C)) ((A . B) . C) ) + ( T (firstatom (head ((A . B) . C))) ) + ) + +((A . B) . C) ist kein Atom, deshalb wird daraus + + = (cond ( T (firstatom (head ((A . B) . C)))) ) + = (firstatom (head ((A . B) . C)) ) + = (firstatom (A . B)) + + + +An diesem Punkt mĂ¼ssen wir wieder die Definition von "firstatom" benutzen, diesmal +aber fĂ¼r "x" Ă¼berall "(A . B)" einsetzen. + + + (firstatom (A . B)) = (cond ( (atom (A . B)) (A . B) ) + (T (firstatom (head (A . B))) ) + ) + = (cond (T (firstatom (head (A . B))) ) ) + = (firstatom (head (A . B)) ) + = (firstatom A) + = (cond ((atom A) A) + (T (firstatom (head A)) ) + ) + = A + + +Wenn in den bedingten AusdrĂ¼cken statt der LISP-AusdrĂ¼cke arithmetische Aus +drĂ¼cke verwendet wĂ¼rden, könnte man damit auch numerische Rechenvorschriften +definieren, wie z.B. den Betrag einer Zahl durch + + + (abs x) = (cond ((x < 0) -x) (T x) ) + + +oder die Fakultät durch + + + (fak n) = (cond ((n = 0) 1) + (T (x * (fak (n - 1)))) + ) + + +Die Fakultät terminiert bei negativen Argumenten nicht. + +Es ist bei den meisten Mathematikern (auĂŸer den Logikern) Ă¼blich, das Wort "Funk +tion" nicht präzise zu verwenden und auf AusdrĂ¼cke wie "2x+y" anzuwenden. Da wir +AusdrĂ¼cke benutzen werden, die Funktionen repräsentieren, benötigen wir eine +Notation, die Funktionen und AusdrĂ¼cke unterscheidet. DafĂ¼r ist die Lambda-Nota +tion von Alonzo Church geeignet. +"f" soll ein Ausdruck sein, der fĂ¼r eine Funktion zweier ganzzahliger Variablen steht. + +Dann sollte es sinnvoll sein, den Funktionsaufruf + + + (f 3 4) + + +zu schreiben, so daĂŸ man dadurch den Wert dieses Funktionsaufrufs berechnen kann; +z.B. könnte "(summe 3 4) = 7" gelten. + +Wenn man "2x + y" als Funktion ansieht, kann man den Funktionsaufruf + + + ((2x + y) 3 4) + + +schreiben. Der Wert dieses Ausdrucks ist aber nicht eindeutig bestimmt, denn es ist +Ă¼berhaupt nicht klar, ob nun "2*3+4" oder 2*4+3" gemeint ist. Eine Zeichenfolge +wie "2x + y" werden wir deshalb Ausdruck und nicht Funktion nennen. Ein Ausdruck +kann in eine Funktion umgewandelt werden, indem man die Zuordnung von Argumen +ten und Variablen festlegt. Bei "2x + y" könnte man beispielsweise festlegen, daĂŸ +"x" immer das erste und "y" immer das zweite Argument sein soll. +Wenn "a" ein Ausdruck in den Variablen x1, ... xn ist, dann ist + + + (lambda (x1 ... xn) a) + + +eine Funktion mit n Argumenten. Den Wert der Funktionsaufrufe mit dieser Funktion +(also der AusdrĂ¼cke der Form + + + ((lambda (x1 ... xn) a) (b1 ... bn)) + erhält man, indem man die Variablen x1 ... xn durch die n Argumente des Aufrufs +ersetzt. Beispielsweise ist + + + ((lambda (x y) (2*x + y)) (3 4)) = 2*3 + 4 = 10 , + + +während + + + ((lambda (y x) (2*x + y)) (3 4)) = 2*4 + 3 = 11 + + +ist. + +Die Variablen in einem Lambdaausdruck sind sogenannte Parameter (oder gebundene +Variable). Interessant ist, daĂŸ eine Funktion sich nicht ändert, wenn man eine Variable +systematisch durch eine andere Variable ersetzt, die nicht bereits im Lambdaausdruck +vorkommt. + + + (lambda (x y) (2*y + x)) + + +ist also dasselbe wie + + + (lambda (u v) (2*v + u)) . + + +Manchmal werden wir AusdrĂ¼cke benutzen, in denen eine Variable nicht durch das +Lambda gebunden ist. Beispielsweise ist das n in + + + (lambda (x y) (x*n + y*n)) + + +nicht gebunden. Eine solche nicht gebundene Variable nennt man frei. +Wenn fĂ¼r eine freie Variable vor der Benutzung kein Wert vereinbart wurde, ist der +Wert des Funktionsaufrufs nicht definiert, falls der Wert der Variablen auf das Ergeb +nis einen EinfluĂŸ hat. + +Die Lambdanotation reicht allein fĂ¼r die Definition rekursiver Funktionen nicht aus. +Neben den Variablen muĂŸ auch der Name der Funktion gebunden werden, weil er +innerhalb der Funktion fĂ¼r eine Zeichenfolge steht. + +Wir hatten die Funktion "firstatom" durch die Gleichung + + + (firstatom x) = (cond ((atom x) x) + (T (firstatom (head x))) + ) + + +definiert. Mit der Lambda-Notation können wir schreiben: + + + firstatom = (lambda (x) (cond ((atom x) x) + (T (firstatom (head x))) + ) ) + + + +Das Gleichheitszeichen ist in Wirklichkeit nicht Teil der LISP-Sprache, sondern eine +KrĂ¼cke, die wir nicht mehr brauchen, wenn wir die richtige Schreibweise eingefĂ¼hrt +haben. + +Die rechte Seite der obigen Gleichung ist als Funktion nicht vollständig, da dort nichts +darauf hinweist, daĂŸ das "firstatom" im einem bedingten Ausdruck fĂ¼r eben die rechte +Seite steht. Deshalb ist die rechte Seite als Definition fĂ¼r die linke Seite ("firstatom") +noch nicht geeignet. + +Damit wir Definitionen schreiben können, in denen der Name der gerade definierten +Funktion auftaucht, fĂ¼hren wir die Label-Notation ein (engl. label = Marke, (Preis-) +Schildchen). Wenn "a" eine Funktion ist, und "n" ihr Name, schreiben wir "(label n +a)". + +Nun können wir die Funktion "firstatom" ohne Gleichheitszeichen schreiben: + + + (label firstatom (lambda (x) (cond ((atom x) x) + (T (firstatom (head x))) + ) ) ) + + +In dieser Definition ist "x" eine gebundene Variable und "firstatom" ein gebundener +Funktionsname. +#page# + +2. Das LISP-Interpreter-System#goalpage("p2")# + + + +2.1 Die universelle LISP-Funktion + "evalquote" #goalpage("p2.1")# + + + +Ein Interpreter oder eine allgemeine Funktion ist eine Funktion, die den Wert jedes +gegebenen Ausdrucks berechnen kann, wenn der Ausdruck in einer geeigneten Form +vorliegt. (Wenn der zu interpretierende Ausdruck einen Aufruf einer unendlich rekur +siven Funktion enthält, wird der Interpreter natĂ¼rlich ebenfalls unendlich rekursiv.) +Wir sind jetzt in der Lage, eine allgemeine LISP-Funktion + + + (evalquote function arguments) + + +zu definieren. "evalquote" muĂŸ als erstes Argument ein LISP-Ausdruck Ă¼bergeben +werden. Dieser wird als Funktion aufgefasst und auf die folgenden Argumente ange +wendet. + +Im Folgenden sind einige nĂ¼tzliche Funktionen zur Manipulation von LISP-Aus +drĂ¼cken angegeben. Einige von ihnen werden als Hilfsfunktionen fĂ¼r die Definition von +"evalquote" gebraucht, die wir uns vorgenommen haben. + + + (equal x y) + + +ist ein Prädikat, das wahr ist, wenn seine Argumente gleiche LISP-AusdrĂ¼cke sind. +(Das elementare Prädikat "eq" ist ja nur fĂ¼r Atome definiert.) + +Die Definition von "equal" ist ein Beispiel fĂ¼r einen bedingten Ausdruck innerhalb +eines bedingten Ausdrucks. + + +(label equal + (lambda (x y) + (cond + ((atom x) (cond + ((atom y) (eq x y)) + (T F) + ) + ) + ((equal (head x) (head y)) (equal (tail x) (tail y))) + (T F) + ) + ) +) + + + +Folgende Funktion liefert einen LISP-Ausdruck, der gleich mit "destination" ist, +auĂŸer daĂŸ darin Ă¼berall statt "old" "new" steht. + + +(changeall (destination old new)) + += (cond ((equal destination old) new) + ((atom destination) destination) + (T (cons (changeall (head destination) old new) + (changeall (tail destination) old new) + ) + ) + ) + + +Beispielsweise gilt + + +(changeall ((A . B) . C) B (X . A)) = ((A . (X . A)) . C) + + +Die folgenden Funktionen sind nĂ¼tzlich, wenn Listen verarbeitet werden sollen. + +1. (append x y) + hängt an die Liste "x" den LISP-Ausdruck "y". + + + (append x y) = + (cond ((null x) y) + (T (cons (head x) (append (tail x) y) )) + ) + + +2. (member list pattern) + Dies Prädikat testet, ob der LISP-Ausdruck "pattern" in der Liste "list" vor + kommt. + + + (member list pattern) = + (cond ((null list) F) + ((equal (head list) pattern) T) + (T (member (tail list) pattern)) + ) + + +3. (pairlist list1 list2 oldpairlist) + Diese Funktion liefert eine Liste von Paaren, die die sich entsprechenden Elemen + te der Listen "list1" und "list2" enthalten, und an der noch die Liste "oldpairlist" + hängt. + + + + (pairlist list1 list2 oldpairlist) = + (cond ((null list1) oldpairlist) + (T (cons (cons (head list1) (head list2)) + (pairlist (tail list1) (tail list2) oldpairlist) + ) + ) + ) + + +Beispiel: + (pairlist (A B C) (U V W) ((D . X) (E . Y)) ) = + ((A . U) (B . V) (C . W) (D . X) (E . Y)) + + +Eine solche Liste von Paaren wird auch Assoziationsliste genannt, wenn das erste +Element jedes Paars ein Atom ist, das Ă¼ber diese Liste mit dem zweiten Element +assoziiert ist. + +5. (association pattern associationlist) + Wenn "association list" eine Assoziationsliste wie oben beschrieben ist, liefert + "association" das Paar der Liste, dessen erstes Element "pattern" ist. Es ist also + eine Funktion zum Durchsuchen von Tabellen. + + + (association pattern alist) = + (cond ((eq (head (head alist)) pattern) (head alist)) + (T (association pattern (tail alist))) + ) + +Beispiel: + +(association B ( (A . (M N)) + (B . (HEAD X)) + (C . (QUOTE M)) + (B . (TAIL X)) + ) ) = (B . (HEAD X)) + + +(replace expr alist) + "alist" muĂŸ eine Assoziationsliste sein. "replace" produziert einen Ausdruck, der + "expr" sehr ähnlich ist, nur sind alle Atome darin durch den LISP-Ausdruck + ersetzt, mit dem sie in "alist" assoziiert sind. + + + (replace expr alist) = + (cond ((atom expr) (association expr alist)) + (T (cons (replace (head expr) alist) + (replace (tail expr) alist) + ) + ) + ) + +Beispiel: + + (replace (X SCHRIEB Y) + ((Y . (GOETZ VON BERLICHINGEN)) (X . GOETHE)) + ) + + = (GOETHE SCHRIEB (GOETZ VON BERLICHINGEN)) + + + +Die allgemeine Funktion "evalquote", die wir jetzt definieren wollen, gehorcht der +folgendem Beispiel zugrundeliegenden Regel: + + +Beispiel: + (evalquote +Funktion: (LAMBDA (X Y) (CONS (HEAD X) Y) ) +Argumente: (A B) (C D) + ) += + (apply +Funktion: (LAMBDA (X Y) (CONS (HEAD X) Y)) +Argumentliste: ((QUOTE (A B)) (QUOTE (C D))) +Bindung: NIL + ) + + +Die Argumente von "evalquote" werden also zu einer gequoteten Argumentliste von +"apply". Die QUOTE-Funktion bewirkt, daĂŸ das Argument der QUOTE-Funktion +wörtlich genommen, also nicht weiter evaluiert wird. Das dritte Argument von "apply", +das NIL ist eine leere Bindeliste zur Bindung von Parametern und Argumenten im +nächsten Schritt: + + += + (eval +Argumente: (CONS (HEAD X) Y) +Bindung: ((X.(A B)) (Y . (C D))) + ) += + (cons (head (A B)) (C D)) += + (A C D) = Ergebnis von "evalquote" . + + +"evalquote" wird hauptsächlich durch die Hilfsfunktion "apply" definiert. "apply" +berechnet Funktionsaufrufe, indem es die Argumente und die Parameter der Funktion +bindet und den Funktionsrumpf berechnet. Die Bindungen werden in einer Assozia +tionsliste, der Bindeliste, gespeichert. Da bedingte AusdrĂ¼cke und Konstanten formal +wie Funktionsaufrufe von Funktionen "cond" und "quote" aussehen, werden sie auch +so behandelt. + +Wir definieren also: + + + (evalquote fkt expr) = (apply fkt (quote expr) NIL) . + + +sowie : + + + (eval expr binding) = + (cond ((atom expr) (tail (association expr binding))) + (T (apply (head expr) (tail expr) binding)) + ) + + +"eval" stellt also erst fest, ob es sich um ein Atom oder um einen Funktionsaufruf +handelt. Da es nur diese beiden Möglichkeiten gibt, ist diese Einteilung vollständig. + +Atome sind immer Ăœbersetzungen von Variablen, fĂ¼r die eine Bindung existieren muĂŸ, +so daĂŸ ihr Wert aus der Bindeliste geholt wird. + +Funktionsaufrufe sind immer Listen; im zweiten Zweig werden die Funktion und die +Parameterliste getrennt und an "apply" Ă¼bergeben. + +Um sich die Aktionen in diesem zweiten Zweig von "eval" genauer vorstellen zu +können, ist vielleicht die in Abschnitt 1.1 beschriebene graphische Darstellungsmetho +de hilfreich; beispielsweise wĂ¼rde sich ein Lambda-Ausdruck so ausnehmen: + + + +-----+-----+ +-----+-----+ +-----+-----+ + | o | o--+-->| o | o--+-->| o | o--+-->NIL + +--+--+-----+ +--+--+-----+ +--+--+-----+ + | | | + V V V + LAMBDA Parameterliste Ausdruck + + +"apply" bekommt nun von "eval" eine Funktion und eine Parameterliste sowie die +Bindeliste Ă¼bergeben. Mit diesen beiden macht es folgendes: + + + (apply fn args binding) = +(cond + ((atom fn) + (cond ((eq fn HEAD) (head (eval (head args) binding))) + ((eq fn TAIL) (tail (eval (head args) binding))) + ((eq fn CONS) (cons (eval (head args) binding) + (eval (head (tail args)) binding) + ) ) + ((eq fn ATOM) (atom (eval (head args) binding))) + ((eq fn EQ) (eq (eval (head args) binding) + (eval (head (tail args)) binding) + ) ) + ((eq fn QUOTE) (head args)) + ((eq fn COND) (evalcond args binding)) + (T (apply (tail (association fn binding)) args binding)) + ) + ((eq (head fn) LABEL) + (apply (head (tail (tail fn))) + args (cons (cons (head (tail fn)) + (head (tail (tail fn))) + ) + binding) + ) ) + ((eq (head fn) LAMBDA) (eval (head (tail (tail fn))) + (pairlist (head (tail fn)) + args binding) + ) ) +) + + + + + + +Das erste Argument von "apply" ist eine Funktion (unter der Voraussetzung, daĂŸ +"quote" und "cond" als Funktionen anerkannt werden). + +Wenn es eine der elementaren Funktionen "head", "tail", "cons", "atom" oder "eq" +ist, wird die jweilige Funktion auf die Argumente angewandt, die vorher berechnet +werden. Diese Berechnung erfolgt mit "eval", das ja fĂ¼r Variablen Werte aus der +Bindeliste liefert und fĂ¼r Funktionsaufrufe das, was "apply" mit ihnen machen kann. + +Wenn es sich um "quote" handelt, wird das erste Argument unverändert geliefert +"quote" heiĂŸt ja "dies ist eine Konstante, die so, wie sie da steht, Ă¼bernommen wer +den soll". + +Wenn es sich um "cond" handelt, wird die Funktion "eval cond" aufgerufen, doch +auch ihre Argumente werden nicht berechnet, auĂŸerdem gehört die Assoziationsliste +zu den Argumenten: + + + eval (cond condlist, binding) = + (cond ((eval (head (head condlist)) binding) + (eval (head (tail (head condlist))) binding) + ) + (T (cond (tail condlist) binding)) + ) + + + +Hier empfiehlt es sich, einen bedingten Ausdruck in graphischer Form hinzuschreiben +und die Auswertung anhand der Zeichnung nachzuvollziehen. + +Wenn die Funktion nichts von alledem ist, wird in der Bindeliste nachgesehen, ob +dies Atom nicht an eine Funktion gebunden ist; falls ja, wird eine Auswertung dieser +Funktion mit den gleichen Argumenten versucht. + +Wenn das erste Argument von "apply" kein Atom ist, muĂŸ es ein LABEL- oder ein +LAMBDA-Ausdruck sein. + +Ein LABEL-Ausdruck hat die Form + + + +-----+-----+ +-----+-----+ +-----+-----+ + | o | o--+-->| o | o--+-->| o | o--+--> NIL + +--+--+-----+ +--+--+-----+ +--+--+-----+ + | | | + V V V + LABEL Name Funktion + + +Funktionsname und Definition werden in einem funktionalen Eintrag in die Bindeliste +eingefĂ¼gt, so daĂŸ der Name an die Funktion gebunden ist. + +Ein LAMBDA-Ausdruck hat die Form + + + +-----+-----+ +-----+-----+ +-----+-----+ + | o | o--+-->| o | o--+-->| o | o--+--> NIL + +--+--+-----+ +--+--+-----+ +--+--+-----+ + | | | + V V V + LAMBDA Parameterliste Ausdruck + + +Dabei ist die Parameterliste eine Liste von Atomen, den Parametern. Die Auswertung +läuft so ab, daĂŸ die Parameter durch "pairlist" an die Argumente gebunden werden +und mit dieser neuen Bindeliste der Ausdruck berechnet wird. + +Das EUMEL-LISP bietet eine Reihe weiterer Möglichkeiten, die erst später beschrie +ben werden. Hier können wir allerdings schon die folgenden Punkte abhandeln: + +1. Jede LISP-Eingabe ist ein LISP-Ausdruck. Der "head" dieses Ausdrucks wird + als Funktion aufgefaĂŸt und auf den gequoteten "tail" des Ausdrucks, nämlich die + nicht zu evaluierenden Argumente angewandt. Die Ăœbersetzung von Kleinbuchsta + ben in GroĂŸbuchstaben wird vom LISP-System Ă¼bernommen. + +2. In der Theorie des reinen LISP mĂ¼ssen alle Funktionen auĂŸer den fĂ¼nf Basisfunk + tionen an allen Stellen wieder definiert werden, an denen sie aufgerufen werden. + Das ist eine fĂ¼r die Praxis äuĂŸerst unhandliche Regelung; das EUMEL-LISP- + System kennt weitere vordefinierte Funktionen und bietet die Möglichkeit, beliebig + viele weitere Standardfunktionen einzufĂ¼hren, auch solche Funktionen, deren + Argumente nicht berechnet werden (wie "quote") oder solche, die beliebig viele + Argumente haben dĂ¼rfen (wie "cond"). + +3. Die Basisfunktion "eq" hat immer einen wohldefinierten Wert, dessen Bedeutung + im Fall, daĂŸ Nicht-Atome verglichen werden, im Kapitel Ă¼ber Listenstrukturen + erklärt wird. + +4. AuĂŸer in sehr seltenen Fällen schreibt man nicht (quote T), (quote F) oder (quote + NIL), sondern T, F und NIL. + +5. Es besteht die Möglichkeit, mit Ganzzahlen zu rechen, die als weiterer Typ von + Atomen gelten. AuĂŸerdem können TEXTe und Einzelzeichen (CHARACTERs) + gespeichert werden. + +6. Es besteht die Möglichkeit der Ein- und Ausgabe von LISP-AusdrĂ¼cken, Ganz + zahlen, TEXTen und CHARACTERs. + +WARNUNG: Die oben angegebenen Definitionen von "eval" und "apply" dienen nur + pädagogischen Zwecken und sind nicht das, was wirklich im Interpreter + abläuft. + Um zu entscheiden, was wirklich vor sich geht, wenn der Interpreter + aufgerufen wird, sollte man sich an die ELAN-Quellprogramme halten. +#page# + +2.2 Anwendungsregeln und Beispiele #goalpage("p2.2")# + + + +Die Funktionsweise des LISP-Interpreteres kann bequem unter Verwendung der +Funktion "trace" verfolgt werden. Der Aufruf: + + + (trace) + + +schaltet den Trace-Protokollmodus des Interpreters ein bzw. aus. + +Das folgende Beispiel ist ein LISP-Programm, das die drei Funktionen "union", +"intersection" und "member" als Standardfunktionen einfĂ¼hrt Die Funktionen lauten +folgendermaĂŸen: + + + (member pattern list) = (cond ((null list) F) + ((eq (head list) pattern) T) + (T (member pattern (tail list))) + ) + + (union x y) = (cond ((null x) y) + ((member (head x) y) (union (tail x) y)) + (T (cons (head x) (union (tail x) y))) + ) + + (intersection x y) = (cond ((null x) NIL) + ((member (head x) y) + (cons (head x) (intersection + (tail x) y)) + ) + (T (intersection (tail x) y)) + ) + + +Um die Funktionen als neue Standardfunktionen einzufĂ¼hren, benutzen wir die Pseu +dofunktion "define": + + + (DEFINE + (MEMBER . (LAMBDA (PATTERN LIST) + (COND ((NULL LIST) F) + ((EQ (HEAD LIST) PATTERN) T) + (T (MEMBER PATTERN (TAIL LIST))) + ) ) ) + (UNION . (LAMBDA (X Y) + (COND ((NULL X) Y) + ((MEMBER (HEAD X) Y) (UNION (TAIL X) Y)) + (T (CONS (HEAD X) (UNION (TAIL X) Y))) + ) ) ) + (INTERSECTION . (LAMBDA (X Y) + (COND ((NULL X) NIL) + ((MEMBER (HEAD X) Y) + (CONS (HEAD X) (INTERSECTION (TAIL + X) Y)) + ) + (T (INTERSECTION (TAIL X) Y)) + ) ) ) + ) + + +Die Funktion DEFINE, liefert als Pseudofunktion nicht nur einen LISP-Ausdruck als +Ergebnis, sondern hat auch einen bleibenden Effekt, nämlich eine Veränderung im +LISP-Heap. + +DEFINE hat beliebig viele Parameter der Form (Name . Funktion) und bewirkt, daĂŸ die +Funktionen unter dem jeweiligen Namen im System verfĂ¼gbar werden, also fĂ¼r die +weitere ProgrammausfĂ¼hrung definiert werden. Das Ergebnis von DEFINE ist eine +Liste der neuen Funktionsnamen, also hier + + + (MEMBER UNION INTERSECTION) + + +Der Wert den der LISP-Interpreter bei Eingabe von + + + (intersection (a1 a2 a3) (a1 a3 a5)) + + +liefert ist (A1 A3) , + + +Die Funktion + + + (union (x y z) (u v w x)) + + +liefert (Y Z U V W X) . + + + +Es folgen einige elementare Regeln fĂ¼r LISP-Programme: + +1. Ein LISP-Programm besteht aus einem Funktionsaufruf. Im Beispiel ist das die + Funktion DEFINE, die ihre Parameter (beliebig viele) berechnet und ausgibt. Die + Berechnung der Parameter erfolgt dabei in der Reihenfolge der Parameter (norma + le LISP-Funktionen mit mehreren Parametern berechnen standardmĂ¤ĂŸig alle + Parameter, allerdings in irgendeiner Reihenfolge). + +2. LISP ist formatfrei, d.h. jedes Symbol kann in jeder Spalte stehen. FĂ¼r die Bedeu + tung des Programms ist nur die Reihenfolge der Symbole maĂŸgeblich. Zeilen + wechsel wird als Leerzeichen aufgefaĂŸt. + +3. Atome mĂ¼ssen mit einem Buchstaben anfangen, damit sie nicht mit Zahlen ver + wechselt werden. + +4. Ein LISP-Ausdruck der Form (A B C . D) ist eine AbkĂ¼rzung fĂ¼r (A.(B.(C.D))). + Jede andere Plazierung des Punkts ist ein Fehler (falsch wäre z.B. (A . B C) ). + +5. Eine Anzahl von Basisfuntionen existiert von Anfang an, ohne daĂŸ sie durch + DEFINE eingefĂ¼hrt wurden. Der Programmierer kann weitere Funktionen bleibend + oder fĂ¼r die Dauer eines Programmlaufs einfĂ¼hren; dabei ist die Reihenfolge der + neuen Funktionen gleichgĂ¼ltig. +#page# + +2.3 Variablen#goalpage("p2.3")# + + + +Eine Variable ist ein Symbol, das ein Argument einer Funktion repräsentiert. Man +kann also schreiben: "a + b, wobei a = 3 und b = 4". In dieser Situation ist keine +Verwechslung möglich, so daĂŸ klar ist, daĂŸ das Ergebnis 7 ist. Um zu diesem Ergeb +nis zu kommen, muĂŸ man die Zahlen anstelle der Variablen einsetzen und die Opera +tion ausfĂ¼hren, d.h. die Zahlen addieren. + +Ein Grund, weshalb das eindeutig ist, liegt darin, daĂŸ "a" und "b" nicht "direkt" +addiert werden können, so daĂŸ etwa "ab" entsteht. In LISP kann die Situation viel +komplizierter sein. Ein Atom kann eine Variable oder ein Atom sein. + +Sollte der zukĂ¼nftige LISP-Benutzer an dieser Stelle entmutigt sein, sei ihm gesagt, +daĂŸ hier nichts Neues eingefĂ¼hrt wird. Dieser Abschnitt ist nur eine Wiederholung der +Ăœberlegungen aus Abschnitt 1.4. Alles, was wir in diesem Abschnitt sagen, kann man +aus den Regeln fĂ¼r LISP-AusdrĂ¼cke oder aus der allgemeinen Funktion "evalquote" +ableiten. + +Der Formalismus, der in LISP die Variablen kennzeichnet, ist die Lambdanotation von +Church. Der Teil des Interpreters, der die Variablen an Werte bindet, heiĂŸt "apply". +Wenn "apply" auf eine Funktion stĂ¶ĂŸt, die mit LAMBDA anfängt, wird die Variablenli +ste (Argumentliste) mit der Parameterliste gepaart und am Anfang der Bindeliste +eingefĂ¼gt. + +Während der Berechnung des Funktionsrumpfs mĂ¼ssen manchmal Variablen durch +ihre Werte ersetzt werden. Das geschieht dadurch, daĂŸ ihr Wert in der Bindeliste +nachgesehen wird. Wenn eine Variable mehrmals gebunden wurde, wird die zuletzt +etablierte Bindung verwendet. Der Teil des Interpreters, der diese "Berechnungen" +und die Berechnung von Funktionsaufrufen durchfĂ¼hrt, heiĂŸt "eval". + + + +#page# + +2.4 Konstanten#goalpage("p2.4")# + + + +Manchmal heiĂŸt es, eine Konstante stehe fĂ¼r sich selbst, im Gegensatz zu einer +Variablen, die fĂ¼r etwas anderes, nämlich ihren Wert, steht. +Dies Konzept funktioniert in LISP nicht so ohne weiteres; es ist hier sinnvoller, zu +sagen, eine Variable ist konstanter als die andere, wenn sie in einer höheren Ebene +gebunden ist und ihren Wert seltener ändert. +In LISP bleibt eine Variable im Bereich des LAMBDA konstant, von dem sie gebunden +ist. Wenn eine Variable einen festen Wert hat, unabhängig davon, was in der Bindeli +ste steht, wird sie (echte) Konstante genannt. Dies wird mit Hilfe der Eigenschaftsliste +(E-Liste) des Atoms erreicht. +Jedes Atom hat eine E-Liste, in der Paare von Atomen und beliebigen Strukturen +gespeichert sind. Ein Atom hat die Eigenschaft A, wenn in seiner E-Liste ein Paar +mit dem Atom A enthält; die dazugehörige "beliebige Struktur" heiĂŸt Wert dieser +Eigenschaft. +Wenn ein Atom die Eigenschaft APVAL besitzt, ist es eine Konstante, deren Wert der +Wert der Eigenschaft ist. +Konstanten können durch die Pseudofunktion + + + (set atom wert) + + +gesetzt werden; nach der Auswertung eines solchen Aufrufs hat das Atom "atom" +immer den Wert "wert" - bis zum nächsten "set". Eine interessante Klasse von +Konstanten sind solche Konstanten, die sich selbst als Wert haben. Ein Beispiel dafĂ¼r +ist NIL. Der Wert dieser Konstanten ist wieder NIL. Daher kann NIL nicht als Variable +benutzt werden, da es ja eine Konstante ist. (T und F gehören ebenfalls zu dieser +Klasse). + +#page# + +2.5 Funktionen#goalpage("p2.5")# + + + +Wenn ein LISP-Ausdruck fĂ¼r eine Funktion steht, ist die Situation ähnlich der, in der +ein Atom fĂ¼r einen Wert steht. Wenn die Funktion rekursiv ist, muĂŸ sie einen Namen +bekommen. Das geht mit einem LABEL-Ausdruck, der den Namen mit der Funk +tionsdefinition in der Bindeliste paart. Dadurch wird der Name an die Funktionsdefini +tion gebunden, so wie eine Variable an ihren Wert gebunden wird. In der Praxis setzt +man LABEL selten ein. Normalerweise ist es einfacher, Name und Definition wie bei +den Konstanten zu verknĂ¼pfen. Dies geschieht mit der Pseudofunktion DEFINE, die +wir am Anfang des Kapitels benutzt haben. +Diese Funktion kann beliebig viele Parameter der Form + + + (atom . funktion) + + +haben, wobei "atom" der Name der zu definierenden Funktion "funktion" werden soll. +Sie bewirkt, daĂŸ die Definition unter der Eigenschaft FUNCTION in der E-Liste des +Atoms abgelegt wird. +#page# + +3. Erweitertes LISP#goalpage("p3")# + + +In diesem Kapitel werden wir einige Erweiterungen zum reinen LISP einfĂ¼hren. Zu +diesen Erweiterungen gehören Möglichkeiten fĂ¼r Arithmetik, Zeichenkettenverarbei +tung, Funktionen, die spezielle Argumente erwarten, und Ein- und Ausgabe. + +In allen Fällen handelt es sich bei den Erweiterungen um zusätzliche Funktionen. So +heiĂŸt das Kommando fĂ¼r die Ausgabe eines LISP-Ausdrucks PUT. Syntaktisch ist +PUT nichts anderes als eine Funktion mit einem Argument. Sie kann mit anderen +Funktionen verkettet werden, und diese Verkettung wird ganz auf die Ă¼bliche Art +behandelt, zuerst Berechnung der innern, dann der äuĂŸeren Funktionsaufrufe. Ein +Ergebnis ist nur in dem trivialen Sinn vorhanden, daĂŸ PUT sein Argument wieder +liefert, also die Identität ist. + +Funktionen, die eine Aktion wie Ein- oder Ausgabe bewirken, oder die Langzeitwir +kung (gesehen auf die AusfĂ¼hrungsdauer des Programms) haben, wie DEFINE und +SET, heiĂŸen Pseudofunktionen. Es ist eine Besonderheit von LISP, daĂŸ alle Funktio +nen einschlieĂŸlich den Pseudofunktionen ein Ergebnis haben mĂ¼ssen. In einigen +Fällen ist das Ergebnis trivial und kann ignoriert werden. + +In diesem Kapitel beschreiben wir verschiedene Erweiterungen der Sprache LISP, die +im System fest enthalten sind. + + +#page# + +3.1 Gequotete Parameter #goalpage("p3.1")# + + + +Bevor ein Argument an eine Funktion Ă¼bergeben wird, wird erst sein Wert in der +Bindeliste nachgesehen, d.h. es wird nicht der Name der Variablen Ă¼bergeben, son +dern ihr Wert. Wenn das Argument als Konstante behandelt werden soll, muĂŸ es +ge"quotet" werden, d.h. statt "argument" steht (quote argument). Wenn ein Argument +einer Funktion immer als Konstante behandelt werden soll, ist es bequemer, das +Argument nicht jedesmal zu quoten. Das EUMEL-LISP-System erlaubt, in diesem +Fall den formalen Parameter in der Funktionsdefinition bereits zu quoten. + +Dieser Mechanismus wurde auch benutzt, um QUOTE zu implementieren; die Funk +tion lautet + + + quote = (lambda ((QUOTE x)) x) + + + + +#page# + +3.2 Funktionen mit beliebig vielen + Argumenten #goalpage("p3.2")# + + + +Ein Beispiel ist "list", das beliebig viele Argumente haben kann, die zu einer Liste +zusammengefaĂŸt werden. Da eine Funktion nur eine feste Anzahl von Parametern +haben kann, eine Funktion mit beliebig vielen Argumenten aber gewiĂŸ keine feste +Anzahl von Argumenten hat, werden die beliebig vielen Argumente zu einer Liste +zusammengefaĂŸt und ein einziger Parameter wird an diese Liste gebunden. Da "list" +genau diese Liste liefern soll, wird diese Funktion ebenfalls zu einer "Identität": + + + list = (lambda ((INDEFINITE x)) x) + + +Solche Parameter werden durch INDEFINITE gekennzeichnet. Sie können auch ge +quotet werden, indem man (INDEFINITE QUOTE parameter) schreibt; das wirkt so, als +wären alle Argumente, die diesem Parameter zugeordnet werden, einzeln gequotet +worden. + + + evalquote = (lambda (fkt (INDEFINITE QUOTE expr)) + (apply fkt expr NIL) ) + + + +#page# + +3.3 Funktionale Parameter #goalpage("p3.3")# + + + +In der Mathematik gibt es Funktionen, die andere Funktionen als Argument haben. In +der Algebra könnte man die Funktion "(operation operator a b)" definieren, wobei +"operator" ein funktionales Argument ist, das die Operation festlegt, die auf "a" und +"b" ausgefĂ¼hrt werden soll. Beispielsweise gilt + + + operation (+ 3 4) = 7 + operation (* 3 4) = 12 + + +In LISP sind funktionale Argumente sehr nĂ¼tzlich. Eine wichtige Funktion mit einem +Argument ist MAPLIST. Ihre Definition ist + + + (LAMBDA (LIST (FUNCTION FN)) + (COND ((NULL LIST) NIL) + (T (CONS (FN (HEAD LIST)) (MAPLIST (TAIL LIST) FN))) + ) ) + + +Diese Funktion nimmt eine Liste und eine Funktion als Argument und wendet die +Funktion auf die Listenelemente an. + + +#page# + +3.4 Prädikate und boolesche Konstanten #goalpage("p3.4")# + + + +Die booleschen Werte sind, wie in Kapitel 1 gesagt, T und F. Bei LISP-AusdrĂ¼cken +mĂ¼ĂŸte daraus (quote T) und (quote F) werden, aber da die APVALs dieser Atome +wieder den Wert T und F haben, ist das quoten nicht nötig. + +Prädikate sind Funktionen, die T oder F als Ergebnis haben; es gibt also keine forma +len Unterschiede zwischen anderen Funktionen und Prädikaten. + +Daher ist es durchaus möglich, daĂŸ eine Funktion einen Wert liefert, der weder T +noch F ist, daĂŸ aber durch einen bedingten Ausdruck an dieser Stelle ein boolescher +Ausdruck verlangt wird. In diesem Fall ist die Wirkung des Ausdrucks nicht definiert. + +Das Prädikat EQ hat folgendes Verhalten: +1. Wenn seine Argumente verschieden sind, ist das Ergebnis F. +2. Wenn die Argumente dasselbe Atom sind, ist das Ergebnis T. +3. Wenn die Argumente gleich, aber nicht atomar sind, ist das Ergebnis T oder F, je + nachdem, ob sie ein und dasselbe Objekt im Heap sind oder nicht. + +#page# + +3.5 Unbenannte Atome #goalpage("p3.5")# + + + +Die meisten Atome im EUMEL-LISP haben einen Namen, der sie bei Ein- und +Ausgabeoperationen identifiziert. +Es gibt aber auch Atome, die keinen Namen haben und stattdessen durch ihre Werte +repräsentiert werden. Momentan sind das Ganzzahlen und Zeichenketten (TEXTe); +auch die booleschen Werte kann man in einem weiteren Sinn dazurechnen. + + + + +3.5.1 Ganzzahlen + + + +Im EUMEL-LISP gibt es Funktionen, die Basisoperationen und Tests durchfĂ¼hren. + +Ganzzahlen haben folgende Eigenschaften: + +1. Eine Ganzzahl besteht aus einem optionalen Vorzeichen und einer Folge von + Ziffern; zwischen Vorzeichen und Ziffern können Leerzeichen stehen. +2. Der Wert einer Ganzzahl liegt zwischen -32768 und 32767 (minint und maxint). +3. Eine Ganzzahl kann Ă¼berall dort stehen, wo ein Atom stehen kann, auĂŸer als + Parameter. +4. Ganzzahlen sind Konstanten; sie brauchen also nicht gequotet werden. +#page# + +3.5.2 Arithmetische Funktionen und Prädikate + + + +Es folgt eine Liste aller arithmetischen Funktionen. +Wenn ein Argument einer dieser Zahlen keine Ganzzahl ist, erfolgt eine Fehlermel +dung. + + (sum x1 ... xn) liefert die Summe der xi; wenn keine Argumente gege + ben werden, wird 0 geliefert. + (difference x y) liefert die Differenz von x und y. + (product x1 ... xn) liefert das Produkt seiner Argumente; wenn + keine Argumente gegeben werden, wird 1 + geliefert. + (quotient x y) liefert den Quotienten von x und y, ohne den + Rest zu berĂ¼cksichtigen. + (remainder x y) liefert den Rest der Division von x und y. + (getint) liest eine Zahl vom Bildschirm ein und + liefert sie. + (putint x) gibt x auf den Bildschirm aus. Identitäts funktion. + + + + + +3.5.3 Zeichenkettenverarbeitung + + + +Im Moment ist nur Zeichenketten-Ein- und Ausgabe implementiert. +Die Ausgabe löst bei Argumenten, die keine Zeichenketten sind, eine Fehlermeldung +aus. + + (gettext) liest eine Zeichenkette ein und liefert sie. + (puttext x) gibt eine Zeichenkette aus. + + + + +3.5.4 Test auf Gleichheit + + + + (equal x y) testet, ob x und y vom gleichen Typ sind, und wenn ja, ob sie gleich + sind. +#page# + +3.6 Aufruf von EUMEL aus #goalpage("p3.6")# + + +Bevor man den LISP-Interpreter benutzen kann, muĂŸ er folgendermaĂŸen implemen +tiert werden: + +archive ("lisp") +fetch all (archive) +release (archive) +check off +insert ("lisp.1") +insert ("lisp.2") +insert ("lisp.3") +insert ("lisp.4") +check on + + +Das LISP-System verfĂ¼gt Ă¼ber einen Heap, in dem alle LISP-AusdrĂ¼cke gespei +chert sind. StandardmĂ¤ĂŸig enthält der Heap eine Reihe von Funktionen, die nicht in +den LISP-Programmen definiert werden mĂ¼ssen (Ăœbersichten Ă¼ber die Standardfunk +tionen siehe Kapitel 3.5). + +Mit + lisp + +wird das LISP-System im EUMEL-Dialog gestartet. In einem Eingabefenster wird +mit Hilfe des Paralleleditors eine LISP-EINGABE-Möglichkeit angeboten. Die Aus +gabe erfolgt in dem LISP-AUSGABE-Fenster. +Das LISP-System kann folgendermaĂŸen verlassen werden: +<ESC> <ESC> break lisp <RETURN>. + +Statt dieser direkten Art der Benutzung der LISP-Maschine ist auch eine an ELAN +angelehnte Art mit den Prozeduren "run lisp", insert lisp" usw. vorgesehen: + +Mit + + run lisp (TEXT CONST dateiname) + +wird eine Kopie des Heaps angelegt, das Programm aus der Datei "dateiname" in die +Kopie eingelesen und gestartet. Durch diesen Kopiermechanismus wird der Original +heap vor ZusammenbrĂ¼chen des LISP-Systems geschĂ¼tzt. + + insert lisp (TEXT CONST dateiname) + +bewirkt dasselbe wie "run lisp"; allerdings wird jetzt direkt auf dem Originalheap +gearbeitet. Dadurch sind alle Ă„nderungen im Heap, die das Programm verursacht +(meist Definition von Funktionen durch DEFINE) bleibend, aber auch ein Zusammen +bruch ist insoweit endgĂ¼ltig, als das LISP-System jetzt neu gestartet werden muĂŸ. +Das geschieht mit + + start lisp system (DATASPACE CONST dsname) + +"dsname" gibt dabei den Datenraum an, der die zum Hochfahren notwendigen Daten +enthält. Solche Daten im richtigen Format enthält der Datenraum "lisp.bootstrap". +Wenn der zuletzt benutzte Heap mit nicht mehr durch LISP-Programme erreich +bare Strukturen vollgestopft ist, schafft die Prozedur + + collect lisp heap garbage + +Abhilfe; mit + + lisp storage info + +kann man den Erfolg kontrollieren. +#page# + +4. Detailbeschreibungen#goalpage("p4")# + + + + + +4.1 Grundfunktionen #goalpage("p4.1")# + + + +Die Datei "lisp.1" enthält ein Paket, das die Grundlage des LISP-Systems bildet. Es +implementiert + + - die primitiven LISP-Funktionen wie "cons", "null", etc., + - die Verwaltung des Heaps, in dem die LISP-Strukturen und die Objektliste + (Oblist) gespeichert sind, + - einen Datentyp SYM, dessen Wertevorrat aus Zeigern auf die im Heap gespei + cherten Strukturen besteht, + - Funktionen zur Konversion allgemeiner Daten in LISP-Strukturen (bisher reali + siert: TEXT <--> SYM und INT <--> SYM). + +Durch die Implementation der Basisoperationen als exportierte und damit allgemein +verfĂ¼gbare ELAN-Prozeduren ist es möglich, LISP-Strukturen durch ELAN-Prog +ramme zu manipulieren; insbesonders können ELAN- und LISP-Programme Ă¼ber +diese Strukturen miteinander kommunizieren. + +Anmerkung: +Wenn Eigenschaften von "SYM"-Objekten beschrieben werden, sind immer die +Eigenschaften der Strukturen gemeint, auf die die Objekte zeigen, wenn nichts ande +res angegeben wird. + + +Es werden folgende Prozeduren exportiert: + + PROC initialize lisp system (DATASPACE CONST new heap): + "new heap" ist der neue Datenraum, in dem der LISP-Heap ab sofort gefĂ¼hrt + wird. + Vorsicht: Beim Wechsel zu einem neuen Datenraum sind die Werte der + SYM-Variablen, die auf Strukturen im alten Heap zeigen, natĂ¼rlich wertlos! + + PROC dump lisp heap (FILE VAR f): + In "f" wird ein Dump des Heaps erstellt. Dieser Dump ist nur mit Kenntnis des + Programmtextes aus "lisp 1" verständlich; er wird hier nicht beschrieben. + + PROC lisp storage (INT VAR size, used): + Nach dem Aufruf gibt "size" die maximal verfĂ¼gbare Anzahl von Knoten an, + während "used" die Anzahl der tatsächlich von LISP-Strukturen belegten + Knoten enthält. Zu diesen Strukturen können auch solche zählen, die nicht mehr + durch "head" oder "tail" etc. erreichbar sind. + + PROC collect lisp heap garbage: + Löscht die im LISP-Heap nicht mehr durch "atom (TEXT CONST)", "proper + ty", "head" und "tail" erreichbaren Strukturen. Es werden auch alle nur von + ELAN-Programmen aus Ă¼ber SYM-Variable erreichbare Strukturen gelöscht, so + daĂŸ die Werte dieser Variablen undefiniert werden. + Die MĂ¼llabfuhr wird von keiner Prozedur dieses Pakets aufgerufen, d.h. der + Benutzer, der ELAN-Programme einsetzt, braucht nicht alle Strukturen in den + Eigenschaftslisten von Atomen aufzubauen, um sie vor einer versehentlichen + Löschung durch die MĂ¼llabfuhr zu schĂ¼tzen, vorausgesetzt, er ruft sie nicht + selbst auf. Er muĂŸ allerdings darauf achten, daĂŸ im Heap noch genug Platz + bleibt. + + OP := (SYM VAR left, SYM CONST right): + Nach der Zuweisung zeigt "left" auf die gleiche Struktur wie vorher "right". + + SYM CONST nil, pname; + Zwei Konstanten, die dem LISP-System ständig zur VerfĂ¼gung stehen mĂ¼s + sen. Ihre Drucknamen sind "NIL" bzw. "PNAME" (vgl. SchluĂŸbemerkungen) + + SYM PROC head (SYM CONST sym): + Entspricht der im Handbuch beschriebenen Funktion "head". + + SYM PROC tail (SYM CONST sym): + Entspricht der im Handbuch beschriebenen Funktion "tail". + + SYM PROC cons (SYM CONST head, tail): + Liefert einen SYM-Wert "zeiger" auf eine neue Struktur. Es gilt: + head ("zeiger") = "head" und tail ("zeiger") = "tail". + + BOOL PROC eq (SYM CONST sym 1, sym 2): + PrĂ¼ft, ob "sym 1" und "sym 2" auf dieselbe Struktur zeigen. Das ist genau dann + der Fall, wenn sie durch Zuweisung auseinander hervorgegangen sind oder wenn + sie auf das gleiche benannte Atom zeigen. + + BOOL PROC equal (SYM CONST sym 1, sym 2): + PrĂ¼ft, ob "sym 1" und "sym 2" dieselbe Struktur haben; "dieselbe Struktur" + braucht aber nicht "Identität" zu bedeuten, wie "eq" das verlangt. + Umgewandelte TEXTe und INTs werden richtig verglichen (siehe "sym (INT + CONST)" und "sym (TEXT CONST)"). + + BOOL PROC null (SYM CONST sym): + PrĂ¼ft, ob "sym" gleich der Konstanten "NIL" ist (entspricht + eq ("sym", "NIL"), ist aber schneller). + + BOOL PROC atom (SYM CONST sym): + PrĂ¼ft, ob "sym" ein ( benanntes oder unbenanntes) Atom ist. + + BOOL PROC is named atom (SYM CONST sym): + PrĂ¼ft, ob "sym" ein benanntes Atom ist. + + PROC begin oblist dump: + Vorbereitung fĂ¼r "next atom". + + SYM PROC next atom: + Liefert das nächste Atom aus der Objektliste. In der Objektliste sind alle benann + ten Atome, die der Heap enthält, aufgefĂ¼hrt (bis auf Ausnahmen; s."delete + atom"). "NIL" wird immer als letzte Atom geliefert. + + SYM PROC atom (TEXT CONST name): + Liefert einen Zeiger auf das Atom mit dem Namen "name". Wenn kein solches + Atom in der Objektliste vorhanden ist, wird "NIL" geliefert. + + SYM PROC new atom (TEXT CONST name): + Liefert einen Zeiger auf das Atom mit dem Namen "name". Wenn kein solches + Atom in der Objektliste vorhanden ist, wird ein neues mit diesem Namen in sie + eingefĂ¼gt. + + PROC create atom (TEXT CONST name): + FĂ¼gt ein Atom mit dem Namen "name" in die Objektliste ein. Wenn ein solches + Atom bereits existiert, wird stattdessen eine Fehlermeldung ausgegeben. + + PROC delete atom (SYM CONST atom): + Streicht das Atom "atom" aus der Objektliste. + + PROC begin property list dump (SYM CONST atom): + Vorbereitung fĂ¼r "next property". + + PROC next property (SYM VAR property id, property): + Liefert die nächste Eigenschaft aus der Eigenschaftsliste des zuletzt durch + "begin property list dump" vorbereiteten Atoms. Wenn es sich bei der Eigen + schaft um eine Flagge handelt, wird "property" auf "NIL" gesetzt; wenn es keine + nächste Eigenschaft mehr gibt, werden "property" und "property id" auf "NIL" + gesetzt. + Der Dump der Eigenschaftsliste beeinträchtigt die "Verwendbarkeit" des Atoms in + keiner Weise; es ist während des Dumps sogar möglich, Eigenschaften und + Flaggen zu lesen. Wenn während des Dumps Eigenschaften oder Flaggen geän + dert oder geschrieben werden, ist mit fehlerhaften Dumpergebnissen zu rechnen. + + PROC add property (SYM CONST atom, property id, property): + "property id" muĂŸ ein benanntes Atom sein. FĂ¼hrt eine neue Eigenschaft mit der + Bezeichnung "property id" und dem Wert "property" ein. Wenn bereits eine + Eigenschaft mit der gleichen Bezeichnung existiert, wird die alte Version Ă¼ber + deckt, ist aber weiter vorhanden. + + PROC alter property (SYM CONST atom, property id, property): + Bringt die Eigenschaft mit der Bezeichnung "property id" auf den neuen Wert + "property". Wenn eine Eigenschaft mit dieser Bezeichnung noch nicht existiert, + wird eine Fehlermeldung ausgegeben. + + BOOL PROC property exists (SYM CONST atom, property id): + PrĂ¼ft, ob das Atom eine Eigenschaft mit der Bezeichnung "property id" besitzt. + + SYM PROC property (SYM CONST atom, property id): + Liefert den Wert der gerade sichtbaren Eigenschaft des Atoms, die die Bezeich + nung "property id" hat. Falls die Eigenschaft nicht existiert, wird "NIL" geliefert. + + PROC delete property (SYM CONST atom, property id): + Löscht den gerade sichtbaren Wert der Eigenschaft des Atoms, die die Bezeich + nung "property id" hat. Wenn eine ältere Version dieser Eigenschaft durch "add + property" Ă¼berdeckt wurde, wird diese jetzt wieder sichtbar. Jede Eigenschaft + bildet also fĂ¼r jedes Atom einen Stapel (Stack). + + PROC add flag (SYM CONST atom, flag id): + Das Atom "atom" erhält die Flagge "flag id". Ein Atom kann dieselbe Flagge + durchaus mehrmals haben. + + BOOL PROC flag (SYM CONST atom, flag id): + PrĂ¼ft, ob "atom" mindestens eine Flagge "flag id" hat. + + PROC delete flag (SYM CONST atom, flag id): + Löscht eine Flagge "flag id" von "atom". Wenn keine Flagge existiert, wird + nichts getan. + + SYM PROC sym (TEXT CONST text): + Konvertiert "text" in ein unbenanntes Atom und liefert einen Zeiger auf dies + Atom. + + TEXT PROC text (SYM CONST sym): + Konvertiert "sym" in einen TEXT zurĂ¼ck, wenn es sich um einen konvertierten + TEXT handelt; wenn nicht, wird eine Fehlermeldung ausgegeben. + + BOOL PROC is text (SYM CONST sym): + PrĂ¼ft, ob "sym" ein konvertierter TEXT ist. + + SYM PROC sym character (TEXT CONST text): + "text" muĂŸ genau ein Zeichen enthalten. Das Zeichen wird in ein + CHARACTER-Objekt im Heap konvertiert und ein Zeiger auf dies Objekt gelie + fert. + + INT PROC character (SYM CONST sym): + "sym" muĂŸ auf ein CHARACTER-Objekt zeigen. Geliefert wird der Code des + dort gespeicherten Zeichens. + + SYM PROC sym (INT CONST i 1, i 2): + Konvertiert "i 1" und "i 2" in ein unbenanntes Atom und liefert einen Zeiger + darauf. + + INT PROC int 1 (SYM CONST sym): + INT PROC int 2 (SYM CONST sym): + Holt die Werte der ersten bzw. zweiten Ganzzahl aus "sym", wenn es sich um + ein konvertiertes INT-Paar handelt; wenn nicht, wird eine Fehlermeldung ausge + geben. + + BOOL PROC is int pair (SYM CONST sym): + PrĂ¼ft, ob "sym" ein konvertiertes INT-Paar ist. + + +ProzedurĂ¼bergreifende Aussagen Ă¼ber das Paket "lisp.1": + + - Es gibt benannte und unbenannte Atome. + + - Die unbenannten Atome sind Konversionsprodukte. + + - Vor dem ersten Aufruf von "delete atom" sind alle benannten Atome in der Ob + jektliste enthalten; d.h. sie können alle durch "begin oblist dump" und wiederhol + ten Aufruf von "next atom" erreicht werden. + + - Jedes benannte Atom hat genau einen Namen, der immer gleich bleibt. Der + Name ist als Eigenschaft mit der Bezeichnung "pname" in der Eigenschaftsliste + gespeichert. "add property", "alter property" und "delete property" geben des + halb eine Fehlermeldung aus, statt ihre normalen Aktionen durchzufĂ¼hren, wenn + ihnen als Eigenschaftsbezeichnung "pname" Ă¼bergeben wird. + + - Es gibt keine zwei Atome, die denselben Namen haben; dadurch reduziert sich + die bei "eq" angegebene Fallunterscheidung auf einen Fall. + + - Es kann durchaus zwei unbenannte Atome mit gleichen Werten geben, die von + "eq" nicht als gleich anerkannt werden, weil sie in verschiedenen Strukturen + gespeichert sind. "equal" achtet nicht auf die Position, sondern auf die Werte + der zu vergleichenden Strukturen. + + - Mehrfache Zugriffe auf die gleiche Eigenschaft desselben Atoms werden so opti + miert, daĂŸ die Eigenschaftsliste nur beim ersten Zugriff (meist durch "property + exists") durchsucht werden muĂŸ. + + + +#page# + +4.2 Weitere Funktionen sowie Eingabe und + Ausgabe #goalpage("p4.2")# + + + +Die Datei "lisp.2" enthält diverse Pakete, die die Verbindung vom LISP-System zur +normalen EUMEL-Umgebung bilden. Momentan sind das Ein- und Ausgabe und +(exemplarisch) die fĂ¼nf Grundrechenarten fĂ¼r Ganzzahlen. + +Die Ein- und Ausgabe von LISP-Strukturen wird durch das Paket namens "lisp io" +mit den folgenden Prozeduren ermöglicht: + + PROC get (FILE VAR f, SYM VAR sym): + Nach dem Aufruf zeigt "sym" auf eine neue aus "f" eingelesene Struktur. + In der ersten und hinter der letzten Zeile des S-Ausdrucks dĂ¼rfen keine weiteren + Daten stehen. + + PROC get all (FILE VAR f, SYM VAR sym): + Wie "get (FILE V, SYM V)", nur daĂŸ die Datei nichts als den S-Ausdruck ent + halten darf. + + PROC get (SYM VAR sym): + Es wird mit "get all" ein S-Audruck von einer Scratch-Datei eingelesen, die + dem Benutzer vorher zum Editieren angeboten wird. Bei Einlesefehlern wird die + Datei zu Korrigieren angeboten, bis keine Fehler mehr auftreten. + + PROC put (FILE VAR f, SYM CONST sym): + Wenn "sym" ein Ganzzahlpaar ist, wird die erste Zahl ausgegeben; wenn es ein + konvertierter TEXT ist, wird der ursprĂ¼ngliche TEXT wieder ausgegeben; bei + einem benannten Atom oder einer allgemeinen LISP-Struktur wird ein S-Aus + druck ausgegeben. + + PROC put (SYM CONST sym): + Wie "put (FILE V, SYM CONST), auĂŸer daĂŸ die Augabe direkt auf den Bildschirm + erfolgt. + + +Das Paket "lisp int" enthält die Prozeduren + + SYM PROC sum (SYM CONST summandenliste); + Erwartet eine Liste von "int pair"-Summanden und liefert deren Summe. + + SYM PROC difference (SYM CONST minuend, subtrahend): + Liefert die Differenz der Parameter. + + SYM PROC product (SYM CONST faktorenliste): + Liefert das Produkt der Listenelemente. + + SYM PROC quotient (SYM CONST dividend, divisor): + Liefert den Quotienten der Parameter. + + SYM PROC remainder (SYM CONST dividend, divisor): + Liefert den Rest. + +#page# + +4.3 Interpreter #goalpage("p4.3")# + + +Die Datei "lisp.3" enthält das Paket "lisp interpreter", das die Prozedur + + SYM PROC evalquote (SYM CONST expression) + +exportiert. Es handelt sich dabei um den im EUMEL-LISP-Handbuch beschriebe +nen Interpreter. + +Wenn "expression" ein LISP-Ausdruck ist, liefert die Prozedur den Wert des Aus +drucks (vorausgesetzt, der LISP-Heap ist vorbereitet, siehe lisp.1). + +Wirkungsweise: +"evalquote" ruft im Wesentlichen die Prozedur "eval" auf. +"eval" erwartet als Argumente einen solchen LISP-Ausdruck wie "evalquote", benö +tigt aber zusätzlich eine sog. Bindeliste. In einer Bindeliste sind durch LAMBDA- und +LABEL-AusdrĂ¼cke bereits gebundene Variable und ihre Werte gespeichert. Die +Manipulation der Bindeliste ist durch eine Reihe von Refinements, die am SchluĂŸ des +Pakets stehen, realisiert. + +Da bisher noch keine LAMBDA- oder LABEL-AusdrĂ¼cke verarbeitet wurden, Ă¼ber +gibt "evalquote" die leere Bindeliste. + +Wirkungsweise von + + SYM PROC eval (SYM CONST expression, association list): + +"eval" kann als erstes Argument ein Atom oder eine zusammengesetzte Struktur +erhalten. + +Atome werden als Variable aufgefaĂŸt, deren Wert in der Bindeliste aufzusuchen ist. +Vor der Konsultation der Bindeliste wird allerdings noch nach der Eigenschaft APVAL +des Atoms gesehen; wenn sie vorhanden ist, handelt es sich um eine Konstante wie +NIL, T oder F, die einen festen Wert hat, nämlich den Wert dieser Eigenschaft. Da +diese Konstanten sich selbst als Wert haben, gilt "eval (NIL, Bindeliste) = NIL" +(entsprechend fĂ¼r "T" und "F"). + +Wenn das erste Arugment von "eval" zusammengesetzt ist, wird angenommen, daĂŸ +es sich um einen Funktionsaufruf der Form + + + +-----+-----+ + | o | o--+--> Argumentliste + +--+--+-----+ + | + V + Funktion + + +handelt. Die Bestandteile "Funktion" und "Argumentliste" werden mit der Bindeliste +Ă¼bergeben an: + + SYM PROC apply (SYM CONST function, arguments, association list): + +"apply" hat die Aufgabe, die Argumente durch "eval" berechnen zu lassen (das +unterbleibt allerdings unter bestimmten Umständen) und die Berechnungergebnisse an +die Parameter der Funktion zu binden; zum SchluĂŸ muĂŸ der Wert des Funktions +rumpfs in Abhängigkeit von diesen neuen Bindungen als Ergebnis der gesamten +Prozedur "apply" berechnet werden; diese Berechnung geschieht wieder durch +"eval". + +Nur in einem LAMBDA-Ausdruck ist direkt bekannt, wo die Parameterliste steht.So +lange das nicht der Fall ist, muĂŸ entweder ein LABEL-Ausdruck oder ein Atom +vorliegen. +Ein LABEL-Ausdruck hat die Form + + + +-----+-----+ +-----+-----+ +-----+-----+ + | o | o--+--->| o | o--+--->| o | NIL | + +--+--+-----+ +--+--+-----+ +--+--+-----+ + | | | + V V V + LABEL Name Funktion + + +Da der Name fĂ¼r die Dauer der Auswertung des Funktionsrumpfs an die Funktion +gebunden sein muĂŸ, wird dis Paar als funktionaler Bindelisteneintrag gespeichert. +Funktionale und nichtfunktionale Bindelisteneinträge sind eindeutig unterschieden. + +Nach dem Abspeichern wird wieder getestet, ob die Funktion diesmal ein +LAMBDA-Ausdruck ist; wenn nicht, wird ein weiterer Schritt zum "Ablättern" von +LABELs und Atomen versucht, usw. + +Wenn die Funktion ein Atom ist, werden analog zu den Vorgängen in "eval" erst die +Eigenschaftsliste und dann die Bindeliste durchsucht. + +Ist die Eigenschaft FUNCTION in der Eigenschaftsliste vorhanden, ist der Wert der +Eigenschaft die (evtl. weiter "abzublätternde") Funktion; ist die Eigenschaft nicht +vorhanden, muĂŸ das Atom an eine Funktion gebunden sein, die dann aus der Binde +liste geholt werden kann. + +Da alle Funktionen (auch die Standardfunktionen) letztendlich als LAMBDA-Aus +drĂ¼cke definiert sind, kommt "apply" auf diese Weise zuletzt zu einem LAMBDA- +Ausdruck. + +Ein LAMBDA-Ausdruck hat die Form + + + +-----+-----+ +-----+-----+ +-----+-----+ + | o | o--+--->| o | o--+--->| | | + +--+--+-----+ +--+--+-----+ +-----+-----+ + | | + V V + LAMBDA Parameterliste + + +Als nächster Schritt werden die Argumente fĂ¼r die zu berechnende Funktion an die +Parameter der Parameterliste gebunden, d.h. es werden Parameter-Argument-Paare +in die Bindeliste eingetragen. + +Die Methode des Eintrags ist je nach Art des Parameters unterschiedlich. Es gibt die +folgenden Arten von Parametern: + + + 1. | + | + V + Name + + + "Name" ist hier - wie bei den restlichen Fällen - der Name des Parame + ters. Diese Art von Parametern ist der Normalfall; die Argumente, die einem + solchen Parameter entsprechen, werden durch "eval" berechnet und zusammen + mit dem Parameter in einem Bindelisteneintrag gespeichert. + + + 2. | + | + V + +-----+-----+ +-----+-----+ + | o | o--+--->| o | NIL + + +--+--+-----+ +--+--+-----+ + | | + V V + QUOTE Name + + + In diesem Fall wird das Argument ohne weitere Verarbeitung in die Bindeliste + Ă¼bernommen. Die Wirkung ist die gleiche, als wäre das Argument durch + "(QUOTE ... )" eingeschlossen. + + + 3. | + | + V + +-----+-----+ +-----+-----+ + | o | o--+--->| o | NIL | + +--+--+-----+ +--+--+-----+ + | | + V V + FUNCTION Name + + + Hier wird ein funktionaler Bindelisteneintrag erzeugt, so daĂŸ "Name" im Funk + tionsrumpf als Name einer Funktion auftreten kann. + + + 4. | + | + V + +-----+-----+ +-----+-----+ + | o | o--+--->| o | NIL | + +--+--+-----+ +--+--+-----+ + | | + V V + INDEFINITE Name + + + Dies ist ein Parameter, der beliebig viele berechnete Argumente aufnehmen + kann. Der Einfachheit halber werden die Ergebnisse zu einer Liste zusammen + gefaĂŸt und mit "Name" in einen Bindelisteneintrag gesteckt. + + + 5. | + | + V + +-----+-----+ +-----+-----+ +-----+-----+ + | o | o--+--->| o | o--+--->| o | NIL | + +--+--+-----+ +--+--+-----+ +--+--+-----+ + | | | + V V V + INDEFINITE QUOTE Name + + + Dieser Parameter kann wie der in Fall 4. aufgefĂ¼hrte beliebig viele Argumente + aufnehmen, die zu einer Liste zusammengefaĂŸt werden. Im Gegensatz zu 4. + wird aber wie bei 2. nichts durch "eval" berechnet, sondern die Argumente so + wie sie vorkommen Ă¼bernommen. + +Auf einen Parameter der Form 4. oder 5. darf kein weiterer Parameter folgen, weil +solch ein Parameter alle restlichen Argumente verbraucht. Solchen Parametern darf - +als Ausnahme - auch kein Argument entsprechen; dann werden sie an die leere +Liste (d.h. NIL) gebunden. + +Der letzte Kasten in der Beschreibung des LAMBDA-Ausdrucks ist mit Absicht leer +geblieben; er kann eine der Formen + + + +-----+-----+ +----------+----------+ + | o | NIL | oder | Ganzzahl | XXXXXXXX | + +--+--+-----+ +----------+----------+ + | + V + Funktionsrumpf + + +annehmen. + +Die erste Form heiĂŸt, daĂŸ die Funktion durch Berechnung des Funktionsrumpfs mittels +"eval" berechnet werden soll; die zweite Form bewirkt den Aufruf einer der Standard +funktionen, je nachdem, welche Funktionsnummer bei "Ganzzahl" steht. In diesem +zweiten Fall werden die Argumente aber nicht durch den Namen des Parameters +identifiziert, sondern durch die Position des Eintrags in der Bindeliste. Dieser Pro +grammteil hängt also wesentlich von der Reihenfolge ab, in der die Bindelisteneinträ +ge, die bei der Parameter-Argument-Zuordnung entstehen, in die Bindeliste einge +fĂ¼gt werden. Zur Zeit ist das die Umkehrung der Reihenfolge der Parameter. + +Die Namen der Refinements "arg 1", "arg 2", "arg 3" beziehen sich auch nicht auf +die Position des Arguments in der Argumentsliste, sondern auf die Position des +Eintrags in der Bindeliste. + +#page# + +4.4 Kommandoprozeduren #goalpage("p4.4")# + + + +Die Datei "lisp.4" enthält eine Reihe von Prozeduren, mit denen der LISP-Interpre +ter ähnlich wie der ELAN-Compiler aufgerufen werden kann. + +Die Prozedur + + start lisp system + +ermöglicht das erneute Starten des LISP-Systems, oder wenn "Ă¼bersetzte" Pro +gramme, die in einem Heap einer anderen Task liegen, in dieser Task verarbeitet +werden sollen. + +Die Prozedur + + lisp + +stellt die LISP-Maschine in einem Doppelfenster im Bildschirmdialog zur VerfĂ¼gung. +Bei der erstmaligen Benutzung muĂŸ die Datei "lisp.bootstrap" vorhanden sein. + +Die Prozedur + + break lisp + +koppelt die LISP-Task vom Benutzer-Terminal ab und baut das Doppelfenster fĂ¼r +den Bildschirmdialog neu auf. + + +Die Prozedur + + run lisp + +bewirkt, daĂŸ ein LISP-Programm eingelesen und ausgefĂ¼hrt wird; nach der AusfĂ¼h +rung wird das Ergebnis der Berechnung ausgegeben. Diese Operationen werden auf +einer Kopie des Heaps ausgefĂ¼hrt, so daĂŸ Ă„nderungen keine Dauerwirkung haben. +Mit + + run lisp again + +wird das zuletzt eingelesene Programm noch einmal gestartet; da dafĂ¼r die gleiche +Kopie des Heaps wie bei "run" benutzt wird, kann das Ergebnis diesmal anders sein. + + insert lisp + +wirkt wie "run lisp", auĂŸer daĂŸ diesmal alle Ă„nderungen, die durch das Einlesen und +AusfĂ¼hren im Heap entstehen, dauerhaft sind. + + + PROC start lisp system (DATASPACE CONST heap): + Eine Kopie von "heap" wird der neue LISP-Heap. Wenn es sich um "nilspa + ce" handelt, werden einige organisatorische Strukturen im Heap aufgebaut und + die Atome "NIL" und "PNAME" erzeugt. + + PROC start lisp system (DATASPACE CONST heap, FILE VAR f): + Zunächst wird "start lisp system (heap)" gegeben. + Danach werden die Eigenschaftsbeschreibungen aus "f" in Strukturen im Heap + umgesetzt. + + Jede Beschreibung in "f" muĂŸ mit dem Zeilenanfang beginnen und kann sich + Ă¼ber mehrere Zeilen erstrecken. Jede Beschreibung besteht aus den Elementen + <Atom> <Eigenschaft> <Wert> + wobei <Eigenschaft> der Name einer Eigenschaft (i.a. APVAL oder FUNCTION) + und <Wert> ein beliebiger S-Ausdruck sein mĂ¼ssen. Die drei Elemente mĂ¼s + sen jeweils durch mindestens ein Leerzeichen getrennt sein. + + Wenn das Atom <Atom> nicht existiert, wird es erzeugt; danach wird <Wert> + unter <Eigenschaft> in der Eigenschaftsliste eingetragen. + + Wenn <Eigenschaft> NIL ist, muĂŸ <Wert> wegfallen; dann wird nichts in die + Eigenschaftsliste eingetragen. + + DATASPACE PROC lisp heap: + Liefert den LISP-Heap. Das ist manchmal fĂ¼r Sicherheitskopien etc. nĂ¼tzlich. + Die durch "run lisp" erzeugten Kopien sind nicht zugänglich. + + PROC run lisp: + Ruft "run lisp (last param)" auf. + + PROC run lisp (TEXT CONST file name): + Das in der Datei "file name" stehende LISP-Programm (d.h. der dort stehende + in einen S-Ausdruck Ă¼bersetzte M-Ausdruck) wird in eine neue Kopie des + LISP-Heaps eingelesen und ausgefĂ¼hrt. Evtl. vorher durch "run lisp" erzeugte + Kopien des Heaps werden vorher gelöscht. + + Wenn das Programm syntaktisch nicht korrekt ist, wird es im Paralleleditor zur + Korrektur angeboten. + + PROC run lisp again: + FĂ¼hrt das zuletzt eingelesene Programm noch einmal im gleichen Heap aus. + + PROC insert lisp: + Ruft "insert lisp (last param)" auf. + + PROC insert lisp (TEXT CONST file name): + Wirkt wie "run lisp (file name)", nur daĂŸ alle Operationen auf dem Originalheap + ausgefĂ¼hrt werden. Auch "run lisp again" wirkt nun nicht mehr auf der Kopie. + diff --git a/lang/lisp/1.8.7/source-disk b/lang/lisp/1.8.7/source-disk new file mode 100644 index 0000000..e61107d --- /dev/null +++ b/lang/lisp/1.8.7/source-disk @@ -0,0 +1 @@ +informatikpaket/01_sprachen.img diff --git a/lang/lisp/1.8.7/src/"15"TAB2"14" b/lang/lisp/1.8.7/src/"15"TAB2"14" Binary files differnew file mode 100644 index 0000000..654b374 --- /dev/null +++ b/lang/lisp/1.8.7/src/"15"TAB2"14" diff --git a/lang/lisp/1.8.7/src/lisp.1 b/lang/lisp/1.8.7/src/lisp.1 new file mode 100644 index 0000000..32a9c27 --- /dev/null +++ b/lang/lisp/1.8.7/src/lisp.1 @@ -0,0 +1,1306 @@ +PACKET lisp heap and oblist management (* Autor: J.Durchholz *) + (* Datum: 09.05.1984 *) + DEFINES (* Version 1.7.2 *) + (* hey 25.2.83 *) + initialize lisp system, + dump lisp heap, + lisp storage, + collect lisp heap garbage, + SYM, + :=, + nil, + pname, + head, + set head, + tail, + set tail, + cons, + eq, + equal, + null, + atom, + is named atom, + begin oblist dump, + next atom, + new atom, + create atom, + delete atom, + begin property list dump, + next property, + add property, + alter property, + property, + delete property, + property exists, + add flag, + flag, + delete flag, + text, + is text, + character, + is character, + sym character, + int 1, + int 2, + is int pair, + sym: + + +(* NOTE: All internal routines are prefixed by x *) + + +(***************************** heap management ****************************) + +LET + max size = 32767, + NODE = STRUCT (INT status, + head, tail); +LET HEAP = STRUCT (INT size, + ROW max size NODE node); + + +BOUND HEAP VAR heap; + + +PROC initialize lisp system (DATASPACE CONST ds): + IF type (ds) < 0 THEN + heap := ds; + x initialize oblist and heap size; + create atom ("NIL"); + create atom ("PNAME"); + ELSE + heap := ds + FI +END PROC initialize lisp system; + + +PROC dump lisp heap (FILE VAR f): + put line (f, "Groesse :" + text (CONCR (heap).size)); + line (f); + put (CONCR (heap).size); + BOOL VAR is char := FALSE; + INT VAR i; + FOR i FROM 1 UPTO CONCR (heap).size REP + cout (i); + dump ith node + PER. + +dump ith node: + put (f, text (i, 6)); + put (f, status); + put (f, head); + put (f, tail); + line (f). + +status: + SELECT ith node.status OF + CASE atomic : "ATOMIC............" + CASE non atomic : "NON ATOMIC........" + CASE oblist bone : "OBLIST BONE......." + CASE property indicator : "PROPERTY INDICATOR" + CASE property root : "PROPERTY ROOT....." + CASE flag indicator : "FLAG INDICATOR...." + CASE text data : "TEXT DATA........." + CASE character data : is char := TRUE; "CHARACTER DATA...." + CASE int data : "INT DATA.........." + OTHERWISE "????." + text (ith node.status, 6) + ".????" + END SELECT. + +head: + maybe a code + text (ith node.head, 6). + +maybe a code: + IF is char THEN + is char := FALSE; + IF ith node.head > 31 AND 128 > ith node.head THEN + " " + code (ith node.head) + " " + ELSE + " " + FI + ELSE + " " + FI. + +tail: + text (ith node.tail, 6). + +ith node: + CONCR (heap).node (i). + +END PROC dump lisp heap; + + +PROC lisp storage (INT VAR size, used): + size := max size; + used := CONCR (heap).size +END PROC lisp storage; + + +PROC collect lisp heap garbage: + mark all used nodes; + transfer all used high address nodes to unused low address nodes; + adjust all pointers to cleared high address area and unmark all nodes; + adjust size. + +mark all used nodes: + INT VAR i; + FOR i FROM 2 UPTO 28 REP + x mark (i) + PER. + +transfer all used high address nodes to unused low address nodes: + INT VAR high address :: CONCR (heap).size + 1, + low address :: 0; + REP + find next lower used high address node; + IF no used high address node found THEN + LEAVE transfer all used high address nodes to unused low address nodes + FI; + find next higher unused low address node; + IF no unused low address node found THEN + LEAVE transfer all used high address nodes to unused low address nodes + FI; + transfer high address node to low address node + PER. + +find next lower used high address node: + REP + high address DECR 1 + UNTIL high address node marked PER. + +high address node marked: + high address node.status < 0. + +no used high address node found: + low address = high address. + +find next higher unused low address node: + REP + low address INCR 1 + UNTIL low address node not marked OR low address = high address PER. + +low address node not marked: + low address node.status > 0. + +no unused low address node found : + low address = high address. + +transfer high address node to low address node: + low address node.status := high address node.status; + low address node.head := high address node.head; + low address node.tail := high address node.tail; + high address node.head := low address. + +adjust all pointers to cleared high address area and unmark all nodes: + (* 'high address' should now point to the last node of the used area *) + FOR low address FROM 1 UPTO high address REP + unmark low address node; + SELECT low address node.status OF + CASE oblist bone: adjust head + CASE atomic, + non atomic, + property indicator, + property root, + flag indicator: adjust head; adjust tail + CASE text data, character data: adjust tail + CASE int data: + OTHERWISE x lisp error ("Status " + text (low address node.status) + + " gefunden bei pointer Justage") + END SELECT + PER. + +unmark low address node: + low address node.status := - low address node.status. + +adjust head: + IF low address node.head > high address THEN + low address node.head := node (low address node.head).head + FI. + +adjust tail: + IF low address node.tail > high address THEN + low address node.tail := node (low address node.tail).head + FI. + +adjust size: + CONCR (heap).size := high address. + +low address node: + node (low address). + +high address node: + node (high address). + +node: + CONCR (heap).node. + +END PROC collect lisp heap garbage; + + +PROC x mark (INT CONST ptr): + IF node not yet marked THEN + mark node; + SELECT - ptr node.status OF + CASE oblist bone: x mark (ptr node.head) + CASE atomic, + non atomic, + property indicator, + property root, + flag indicator: x mark (ptr node.head); x mark (ptr node.tail) + CASE text data, character data: x mark (ptr node.tail) + CASE int data: + OTHERWISE error stop ("Status " + text (- ptr node.status) + + " gefunden beim Markieren") + END SELECT + FI. + + +node not yet marked: + ptr node.status > 0. + +mark node: + ptr node.status := - ptr node.status. + +ptr node: + CONCR (heap).node (ptr) + +END PROC x mark; + + +TYPE SYM = INT; + + +OP := (SYM VAR left, SYM CONST right): + CONCR (left) := CONCR (right) +END OP :=; + + +LET atomic = 1, + non atomic = 2, + oblist bone = 3, + property indicator = 4, + property root = 5, + flag indicator = 6, + text data = 7, + character data = 8, + int data = 9; + +SYM CONST nil :: SYM :(35), (* 'x initialize oblist and heap size' will *) + pname :: SYM :(44); (* place the atom NIL at node 35 and PNAME *) + (* at node 44 *) + + +(***************************** basic functions ****************************) + + +SYM PROC head (SYM CONST sym): + SELECT status of sym OF + CASE atomic: error stop ("Atome haben keinen head"); nil + CASE non atomic: SYM :(head of sym) + CASE oblist bone, + property indicator, + property root, + flag indicator : x lisp error ("Versteckter Knoten, Type:" + + text (status of sym)); + nil + CASE text data, + character data, + int data : error stop ("Daten haben keinen head"); nil + OTHERWISE x lisp error ("Illegaler Status " + text (status of sym)); + nil + END SELECT. + +status of sym: + sym node.status. + +head of sym: + sym node.head. + +sym node: + CONCR (heap).node (CONCR (sym)) + +END PROC head; + + +SYM PROC x head (SYM CONST sym): + SYM :(CONCR (heap).node (CONCR (sym)).head) +END PROC x head; + + +PROC set head (SYM CONST sym, new head): + SELECT status of sym OF + CASE atomic: errorstop ("Atome haben keinen head") + CASE non atomic: head of sym := CONCR (new head) + CASE oblist bone, + property indicator, + property root, + flag indicator : x lisp error ("Versteckter Knoten, Type:" + + text (status of sym)) + CASE text data, + character data, + int data : error stop ("Daten haben keinen head") + OTHERWISE x lisp error ("Illegaler Status " + text (status of sym)) + END SELECT. + +status of sym: + sym node.status. + +head of sym: + sym node.head. + +sym node: + CONCR (heap).node (CONCR (sym)). + +END PROC set head; + + +PROC x set head (SYM CONST sym, new head): + CONCR (heap).node (CONCR (sym)).head := CONCR (new head) +END PROC x set head; + + +SYM PROC tail (SYM CONST sym): + SELECT status of sym OF + CASE atomic: error stop ("Atome haben keinen tail"); nil + CASE non atomic: SYM :(tail of sym) + CASE oblist bone, + property indicator, + flag indicator : x lisp error ("Versteckter Knoten:" + + text (status of sym)); + nil + CASE text data, + character data, + int data : error stop ("Daten haben keinen tail"); nil + OTHERWISE x lisp error ("Illegaler Status: "+ text (status of sym)); + nil + END SELECT. + +status of sym: + sym node.status. + +tail of sym: + sym node.tail. + +sym node: + CONCR (heap).node (CONCR (sym)). + +END PROC tail; + + +SYM PROC x tail (SYM CONST sym): + SYM :(CONCR (heap).node (CONCR (sym)).tail) +END PROC x tail; + + +PROC set tail (SYM CONST sym, new tail): + SELECT status of sym OF + CASE atomic: error stop ("Atome haben keinen tail") + CASE non atomic: tail of sym := CONCR (new tail) + CASE oblist bone, + property indicator, + property root, + flag indicator : x lisp error ("Versteckter Knoten, Type: " + + text (status of sym)) + CASE text data, + character data, + int data : error stop ("Daten tails sind unveraenderbar") + OTHERWISE x lisp error ("Illegaler Status: " + text (status of sym)) + END SELECT. + +status of sym: + sym node.status. + +tail of sym: + sym node.tail. + +sym node: + CONCR (heap).node (CONCR (sym)). + +END PROC set tail; + + +PROC x set tail (SYM CONST sym, new tail): + CONCR (heap).node (CONCR (sym)).tail := CONCR (new tail) +END PROC x set tail; + + +SYM PROC cons (SYM CONST head, tail): + SYM VAR result; + search free node; + result node.status := non atomic; + result node.head := CONCR (head); + result node.tail := CONCR (tail); + result. + +search free node: + IF CONCR (heap).size = max size THEN + error stop ("LISP Heap Ueberlauf"); + LEAVE cons WITH nil + ELSE + CONCR (heap).size INCR 1; + CONCR (result) := CONCR (heap).size; cout(CONCR(result)) + FI. + +result node: + CONCR (heap).node (CONCR (result)). + +END PROC cons; + + +BOOL PROC eq (SYM CONST sym 1, sym 2): + CONCR (sym 1) = CONCR (sym 2) +END PROC eq; + + +BOOL PROC equal (SYM CONST sym 1, sym 2): + eq (sym 1, sym 2) COR have same value. + +have same value: + IF sym 1 node.status <> sym 2 node.status THEN + FALSE + ELSE + SELECT sym 1 node.status OF + CASE atomic: FALSE + CASE non atomic: equal (head (sym 1), head (sym 2)) CAND + equal (tail (sym 1), tail (sym 2)) + CASE oblist bone, + property indicator, + property root, + flag indicator: x lisp error ("Versteckter Knoten, Type: " + + text (x status (sym 1))); FALSE + CASE text data: equal texts + CASE character data: sym 1 node.head = sym 2 node.head + CASE int data: sym 1 node.head = sym 2 node.head AND + sym 1 node.tail = sym 2 node.tail + OTHERWISE x lisp error ("Ilegaler Status " + text (x status (sym 1))); + FALSE + END SELECT + FI. + +equal texts: + equal length CAND equal character sequence. + +equal length: + eq (x head (sym 1), x head (sym 2)). + +equal character sequence: + SYM VAR actual sym 1 character :: sym 1, + actual sym 2 character :: sym 2; + INT VAR i; + FOR i FROM 1 UPTO sym 1 node. head REP + actual sym 1 character := x tail (actual sym 1 character); + actual sym 2 character := x tail (actual sym 2 character); + IF eq (actual sym 1 character, actual sym 2 character) THEN + LEAVE equal character sequence WITH TRUE + FI; + IF x status (actual sym 1 character) <> character data OR + x status (actual sym 2 character) <> character data THEN + x lisp error ("Ungueltiges Zeichen im text"); + LEAVE equal character sequence WITH FALSE + FI; + IF CONCR (x head (actual sym 1 character)) <> + CONCR (x head (actual sym 2 character)) THEN + LEAVE equal character sequence WITH FALSE + FI + PER; + TRUE. + +sym 1 node: + CONCR (heap).node (CONCR (sym 1)). + +sym 2 node: + CONCR (heap).node (CONCR (sym 2)). + +END PROC equal; + + +BOOL PROC null (SYM CONST sym): + CONCR (sym) = CONCR (nil) +END PROC null; + + +BOOL PROC atom (SYM CONST sym): + SELECT x status (sym) OF + CASE atomic, + text data, + character data, + int data: TRUE + CASE non atomic: FALSE + CASE oblist bone, + property indicator, + property root, + flag indicator : x lisp error ("Versteckter Knoten, Type:" + + text (x status (sym))); TRUE + OTHERWISE x lisp error ("Illegaler Status " + + text (x status (sym))); TRUE + END SELECT +END PROC atom; + + +BOOL PROC is named atom (SYM CONST sym): + x status (sym) = atomic +END PROC is named atom; + + +(*------------------- internal heap management routines ------------------*) + + +SYM PROC x new node (INT CONST status, head, tail): + IF CONCR (heap).size = max size THEN + error stop ("LISP Heap Ueberlauf"); nil + ELSE + CONCR (heap).size INCR 1; + new node.status := status; + new node.head := head; + new node.tail := tail; + SYM :(CONCR (heap).size) + FI. + +new node: + node (CONCR (heap).size). + +node: + CONCR (heap).node. + +END PROC x new node; + + +INT PROC x status (SYM CONST sym): + CONCR (heap).node (CONCR (sym)).status +END PROC x status; + + +(**************************** oblist management ***************************) + + +(* Oblist organization: + +(NOTE: + + +-----------------+ + l <status> l + All nodes are represented as +--------+--------+ in all comments + l <head> l <tail> l of this packet. + +--------+--------+ + +END OF NOTE) + + +The 'oblist' (object list) is organized as follows: + + +-------------+ + l oblist bone l + +------+------+ +--> list of all atoms whose print names begin with "§" + l o l XXXX l l + +---+--+------+ l + +------------+ + +-------------+ + l oblist bone l + +------+------+ +--> list of all atoms whose print names begin with "A" + l o l XXXX l l + +---+--+------+ l + +------------+ + . + . + . + + +-------------+ + l oblist bone l + +------+------+ +--> list of all atoms whose print names begin with "Z" + l o l XXXX l l + +---+--+------+ l + +------------+ + + +These nodes with status 'oblist bone' form the oblist skeleton. As long as +the lisp heap exists, they are stored contiguously in nodes 2 - 28; they +cannot be changed directly by the user. This way of storing the oblist +skeleton allows a hashing scheme to be applied when searching for an atom +with a given name. The hash width of 27 is the smallest one thas distributes +all atoms according to their character; with a smaller hash size, two or +more lists would be merged, with the effect that some of the atom lists +would contain atoms beginning with different characters. + + +The list of all atoms whose print names begin with a certain character +is organized as follows: + + +-------------+ + l atomic l + +------+------+ + l o l o---+--> property list of first atom + +---+--+------+ + l + V + +-------------+ + l atomic l + +------+------+ + l o l o---+--> property list of 2nd atom + +---+--+------+ + l + V + . + . + . + + l + V + +-------------+ + l atomic l + +------+------+ + l o l o---+--> property list of last atom + +---+--+------+ + l + V + oblist bone where the atom list began + + +These lists cannot be acessed directly by the user, too. +*) + + + +PROC x initialize oblist and heap size: + node (1).status := text data; + node (1).head := 32 (* blank *); + node (1).tail := 1; + INT VAR i; + FOR i FROM 2 UPTO 28 REP + node (i).status := oblist bone; + node (i).head := i + PER; + CONCR (heap).size := 28. + +node: + CONCR (heap).node. + +END PROC x initialize oblist and heap size; + + +(*++++++++++++++++++++++++++++++ oblist dump +++++++++++++++++++++++++++++*) + + +SYM VAR actual oblist bone :: SYM :(0), + actual atom :: SYM :(0); + + +PROC begin oblist dump: + actual oblist bone := SYM :(2); + actual atom := SYM :(2) +END PROC begin oblist dump; + + +SYM PROC next atom: + actual atom := x head (actual atom); + WHILE no more atoms in this atom list REP + try next oblist bone + PER; + actual atom. + +no more atoms in this atom list: + (* NIL is given as last atom when 'next atom' is called repeatedly, so *) + (* it can serve as a terminator. So NIL "does not count" if it is *) + (* encountered during one of the calls. *) + IF null (actual atom) THEN + actual atom := x head (actual atom) + FI; + eq (actual atom, actual oblist bone). + +try next oblist bone: + IF actual oblist bone is last oblist bone THEN + actual atom := SYM :(2); + LEAVE next atom WITH nil + FI; + CONCR (actual oblist bone) INCR 1; + actual atom := x head (actual oblist bone). + +actual oblist bone is last oblist bone: + CONCR (actual oblist bone) = 28. + +END PROC next atom; + + +(*+++++++++++++++++++++++ atom search and creation +++++++++++++++++++++++*) + + +SYM VAR predecessor, result; + (* Variables used for communication between the internal search *) + (* procedures and the procedures calling them. *) + + +SYM PROC atom (TEXT CONST name): + x search atom (name); + IF atom not already existing THEN + nil + ELSE + result + FI. + +atom not already existing: + x status (result) = oblist bone. + +END PROC atom; + + +SYM PROC new atom (TEXT CONST name): + x search atom (name); + IF atom not already existing THEN + x create new atom (name); + FI; + result. + +atom not already existing: + x status (result) = oblist bone. + +END PROC new atom; + + +PROC create atom (TEXT CONST name): + x search atom (name); + IF atom already existing THEN + error stop ("Atom " + name + " existiert bereits") + ELSE + x create new atom (name) + FI. + +atom already existing: + x status (result) <> oblist bone. + +END PROC create atom; + + +PROC delete atom (SYM CONST atom): + IF is named atom (atom) THEN + IF null (atom) OR eq (atom, pname) THEN + error stop ("Dies Atom darf nicht geloescht werden") + ELSE + search predecessor; + delete atom from atom list + FI + ELSE + error stop ("Nur benannte Atome können geloescht werden") + FI. + +search predecessor: + predecessor := x head (atom); + WHILE NOT eq (x head (predecessor), atom) REP + predecessor := x head (predecessor) + PER. + +delete atom from atom list: + x set head (predecessor, x head (atom)). + +END PROC delete atom; + + +PROC x search atom (TEXT CONST name): + CONCR (result) := (code (name SUB 1) + 17) MOD 27 + 2; + (* This formula places the list of atoms beginning with "§" at the *) + (* first oblist bone, the list of atoms beginning with "A" at the *) + (* at the second one, and so on. (See also the big comment in lines *) + (* 600 - 700) *) + REP + predecessor := result; + result := x head (predecessor); + UNTIL end of atom list reached COR right atom found PER. + +end of atom list reached: + x status (result) = oblist bone. + +right atom found: + SYM VAR actual character node := property (result, pname); + IF NOT is text (actual character node) THEN + x lisp error ("Namen erwartet"); + LEAVE right atom found WITH FALSE + FI; + IF CONCR (x head (actual character node)) <> length (name) THEN + FALSE + ELSE + INT VAR i; + FOR i FROM 1 UPTO length (name) REP + to next character node; + check wether is character data node; + check wether character matches; + PER; + TRUE + FI. + +to next character node: + actual character node := x tail (actual character node). + +check wether is character data node: + IF x status (actual character node) <> character data THEN + x lisp error ("Zeichenkette erwartet"); + LEAVE right atom found WITH FALSE + FI. + +check wether character matches: + IF code (name SUB i) <> CONCR (x head (actual character node)) THEN + LEAVE right atom found WITH FALSE + FI. + +END PROC x search atom; + + +PROC x create new atom (TEXT CONST name): + (* It is necessary that 'x search atom' has been executed before *) + (* calling 'x create new atom' because this procedure relies on the *) + (* value of 'predecessor'. *) + enable stop; + SYM CONST sym name :: sym (name); + IF CONCR (heap).size + 3 > max size THEN + error stop ("LISP Heap Ueberlauf") + FI; + result := newly created atom; + x set head (predecessor, result). + +newly created atom: + x new node (atomic, CONCR (oblist bone node), CONCR (property list)). + +oblist bone node: + x head (predecessor). + +property list: + x new node (property indicator, CONCR (pname), property root node). + +property root node: + CONCR (x new node (property root, CONCR (sym name), CONCR (nil))). + +END PROC x create new atom; + + +(************************* property list handling *************************) + +(* +The property lists consist of chained units of the structure + + +--------------------+ +---------------+ + l property indicator l l property root l + +----------+---------+ +-------+-------+ + l o l o----+-->l o l o---+--> . . . + +----+-----+---------+ +---+---+-------+ + l l + V V + property id property + + +or + + +----------------+ + l flag indicator l + +--------+-------+ + l o l o---+--> . . . + +---+----+-------+ + l + V + flag id + + + +The property lists cannot be altered or read directly, too. + +For property list handling there exist procedures that insert, change, read +and delete properties resp. flags. Thus, the only thing that can be done +with any property of an atom without using these special procedures, is +comparing to or 'cons'ing with some other S-expression. +At any given time the property list of any atom (including 'NIL') contains +the property 'PNAME' giving the print name of the atom, stored as a list of +characters. This special property cannot be altered, overwritten by 'add +property' or deleted. +*) + + +(*++++++++++++++++++++++++++ property list dump ++++++++++++++++++++++++++*) + + +SYM VAR actual property list node :: nil; + + +PROC begin property list dump (SYM CONST atom): + actual property list node := x tail (atom) +END PROC begin property list dump; + + +PROC next property (SYM VAR property id, property): + IF null (actual property list node) THEN + property id := nil; + property := nil + ELSE + SELECT x status (actual property list node) OF + CASE flag indicator: get flag id + CASE property indicator: get property id and property + OTHERWISE x lisp error ("Flagge oder Eigenschaft erwartet und nicht: " + + text (x status (actual property list node))) + END SELECT + FI. + +get flag id: + property id := x head (actual property list node); + actual property list node := x tail (actual property list node); + property := nil. + +get property id and property: + property id := x head (actual property list node); + actual property list node := x tail (actual property list node); + IF x status (actual property list node) = property root THEN + property := x head (actual property list node); + actual property list node := x tail (actual property list node) + ELSE + x lisp error ("Eigenschaftswurzel erwartet, nicht:" + + text (x status (actual property list node))); + property := nil + FI. + +END PROC next property; + + +(*+++++++++++++++++++++++++++++ properties +++++++++++++++++++++++++++++++*) + + +SYM VAR last atom :: SYM :(0), + p list predecessor, + p list result; + + +PROC add property (SYM CONST atom, property id, property): + IF eq (property id, pname) THEN + errorstop ("Der PNAME eines Atoms darf nicht versteckt sein") + ELSE + IF CONCR (heap).size + 2 > max size THEN + error stop ("LISP Heap Ueberlauf"); + LEAVE add property + FI; + x set tail (atom, new property plus old property list); + IF eq (atom, last atom) AND + eq (property id, x head (p list result)) THEN + p list predecessor := atom; + p list result := x tail (atom) + FI + FI. + +new property plus old property list: + x new node (property indicator, + CONCR (property id), CONCR (property root plus old property list)). + +property root plus old property list: + x new node (property root, CONCR (property), CONCR (old property list)). + +old property list: + x tail (atom) + +END PROC add property; + + +PROC alter property (SYM CONST atom, property id, new property): + IF eq (property id, pname) THEN + error stop ("Namen kann man nicht aendern") + ELSE + x search property id (atom, property id); + IF null (p list result) THEN + error stop ("Eigenschaft existiert nicht") + ELSE + x set head (x tail (p list result), new property) + FI + FI +END PROC alter property; + + +SYM PROC property (SYM CONST atom, property id): + x search property id (atom, property id); + IF null (p list result) THEN + nil + ELSE + x head (x tail (p list result)) + FI +END PROC property; + + +PROC delete property (SYM CONST atom, property id): + IF eq (property id, pname) THEN + errorstop ("Der Name eines Atoms darf nicht geloescht werden") + ELSE + x search property id (atom, property id); + IF NOT null (p list result) THEN + x set tail (p list predecessor, x tail (x tail (p list result))); + last atom := SYM :(0) + FI + FI +END PROC delete property; + + +BOOL PROC property exists (SYM CONST atom, property id): + x search property id (atom, property id); + NOT null (p list result) +END PROC property exists; + + +PROC x search property id (SYM CONST atom, property id): + IF eq (last atom, atom) AND eq (x head (p list result), property id) THEN + LEAVE x search property id + FI; + last atom := atom; + p list predecessor := atom; + REP + p list result := x tail (p list predecessor); + IF end of property list THEN + last atom := SYM :(0); + LEAVE x search property id + FI; + SELECT x status (p list result) OF + CASE flag indicator: p list predecessor := p list result + CASE property indicator: check wether property root node follows; + IF correct property id found THEN + LEAVE x search property id + ELSE + p list predecessor := xtail (p list result) + FI + CASE property root: xlisperror("Unordentliche Eigenschaftwurzel"); + p list result := nil; + last atom := SYM :(0); + LEAVE x search property id + OTHERWISE x lisp error ("Eigenschaften erwartet und nicht: " + + text (x status (p list result))); + p list result := nil; + last atom := SYM :(0); + LEAVE x search property id + END SELECT + PER. + +end of property list: + null (p list result). + +check wether property root node follows: + IF x status (x tail (p list result)) <> property root THEN + x lisp error ("Eigenschaftswurzel erwartet"); + p list result := nil; + last atom := SYM :(0); + LEAVE x search property id + FI. + +correct property id found: + eq (x head (p list result), property id). + +END PROC x search property id; + + +(*++++++++++++++++++++++++++++++++ flags +++++++++++++++++++++++++++++++++*) + + +PROC add flag (SYM CONST atom, flag id): + enable stop; + x set tail (atom, new flag plus old property list). + +new flag plus old property list: + x new node (flag indicator, CONCR (flag id), old property list). + +old property list: + CONCR (x tail (atom)) + +END PROC add flag; + + +BOOL PROC flag (SYM CONST atom, flag id): + x search flag id (atom, flag id); + NOT null (result) +END PROC flag; + + +PROC delete flag (SYM CONST atom, flag id): + x search flag id (atom, flag id); + IF NOT (is error COR null (result)) THEN + x set tail (predecessor, x tail (result)) + FI +END PROC delete flag; + + +PROC x search flag id (SYM CONST atom, flag id): + predecessor := atom; + REP + result := x tail (predecessor); + IF end of property list THEN + LEAVE x search flag id + FI; + SELECT x status (result) OF + CASE property root, property indicator: predecessor := result + CASE flag indicator: IF correct flag id found THEN + LEAVE x search flag id + ELSE + predecessor := result + FI + OTHERWISE x lisp error ("Eigenschaften erwartet und nicht:" + + text (x status (result))); + result := nil; + LEAVE x search flag id + END SELECT + PER. + +end of property list: + null (result). + +correct flag id found: + eq (x head (result), flag id). + +END PROC x search flag id; + + +(****** Conversion of non-LISP data to LISP structures and vice versa *****) + + +TEXT PROC text (SYM CONST sym): + IF is text (sym) THEN + TEXT VAR result := ""; + SYM VAR actual node :: sym; + INT VAR i; + FOR i FROM 1 UPTO CONCR (x head (sym)) REP + actual node := x tail (actual node); + result CAT actual character + PER; + result + ELSE + error stop ("ist kein text"); + "" + FI. + +actual character: + IF x status (actual node) <> character data THEN + x lisp error ("Zeichenfolge erwartet"); + LEAVE text WITH result + FI; + code (CONCR (x head (actual node))). + +END PROC text; + + +BOOL PROC is text (SYM CONST sym): + x status (sym) = text data +END PROC is text; + + +SYM PROC sym (TEXT CONST text): + SYM VAR result :: x new node (text data, + length (text), CONCR (nil)), + actual character node :: result; + INT VAR length of text; + ignore blanks at end of text; + INT VAR i; + FOR i FROM 1 UPTO length of text REP + x set tail (actual character node, new next character node); + actual character node := x tail (actual character node) + PER; + result. + +ignore blanks at end of text: + FOR length of text FROM length (text) DOWNTO 0 REP + IF (text SUB length of text) <> " " THEN + LEAVE ignore blanks at end of text + FI + PER; + length of text := 0. + +new next character node: + x new node (character data, code (text SUB i), 1). + +END PROC sym; + + +INT PROC character (SYM CONST sym): + IF x status (sym) = character data THEN + CONCR (x head (sym)) + ELSE + error stop ("ist kein Charakter"); + -1 + FI +END PROC character; + + +BOOL PROC is character (SYM CONST sym): + x status (sym) = character data +END PROC is character; + + +SYM PROC sym character (INT CONST char): + x new node (character data, char MOD 256, 1) +END PROC sym character; + + +INT PROC int 1 (SYM CONST sym): + IF x status (sym) = int data THEN + CONCR (x head (sym)) + ELSE + error stop ("ist keine Zahl"); + -1 + FI +END PROC int 1; + + +INT PROC int 2 (SYM CONST sym): + IF x status (sym) = int data THEN + CONCR (x tail (sym)) + ELSE + error stop ("ist keine Zahl"); + -1 + FI +END PROC int 2; + + +BOOL PROC is int pair (SYM CONST sym): + x status (sym) = int data +END PROC is int pair; + + +SYM PROC sym (INT CONST int 1, int 2): + x new node (int data, int 1, int 2) +END PROC sym; + + +(********************* internal error routine *****************************) + + +PROC x lisp error (TEXT CONST error message): + error stop (""13"LISP SYSTEM FEHLER: " + error message ) +END PROC x lisp error; + + +END PACKET lisp heap and oblist management; + + + +PACKET name (* Autor: J.Durchholz *) + (* Datum: 15.06.1982 *) + DEFINES (* Version 1.1.1 *) + + name: + +TEXT PROC name (SYM CONST sym): + IF is named atom (sym) THEN + text (property (sym, pname)) + ELSE + ""15"IST_KEIN_ATOM"14"" + FI +END PROC name; + + +END PACKET name; + + + +PACKET lisp storage info (* Autor: J.Durchholz *) + (* Datum: 23.08.1982 *) + DEFINES (* Version 1.1.1 *) + + lisp storage info: + + +PROC lisp storage info: + INT VAR size, used; + lisp storage (size, used); + out (""13""10" "); + put (used); + put ("Knoten von"); + put (size); + put line ("Knoten des LISP-Heaps sind belegt!") +END PROC lisp storage info; + + +END PACKET lisp storage info; + diff --git a/lang/lisp/1.8.7/src/lisp.2 b/lang/lisp/1.8.7/src/lisp.2 new file mode 100644 index 0000000..28e6924 --- /dev/null +++ b/lang/lisp/1.8.7/src/lisp.2 @@ -0,0 +1,584 @@ +PACKET character buffer (* Autor : J.Durchholz *) + (* Datum : 09.05.1984 *) + DEFINES (* Version 1.7.2 *) + (* 21.2.83. hey 293, 450,97,361 *) + get char, + line nr, + init char buffer: + + +TEXT VAR buffer; +INT VAR pointer, + line; + + +INT PROC line nr: + line +END PROC line nr; + + +PROC init char buffer: + buffer := ""; + pointer := 1; + line := 0; +END PROC init char buffer; + + +PROC get char (FILE VAR f, TEXT VAR char): + IF buffer empty THEN + try to find nonempty line and put it into buffer; + char := " "; + pointer := 1 + ELSE + char := buffer SUB pointer; + pointer INCR 1 + FI. + +buffer empty: + pointer > length (buffer). + +try to find nonempty line and put it into buffer: + REP + IF eof (f) THEN + char := ""; + LEAVE get char + FI; + get line (f, buffer); + line INCR 1 + UNTIL buffer <> "" PER. + +END PROC get char; + + +END PACKET character buffer; + + + + +PACKET lisp io (* Autor: J.Durchholz *) + (* Datum: 10.09.1982 *) + DEFINES (* Version 4.1.3 *) + (* Ă„nderung: notebook *) + put, note, (* 13.3.86 I. Ley *) + verbose lisp output, + get, + get all: + + +BOOL VAR verbose :: FALSE; + + +PROC verbose lisp output (BOOL CONST b): + verbose := b +END PROC verbose lisp output; + +BOOL PROC verbose lisp output: + verbose +END PROC verbose lisp output; + + +PROC put (SYM CONST sym): + IF atom (sym) THEN + put atom + ELSE + put structure + FI. + +put atom: + IF is named atom (sym) THEN + put (name (sym)) + ELIF is int pair (sym) THEN + put (int 1 (sym)) + ELIF is text (sym) THEN + IF verbose THEN + TEXT VAR buffer :: text (sym); + change all (buffer, """", """"""); + buffer CAT """"; + put ("""" + buffer) + ELSE + write (text (sym)) + FI + ELIF is character (sym) THEN + IF verbose THEN + buffer := "'"; + buffer CAT code (character (sym)); + buffer CAT "'"; + put (buffer) + ELSE + out (code (character (sym))) + FI + ELSE + put (""15"UNBEKANNTER_ATOM_TYP"14"") + FI. + +put structure: + put ("("); + SYM VAR actual node := sym; + REP + put (head (actual node)); + actual node := tail (actual node) + UNTIL atom (actual node) PER; + IF NOT null (actual node) THEN + put ("."); + put (actual node) + FI; + put (")"). + +END PROC put; + +PROC put (FILE VAR f, SYM CONST sym): + IF atom (sym) THEN + put atom + ELSE + put structure + FI. + +put atom: + IF is named atom (sym) THEN + put (f, name (sym)) + ELIF is int pair (sym) THEN + put (f, int 1 (sym)) + ELIF is text (sym) THEN + IF verbose THEN + TEXT VAR buffer :: text (sym); + change all (buffer, """", """"""); + buffer CAT """"; + put (f, """" + buffer) + ELSE + put (f, text (sym)) + FI + ELIF is character (sym) THEN + IF verbose THEN + buffer := "'"; + buffer CAT code (character (sym)); + buffer CAT "'"; + put (f, buffer) + ELSE + put (f, code (character (sym))) + FI + ELSE + put ( f, ""15"UNBEKANNTER_ATOM_TYP"14"") + FI. + +put structure: + put (f, "("); + SYM VAR actual node := sym; + REP + put (f, head (actual node)); + actual node := tail (actual node) + UNTIL atom (actual node) PER; + IF NOT null (actual node) THEN + put (f, "."); + put (f, actual node) + FI; + put (f, ")"). + +END PROC put; + + PROC note (SYM CONST sym): + IF atom (sym) THEN + note atom + ELSE + note structure + FI. + +note atom: + IF is named atom (sym) THEN + note ( name (sym)) + ELIF is int pair (sym) THEN + note (int 1 (sym)) + ELIF is text (sym) THEN + IF verbose THEN + TEXT VAR buffer :: text (sym); + change all (buffer, """", """"""); + buffer CAT """"; + note ( """" + buffer) + ELSE + note ( text (sym)) + FI + ELIF is character (sym) THEN + IF verbose THEN + buffer := "'"; + buffer CAT code (character (sym)); + buffer CAT "'"; + note ( buffer) + ELSE + note ( code (character (sym))) + FI + ELSE + note ( ""15"UNBEKANNTER_ATOM_TYP"14"") + FI. + +note structure: + note ( "("); + SYM VAR actual node := sym; + REP + note ( head (actual node)); + actual node := tail (actual node) + UNTIL atom (actual node) PER; + IF NOT null (actual node) THEN + note ( "."); + note ( actual node) + FI; + note ( ")"). + +END PROC note; + +PROC get (FILE VAR f, SYM VAR s): + initialize scanner (f); + IF NOT get s expression (s) THEN + error ("LISP-Ausdruck erwartet") + FI; + scanner postprocessing (f) +END PROC get; + + +(**************************** parser for 'get' ****************************) + + +LET end of file type = 0, + name type = 1, + text type = 2, + character type = 3, + int type = 4, + other char type = 5; + + +BOOL PROC get s expression (SYM VAR s): + (* The boolean result indicates wether the error has not occurred that *) + (* 'get next symbol' was called, but then the symbol was not expected *) + (* and thus could not be processed. *) + get next symbol; + SELECT symbol type OF + CASE end of file type: FALSE + CASE name type: s := new atom (symbol); TRUE + CASE text type: s := sym (symbol); TRUE + CASE character type: s := sym character (code (symbol)); TRUE + CASE int type: s := sym (int (symbol), -1); TRUE + CASE other char type: get structure + OTHERWISE error ("EINLESEFEHLER: unbekannter Symboltyp: " + + text (symbol type)); TRUE + END SELECT. + +get structure: + IF symbol <> "(" THEN + FALSE + ELSE + get list; + IF symbol type <> other char type OR symbol <> ")" THEN + error (">> ) << erwartet"); + FALSE + ELSE + TRUE + FI + FI. + +get list: + SYM VAR father, son; + IF get s expression (son) THEN + get list elements; + ELSE + s := nil + FI. + +get list elements: + father := cons (son, nil); + s := father; + WHILE get s expression (son) REP + set tail (father, cons (son, nil)); + father := tail (father) + PER; + IF symbol type = other char type AND symbol = "." THEN + IF get s expression (son) THEN + set tail (father, son); + get next symbol + ELSE + error ("LISP-Ausdruck nach dem Punkt erwartet") + FI + FI. + +END PROC get s expression; + + +(********************* scanner for 'get x espression' *********************) + + +FILE VAR infile; + + +PROC initialize scanner (FILE CONST f): + infile := f; + no input errors := TRUE; + init char buffer; + get char (infile, actual char) +END PROC initialize scanner; + + +PROC scanner postprocessing (FILE VAR f): + f := infile +END PROC scanner postprocessing; + + +TEXT VAR symbol; INT VAR symbol type; + + +PROC get next symbol: + skip blanks; + IF actual char = "" THEN + symbol := "DATEIENDE"; + symbol type := end of file type + ELIF is letter THEN + get name + ELIF is digit or sign THEN + get integer + ELIF is double quote THEN + get text + ELIF is single quote THEN + get character + ELSE + get other char + FI . + +is letter: + IF "a" <= actual char AND actual char <= "z" THEN + actual char := code (code (actual char) - code ("a") + code ("A")); + TRUE + ELSE + "§" <= actual char AND actual char <= "Z" + FI. + +get name: + symbol type := name type; + symbol := actual char; + REP + get char (infile, actual char); + IF is neither letter nor digit THEN + LEAVE get name + FI; + symbol CAT actual char + PER. + +is neither letter nor digit: + NOT (is letter OR is digit OR is underscore). + +is digit: + "0" <= actual char AND actual char <= "9". + +is underscore: + actual char = "_". + +is digit or sign: + is digit OR actual char = "+" OR actual char = "-". + +get integer: + symbol type := int type; + IF actual char = "+" THEN + get char (infile, actual char); + skip blanks; + symbol := actual char + ELIF actual char = "-" THEN + symbol := "-"; + get char (infile, actual char); + skip blanks; + symbol CAT actual char + ELSE + symbol := actual char + FI; + REP + get char (infile, actual char); + IF NOT is digit THEN + LEAVE get integer + FI; + symbol CAT actual char + PER. + +is double quote: + actual char = """". + +get text: + symbol := ""; + symbol type := text type; + REP + get char (infile, actual char); + IF is double quote THEN + get char (infile, actual char); + IF NOT is double quote THEN LEAVE get text + FI + ELIF actual char = "" THEN LEAVE get text (*hey*) + FI; + symbol CAT actual char + PER. + +is single quote: + actual char = "'". + +get character: + symbol type := character type; + get char (infile, symbol); + get char (infile, actual char); + IF actual char <> "'" THEN + error (">> ' << erwartet") + ELSE + get char (infile, actual char) + FI. + +get other char: + symbol type := other char type; + symbol := actual char; + get char (infile, actual char). + +END PROC get next symbol; + + +TEXT VAR actual char; + + +PROC skip blanks: + INT VAR comment depth :: 0; + WHILE is comment OR actual char = " " REP + get char (infile, actual char) + PER. + +is comment: + IF actual char = "{" THEN + comment depth INCR 1; + TRUE + ELIF actual char = "}" THEN + IF comment depth = 0 THEN + error (">> { << fehlt") + ELSE + comment depth DECR 1 + FI; + TRUE + ELSE + IF comment depth > 0 THEN + IF actual char = "" THEN + error ("DATEIENDE im Kommentar"); + FALSE + ELSE + TRUE + FI + ELSE + FALSE + FI + FI. + +END PROC skip blanks; + + +BOOL VAR no input errors; +FILE VAR errors; + + +PROC error (TEXT CONST error message): + out ("FEHLER in Zeile "); + out (text (line nr)); + out (" bei >> "); + out (symbol); + out (" << : "); + out (error message); + line; + IF no input errors THEN + no input errors := FALSE; + errors := notefile; modify(errors); + headline (errors, "Einlesefehler"); output(errors) + FI; + write (errors, "FEHLER in Zeile "); + write (errors, text (line nr)); + write (errors, " bei >> "); + write (errors, symbol); + write (errors, " << : "); + write (errors, error message); + line (errors) +END PROC error; + + +PROC get (SYM VAR sym): (*hey*) + disable stop; + FILE VAR in :: sequential file (modify, "LISP INPUT"), + out :: notefile; modify (out); + headline (out,"LISP OUTPUT"); + headline (in, "LISP INPUT"); + noteedit (in); + input (in); + get (in, sym); + WHILE NOT no input errors AND NOT is error REP + modify (errors); + headline (errors, " LISP-Fehlermeldungen"); + headline (in, " Bitte KORREKTEN LISP-Ausdruck"); + noteedit (in); + headline (errors, "notebook"); + input (in); + get (in, sym) + PER; +END PROC get; + + +PROC get all (FILE VAR f, SYM VAR sym): + get (f, sym); + skip blanks; + IF NOT eof (infile) THEN + error ("Hinter dem letzten Symbol des LISP-Ausdruck stehen noch Zeichen") + FI +END PROC get all; + + +END PACKET lisp io; + + + +PACKET lisp integer (* Autor: J.Durchholz *) + (* Datum: 30.08.1982 *) + DEFINES (* Version 1.1.2 *) + + sum, + difference, + product, + quotient, + remainder: + +SYM PROC sum (SYM CONST summand list): + INT VAR result := 0; + SYM VAR list rest := summand list; + WHILE NOT atom (list rest) REP + result INCR int 1 (head (list rest)); + list rest := tail (list rest) + PER; + IF NOT null (list rest) THEN + error stop ("Summandenliste endet falsch") + FI ; + sym (result, -1) +END PROC sum; + + +SYM PROC difference (SYM CONST minuend, subtrahend): + sym (int 1 (minuend) - int 1 (subtrahend), -1) +END PROC difference; + + +SYM PROC product (SYM CONST factor list): + INT VAR result := 1; + SYM VAR list rest := factor list; + WHILE NOT atom (list rest) REP + result := result * int 1 (head (list rest)); + list rest := tail (list rest) + PER; + IF NOT null (list rest) THEN + error stop ("Faktorenliste endet falsch") + FI; + sym (result, -1) +END PROC product; + + +SYM PROC quotient (SYM CONST dividend, divisor): + sym (int 1 (dividend) DIV int 1 (divisor), -1) +END PROC quotient; + + +SYM PROC remainder(SYM CONST dividend, divisor): + sym (int 1 (dividend) MOD int 1 (divisor), -1) +END PROC remainder; + + +END PACKET lisp integer; + diff --git a/lang/lisp/1.8.7/src/lisp.3 b/lang/lisp/1.8.7/src/lisp.3 new file mode 100644 index 0000000..a93463c --- /dev/null +++ b/lang/lisp/1.8.7/src/lisp.3 @@ -0,0 +1,767 @@ +PACKET lisp heap maintenance (* Autor: J.Durchholz *) + (* Datum: 09.05.1984 *) + DEFINES (* Version 1.7.2 *) + (* Testhilfe *) + create lisp system, (* hey, 02.3.83 : 121,334,542,732 *) + dump oblist: + + +PROC create lisp system (FILE VAR f, DATASPACE CONST new heap): + initialize lisp system (new heap); + input (f); + WHILE NOT eof (f) REP + TEXT VAR name; + get (f, name); + SYM CONST s :: new atom (name); + get (f, name); + SYM CONST property name :: new atom (name); + IF NOT null (property name) THEN + SYM VAR property; + get (f, property); + add property (s, property name, property) + FI + PER +END PROC create lisp system; + + +PROC dump oblist (FILE VAR f): + begin oblist dump; + REP + SYM CONST actual atom :: next atom; + put line (f, name (actual atom)); + dump property list + UNTIL null (actual atom) PER. + +dump property list: + begin property list dump (actual atom); + REP + SYM VAR id, value; + next property (id, value); + write (f, " "); + write (f, name (id)); + write (f, " "); + write (f, name (value)); + line (f) + UNTIL null (id) AND null (value) PER. + +END PROC dump oblist; + + +PROC dump oblist: + begin oblist dump; + REP + SYM CONST actual atom :: next atom; + put line (name (actual atom)); + dump property list + UNTIL null (actual atom) PER. + +dump property list: + begin property list dump (actual atom); + REP + SYM VAR id, value; + next property (id, value); + out (" "); + out (name (id)); + out (" "); + put line (name (value)); + UNTIL null (id) AND null (value) PER. + +END PROC dump oblist; + + +END PACKET lisp heap maintenance; + + + +PACKET lisp interpreter (* Autor: J.Durchholz *) + (* Datum: 27.12.1982 *) + DEFINES (* Version 3.1.7 *) + evalquote, + apply, + eval, + try: + + +(* SYM-objects used by the interpreter. They all point to constant structure + within the heap. As their address may change during garbage collection, + it must be possible to correct the references to them made by the + SYM-objects. That is the reason why they are declared VAR instead of CONST*) +SYM VAR lambda constant, + label constant, + quote constant, + function constant, + indefinite constant, + apval constant, + true constant, + false constant; + +SYM VAR errors; +BOOL VAR trace :: FALSE; + +PROC initialize constants: + lambda constant := new atom ("LAMBDA"); + label constant := new atom ("LABEL"); + quote constant := new atom ("QUOTE"); + function constant := new atom ("FUNCTION"); + indefinite constant := new atom ("INDEFINITE"); + apval constant := new atom ("APVAL"); + true constant := new atom ("T"); + false constant := new atom ("F"); + errors := new atom ("ERRORS") +END PROC initialize constants; + + +SYM PROC evalquote (SYM CONST expr): (*hey*) + enable stop; + initialize constants; + x apply ( head (expr), quote (tail (expr)), nil ) +END PROC evalquote; + + +SYM PROC quote (SYM CONST x): + IF eq (x,nil) THEN nil + ELSE set head (x, new head); set tail (x, quote (tail(x))); x + FI . +new head: + cons (quote constant, cons (head(x), nil) ) +END PROC quote; + + +SYM PROC apply (SYM CONST function, argument list, alist): + enable stop; + initialize constants; + x apply (function, argument list, alist) +END PROC apply; + + +SYM PROC x apply (SYM CONST function, argument list, alist): + IF trace THEN line; + put ("a p p l y :"); put (function); line; + put ("arguments :"); put (argument list); line; + FI; + SYM VAR new alist; + initialize for alist insertion; + reduce actual fn to lambda expression; + insert parameter evaluated argument pairs in reversed order in new alist; + function body evaluation. + +reduce actual fn to lambda expression: + SYM VAR actual fn :: function; + REP + IF is named atom (actual fn) THEN + get function from property list of actual fn + or from functional alist entry + ELIF atom (actual fn) THEN + error stop ("Eine Funktion darf kein unbenanntes Atom sein") + ELSE + IF eq (head (actual fn), lambda constant) THEN + LEAVE reduce actual fn to lambda expression + ELIF eq (head (actual fn), label constant) THEN + get function from label expression and update alist + ELSE + error stop ("Funktion ist weder Atom noch LAMBDA-/LABEL-Ausdruck") + FI + FI + PER. + +get function from property list of actual fn or from functional alist entry: + IF property exists (actual fn, function constant) THEN + get function from property list of actual fn + ELSE + get function from functional alist entry + FI. + +get function from property list of actual fn: + actual fn := property (actual fn, function constant). + +get function from functional alist entry: + SYM VAR actual alist entry; + begin alist retrieval; + REP + IF end of alist THEN + error stop ("Die Funktion " + name (actual fn) + + " ist nicht definiert") + FI; + search for next functional alist entry; + UNTIL eq (head (actual functional alist entry), actual fn) PER; + actual fn := tail (actual functional alist entry). + +get function from label expression and update alist: + actual fn := tail (actual fn); + IF atom (actual fn) COR + (NOT atom (head (actual fn)) OR atom (tail (actual fn))) COR + NOT null (tail (tail (actual fn))) THEN + error stop ("Ungueltiger LABEL-Ausdruck") + FI; + SYM VAR new alist entry; + prepare new functional alist entry; + set head (new alist entry, head (actual fn)); + actual fn := head (tail (actual fn)); + set tail (new alist entry, actual fn). + +insert parameter evaluated argument pairs in reversed order in new alist: + actual fn := tail (actual fn); + IF atom (actual fn) THEN + error stop ("Ungueltiger LAMBDA-Ausdruck") + FI; + SYM VAR parameter list rest :: head (actual fn), + argument list rest :: argument list; + actual fn := tail (actual fn); + WHILE NOT null (parameter list rest) REP + add next parameter argument pair to alist + PER; + check wether no arguments are left over. + +add next parameter argument pair to alist: + IF atom (parameter list rest) THEN + error stop ("Parameterliste endet falsch") + FI; + SYM VAR param pointer :: head (parameter list rest); + parameter list rest := tail (parameter list rest); + IF is named atom (param pointer) AND NOT null (param pointer) THEN + add parameter evaluated argument pair to alist; + advance argument list rest + ELIF atom (param pointer) THEN + error stop ("Unbenannte Atome und NIL koennen nicht Parameter sein") + ELSE + IF eq (head (param pointer), indefinite constant) THEN + check wether is last param; + advance param pointer; + IF eq (head (param pointer), quote constant) THEN + advance param pointer; + move param pointer to parameter; + add parameter indefinite quoted argument pair to alist + ELSE + move param pointer to parameter; + add parameter indefinite evaluated argument pair to alist + FI; + argument list rest := nil + ELIF eq (head (param pointer), quote constant) THEN + advance param pointer; + move param pointer to parameter; + add parameter quoted argument pair to alist; + advance argument list rest + ELIF eq (head (param pointer), function constant) THEN + advance param pointer; + move param pointer to parameter; + add parameter functional argument pair to alist; + advance argument list rest + ELSE + error stop ("Ungueltiger Parameter") + FI + FI. + +advance param pointer: + param pointer := tail (param pointer); + IF atom (param pointer) THEN + error stop ("Ungueltiger Parameter") + FI. + +move param pointer to parameter: + IF NOT null (tail (param pointer)) THEN + error stop ("Ungueltiger Parameter") + FI; + param pointer := head (param pointer); + IF NOT atom (param pointer) OR null (param pointer) THEN + error stop ("Unbenannte Atome und NIL koennen nicht Parameter sein") + FI. + +advance argument list rest: + argument list rest := tail (argument list rest). + +add parameter evaluated argument pair to alist: + prepare new alist entry; + set head (new alist entry, param pointer); + set tail (new alist entry, x eval (actual argument, alist)). + +check wether is last param: + IF NOT null (parameter list rest) THEN + error stop ("Ein INDEFINITE-Parameter muss der letzte sein") + FI. + +add parameter indefinite quoted argument pair to alist: + prepare new alist entry; + set head (new alist entry, param pointer); + set tail (new alist entry, argument list rest); + WHILE NOT atom (argument list rest) REP + argument list rest := tail (argument list rest) + PER; + IF NOT null (argument list rest) THEN + error stop ("Argumentliste endet falsch") + FI. + +add parameter indefinite evaluated argument pair to alist: + prepare new alist entry; + set head (new alist entry, param pointer); + last evaluated argument := new alist entry; + WHILE NOT atom (argument list rest) REP + set tail (last evaluated argument, + cons (x eval (head (argument list rest), alist), nil)); + last evaluated argument := tail (last evaluated argument); + advance argument list rest + PER; + IF NOT null (argument list rest) THEN + error stop ("Argumentliste endet falsch") + FI. + +last evaluated argument: + param pointer. +(* The value of param pointer is not used further, so the *) +(* variable can be "reused" in this manner. *) + +add parameter quoted argument pair to alist: + prepare new alist entry; + set head (new alist entry, param pointer); + set tail (new alist entry, actual argument). + +add parameter functional argument pair to alist: + prepare new functional alist entry; + set head (new alist entry, param pointer); + set tail (new alist entry, actual argument). + +actual argument: + IF atom (argument list rest) THEN + IF null (argument list rest) THEN + error stop ("Zuwenig Argumente") + ELSE + error stop ("Argumentliste endet falsch") + FI + FI; + head (argument list rest). + +check wether no arguments are left over: + IF NOT null (argument list rest) THEN + error stop ("Zuviele Argumente") + FI. + +function body evaluation: + IF is int pair (actual fn) THEN + predefined function evaluation + ELIF atom (actual fn) COR NOT null (tail (actual fn)) THEN + error stop ("Ungueltiger LAMBDA-Ausdruck"); nil + ELSE + x eval (head (actual fn), new alist) + FI. + +predefined function evaluation: + SELECT int 1 (actual fn) OF + CASE 0: call eval cond + CASE 1: call begin oblist dump + CASE 2: call next atom + CASE 3: call add property + CASE 4: call alter property + CASE 5: call delete property + CASE 6: call property exists + CASE 7: call property + CASE 8: call add flag + CASE 9: call flag + CASE 10: call delete flag + CASE 11: call begin property list dump + CASE 12: call next property + CASE 13: call apply + CASE 14: call eval + CASE 15: call try + CASE 16: give association list + CASE 17: call error stop + CASE 18: call head + CASE 19: call set head + CASE 20: call tail + CASE 21: call set tail + CASE 22: call cons + CASE 23: call eq + CASE 24: call get sym + CASE 25: call put sym + CASE 26: call null + CASE 27: call is atom + CASE 28: call is named atom + CASE 29: call get named atom + CASE 30: call put named atom + CASE 31: call is text + CASE 32: call get text + CASE 33: call put text + CASE 34: call is character + CASE 35: call get character + CASE 36: call put character + CASE 37: call is int + CASE 38: call get int + CASE 39: call put int + CASE 40: call sum + CASE 41: call difference + CASE 42: call product + CASE 43: call quotient + CASE 44: call remainder + CASE 45: call equal + CASE 46: call trace + CASE 47: call define + CASE 48: call set + OTHERWISE error stop("Es gibt (noch) keine LISP-Funktion mit der Nummer" + + text (int 1 (actual fn)) ); nil + END SELECT. + +call eval cond: + x eval condition (arg 1, alist). + +call begin oblist dump: + begin oblist dump; nil. + +call next atom: + next atom. + +call add property: + add property (arg 3, arg 2, arg 1); arg 1. + +call alter property: + alter property (arg 3, arg 2, arg 1); arg 1. + +call delete property: + delete property (arg 2, arg 1); nil. + +call property exists: + IF property exists(arg 2,arg 1) THEN true constant ELSE false constant FI. + +call property: + property (arg 2, arg 1). + +call add flag: + add flag (arg 2, arg 1); nil. + +call flag: + IF flag (arg 2, arg 1) THEN true constant ELSE false constant FI. + +call delete flag: + delete flag (arg 2, arg 1); nil. + +call begin property list dump: + begin property list dump (arg 1); nil. + +call next property: + SYM VAR s1, s2; next property (s1, s2); cons (s1, s2). + +call apply: + x apply (arg 3, arg 2, arg 1). + +call eval: + x eval (arg 2, arg 1). + +call try: + x try (arg 4, arg 3, arg 2, arg 1). + +give association list: + alist. + +call error stop: + error stop (text (arg 1)); nil. + +call head: + head (arg 1). + +call set head: + set head (arg 2, arg 1); arg 2. + +call tail: + tail (arg 1). + +call set tail: + set tail (arg 2, arg 1); arg 2. + +call cons: + cons (arg 2, arg 1). + +call eq: + IF eq (arg 2, arg 1) THEN true constant ELSE false constant FI. + +call get sym: + get (s1); s1. + +call put sym: + put (arg 1); arg 1. + +call null: + IF null (arg 1) THEN true constant ELSE false constant FI. + +call is atom: + IF atom (arg 1) THEN true constant ELSE false constant FI. + +call is named atom: + IF is named atom (arg 1) THEN true constant ELSE false constant FI. + +call get named atom: + TEXT VAR t; get (t); new atom (t). + +call put named atom: + put (name (arg 1)); arg 1. + +call is text: + IF is text (arg 1) THEN true constant ELSE false constant FI. + +call get text: + get (t); sym (t). + +call put text: + put (text (arg 1)); arg 1. + +call is character: + IF is character (arg 1) THEN true constant ELSE false constant FI. + +call get character: + inchar (t); sym character (code (t)). + +call put character: + out (code (character (arg 1))); arg 1. + +call is int: + IF is int pair (arg 1) THEN true constant ELSE false constant FI. + +call get int: + INT VAR i; get (i); sym (i, -1). + +call put int: + put (int 1 (arg 1)); arg 1. + +call sum: + sum (arg 1). + +call difference: + difference (arg 2, arg 1). + +call product: + product (arg 1). + +call quotient: + quotient (arg 2, arg 1). + +call remainder: + remainder(arg 2, arg 1). + +call equal: + IF equal (arg 2, arg 1) THEN true constant ELSE false constant FI. + +call trace: + trace := NOT trace; + IF trace THEN true constant ELSE false constant FI . + +call define: (*hey*) + define (arg 1) . + +call set: (*hey*) + add property (new atom ( name (arg 2)), apval constant, arg 1); arg 1 . + +arg 1: + tail (head (new alist)). + +arg 2: + tail (head (tail (new alist))). + +arg 3: + tail (head (tail (tail (new alist)))). + +arg 4: + tail (head (tail (tail (tail (new alist))))). + +END PROC x apply; + +SYM PROC define (SYM CONST x): (*hey*) + IF eq (x, nil) THEN nil + ELSE add property (new atom (name (head (head (x)))), + function constant, tail (head (x)) ); + cons (head (head (x)), define (tail (x)) ) + FI . +END PROC define; + +SYM VAR old alist :: nil; + +SYM PROC eval (SYM CONST expression, alist): + enable stop; + initialize constants; + x eval (expression, alist) +END PROC eval; + + +SYM PROC x eval (SYM CONST expression, alist): (*hey*) + IF trace THEN line; + put ("e v a l :"); put (expression); line; + IF NOT equal (alist, old alist) THEN + put ("bindings :"); old alist := alist; put (alist); line FI + FI; + IF atom (expression) THEN + IF is named atom (expression) THEN + value from property list of expression or from alist entry + ELSE + expression + FI + ELSE + x apply (head (expression), tail (expression), alist) + FI. + +value from property list of expression or from alist entry: + IF property exists (expression, apval constant) THEN + value from property list of expression + ELSE + value from alist entry + FI. + +value from property list of expression: + property (expression, apval constant). + +value from alist entry: + SYM VAR actual alist entry; + begin alist retrieval; + REP + IF end of alist THEN + error stop ("Das Atom " + name (expression) + " hat keinen Wert") + FI; + search for next alist entry + UNTIL eq (head (actual alist entry), expression) PER; + tail (actual alist entry). + +END PROC x eval; + + +SYM PROC try (SYM CONST expression list, alist, + error output, break possible): + enable stop; + initialize constants; + x try (expression list, alist, error output, break possible) +END PROC try; + + +SYM PROC x try (SYM CONST expression list, alist, + error output, break possible): + BOOL CONST output :: bool (error output), + halt enabled :: bool (break possible); + SYM VAR expr list rest :: expression list; + REP + IF null (expr list rest) THEN + LEAVE x try WITH nil + ELIF atom (expr list rest) THEN + error stop ("Ausdrucksliste fuer 'try' endet falsch") + ELSE + try evaluation of actual expression + FI; + expr list rest := tail (expr list rest) + PER; + nil. + +try evaluation of actual expression: + disable stop; + SYM VAR result :: x eval (head (expr list rest), alist); + IF is error THEN + IF error message = "halt from terminal" AND halt enabled THEN + enable stop + ELIF output THEN + put error + FI; + add property (errors, apval constant, sym (error message)); + clear error + ELSE + LEAVE x try WITH result + FI; + enable stop. + +END PROC x try; + + +SYM PROC x eval condition (SYM CONST pair list, alist): + enable stop; + SYM VAR cond pair list rest :: pair list; + REP + IF atom (cond pair list rest) THEN + error stop ("Keine 'T'-Bedingung in bedingtem Ausdruck gefunden") + FI; + check wether is correct pair; + IF true condition found THEN + LEAVE x eval condition WITH x eval (head (tail (actual pair)), alist) + FI; + cond pair list rest := tail (cond pair list rest) + PER; + nil. + +check wether is correct pair: + IF atom (actual pair) COR + atom (tail (actual pair)) COR + NOT null (tail (tail (actual pair))) THEN + error stop ("Ungueltiges Paar im bedingten Ausdruck") + FI. + +true condition found: + bool (x eval (head (actual pair), alist)). + +actual pair: + head (cond pair list rest). + +END PROC x eval condition; + + +BOOL PROC bool (SYM CONST sym): + IF eq (sym, true constant) THEN + TRUE + ELIF eq (sym, false constant) THEN + FALSE + ELSE + error stop ("'T' oder 'F' erwartet"); TRUE + FI +END PROC bool; + + +(******* a-list handling refinements used in 'x apply' and 'x eval' *******) + +(* declared within 'x apply' and 'x eval': 'actual alist entry' *) + +. + +initialize for alist insertion: + new alist := alist. + +begin alist retrieval: + SYM VAR actual alist pos :: alist. + +search for next alist entry: + WHILE NOT end of alist REP + IF atom (actual alist pos) THEN + error stop ("Bindeliste endet falsch") + FI; + actual alist entry := head (actual alist pos); + actual alist pos := tail (actual alist pos); + UNTIL is non functional alist entry PER. + +is non functional alist entry: + NOT is functional alist entry. + +search for next functional alist entry: + WHILE NOT end of alist REP + IF atom (actual alist pos) THEN + error stop ("Bindeliste endet falsch") + FI; + actual alist entry := head (actual alist pos); + actual alist pos := tail (actual alist pos); + UNTIL is functional alist entry PER; + actual alist entry := tail (actual alist entry). + +is functional alist entry: + check wether is alist entry; + null (head (actual alist entry)). + +check wether is alist entry: + IF atom (actual alist entry) THEN + error stop ("Bindelisteneintrag ist kein Paar") + FI. + +end of alist: + null (actual alist pos). + +actual functional alist entry: + actual alist entry. + +prepare new alist entry: + new alist := cons (cons (nil, nil), new alist); + new alist entry := head (new alist). + +prepare new functional alist entry: + new alist := cons (cons (nil, cons (nil, nil)), new alist); + new alist entry := tail (head (new alist)). + + +END PACKET lisp interpreter; + + + diff --git a/lang/lisp/1.8.7/src/lisp.4 b/lang/lisp/1.8.7/src/lisp.4 new file mode 100644 index 0000000..0733dcd --- /dev/null +++ b/lang/lisp/1.8.7/src/lisp.4 @@ -0,0 +1,143 @@ +PACKET lisp (* Autor: J.Durchholz , P. Heyderhoff *) + (* Datum: 09.05.1984 *) + DEFINES (* Version 1.7.2 *) + (* Ă„nderung: notebook *) + (* 13.3.86 I. Ley *) + (* Ă„nderung: start lisp system *) + (* 25.3.86 I. Ley *) + (* Anpassung an ELAN-Compiler Version 1.7.5 *) + (* 8.4.86 I. Ley *) + start lisp system, + lisp heap, + insert lisp, + run lisp, + run lisp again, + lisp, + break lisp: + +SYM VAR run again pointer :: nil; +DATASPACE VAR insert heap :: nil space; + +PROC start lisp system (DATASPACE CONST heap): + enable stop; + initialize lisp system (heap); + forget (insert heap); + insert heap := heap +END PROC start lisp system; + + +PROC start lisp system (DATASPACE CONST heap, FILE VAR f): + enable stop; + create lisp system (f, heap); + forget (insert heap); + insert heap := heap +END PROC start lisp system; + + +PROC start lisp system (FILE VAR f): + create lisp system (f, insert heap) +END PROC start lisp system; + + +DATASPACE PROC lisp heap: + insert heap +END PROC lisp heap; + + +DATASPACE VAR run heap :: nil space; + + +PROC insert lisp: + insert lisp (last param) +END PROC insert lisp; + + +PROC insert lisp (TEXT CONST file name): + interpret (insert heap, file name) +END PROC insert lisp; + + +PROC run lisp: + run lisp (last param) +END PROC run lisp; + + +PROC run lisp (TEXT CONST file name): + forget (run heap); + run heap := insert heap; + interpret (run heap, file name) +END PROC run lisp; + + +PROC interpret (DATASPACE CONST heap, TEXT CONST file name): + enable stop; + FILE VAR f :: sequential file (input, file name); + interpret (heap, f) +END PROC interpret; + + +PROC interpret (DATASPACE CONST heap, FILE VAR f): + initialize lisp system (heap); + get (f, run again pointer); + add property (new atom ("program"), new atom ("APVAL"), run again pointer); + put (evalquote (run again pointer)) +END PROC interpret; + +PROC run lisp again: + put (evalquote (run again pointer)) +END PROC run lisp again; + + +PROC get ausdruck: + enable stop; get (ausdruck) +END PROC get ausdruck; + +SYM VAR ausdruck; + +PROC lisp: + +(* HAUPT TESTPROGRAMM FUER LISP Heyderhoff 25.1.83 *) +IF NOT exists ("LISP HEAP") THEN + FILE VAR bootstrap :: sequential file (input, "lisp.bootstrap"); + create lisp system (bootstrap, new ("LISP HEAP")); + verbose lisp output (TRUE); +FI; +SYM VAR work; +command dialogue(FALSE); forget ("LISP INPUT"); command dialogue(TRUE); +(* bildlaenge(23); *) (* EUMEL 1.65 *) +disable stop; +REP + get (ausdruck); + IF is error THEN + handle error + ELSE + work := evalquote (ausdruck); + IF is error THEN handle error + ELSE note (work) + FI + FI +PER . + +handle error: + IF text (error message, 18) = "halt from terminal" THEN + enable stop + ELSE + note (error message); + put ( error message); pause(20); + clear error; + FI . +END PROC lisp; + +PROC break lisp: + break; + page; + quit; + FILE VAR in :: sequential file (modify, "LISP INPUT"), + out :: notefile; modify (out); + headline (out,"LISP OUTPUT"); + headline (in, "LISP INPUT"); + noteedit (in); +END PROC break lisp + +END PACKET lisp; + diff --git a/lang/lisp/1.8.7/src/lisp.bootstrap b/lang/lisp/1.8.7/src/lisp.bootstrap new file mode 100644 index 0000000..37efbde --- /dev/null +++ b/lang/lisp/1.8.7/src/lisp.bootstrap @@ -0,0 +1,118 @@ +NIL APVAL +NIL +T APVAL +T +F APVAL +F +COND FUNCTION +(LAMBDA ((INDEFINITE QUOTE X)) . 0) +BEGINOBLISTDUMP FUNCTION +(LAMBDA () . 1) +NEXTATOM FUNCTION +(LAMBDA () . 2) +ADDPROPERTY FUNCTION +(LAMBDA (X X X) . 3) +ALTERPROPERTY FUNCTION +(LAMBDA (X X X) . 4) +DELETEPROPERTY FUNCTION +(LAMBDA (X X) . 5) +PROPERTYEXISTS FUNCTION +(LAMBDA (X X) . 6) +PROPERTY FUNCTION +(LAMBDA (X X) . 7) +ADDFLAG FUNCTION +(LAMBDA (X X) . 8) +FLAG FUNCTION +(LAMBDA (X X) . 9) +DELETEFLAG FUNCTION +(LAMBDA (X X) . 10) +BEGINPROPERTYLISTDUMP FUNCTION +(LAMBDA (X) . 11) +NEXTPROPERTY FUNCTION +(LAMBDA () . 12) +APPLY FUNCTION +(LAMBDA (X X X) . 13) +EVAL FUNCTION +(LAMBDA (X X) . 14) +TRY FUNCTION +(LAMBDA (X X X X) . 15) +ASSOCIATIONLIST FUNCTION +(LAMBDA () . 16) +ERRORSTOP FUNCTION +(LAMBDA (X) . 17) +HEAD FUNCTION +(LAMBDA (X) . 18) +SETHEAD FUNCTION +(LAMBDA (X X) . 19) +TAIL FUNCTION +(LAMBDA (X) . 20) +SETTAIL FUNCTION +(LAMBDA (X X) . 21) +CONS FUNCTION +(LAMBDA (X X) . 22) +EQ FUNCTION +(LAMBDA (X X) . 23) +GET FUNCTION +(LAMBDA () . 24) +PUT FUNCTION +(LAMBDA (X) . 25) +NULL FUNCTION +(LAMBDA (X) . 26) +ATOM FUNCTION +(LAMBDA (X) . 27) +NAMEDATOM FUNCTION +(LAMBDA (X) . 28) +GETATOM FUNCTION +(LAMBDA () . 29) +PUTATOM FUNCTION +(LAMBDA (X) . 30) +TEXT FUNCTION +(LAMBDA (X) . 31) +GETTEXT FUNCTION +(LAMBDA () . 32) +PUTTEXT FUNCTION +(LAMBDA (X) . 33) +CHARACTER FUNCTION +(LAMBDA (X) . 34) +GETCHARACTER FUNCTION +(LAMBDA () . 35) +PUTCHARACTER FUNCTION +(LAMBDA (X) . 36) +INT FUNCTION +(LAMBDA (X). 37) +GETINT FUNCTION +(LAMBDA () . 38) +PUTINT FUNCTION +(LAMBDA (X) . 39) +SUM FUNCTION +(LAMBDA ((INDEFINITE X)) . 40) +DIFFERENCE FUNCTION +(LAMBDA (X X). 41) +PRODUCT FUNCTION +(LAMBDA ((INDEFINITE X)). 42) +QUOTIENT FUNCTION +(LAMBDA (X X).43) +REMAINDER FUNCTION +(LAMBDA (X X).44) +EQUAL FUNCTION +(LAMBDA (X X) . 45) +TRACE FUNCTION +(LAMBDA () . 46 ) +DEFINE FUNCTION +(LAMBDA ((INDEFINITE X)) . 47 ) +SET FUNCTION +(LAMBDA (X X) . 48 ) +QUOTE FUNCTION +(LAMBDA ((QUOTE X)) X) +LIST FUNCTION +(LAMBDA ((INDEFINITE X)) X) +DO FUNCTION +(LAMBDA ((INDEFINITE X)) NIL) +PUTLIST FUNCTION +(LAMBDA ((INDEFINITE X)) + (COND + ((NULL X) NIL) + (T (DO (PUT (HEAD X)) (PUTLIST (TAIL X)))) + ) +) + |