From: Tim Vaughan Date: Sun, 6 Nov 2016 03:53:35 +0000 (+1300) Subject: Implemented cond as macro. X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=scheme.forth.jl.git;a=commitdiff_plain;h=1d07170e70db6f42a900ea918ac22cce65345f2f Implemented cond as macro. --- diff --git a/scheme-library.scm b/scheme-library.scm index 9a9358c..ffe02ea 100644 --- a/scheme-library.scm +++ b/scheme-library.scm @@ -64,6 +64,28 @@ ; 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 diff --git a/scheme-primitives.4th b/scheme-primitives.4th index 38fe2e0..edf5894 100644 --- a/scheme-primitives.4th +++ b/scheme-primitives.4th @@ -483,6 +483,13 @@ defer display drop symbol-type ; make-primitive gensym +( Generate the NONE object indicating an unspecified return value. ) +:noname ( args -- result ) + 0 ensure-arg-count + + none +; make-primitive none + \ }}} \ vim:fdm=marker