Page Numbers: Yes X: 510 Y: 10.42" First Page: 1
Margins: Top: 1.0" Bottom: 1.5"
Heading:

3-LISP DEUS-EX-MACHINA PROCESSOR (Miscellany)

;;; -*- October 8, 1982 4:16 PM -*-

;;; Misc.
;;; =====
;;;

(define @PASS (lambda simple [x] $T))

(define @N-ARGS!
(lambda simple [@n args!]
(if (@rail args!)
(if (= @n 0)
(@empty args!)
(and (@n-args! (- @n 1) (rest args!))
(@normal (1st args!))))
$F)))

(define @0-ARGS! (lambda simple [args!] (@n-args! 0 args!)))

(define @1-ARG! (lambda simple [args!] (@n-args! 1 args!)))

(define @2-ARGS! (lambda simple [args!] (@n-args! 2 args!)))

(define @3-ARGS! (lambda simple [args!] (@n-args! 3 args!)))

(define @4-ARGS! (lambda simple [args!] (@n-args! 4 args!)))

(define @5-ARGS! (lambda simple [args!] (@n-args! 5 args!)))

(define @3R-ARGS!
(lambda simple [args!]
(and (@n-args! 3 args!) (@rail (1st args!) (@normal (1st args!))))))

(define @3/2-ARGS!
(lambda simple [args!]
(and (@n-args! 3 args!) (@n-args! 2 (1st args!)))))

(define 3/3-ARGS!
(lambda simple [args!]
(and (@n-args! 3 args!) (@n-args! 3 (1st args!)))))

(define BOOL
(lambda simple [f]
(lambda simple x
(if (f . x) $T-value $F-value))))

(define @TAKES-0
(lambda simple [@fun]
(lambda simple [fun args]
(@fun))))

(define @TAKES-1
(lambda simple [@fun]
(lambda simple [fun args]
(@fun (1st args)))))

(define @TAKES-2
(lambda simple [@fun]
(lambda simple [fun args]
(@fun (1st args) (2nd args)))))

(define @TAKES-3
(lambda simple [@fun]
(lambda simple [fun args]
(@fun (1st args) (2nd args) (3rd args)))))

(define @TAKES-4
(lambda simple [@fun]
(lambda simple [fun args]
(@fun (1st args) (2nd args) (3rd args) (4th args)))))

(define @TAKES-5
(lambda simple [@fun]
(lambda simple [fun args]
(@fun (1st args) (2nd args) (3rd args) (4th args) (5th args)))))

(define @TAKES-N
(lambda simple [@fun]
(lambda simple [fun args]
(@fun . (@spread args)))))

(define @TAKES-3/2
(lambda simple [@fun]
(lambda simple [fun args]
(@fun (1st (1st args)) (2nd (1st args)) (2nd args) (3rd args)))))

(define @TAKES-3/3
(lambda simple [@fun]
(lambda simple [fun args]
(@fun (1st (1st args)) (2nd (1st args)) (3rd (1st args)) (2nd args) (3rd args)))))

(define @SPREAD
(lambda simple [x]
(if (@empty x)
(scons)
(prep (1st x) (@spread (rest x))))))

(define MAP1
(lambda simple [@fun vector]
(cond [(@empty vector) (vcons vector)]
[$T (prep (@fun (1st arg)) (map1 fun (rest arg)))])))