(set (quote define) (macro (name val rest)
(list
- 'progn
+ 'begin
(list
'set
(list 'quote name)
(defun caddr (l) (car (cdr (cdr l))))
-(defun nth (list n)
- (cond ((= n 0) (car list))
- ((nth (cdr list) (1- n)))
- )
+(define list-tail (lambda (x k)
+ (if (zero? k)
+ x
+ (list-tail (cdr x (- k 1)))
+ )
+ )
+ )
+
+(define list-ref (lambda (x k)
+ (car (list-tail x k))
+ )
)
; simple math operators
(odd? 3)
(odd? -1)
-(define exact? number?)
-(defun inexact? (x) #f)
-
; (if <condition> <if-true>)
; (if <condition> <if-true> <if-false)
; expressions to evaluate
(set! make-exprs (lambda (vars exprs)
- (cond ((not (null? vars)) (cons
- (list set
- (list quote
- (car (car vars))
- )
- (cadr (car vars))
- )
- (make-exprs (cdr vars) exprs)
- )
- )
+ (cond ((not (null? vars))
+ (cons
+ (list set
+ (list quote
+ (car (car vars))
+ )
+ (cond ((null? (cdr (car vars))) ())
+ (else (cadr (car vars))))
+ )
+ (make-exprs (cdr vars) exprs)
+ )
+ )
(exprs)
)
)
(let ((x 1)) x)
+(define let* let)
; boolean operators
(define or (lexpr (l)
(define string (lexpr (chars) (list->string chars)))
+(display "apply\n")
+(apply cons '(a b))
+
+(define map (lexpr (proc lists)
+ (let ((args (lambda (lists)
+ (if (null? lists) ()
+ (cons (caar lists) (args (cdr lists))))))
+ (next (lambda (lists)
+ (if (null? lists) ()
+ (cons (cdr (car lists)) (next (cdr lists))))))
+ (domap (lambda (lists)
+ (if (null? (car lists)) ()
+ (cons (apply proc (args lists)) (domap (next lists)))
+ )))
+ )
+ (domap lists))))
+
+(map cadr '((a b) (d e) (g h)))
+
+(define for-each (lexpr (proc lists)
+ (apply map proc lists)
+ #t))
+
+(for-each display '("hello" " " "world" "\n"))
+
+(define -string-ml (lambda (strings)
+ (if (null? strings) ()
+ (cons (string->list (car strings)) (-string-ml (cdr strings))))))
+
+(define string-map (lexpr (proc strings)
+ (list->string (apply map proc (-string-ml strings))))))
+
+(string-map 1+ "HAL")
+
+(define string-for-each (lexpr (proc strings)
+ (apply for-each proc (-string-ml strings))))
+
+(string-for-each write-char "IBM\n")
+
+(define newline (lambda () (write-char #\newline)))
+
+(newline)
+
+(call-with-current-continuation
+ (lambda (exit)
+ (for-each (lambda (x)
+ (write "test" x)
+ (if (negative? x)
+ (exit x)))
+ '(54 0 37 -3 245 19))
+ #t))
+
+(define repeat (macro (count rest)
+ (list
+ let
+ (list
+ (list '__count__ count))
+ (append
+ (list
+ while
+ (list
+ <=
+ 0
+ (list
+ set!
+ '__count__
+ (list
+ -
+ '__count__
+ 1))))
+ rest))))
+
;(define number->string (lexpr (arg opt)
; (let ((base (if (null? opt) 10 (car opt)))
;