; Code as data (define (fact n) (if (= n 0) 1 (* n (fact (- n 1))))) (define (fact-exp n) (if (= n 0) 1 (list '* n (fact-exp (- n 1))))) (fact 5) ; 120 (fact-exp 5) ; (* 5 (* 4 (* 3 (* 2 (* 1 1))))) (eval (fact-exp 5)) ; 120 (define (fib n) (if (< n 2) n (+ (fib (- n 2)) (fib (- n 1))))) (define (fib-exp n) (if (< n 2) n (list '+ (fib-exp (- n 2)) (fib-exp (- n 1))))) ; Macros (print 2) ; prints 2 (begin (print 2) (print 2)) ; prints 2 twice (define (twice expr) (begin expr expr)) (twice (print 2)) ; only prints 2 once (define (twice expr) (list 'begin expr expr)) (twice '(print 2)) ; (begin (print 2) (print 2)) (eval (twice '(print 2))) ; actually prints 2 twice (define-macro (twice expr) (list 'begin expr expr)) (twice (print 2)) ; actually prints 2 twice (define-macro (add-to! sym expr) (list 'set! sym (list '+ sym expr))) (define x 4) (add-to! x (* 2 3)) x ; is now 10 (define-macro (for sym vals expr) (list 'map (list 'lambda (list sym) expr) vals)) (map (lambda (x) (* x x)) '(1 2 3 4)) ; (1 4 9 16) (for x '(1 2 3 4) (* x x)) ; same as the above ; Quasiquotation (define x 2) '(1 2 3) ; (1 2 3) (list 1 x 3) ; (1 2 3) '(1 x 3) ; (1 x 3) `(1 ,x 3) ; (1 2 3) '(1 ,x 3) ; (1 (unquote x) 3) `(1 ,(+ x 5) 3); (1 6 3) (define-macro (for sym vals expr) `(map (lambda (,sym) ,@exprs) ,vals)) ; Variable-Arity Procedures (define (count . args) (if (null? args) 0 (+ 1 (apply count (cdr args))))) (count) ; 0 (count 1) ; 1 (count 1 2 3) ; 3 (count 1 '(2 3) 4) ; 3 ; Doctest Example ; Treat these four procedures as black boxes. You don't need to ; understand how they work. (define (display-test code actual expected) (define passed (equal? actual expected)) (display code) (display " -> ") (display actual) (if passed (display " PASS") (begin (display " FAIL - expected ") (display expected))) (newline) passed) (define (display-results results) (display (apply + (map (lambda (x) (if x 1 0)) results))) (display " passed, ") (display (apply + (map (lambda (x) (if x 0 1)) results))) (display " failed") (newline) (newline)) (define (display-header name) (display "TESTS FOR ") (display name) (newline) (display "--------------------------------------------") (newline)) (define (display-overall-header) (display "OVERALL RESULTS") (newline) (display "--------------------------------------------") (newline)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Actual Doctest Example ; test macro (define-macro (test . clauses) `(map (lambda (clause) (display-test (car clause) (eval (car clause)) (car (cdr clause)))) ',clauses)) (test ((+ 1 1) 2) ((+ 2 3) 5) ((* 2 2) 3)) ; (+ 1 1) -> 2 - PASS ; (+ 2 3) -> 5 - PASS ; (* 2 2) -> 4 - expected 3 ; (#t #t #f) ; List of tests that have been defined so far (define _tests nil) ; define-t works like define, except that the second operand ; should be a test (define-macro (define-t header tests . body) (define name (car header)) (define new-test (cons name tests)) (set! _tests (cons new-test _tests)) `(define ,header . ,body)) ; Code that runs all of the doctests that have been added so far (define (run-tests) (define results (map (lambda (x) (define name (car x)) (define doctests (cdr x)) (display-header name) (define results (eval doctests)) (display-results results) results) _tests)) (display-overall-header) (display-results (apply append results))) ; Examples: (define-t (square x) (test ((square 0) 0) ((square 5) 25) ((square -3) 9)) (* x x)) (define-t (fact n) (test ((fact 0) 1) ((fact 3) 6) ((fact 5) 120)) (define (fact-helper n t) (if (= n 0) t (fact-helper (- n 1) (* n t)))) (fact-helper n 1)) (run-tests) ; TESTS FOR fact ; -------------------------------------------- ; (fact 0) -> 1 PASS ; (fact 3) -> 6 PASS ; (fact 5) -> 120 PASS ; 3 passed, 0 failed ; TESTS FOR square ; -------------------------------------------- ; (square 0) -> 0 PASS ; (square 5) -> 25 PASS ; (square -3) -> 9 PASS ; 3 passed, 0 failed ; OVERALL RESULTS ; -------------------------------------------- ; 6 passed, 0 failed