; Lisp code placed in ROM
; return a list containing all of the arguments
-(def (quote list) (lexpr (l) l))
+(def (quote list) (lambda l l))
(def (quote def!)
- (macro (name value rest)
+ (macro (name value)
(list
def
(list quote name)
(begin
(def! append
- (lexpr (args)
+ (lambda args
(def! append-list
(lambda (a b)
(cond ((null? a) b)
(begin
(def! or
- (macro (l)
+ (macro l
(def! _or
(lambda (l)
(cond ((null? l) #f)
(begin
(def! and
- (macro (l)
+ (macro l
(def! _and
(lambda (l)
(cond ((null? l) #t)
)
)
)
- (_and l)))
+ (_and l)
+ )
+ )
'and)
; execute to resolve macros
(begin
(def! quasiquote
- (macro (x rest)
+ (macro (x)
(def! constant?
; A constant value is either a pair starting with quote,
; or anything which is neither a pair nor a symbol
)
)
)
- (expand-quasiquote x 0)
+ (def! result (expand-quasiquote x 0))
+ result
)
)
'quasiquote)
+
;
; Define a variable without returning the value
; Useful when defining functions to avoid
(begin
(def! define
- (macro (first rest)
+ (macro (first . rest)
; check for alternate lambda definition form
(cond ((list? first)
(set! rest (car rest))
)
)
- `(begin
- (def (quote ,first) ,rest)
- (quote ,first))
+ (def! result `(,begin
+ (,def (,quote ,first) ,rest)
+ (,quote ,first))
+ )
+ result
)
)
'define
(define (caddr l) (car (cdr (cdr l))))
-(define (list-tail x k)
- (if (zero? k)
- x
- (list-tail (cdr x (- k 1)))
- )
- )
-
-(define (list-ref x k)
- (car (list-tail x k))
- )
-
; (if <condition> <if-true>)
; (if <condition> <if-true> <if-false)
(define if
- (macro (test args)
+ (macro (test . args)
(cond ((null? (cdr args))
`(cond (,test ,(car args)))
)
; simple math operators
-(define zero? (macro (value rest) `(eq? ,value 0)))
+(define zero? (macro (value) `(eq? ,value 0)))
(zero? 1)
(zero? 0)
(zero? "hello")
-(define positive? (macro (value rest) `(> ,value 0)))
+(define positive? (macro (value) `(> ,value 0)))
(positive? 12)
(positive? -12)
-(define negative? (macro (value rest) `(< ,value 0)))
+(define negative? (macro (value) `(< ,value 0)))
(negative? 12)
(negative? -12)
(abs 12)
(abs -12)
-(define max (lexpr (first rest)
+(define max (lambda (first . rest)
(while (not (null? rest))
(cond ((< first (car rest))
(set! first (car rest)))
(max 1 2 3)
(max 3 2 1)
-(define min (lexpr (first rest)
+(define min (lambda (first . rest)
(while (not (null? rest))
(cond ((> first (car rest))
(set! first (car rest)))
(odd? -1)
+(define (list-tail x k)
+ (if (zero? k)
+ x
+ (list-tail (cdr x (- k 1)))
+ )
+ )
+
+(define (list-ref x k)
+ (car (list-tail x k))
+ )
+
; define a set of local
; variables all at once and
; then evaluate a list of
; (let ((x 1) (y)) (set! y (+ x 1)) y)
(define let
- (macro (vars exprs)
+ (macro (vars . exprs)
(define (make-names vars)
(cond ((not (null? vars))
(cons (car (car vars))
; (let* ((x 1) (y)) (set! y (+ x 1)) y)
(define let*
- (macro (vars exprs)
+ (macro (vars . exprs)
;
; make the list of names in the let
(let* ((x 1) (y x)) (+ x y))
-(define when (macro (test l) `(cond (,test ,@l))))
+(define when (macro (test . l) `(cond (,test ,@l))))
(when #t (write 'when))
-(define unless (macro (test l) `(cond ((not ,test) ,@l))))
+(define unless (macro (test . l) `(cond ((not ,test) ,@l))))
(unless #f (write 'unless))
(equal? '(a b c) '(a b c))
(equal? '(a b c) '(a b b))
-(define member (lexpr (obj list test?)
+(define member (lambda (obj list . test?)
(cond ((null? list)
#f
)
(char-downcase #\0)
(char-downcase #\space)
-(define string (lexpr (chars) (list->string chars)))
+(define string (lambda chars (list->string chars)))
(display "apply\n")
(apply cons '(a b))
(define map
- (lexpr (proc lists)
+ (lambda (proc . lists)
(define (args lists)
(cond ((null? lists) ())
(else
(map cadr '((a b) (d e) (g h)))
-(define for-each (lexpr (proc lists)
+(define for-each (lambda (proc . lists)
(apply map proc lists)
#t))
)
)
-(define string-map (lexpr (proc strings)
+(define string-map (lambda (proc . strings)
(list->string (apply map proc (_string-ml strings))))))
(string-map (lambda (x) (+ 1 x)) "HAL")
-(define string-for-each (lexpr (proc strings)
+(define string-for-each (lambda (proc . strings)
(apply for-each proc (_string-ml strings))))
(string-for-each write-char "IBM\n")
(define repeat
- (macro (count rest)
+ (macro (count . rest)
(define counter '__count__)
(cond ((pair? count)
(set! counter (car count))
(repeat (x 3) (write 'goodbye x))
(define case
- (macro (test l)
+ (macro (test . l)
; construct the body of the
; case, dealing with the
; lambda version ( => lambda)
(case 12 (1 "one") (2 "two") (3 => (lambda (x) (write "the value is" x))) (12 "twelve") (else "else"))
-;(define number->string (lexpr (arg opt)
+;(define number->string (lambda (arg . opt)
; (let ((base (if (null? opt) 10 (car opt)))
;
;
projects / fw / altos / blobdiff