docs: add example scheme programs

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)

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)

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)

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))

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)

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)