diff --git a/examples/callcc.scm b/examples/callcc.scm new file mode 100644 index 0000000..bcb19a4 --- /dev/null +++ b/examples/callcc.scm @@ -0,0 +1,30 @@ +; call/cc used for early exit from a loop. +(define (list-product items) + (call/cc + (lambda (break) + (let loop ((xs items) (acc 1)) + (cond ((null? xs) acc) + ((= (car xs) 0) (break 0)) + (else (loop (cdr xs) (* acc (car xs))))))))) + +(display "product 1..5 = ") +(display (list-product '(1 2 3 4 5))) +(newline) +(display "product with a zero = ") +(display (list-product '(1 2 0 4 5))) +(newline) + +; call/cc with re-entry: a captured continuation is invoked repeatedly +; to build a loop that sums 1..5 within a single expression. +(display "reentry sum 1..5 = ") +(display + (let ((sum 0) + (i 0) + (k #f)) + (call/cc (lambda (c) (set! k c))) + (set! i (+ i 1)) + (set! sum (+ sum i)) + (if (< i 5) + (k #f) + sum))) +(newline) diff --git a/examples/factorial.scm b/examples/factorial.scm new file mode 100644 index 0000000..7fd6824 --- /dev/null +++ b/examples/factorial.scm @@ -0,0 +1,13 @@ +; Tail-recursive factorial using a named let accumulator. +(define (factorial n) + (let loop ((i n) (acc 1)) + (if (= i 0) + acc + (loop (- i 1) (* acc i))))) + +(display "10! = ") +(display (factorial 10)) +(newline) +(display "20! = ") +(display (factorial 20)) +(newline) diff --git a/examples/fib.scm b/examples/fib.scm new file mode 100644 index 0000000..9a40be3 --- /dev/null +++ b/examples/fib.scm @@ -0,0 +1,15 @@ +; Naive recursive Fibonacci. +(define (fib n) + (if (< n 2) + n + (+ (fib (- n 1)) (fib (- n 2))))) + +(display "fib 10 = ") +(display (fib 10)) +(newline) +(display "fib 20 = ") +(display (fib 20)) +(newline) +(display "fib 25 = ") +(display (fib 25)) +(newline) diff --git a/examples/macros.scm b/examples/macros.scm new file mode 100644 index 0000000..2b76069 --- /dev/null +++ b/examples/macros.scm @@ -0,0 +1,49 @@ +; User-defined macros via define-syntax / syntax-rules. +(define-syntax swap! + (syntax-rules () + ((_ a b) + (let ((tmp a)) + (set! a b) + (set! b tmp))))) + +(define x 1) +(define y 2) +(swap! x y) +(display "swap x y -> ") +(display (list x y)) +(newline) + +; Hygiene: a user variable literally named tmp must not be captured +; by the tmp introduced inside the macro template. +(define tmp 10) +(define other 20) +(swap! tmp other) +(display "swap tmp other -> ") +(display (list tmp other)) +(newline) + +; Ellipsis patterns. +(define-syntax my-list + (syntax-rules () + ((_ e ...) (list e ...)))) +(display "my-list -> ") +(display (my-list 1 2 3 4 5)) +(newline) + +; Recursive macro. +(define-syntax my-or + (syntax-rules () + ((_) #f) + ((_ e) e) + ((_ e rest ...) (let ((t e)) (if t t (my-or rest ...)))))) +(display "my-or -> ") +(display (my-or #f #f 7 8)) +(newline) + +; when / unless come from the prelude. +(when (> 5 3) + (display "when fired") + (newline)) +(unless (> 3 5) + (display "unless fired") + (newline)) diff --git a/examples/maps.scm b/examples/maps.scm new file mode 100644 index 0000000..204bfb3 --- /dev/null +++ b/examples/maps.scm @@ -0,0 +1,24 @@ +; Higher-order list operations. +(display "squares: ") +(display (map (lambda (x) (* x x)) '(1 2 3 4 5))) +(newline) + +(display "odds: ") +(display (filter odd? '(1 2 3 4 5 6 7 8))) +(newline) + +(display "sum via fold: ") +(display (fold-left + 0 '(1 2 3 4 5 6 7 8 9 10))) +(newline) + +(display "zip-add: ") +(display (map + '(1 2 3) '(10 20 30))) +(newline) + +(display "for-each: ") +(for-each display '(a b c d)) +(newline) + +(display "append+reverse: ") +(display (reverse (append '(1 2) '(3 4) '(5 6)))) +(newline) diff --git a/examples/tailloop.scm b/examples/tailloop.scm new file mode 100644 index 0000000..dfdcc0b --- /dev/null +++ b/examples/tailloop.scm @@ -0,0 +1,20 @@ +; Deep tail recursion: counting to a large number must not overflow the stack. +(define (count-up n) + (let loop ((i 0)) + (if (= i n) + i + (loop (+ i 1))))) + +(display "counted to ") +(display (count-up 1000000)) +(newline) + +; Mutual tail recursion should also stay in constant stack space. +(define (even-loop n) + (if (= n 0) #t (odd-loop (- n 1)))) +(define (odd-loop n) + (if (= n 0) #f (even-loop (- n 1)))) + +(display "even? 1000000 -> ") +(display (even-loop 1000000)) +(newline)