; having lots of output generated
;
-(setq def (macro (name val rest)
- (list
- 'progn
- (list
- 'set
- (list 'quote name)
- val)
- (list 'quote name)
- )
- )
- )
+(set (quote define) (macro (name val rest)
+ (list
+ 'progn
+ (list
+ 'set
+ (list 'quote name)
+ val)
+ (list 'quote name)
+ )
+ )
+ )
;
; A slightly more convenient form
; (defun <name> (<params>) s-exprs)
;
-(def defun (macro (name args exprs)
+(define defun (macro (name args exprs)
(list
- def
+ define
name
(cons 'lambda (cons args exprs))
)
(defun 1+ (x) (+ x 1))
(defun 1- (x) (- x 1))
+(define zero? (macro (value rest)
+ (list
+ eq?
+ value
+ 0)
+ )
+ )
+
+(zero? 1)
+(zero? 0)
+(zero? "hello")
+
+(define positive? (macro (value rest)
+ (list
+ >
+ value
+ 0)
+ )
+ )
+
+(positive? 12)
+(positive? -12)
+
+(define negative? (macro (value rest)
+ (list
+ <
+ value
+ 0)
+ )
+ )
+
+(negative? 12)
+(negative? -12)
+
+(defun abs (x) (cond ((>= x 0) x)
+ (else (- x)))
+ )
+
+(abs 12)
+(abs -12)
+
+(define max (lexpr (first rest)
+ (while (not (null? rest))
+ (cond ((< first (car rest))
+ (set! first (car rest)))
+ )
+ (set! rest (cdr rest))
+ )
+ first)
+ )
+
+(max 1 2 3)
+(max 3 2 1)
+
+(define min (lexpr (first rest)
+ (while (not (null? rest))
+ (cond ((> first (car rest))
+ (set! first (car rest)))
+ )
+ (set! rest (cdr rest))
+ )
+ first)
+ )
+
+(min 1 2 3)
+(min 3 2 1)
+
+(defun even? (x) (zero? (% x 2)))
+
+(even? 2)
+(even? -2)
+(even? 3)
+(even? -1)
+
+(defun odd? (x) (not (even? x)))
+
+(odd? 2)
+(odd? -2)
+(odd? 3)
+(odd? -1)
+
+(define exact? number?)
+(defun inexact? (x) #f)
+
+ ; (if <condition> <if-true>)
+ ; (if <condition> <if-true> <if-false)
+
+(define if (macro (test args)
+ (cond ((null? (cdr args))
+ (list
+ cond
+ (list test (car args)))
+ )
+ (else
+ (list
+ cond
+ (list test (car args))
+ (list 'else (cadr args))
+ )
+ )
+ )
+ )
+ )
+
+(if (> 3 2) 'yes)
+(if (> 3 2) 'yes 'no)
+(if (> 2 3) 'no 'yes)
+(if (> 2 3) 'no)
+
; define a set of local
; variables and then evaluate
; a list of sexprs
;
; e.g.
;
- ; (let ((x 1) (y)) (setq y (+ x 1)) y)
+ ; (let ((x 1) (y)) (set! y (+ x 1)) y)
-(def let (macro (vars exprs)
+(define let (macro (vars exprs)
((lambda (make-names make-exprs make-nils)
;
; make the list of names in the let
;
- (setq make-names (lambda (vars)
- (cond (vars
+ (set! make-names (lambda (vars)
+ (cond ((not (null? vars))
(cons (car (car vars))
(make-names (cdr vars))))
)
; pre-pended to the
; expressions to evaluate
- (setq make-exprs (lambda (vars exprs)
- (cond (vars (cons
+ (set! make-exprs (lambda (vars exprs)
+ (cond ((not (null? vars)) (cons
(list set
(list quote
(car (car vars))
; the parameters to the lambda is a list
; of nils of the right length
- (setq make-nils (lambda (vars)
- (cond (vars (cons nil (make-nils (cdr vars))))
+ (set! make-nils (lambda (vars)
+ (cond ((not (null? vars)) (cons () (make-nils (cdr vars))))
)
)
)
; prepend the set operations
; to the expressions
- (setq exprs (make-exprs vars exprs))
+ (set! exprs (make-exprs vars exprs))
; build the lambda.
)
)
+(let ((x 1)) x)
+
; boolean operators
-(def or (lexpr (l)
- (let ((ret nil))
- (while l
- (cond ((setq ret (car l))
- (setq l nil))
- ((setq l (cdr l)))))
+(define or (lexpr (l)
+ (let ((ret #f))
+ (while (not (null? l))
+ (cond ((car l) (set! ret #t) (set! l ()))
+ ((set! l (cdr l)))))
ret
)
)
; execute to resolve macros
-(or nil t)
+(or #f #t)
-(def and (lexpr (l)
- (let ((ret t))
- (while l
- (cond ((setq ret (car l))
- (setq l (cdr l)))
- ((setq ret (setq l nil)))
+(define and (lexpr (l)
+ (let ((ret #t))
+ (while (not (null? l))
+ (cond ((car l)
+ (set! l (cdr l)))
+ (#t
+ (set! ret #f)
+ (set! l ()))
)
)
ret
; execute to resolve macros
-(and t nil)
+(and #t #f)
+
+
+(define append (lexpr (args)
+ (let ((append-list (lambda (a b)
+ (cond ((null? a) b)
+ (else (cons (car a) (append-list (cdr a) b)))
+ )
+ )
+ )
+ (append-lists (lambda (lists)
+ (cond ((null? lists) lists)
+ ((null? (cdr lists)) (car lists))
+ (else (append-list (car lists) (append-lists (cdr lists))))
+ )
+ )
+ )
+ )
+ (append-lists args)
+ )
+ )
+ )
+
+(append '(a b c) '(d e f) '(g h i))
+
+(defun reverse (list)
+ (let ((result ()))
+ (while (not (null? list))
+ (set! result (cons (car list) result))
+ (set! list (cdr list))
+ )
+ result)
+ )
+
+(reverse '(1 2 3))
+
+(define list-tail
+ (lambda (x k)
+ (if (zero? k)
+ x
+ (list-tail (cdr x) (- k 1)))))
+
+(list-tail '(1 2 3) 2)
+ ; recursive equality
+
+(defun equal? (a b)
+ (cond ((eq? a b) #t)
+ ((and (pair? a) (pair? b))
+ (and (equal? (car a) (car b))
+ (equal? (cdr a) (cdr b)))
+ )
+ (else #f)
+ )
+ )
+
+(equal? '(a b c) '(a b c))
+(equal? '(a b c) '(a b b))
+
+;(define number->string (lexpr (arg opt)
+; (let ((base (if (null? opt) 10 (car opt)))
+ ;
+;
+
projects / fw / altos / blobdiff