X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=scheme-library.scm;h=aad91f426c85c5c250e59adb22b65470163dec7a;hb=749dd8439730c404058c7a672252ab19967268ac;hp=62a7aa3513148f2bb39eaed311f2d7fb2d0297c4;hpb=82b93d081309895fe1a8e446daad5b8a75896fa3;p=scheme.forth.jl.git diff --git a/scheme-library.scm b/scheme-library.scm index 62a7aa3..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) @@ -27,24 +33,95 @@ () (append (reverse (cdr l)) (list (car l))))) -;; LIBRARY FORMS + +;; 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) - `(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))) + +; 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)) + ;; TESTING (define-macro (backwards . body) (cons 'begin (reverse body))) -(define method '(while (> counter 0) - (display counter) (newline) - (set! counter (- counter 1)))) - +; Test for the while macro. (define (count) (define counter 10) (while (> counter 0)