(export and boolean=? boolean? cond if not or unless when) (import (only (csc builtins) builtin-if call-builtin)) (begin (define-syntax if (syntax-rules () ((if test consequent) (builtin-if test consequent #f)) ((if test consequent alternate) (builtin-if test consequent alternate)))) (define-syntax cond (syntax-rules (else =>) ((cond (else result1 result2 ...)) (begin result1 result2 ...)) ((cond (test => result)) (let ((temp test)) (if temp (result temp)))) ((cond (test => result) clause1 clause2 ...) (let ((temp test)) (if temp (result temp) (cond clause1 clause2 ...)))) ((cond (test)) test) ((cond (test) clause1 clause2 ...) (let ((temp test)) (if temp temp (cond clause1 clause2 ...)))) ((cond (test result1 result2 ...)) (if test (begin result1 result2 ...))) ((cond (test result1 result2 ...) clause1 clause2 ...) (if test (begin result1 result2 ...) (cond clause1 clause2 ...))))) (define-syntax and (syntax-rules () ((and) #t) ((and test) test) ((and test1 test2 ...) (if test1 (and test2 ...) #f)))) (define-syntax or (syntax-rules () ((or) #f) ((or test) test) ((or test1 test2 ...) (let ((x test1)) (if x x (or test2 ...)))))) (define-syntax when (syntax-rules () ((when test result1 result2 ...) (if test (begin result1 result2 ...))))) (define-syntax unless (syntax-rules () ((unless test result1 result2 ...) (if (not test) (begin result1 result2 ...))))) ; This is a secret copy of case-lambda. ; The real one is defined in the (scheme case-lambda) library. (define-syntax case-lambda (syntax-rules () ((case-lambda (params body0 ...) ...) (lambda args (let ((len (length args))) (let-syntax ((cl (syntax-rules ::: () ((cl) (error "no matching clause")) ((cl ((p :::) . body) . rest) (if (= len (length ’(p :::))) (apply (lambda (p :::) . body) args) (cl . rest))) ((cl ((p ::: . tail) . body) . rest) (if (>= len (length ’(p :::))) (apply (lambda (p ::: . tail) . body) args) (cl . rest)))))) (cl (params body0 ...) ...))))))) (define (not obj) (if obj #f #t)) (define (boolean? obj) (call-builtin eq? 2 (call-builtin typeof obj))) (define (boolean=? b1 b2 . bs) (and (boolean? b1) (let loop ((bs (cons b2 bs))) (or (null? bs) (and (boolean? (car bs)) (call-builtin eq? b1 (car bs)) (loop (cdr bs))))))))