X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=scheme-library.scm;h=484f500efaa87092da9fa0f3e8097fe64a975a50;hb=069f0a8c965a6b7277f5ba8a3f939c69d787838e;hp=9a9358c626c665f2ecd46c2c8fee9891e1000315;hpb=f0a8c4a13b2c6d38fd8fe9e1dedb75997386a6e0;p=scheme.forth.jl.git

diff --git a/scheme-library.scm b/scheme-library.scm
index 9a9358c..484f500 100644
--- a/scheme-library.scm
+++ b/scheme-library.scm
@@ -13,6 +13,14 @@
 (define (cddr l) (cdr (cdr l)))
 (define (cadar l) (car (cdr (car l))))
 
+; Return number of items in list
+(define (length l)
+  (define (iter a count)
+    (if (null? a)
+      count
+      (iter (cdr a) (+ count 1))))
+  (iter l 0))
+
 ; Join two lists together
 (define (join l1 l2)
   (if (null? l1)
@@ -64,6 +72,61 @@
 
 ; 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)
+  (let ((first (car expressions))
+        (rest (cdr expressions)))
+    (if (null? rest)
+      first
+      `(if ,first
+         ,(expand-and-expressions rest)
+         #f))))
+
+(define-macro (and . expressions)
+              (if (null? expressions)
+                #t
+                (expand-and-expressions expressions)))
+
+; or
+
+(define (expand-or-expressions expressions)
+  (if (null? expressions)
+    #f
+    (let ((first (car expressions))
+          (rest (cdr expressions))
+          (val (gensym)))
+      `(let ((,val ,first))
+         (if ,val
+            ,val
+            ,(expand-or-expressions rest))))))
+
+(define-macro (or . expressions)
+              (expand-or-expressions expressions))
+
 
 ;; TESTING