X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=scheme-library.scm;h=aad91f426c85c5c250e59adb22b65470163dec7a;hb=749dd8439730c404058c7a672252ab19967268ac;hp=207bb30062fe236189c9b49b402462b934af5255;hpb=480095585b96fbcc5a4fb58fb57188609aadb6e5;p=scheme.forth.jl.git

diff --git a/scheme-library.scm b/scheme-library.scm
index 207bb30..aad91f4 100644
--- a/scheme-library.scm
+++ b/scheme-library.scm
@@ -7,6 +7,12 @@
 (define (null? args)
   (eq? args ()))
 
+(define (caar l) (car (car l)))
+(define (cadr l) (car (cdr l)))
+(define (cdar l) (cdr (car l)))
+(define (cddr l) (cdr (cdr l)))
+(define (cadar l) (car (cdr (car l))))
+
 ; Join two lists together
 (define (join l1 l2)
   (if (null? l1)
@@ -21,13 +27,107 @@
       (car lists)
       (join (car lists) (apply append (cdr lists))))))
 
+; Reverse the contents of a list
+(define (reverse l)
+  (if (null? l)
+    ()
+    (append (reverse (cdr l)) (list (car l)))))
+
+
+;; LIBRARY SPECIAL FORMS
+
+; let
+
+(define (let-vars args)
+  (if (null? args)
+    '()
+    (cons (caar args) (let-vars (cdr args)))))
+
+(define (let-inits args)
+  (if (null? args)
+    '()
+  (cons (cadar args) (let-inits (cdr args)))))
+
+(define-macro (let args . body)
+              `((lambda ,(let-vars args)
+                 ,@body) ,@(let-inits args)))
+
+; while
+
+(define-macro (while condition . body)
+              (let ((loop (gensym)))
+                `(begin
+                   (define (,loop)
+                     (if ,condition
+                       (begin ,@body (,loop))))
+                   (,loop))))
+
+; cond
+
+(define (cond-predicate clause) (car clause))
+(define (cond-actions clause) (cdr clause))
+(define (cond-else-clause? clause)
+  (eq? (cond-predicate clause) 'else))
+
+(define (expand-clauses clauses)
+  (if (null? clauses)
+    (none)
+    (let ((first (car clauses))
+          (rest (cdr clauses)))
+      (if (cond-else-clause? first)
+        (if (null? rest)
+          `(begin ,@(cond-actions first))
+          (error "else clause isn't last in cond expression."))
+        `(if ,(cond-predicate first)
+           (begin ,@(cond-actions first))
+           ,(expand-clauses rest))))))
+
+(define-macro (cond . clauses)
+              (if (null? clauses)
+                (error "cond requires at least one clause.")
+                (expand-clauses clauses)))
+
+; and
+
+(define (expand-and-expressions expressions)
+  (if (null? expressions)
+    #t
+    (let ((first (car expressions))
+          (rest (cdr expressions)))
+      `(if ,first
+         ,(expand-and-expressions rest)
+         #f))))
+
+(define-macro (and . expressions)
+              (expand-and-expressions expressions))
+
+; or
+
+(define (expand-or-expressions expressions)
+  (if (null? expressions)
+    #f
+    (let ((first (car expressions))
+          (rest (cdr expressions)))
+      `(if ,first
+         #t
+         ,(expand-or-expressions rest)))))
+
+(define-macro (or . expressions)
+              (expand-or-expressions expressions))
 
-;; LIBRARY FORMS
-(define-macro (let value . body )
-              (list (list 'lambda (list (car value)) body)) (cdr value))
 
 ;; TESTING
 
+(define-macro (backwards . body)
+              (cons 'begin (reverse body)))
+
+; Test for the while macro.
+(define (count)
+  (define counter 10)
+  (while (> counter 0)
+         (display counter) (newline)
+         (set! counter (- counter 1))))
+
 ; Basic iterative summation.  Run this on large numbers to
 ; test garbage collection and tail-call optimization.
 (define (sum n)