Implemented cond as macro.

[scheme.forth.jl.git] / scheme-library.scm

diff --git a/scheme-library.scm b/scheme-library.scm
index 5ee0b49..ffe02ea 100644 (file)
--- a/scheme-library.scm
+++ b/scheme-library.scm
@@ -33,8 +33,8 @@
     ()
     (append (reverse (cdr l)) (list (car l)))))
 
-;; LIBRARY FORMS
 
+;; LIBRARY SPECIAL FORMS
 
 ; let
 
@@ -55,12 +55,37 @@
 ; while
 
 (define-macro (while condition . body)
-              (define loop (gensym))
-              `(begin
-                 (define (,loop)
-                   (if ,condition
-                     (begin ,@body (,loop))))
-                 (,loop)))
+              (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)))
 
 ;; TESTING