Page Numbers: Yes X: 306 Y: 1.0" First Page: 36
Margins: Top: 1.0" Bottom: 1.3"
Heading:

STD. PROCEDURE DEFNS.3-LISP REFERENCE MANUALFebruary 1, 1983

————————————————————————————————————————————

8.e. Vector Utilities

————————————————————————————————————————————

VECTOR PREDICATES and SELECTOR FUNCTIONS:

(define 1ST (lambda simple [vector] (nth 1 vector)))
(define 2ND (lambda simple [vector] (nth 2 vector)))
(define 3RD (lambda simple [vector] (nth 3 vector)))
(define 4TH (lambda simple [vector] (nth 4 vector)))
(define 5TH (lambda simple [vector] (nth 5 vector)))
(define 6TH (lambda simple [vector] (nth 6 vector)))

(define REST (lambda simple [vector] (tail 1 vector)))

(define FOOT
(lambda simple [vector]
(tail (length vector) vector)))

VECTOR PREDICATES:

(define UNIT
(lambda simple [vector]
(and (not (empty vector)) (empty (rest vector)))))

(define DOUBLE
(lambda simple [vector]
(and (not (empty vector)) (unit (rest vector)))))

(define MEMBER
(lambda simple [element vector]
(cond [(empty vector) $F]
[(= element (1st vector)) $T]
[$T (member element (rest vector))])))

ISOMORPHIC:

(define ISOMORPHIC
(lambda simple [e1 e2]
(cond [(not (= (type e1) (type e2))) $F]
[(= e1 e2) $T]
[(rail e1)
(or (and (empty e1) (empty e2))
(and (not (empty e1))
(not (empty e2))
(isomorphic (1st e1) (1st e2))
(isomorphic (rest e1) (rest e2))))]
[(pair e1)
(and (isomorphic (car e1) (car e2))
(isomorphic (cdr e1) (cdr e2)))]
[(closure e1)
(and (isomorphic (procedure-type e1)
(procedure-type e2))
(isomorphic (pattern e1) (pattern e2))
(isomorphic (body e1) (body e2))
(isomorphic (environment-designator e1)
(environment-designator e2)))]
[(handle e1) (isomorphic \e1 \e2)]
[$T $F])))

INDEX:

(define INDEX
(lambda simple [element vector]
(labels
[[index-helper
(lambda simple [vector-tail position]
(cond [(empty vector-tail) 0]
[(= (1st vector-tail) element) position]
[$T (index-helper (rest vector-tail) (1+ position))]))]]
(index-helper vector 1))))

GENERALISED CONSTRUCTORS:

(define VECTOR-CONSTRUCTOR
(lambda simple [template]
(if (external template) scons rcons)))

(define XCONS
(lambda simple args
(pcons (1st args) (rcons . (rest args)))))

MAP:

(define MAP
(lambda simple args
(cond [(empty (2nd args)) ((vector-constructor (2nd args)))]
[(double args)
(prep ((1st args) (1st (2nd args)))
(map (1st args) (rest (2nd args))))]
[$T (prep ((1st args) . (map 1st (rest args)))
(map . (prep (1st args) (map rest (rest args)))))])))

COPYING and ADJOINING:

(define COPY-VECTOR
(lambda simple [vector]
(if (empty vector)
((vector-constructor vector))
(prep (1st vector) (copy-vector (rest vector))))))

(define CONCATENATE
(lambda simple [rail1 rail2]
(replace (foot rail1) rail2)))

(define APPEND
(lambda simple [vector1 vector2]
(if (empty vector1)
vector2
(prep (1st vector1)
(append (rest vector1) vector2)))))

(define APPEND*
(lambda simple args
(if (unit args)
(1st args)
(append (1st args) (append* . (rest args))))))

REVERSING:

(define REVERSE
(labels
[[rev (lambda simple [v1 v2]
(if (empty v1)
v2
(rev (rest v1) (prep (1st v1) v2))))]]
(lambda simple [vector]
(rev vector ((vector-constructor vector))))))

PUSH and POP:

(define PUSH
(lambda simple [element stack]
(replace ↑stack
↑(prep element
(if (empty stack)
(scons)
(prep (1st stack) (rest stack)))))))

(define POP
(lambda simple [stack]
(let [[top (1st stack)]]
(block
(replace ↑stack ↑(rest stack))
top))))

————————————————————————————————————————————

8.f. Arithmetic Utilities

————————————————————————————————————————————

(define 1+ (lambda simple [n] (+ n 1)))
(define 1- (lambda simple [n] (- n 1)))

(define **
(lambda simple [m n]
(do [[i 0 (1+ i)]
[a 1 (* a m)]]
[[(= i n) a]])))

(define REMAINDER
(lambda simple [x y]
(- x (* (/ x y) y))))

(define ABS
(lambda simple [n]
(if (< n 0) (- n) n)))

(define MAX
(lambda simple numbers
(labels
[[max2
(lambda simple [x y] (if (> x y) x y))]
[max-helper
(lambda simple [unseen-numbers maximum]
(if (empty unseen-numbers)
maximum
(max-helper (rest unseen-numbers)
(max2 maximum (1st unseen-numbers)))))]]
(max-helper (rest numbers) (1st numbers)))))

(define MIN
(lambda simple numbers
(labels
[[min2
(lambda simple [x y] (if (< x y) x y))]
[min-helper
(lambda simple [unseen-numbers minimum]
(if (empty unseen-numbers)
minimum
(min-helper (rest unseen-numbers)
(min2 minimum (1st unseen-numbers)))))]]
(min-helper (rest numbers) (1st numbers)))))

(define ODD (lambda simple args (not (zero (remainder n 2))))
(define EVEN (lambda simple args (zero (remainder n 2)))

(define NEGATIVE (lambda simple [n] (< n 0)))
(define NON-NEGATIVE (lambda simple [n] (>= n 0)))
(define POSITIVE (lambda simple [n] (> n 0)))
(define ZERO (lambda simple [n] (= n 0)))

————————————————————————————————————————————

8.g. General Utilities

————————————————————————————————————————————

TYPE PREDICATES:

(define ATOM (lambda simple [x] (= (type x) ’atom)))
(define RAIL (lambda simple [x] (= (type x) ’rail)))
(define PAIR (lambda simple [x] (= (type x) ’pair)))
(define NUMERAL (lambda simple [x] (= (type x) ’numeral)))
(define HANDLE (lambda simple [x] (= (type x) ’handle)))
(define BOOLEAN (lambda simple [x] (= (type x) ’boolean)))
(define CHARAT (lambda simple [x] (= (type x) ’charat)))
(define CLOSURE (lambda simple [x] (= (type x) ’closure)))
(define STREAMER (lambda simple [x] (= (type x) ’streamer)))

(define NUMBER (lambda simple [x] (= (type x) ’number)))
(define SEQUENCE (lambda simple [x] (= (type x) ’sequence)))
(define TRUTH-VALUE (lambda simple [x] (= (type x) ’truth-value)))
(define CHARACTER (lambda simple [x] (= (type x) ’character)))
(define FUNCTION (lambda simple [x] (= (type x) ’function)))
(define STREAM (lambda simple [x] (= (type x) ’stream)))

(define VECTOR
(lambda simple [x] (member (type x) [’rail ’sequence])))

(define INTERNAL
(lambda simple [x]
(member (type x)
[’atom ’rail ’pair ’numeral ’handle ’boolean ’charat
’closure ’streamer])))

(define EXTERNAL
(lambda simple [x]
(member (type x) [’number ’sequence ’truth-value ’character
’function ’stream])))

(define CHARACTER-STRING
(lambda simple [s]
(cond [(or (not (sequence s)) (empty s)) $F]
[(and (unit s) (character (1st s))) $T]
[$T (and (character (1st s))
(character-string (rest s)))])))

ENVIRONMENT:

(define ENVIRONMENT
(lambda simple [closure]
↑(environment-designator closure)))

REFERENT:

(define REFERENT
(lambda reflect! [[exp! env!] env cont]
(normalise ↑exp! ↑env! cont)))

MACRO EXPANSION:

(define MACRO-EXPANDER
(lambda simple [macro-closure]
↑(binding ’expander (environment ↑macro-closure))))

ID and ID*:

(define ID (lambda simple [x] x))
(define ID* (lambda simple x x))

STANDARD REPLACING PROCEDURES:

(define RPLACT
(lambda simple [n rail new-tail]
(replace (tail n rail) new-tail)))

(define RPLACN
(lambda simple [n rail new-element]
(replace (tail (- n 1) rail) (prep new-element (tail n rail)))))

(define RPLACA
(lambda simple [pair new-car]
(replace pair (pcons new-car (cdr pair)))))

(define RPLACD
(lambda simple [pair new-cdr]
(replace pair (pcons (car pair) new-cdr))))

BOOLEANS:

(define NOT (lambda simple [x] (if x $F $T)))

(define AND
(lambda reflect [args env cont]
(if (rail args)
(and-helper args env cont)
(normalise args env
(lambda simple [args!]
(and-helper args! env cont))))))

(define AND-HELPER
(lambda simple [args env cont]
(if (empty args)
(cont ’$T)
(normalise (1st args) env
(lambda simple [premise!]
(if ↑premise!
(and-helper (rest args) env cont)
(cont ’$F)))))))

(define OR
(lambda reflect [args env cont]
(if (rail args)
(or-helper args env cont)
(normalise args env
(lambda simple [args!]
(or-helper args! env cont))))))

(define OR-HELPER
(lambda simple [args env cont]
(if (empty args)
(cont ’$F)
(normalise (1st args) env
(lambda simple [premise!]
(if ↑premise!
(cont ’$T)
(or-helper (rest args) env cont)))))))

————————————————————————————————————————————

8.h. Input / Ouput

————————————————————————————————————————————

READ and PRINT (yet to be explained):

(define READ (lambda simple [stream] (mystery)))

(define PRINT (lambda simple [x stream] (mystery)))

INTERNALISATION and EXTERNALISATION (yet to be implemented):

(define INTERNALISE (lambda simple [x] (mystery)))

(define EXTERNALISE (lambda simple [x] (mystery)))

PRINT-STRING:

(define PRINT-STRING
(lambda simple [string stream]
(if (empty string)
’OK
(block (output (1st string) stream)
(print-string (rest string) stream)))))

NEWLINE:

(define NEWLINE
(lambda simple [stream]
(output #
stream)))

PROMPT and REPLY:

(define PROMPT
(lambda simple [level stream]
(block (newline stream)
(print ↑level stream)
(print-string "> " stream))))

(define REPLY
(lambda simple [answer stream]
(block (print-string "=> " stream)
(print answer stream))))

————————————————————————————————————————————

8.i. Programming Aids

————————————————————————————————————————————

BREAK, ADVISE, TRACE, etc. (none of which are defined yet):

(define BREAK .... )
(define ERROR .... )

(define ADVISE-ON-ENTRY .... )
(define ADVISE-ON-EXIT .... )
(define ADVISE .... )

(define TRACE-ON-ENTRY .... )
(define TRACE-ON-EXIT .... )
(define TRACE .... )

————————————————————————————————————————————

8.j. System

————————————————————————————————————————————

VERSION ID:

(define VERSION
(lanbda simple []
"3-LISP kernel procedures as of December 20, 1982 12:42 AM"))

LOADING FILES:

(define LOAD
(lambda macro [filename]
̀ (loadfile ,↑filename)))

EDITING DEFINITIONS:

(define EDIT
(lambda macro [name]
̀ (editdef ,↑name)))

————————————————————————————————————————————

8.k Primitive Procedures

————————————————————————————————————————————

(define TYPE (lambda simple [e] (type e)))
(define = (lambda simple entities (= . entities)))
(define EF (lambda simple [premise c1 c2] (ef premise c1 c2)))
(define UP (lambda simple [e] (up e)))
(define DOWN (lambda simple [s!] (down s!)))
(define REPLACE (lambda simple [s1 s2] (replace s1 s2)))

(define ACONS (lambda simple [] (acons)))

(define PCONS (lambda simple [s1 s2] (pcons s1 s2)))
(define CAR (lambda simple [pair] (car pair)))
(define CDR (lambda simple [pair] (cdr pair)))

(define RCONS (lambda simple structures (rcons . structures)))
(define SCONS (lambda simple entities (scons . entities)))
(define PREP (lambda simple [e vector] (prep e vector)))
(define LENGTH (lambda simple [vector] (length vector)))
(define NTH (lambda simple [n vector] (nth n vector)))
(define TAIL (lambda simple [n vector] (tail n vector)))
(define EMPTY (lambda simple [vector] (empty vector)))

(define CCONS
(lambda simple [kind def-env pattern body]
(ccons kind def-env pattern body)))
(define PROCEDURE-TYPE
(lambda simple [closure] (procedure-type closure)))
(define ENVIRONMENT-DESIGNATOR
(lambda simple [closure] (environment-designator closure)))
(define PATTERN (lambda simple [closure] (pattern closure)))
(define BODY (lambda simple [closure] (body closure)))

(define + (lambda simple numbers (+ . numbers)))
(define - (lambda simple numbers (- . numbers)))
(define / (lambda simple numbers (/ . numbers)))
(define * (lambda simple numbers (* . numbers)))
(define < (lambda simple numbers (< . numbers))))
(define <= (lambda simple numbers (<= . numbers)))
(define > (lambda simple numbers (> . numbers)))
(define >= (lambda simple numbers (>= . numbers)))

(define HASH (lambda simple [s range] (hash s range)))

(define INPUT (lambda simple [stream] (input stream)))
(define OUTPUT (lambda simple [e stream] (output e stream)))

(define LOADFILE (lambda simple [file-name] (loadfile file-name)))

(define EDITDEF (lambda simple [procedure-name] (editdef procedure-name)))