chez scheme

Chez Scheme Syntax Overview

Understanding Scheme Basics

Scheme is a dialect of Lisp with minimal, elegant syntax.

Core principle: Everything is an expression that returns a value.

Syntax pattern: (function arg1 arg2 arg3 ...)

Parentheses group expressions
First element is the function/operator
Remaining elements are arguments
This is called "prefix notation" or "Polish notation"

Examples of basic syntax:

; Addition
(+ 2 3)          ; Returns: 5

; Multiplication
(* 4 5)          ; Returns: 20

; Function call
(string-length "hello")  ; Returns: 5

; Nested expressions
(+ (* 2 3) 4)    ; Returns: 10
                 ; First evaluates (* 2 3) = 6
                 ; Then evaluates (+ 6 4) = 10

Comments:

; Single-line comment starts with semicolon

#|
  Multi-line
  comment between
  #| and |#
|#

Case sensitivity: Scheme is case-insensitive by default, but Chez Scheme preserves case.

(define MyVar 10)
MyVar    ; Works
MYVAR    ; Doesn't Work

Basic Data Types

Scheme has several fundamental data types:

Type	Examples	Predicate
Number	`42`, `3.14`, `1/3`, `2+3i`	`number?`
Boolean	`#t`, `#f`	`boolean?`
String	`"hello"`, `"world"`	`string?`
Character	`#\a`, `#\space`	`char?`
Symbol	`'foo`, `'bar`	`symbol?`
List	`'(1 2 3)`, `'(a b c)`	`list?`
Pair	`'(1 . 2)`	`pair?`
Vector	`#(1 2 3)`	`vector?`
Procedure	`(lambda (x) (* x x))`	`procedure?`

Numbers:

; Integers
42
-17
0

; Floating point
3.14
-2.5

; Fractions (exact rationals)
1/3
22/7

; Complex numbers
2+3i
-1-4i

; Different bases
#b1010      ; Binary (10 in decimal)
#o755       ; Octal (493 in decimal)
#x1A        ; Hexadecimal (26 in decimal)

Booleans:

#t          ; True
#f          ; False

; Everything except #f is considered true
(if 0 'yes 'no)        ; Returns: yes
(if "" 'yes 'no)       ; Returns: yes
(if '() 'yes 'no)      ; Returns: yes
(if #f 'yes 'no)       ; Returns: no

Strings:

"Hello, World!"
"Multiple\nlines"
"Escape \"quotes\""
""              ; Empty string

Characters:

#\a             ; Letter 'a'
#\Z             ; Letter 'Z'
#\0             ; Digit '0'
#\space         ; Space character
#\newline       ; Newline character
#\tab           ; Tab character

Symbols:

'foo            ; Symbol foo
'hello-world    ; Symbol hello-world
'+              ; Symbol +
'lambda         ; Symbol lambda

; Symbols are like unique identifiers/names

Variables and Definitions

define: Create global variables and functions.

Syntax for variables:

(define variable-name value)

Examples:

; Define a number
(define x 10)
x                   ; Returns: 10

; Define a string
(define message "Hello")
message             ; Returns: "Hello"

; Define using an expression
(define y (* 5 4))
y                   ; Returns: 20

; Redefine (changes value)
(define x 100)
x                   ; Returns: 100

Syntax for functions:

(define (function-name parameter1 parameter2 ...)
  body-expression)

Function examples:

; Simple function
(define (square x)
  (* x x))

(square 5)          ; Returns: 25

; Multiple parameters
(define (add a b)
  (+ a b))

(add 3 7)           ; Returns: 10

; Multiple expressions (returns last one)
(define (greet name)
  (display "Processing...")
  (newline)
  (string-append "Hello, " name "!"))

(greet "Alice")     ; Prints "Processing..." then returns "Hello, Alice!"

Arithmetic Operations

All arithmetic uses prefix notation.

Operation	Syntax	Example	Result
Addition	`(+ n1 n2 ...)`	`(+ 1 2 3)`	6
Subtraction	`(- n1 n2 ...)`	`(- 10 3)`	7
Multiplication	`(* n1 n2 ...)`	`(* 2 3 4)`	24
Division	`(/ n1 n2 ...)`	`(/ 10 2)`	5
Quotient	`(quotient n1 n2)`	`(quotient 10 3)`	3
Remainder	`(remainder n1 n2)`	`(remainder 10 3)`	1
Modulo	`(modulo n1 n2)`	`(modulo 10 3)`	1
Exponentiation	`(expt base exp)`	`(expt 2 8)`	256
Square root	`(sqrt n)`	`(sqrt 16)`	4
Absolute value	`(abs n)`	`(abs -5)`	5

Multiple arguments:

(+ 1 2 3 4 5)       ; Returns: 15
(* 2 3 4)           ; Returns: 24

; With single argument
(+ 5)               ; Returns: 5
(- 10)              ; Returns: -10 (negation)

; No arguments
(+)                 ; Returns: 0
(*)                 ; Returns: 1

Nested operations:

; Traditional: (2 + 3) * 4
(* (+ 2 3) 4)       ; Returns: 20

; Traditional: 2 + 3 * 4
(+ 2 (* 3 4))       ; Returns: 14

; Traditional: (10 - 2) / (3 + 1)
(/ (- 10 2) (+ 3 1))  ; Returns: 2

Comparison and Logical Operations

Comparison operators:

Operator	Description	Example	Result
`=`	Numeric equality	`(= 5 5)`	`#t`
`<`	Less than	`(< 3 5)`	`#t`
`>`	Greater than	`(> 5 3)`	`#t`
`<=`	Less than or equal	`(<= 5 5)`	`#t`
`>=`	Greater than or equal	`(>= 5 3)`	`#t`
`eq?`	Same object	`(eq? 'a 'a)`	`#t`
`eqv?`	Equivalent value	`(eqv? 5 5)`	`#t`
`equal?`	Structurally equal	`(equal? '(1 2) '(1 2))`	`#t`

Comparison examples:

; Numeric comparisons
(= 5 5)             ; #t
(= 5 6)             ; #f
(< 3 5)             ; #t
(> 5 3)             ; #t

; Multiple arguments (chain)
(< 1 2 3 4)         ; #t (all comparisons true)
(< 1 3 2 4)         ; #f (3 is not < 2)

; String comparison
(string=? "hello" "hello")    ; #t
(string<? "abc" "xyz")        ; #t

Logical operators:

Operator	Description	Example
`and`	Logical AND	`(and #t #t)` → #t
`or`	Logical OR	`(or #f #t)` → #t
`not`	Logical NOT	`(not #t)` → #f

Logical examples:

; AND - returns #f if any argument is #f
(and #t #t #t)      ; #t
(and #t #f #t)      ; #f

; OR - returns #t if any argument is true
(or #f #f #t)       ; #t
(or #f #f #f)       ; #f

; NOT
(not #t)            ; #f
(not #f)            ; #t

; Short-circuit evaluation
(and #f (display "This won't print"))  ; #f (doesn't evaluate second)
(or #t (display "This won't print"))   ; #t (doesn't evaluate second)

Conditional Expressions

if expression syntax:

(if condition
    then-expression
    else-expression)

if examples:

; Basic if
(if (> 5 3)
    "yes"
    "no")           ; Returns: "yes"

; If with computation
(if (= (* 2 3) 6)
    (+ 10 5)
    (- 10 5))       ; Returns: 15

; Nested if
(define (sign x)
  (if (< x 0)
      "negative"
      (if (= x 0)
          "zero"
          "positive")))

(sign -5)           ; Returns: "negative"
(sign 0)            ; Returns: "zero"
(sign 5)            ; Returns: "positive"

cond expression (multi-way conditional):

(cond
  (condition1 result1)
  (condition2 result2)
  (condition3 result3)
  ...
  (else default-result))

cond examples:

; Multiple conditions
(define (grade score)
  (cond
    ((>= score 90) "A")
    ((>= score 80) "B")
    ((>= score 70) "C")
    ((>= score 60) "D")
    (else "F")))

(grade 85)          ; Returns: "B"
(grade 55)          ; Returns: "F"

; Without else
(cond
  ((< 5 3) "impossible")
  ((> 5 3) "correct"))  ; Returns: "correct"

case expression (switch-like):

(case key-expression
  ((value1 value2 ...) result1)
  ((value3 value4 ...) result2)
  ...
  (else default-result))

case examples:

(define (day-name n)
  (case n
    ((1) "Monday")
    ((2) "Tuesday")
    ((3) "Wednesday")
    ((4) "Thursday")
    ((5) "Friday")
    ((6 7) "Weekend")
    (else "Invalid day")))

(day-name 1)        ; Returns: "Monday"
(day-name 6)        ; Returns: "Weekend"

Lists and Pairs

Lists are fundamental to Scheme.

Creating lists:

; Quoted list (doesn't evaluate)
'(1 2 3 4)

; Using list function
(list 1 2 3 4)

; Empty list
'()
(list)

; Mixed types
'(1 "hello" x #t)
(list 1 "hello" 'x #t)

Difference between quote and list:

; With quote - literal
'(+ 1 2)            ; Returns: (+ 1 2) - just a list of symbols
'((+ 1 2) 3)        ; Returns: ((+ 1 2) 3)

; With list - evaluates arguments
(list + 1 2)        ; Returns: (#<procedure:+> 1 2)
(list (+ 1 2) 3)    ; Returns: (3 3)

Accessing list elements:

Function	Description	Example	Result
`car`	First element	`(car '(1 2 3))`	1
`cdr`	Rest of list	`(cdr '(1 2 3))`	(2 3)
`cadr`	Second element	`(cadr '(1 2 3))`	2
`caddr`	Third element	`(caddr '(1 2 3))`	3
`list-ref`	Element at index (0-based)	`(list-ref '(a b c) 1)`	b

List manipulation:

; cons - add element to front
(cons 1 '(2 3))             ; Returns: (1 2 3)
(cons 'a '())               ; Returns: (a)

; append - combine lists
(append '(1 2) '(3 4))      ; Returns: (1 2 3 4)
(append '(a) '(b) '(c))     ; Returns: (a b c)

; length
(length '(1 2 3 4))         ; Returns: 4
(length '())                ; Returns: 0

; reverse
(reverse '(1 2 3))          ; Returns: (3 2 1)

; member - find element
(member 3 '(1 2 3 4))       ; Returns: (3 4)
(member 'x '(a b c))        ; Returns: #f

Pairs (dotted pairs):

; Create pair with cons
(cons 1 2)              ; Returns: (1 . 2)

; Lists are chains of pairs ending in '()
(cons 1 (cons 2 (cons 3 '())))  ; Returns: (1 2 3)
; Same as '(1 2 3)

; Access pair elements
(car '(1 . 2))          ; Returns: 1
(cdr '(1 . 2))          ; Returns: 2

Lambda Expressions

lambda creates anonymous functions.

Syntax:

(lambda (parameter1 parameter2 ...)
  body-expression)

Basic examples:

; Anonymous function
(lambda (x) (* x x))

; Call immediately
((lambda (x) (* x x)) 5)    ; Returns: 25

; Assign to variable
(define square (lambda (x) (* x x)))
(square 5)                  ; Returns: 25

; Multiple parameters
(define add (lambda (a b) (+ a b)))
(add 3 7)                   ; Returns: 10

Note: These are equivalent:

; Using lambda explicitly
(define square (lambda (x) (* x x)))

; Shorthand (what we've been using)
(define (square x) (* x x))

; Both create the same function

Variable number of arguments:

; Rest parameters
(define (sum . numbers)
  (if (null? numbers)
      0
      (+ (car numbers) (apply sum (cdr numbers)))))

(sum 1 2 3 4 5)     ; Returns: 15

; Mix fixed and rest parameters
(define (greet name . titles)
  (string-append name " " (apply string-append titles)))

(greet "John" "Dr. " "PhD")  ; Returns: "John Dr. PhD"

Higher-order functions:

; Function that returns a function
(define (make-adder n)
  (lambda (x) (+ x n)))

(define add5 (make-adder 5))
(add5 10)           ; Returns: 15
(add5 3)            ; Returns: 8

; Function that takes a function
(define (apply-twice f x)
  (f (f x)))

(apply-twice (lambda (x) (* x 2)) 3)  ; Returns: 12
; First: (* 3 2) = 6
; Second: (* 6 2) = 12

Local Bindings: let, let*, and letrec

let: Create local variables (parallel binding).

Syntax:

(let ((var1 value1)
      (var2 value2)
      ...)
  body-expression)

let examples:

; Simple let
(let ((x 5)
      (y 10))
  (+ x y))          ; Returns: 15

; Variables are parallel (can't reference each other)
(let ((x 5)
      (y x))        ; Error! x not yet defined
  (+ x y))

; Correct way
(let ((x 5))
  (let ((y x))
    (+ x y)))       ; Returns: 10

let*: Create local variables (sequential binding).

(let* ((var1 value1)
       (var2 value2)  ; Can use var1 here
       ...)
  body-expression)

let* examples:

; Sequential binding
(let* ((x 5)
       (y (* x 2)))     ; Can use x
  (+ x y))              ; Returns: 15

; Each binding can use previous ones
(let* ((a 1)
       (b (+ a 1))      ; Uses a
       (c (+ a b)))     ; Uses a and b
  c)                    ; Returns: 3

letrec: Create local recursive functions.

(letrec ((var1 value1)
         (var2 value2)
         ...)
  body-expression)

letrec examples:

; Recursive function
(letrec ((factorial
          (lambda (n)
            (if (<= n 1)
                1
                (* n (factorial (- n 1)))))))
  (factorial 5))    ; Returns: 120

; Mutually recursive functions
(letrec ((even?
          (lambda (n)
            (if (= n 0)
                #t
                (odd? (- n 1)))))
         (odd?
          (lambda (n)
            (if (= n 0)
                #f
                (even? (- n 1))))))
  (even? 10))       ; Returns: #t

Recursion

Recursion is the primary iteration mechanism in Scheme.

Basic recursive pattern:

(define (function-name param)
  (if base-case
      base-result
      (recursive-call)))

Factorial example:

(define (factorial n)
  (if (<= n 1)
      1                         ; Base case
      (* n (factorial (- n 1)))))  ; Recursive case

(factorial 5)       ; Returns: 120
; 5 * 4 * 3 * 2 * 1 = 120

List recursion:

; Sum all numbers in list
(define (sum-list lst)
  (if (null? lst)
      0                         ; Base: empty list
      (+ (car lst)              ; Add first element
         (sum-list (cdr lst))))) ; Recursively sum rest

(sum-list '(1 2 3 4))   ; Returns: 10

; Length of list
(define (my-length lst)
  (if (null? lst)
      0
      (+ 1 (my-length (cdr lst)))))

(my-length '(a b c d))  ; Returns: 4

Tail recursion (more efficient):

; Tail-recursive factorial
(define (factorial n)
  (define (fact-iter n acc)
    (if (<= n 1)
        acc
        (fact-iter (- n 1) (* n acc))))
  (fact-iter n 1))

; Tail-recursive sum
(define (sum-list lst)
  (define (sum-iter lst acc)
    (if (null? lst)
        acc
        (sum-iter (cdr lst) (+ acc (car lst)))))
  (sum-iter lst 0))

(sum-list '(1 2 3 4))   ; Returns: 10

Common List Operations

map: Apply function to each element.

; Syntax: (map function list)

(map (lambda (x) (* x 2)) '(1 2 3))
; Returns: (2 4 6)

(map car '((a b) (c d) (e f)))
; Returns: (a c e)

; Multiple lists
(map + '(1 2 3) '(10 20 30))
; Returns: (11 22 33)

filter: Keep elements that satisfy predicate.

; Keep only even numbers
(filter even? '(1 2 3 4 5 6))
; Returns: (2 4 6)

; Keep numbers > 5
(filter (lambda (x) (> x 5)) '(1 8 3 9 2 7))
; Returns: (8 9 7)

fold (reduce): Combine elements.

; foldl - fold from left
(foldl + 0 '(1 2 3 4))
; Returns: 10
; ((((0 + 1) + 2) + 3) + 4)

; foldr - fold from right
(foldr cons '() '(1 2 3))
; Returns: (1 2 3)

; foldl vs foldr
(foldl - 0 '(1 2 3))    ; (((0 - 1) - 2) - 3) = -6
(foldr - 0 '(1 2 3))    ; (1 - (2 - (3 - 0))) = 2

apply: Apply function to list as arguments.

(apply + '(1 2 3 4))
; Same as: (+ 1 2 3 4)
; Returns: 10

(apply max '(3 7 2 9 1))
; Same as: (max 3 7 2 9 1)
; Returns: 9

String Operations

Common string functions:

Function	Description	Example	Result
`string-length`	Get length	`(string-length "hello")`	5
`string-append`	Concatenate	`(string-append "hi" " " "there")`	"hi there"
`string-ref`	Get character	`(string-ref "hello" 1)`	#\e
`substring`	Extract portion	`(substring "hello" 1 4)`	"ell"
`string-upcase`	Uppercase	`(string-upcase "hello")`	"HELLO"
`string-downcase`	Lowercase	`(string-downcase "HELLO")`	"hello"
`string->list`	Convert to list	`(string->list "abc")`	(#\a #\b #\c)
`list->string`	Convert from list	`(list->string '(#\a #\b))`	"ab"

Examples:

; Concatenation
(string-append "Hello" ", " "World" "!")
; Returns: "Hello, World!"

; Substring
(substring "Hello, World!" 0 5)
; Returns: "Hello"

; Character access
(string-ref "Scheme" 0)     ; Returns: #\S

; String manipulation
(string-upcase "hello")     ; Returns: "HELLO"
(string-downcase "WORLD")   ; Returns: "world"

Input and Output

Display output:

; display - print without quotes
(display "Hello, World!")   ; Prints: Hello, World!

; newline - print newline
(newline)

; write - print with quotes
(write "Hello")             ; Prints: "Hello"

; print multiple things
(display "x = ")
(display 42)
(newline)
; Prints: x = 42

Read input:

; read - read S-expression
(define input (read))
; User types: (1 2 3)
; input is: '(1 2 3)

; read-line - read line as string
(define line (read-line))
; User types: Hello World
; line is: "Hello World"

File I/O:

; Open file for reading
(define in (open-input-file "input.txt"))

; Read from file
(read in)
(read-line in)

; Close file
(close-input-port in)

; Open file for writing
(define out (open-output-file "output.txt"))

; Write to file
(write '(1 2 3) out)
(display "Hello" out)

; Close file
(close-output-port out)

Common Predicates

Predicates are functions that return boolean values.

Predicate	Tests for	Example
`null?`	Empty list	`(null? '())` → #t
`pair?`	Pair/cons cell	`(pair? '(1 2))` → #t
`list?`	Proper list	`(list? '(1 2))` → #t
`number?`	Number	`(number? 42)` → #t
`integer?`	Integer	`(integer? 5)` → #t
`real?`	Real number	`(real? 3.14)` → #t
`string?`	String	`(string? "hi")` → #t
`char?`	Character	`(char? #\a)` → #t
`symbol?`	Symbol	`(symbol? 'x)` → #t
`boolean?`	Boolean	`(boolean? #t)` → #t
`procedure?`	Function	`(procedure? +)` → #t
`zero?`	Zero	`(zero? 0)` → #t
`positive?`	Positive number	`(positive? 5)` → #t
`negative?`	Negative number	`(negative? -5)` → #t
`even?`	Even number	`(even? 4)` → #t
`odd?`	Odd number	`(odd? 3)` → #t

Quick Reference Summary

Basic syntax patterns:

; Define variable
(define name value)

; Define function
(define (name params...) body)

; Lambda
(lambda (params...) body)

; Conditional
(if test then else)
(cond (test1 result1) (test2 result2) ... (else default))

; Local binding
(let ((var val) ...) body)
(let* ((var val) ...) body)
(letrec ((var val) ...) body)

; List operations
(car list)          ; First element
(cdr list)          ; Rest
(cons item list)    ; Add to front
(append list1 list2) ; Combine

; Higher-order
(map function list)
(filter predicate list)
(apply function list)

Multiple Expressions in Conditionals

The Problem with if

if only accepts single expressions for then and else branches.

This doesn't work:

; ✗ Error - trying multiple expressions
(if (> x 0)
    (display "Positive")
    (newline)           ; Error! if expects only one expression
    (display "Negative"))

You need a way to group multiple expressions into one.

Solution: Using begin

begin: Groups multiple expressions into a single expression.

Syntax:

(begin
  expression1
  expression2
  expression3
  ...
  final-expression)

What begin does:

Evaluates all expressions in sequence (top to bottom)
Returns the value of the last expression only
Side effects (like display, file I/O) from all expressions occur

Basic begin example:

(begin
  (display "First")
  (newline)
  (display "Second")
  (newline)
  42)               ; This value is returned

; Prints:
; First
; Second
; Returns: 42

Using begin with if

Pattern for multiple expressions in then branch:

(if condition
    (begin
      expression1
      expression2
      ...)
    else-expression)

Example:

(define x 10)

(if (> x 0)
    (begin
      (display "x is positive")
      (newline)
      (display "x = ")
      (display x)
      #t)           ; Return value
    #f)

; Prints:
; x is positive
; x = 10
; Returns: #t

Multiple expressions in else branch:

(if (> x 0)
    (display "Positive")
    (begin
      (display "Not positive")
      (newline)
      (display "Please enter a positive number")
      #f))

Multiple expressions in both branches:

(if (> x 0)
    (begin
      (display "Positive: ")
      (display x)
      'positive)
    (begin
      (display "Not positive: ")
      (display x)
      'not-positive))

Real-world example - login check:

(define (login username password)
  (if (and (string=? username "admin")
           (string=? password "secret"))
      (begin
        (display "Login successful!")
        (newline)
        (display "Welcome, ")
        (display username)
        (newline)
        #t)         ; Return success
      (begin
        (display "Login failed!")
        (newline)
        (display "Invalid credentials")
        (newline)
        #f)))       ; Return failure

(login "admin" "secret")
; Prints:
; Login successful!
; Welcome, admin
; Returns: #t

Alternative: when and unless

Chez Scheme provides when and unless for common cases.

when: Execute multiple expressions if condition is true.

; Syntax
(when condition
  expression1
  expression2
  ...)

; Equivalent to:
(if condition
    (begin expression1 expression2 ...)
    (void))     ; or returns unspecified value

when example:

(define x 10)

(when (> x 0)
  (display "x is positive")
  (newline)
  (display "x = ")
  (display x))

; No else branch needed
; If condition is false, does nothing

unless: Execute multiple expressions if condition is false.

; Syntax
(unless condition
  expression1
  expression2
  ...)

; Equivalent to:
(if (not condition)
    (begin expression1 expression2 ...)
    (void))

unless example:

(define balance 50)

(unless (>= balance 100)
  (display "Warning: Low balance")
  (newline)
  (display "Current balance: ")
  (display balance))

; Executes when balance < 100

Comparison:

Form	When to Use	Has else?
`if` + `begin`	Need both then and else branches	Yes
`when`	Only execute if true, no else needed	No
`unless`	Only execute if false, no else needed	No

Using cond for Multiple Expressions

cond clauses can have multiple expressions without begin.

Syntax:

(cond
  (condition1
    expression1
    expression2
    ...)
  (condition2
    expression1
    expression2
    ...)
  (else
    expression1
    expression2
    ...))

Example:

(define (grade-message score)
  (cond
    ((>= score 90)
     (display "Excellent!")
     (newline)
     (display "Grade: A")
     'A)
    ((>= score 80)
     (display "Good job!")
     (newline)
     (display "Grade: B")
     'B)
    ((>= score 70)
     (display "Passing")
     (newline)
     (display "Grade: C")
     'C)
    (else
     (display "Failed")
     (newline)
     (display "Grade: F")
     'F)))

(grade-message 85)
; Prints:
; Good job!
; Grade: B
; Returns: B

Note: Each clause can have multiple expressions, and the value of the last expression is returned if that clause matches.

Comparison with if + begin:

; Using if + begin (verbose)
(if (>= score 90)
    (begin
      (display "Excellent!")
      'A)
    (if (>= score 80)
        (begin
          (display "Good!")
          'B)
        ...))

; Using cond (cleaner)
(cond
  ((>= score 90)
   (display "Excellent!")
   'A)
  ((>= score 80)
   (display "Good!")
   'B)
  ...)

Common Patterns and Examples

Pattern 1: Validation with multiple actions

(define (validate-age age)
  (if (and (>= age 0) (<= age 150))
      (begin
        (display "Age is valid")
        (newline)
        #t)
      (begin
        (display "Error: Invalid age")
        (newline)
        (display "Age must be between 0 and 150")
        (newline)
        #f)))

Pattern 2: Side effects only when condition is true

; Using when
(when (file-exists? "config.txt")
  (display "Loading config...")
  (newline)
  (load-config)
  (display "Config loaded"))

; Without when (more verbose)
(if (file-exists? "config.txt")
    (begin
      (display "Loading config...")
      (newline)
      (load-config)
      (display "Config loaded"))
    (void))

Pattern 3: Guard clauses

(define (process-data data)
  ; Early return with multiple expressions
  (unless (valid-data? data)
    (display "Error: Invalid data")
    (newline)
    (return-error))

  ; Continue processing if valid
  (display "Processing...")
  (transform-data data))

Pattern 4: Logging with computation

(define (calculate x y)
  (if (= y 0)
      (begin
        (display "Error: Division by zero")
        (newline)
        (display "Returning default value")
        (newline)
        0)
      (begin
        (display "Calculating: ")
        (display x)
        (display " / ")
        (display y)
        (newline)
        (/ x y))))

When begin is NOT Needed

Some forms already allow multiple expressions implicitly.

Function bodies (define):

; begin NOT needed in function body
(define (greet name)
  (display "Hello, ")
  (display name)
  (display "!")
  (newline)
  'done)            ; Returns 'done

; All expressions execute in sequence
; Last one is the return value

let, let*, letrec bodies:

; begin NOT needed in let body
(let ((x 10)
      (y 20))
  (display "Computing sum")
  (newline)
  (+ x y))          ; Returns 30

lambda bodies:

; begin NOT needed in lambda body
(lambda (x)
  (display "Processing: ")
  (display x)
  (newline)
  (* x x))          ; Returns x squared

cond clauses:

; begin NOT needed in cond clauses
(cond
  ((> x 0)
   (display "Positive")
   (newline)
   'pos)
  (else
   (display "Not positive")
   'not-pos))

case clauses:

; begin NOT needed in case clauses
(case n
  ((1)
   (display "One")
   1)
  ((2)
   (display "Two")
   2))

Summary: When to Use What

Situation	Use	Example
Multiple expressions in if then/else	`begin`	`(if test (begin e1 e2) e3)`
Only execute if true, no else	`when`	`(when test e1 e2)`
Only execute if false, no else	`unless`	`(unless test e1 e2)`
Multi-way with multiple expressions	`cond`	`(cond (t1 e1 e2) (t2 e3 e4))`
In function/lambda/let body	Nothing (implicit)	`(define (f) e1 e2)`

Quick reference:

; if with multiple expressions
(if test
    (begin e1 e2 e3)
    (begin e4 e5 e6))

; when (cleaner for one-sided if)
(when test
  e1
  e2
  e3)

; unless (cleaner for negative one-sided if)
(unless test
  e1
  e2
  e3)

; cond (no begin needed)
(cond
  (test1 e1 e2 e3)
  (test2 e4 e5 e6)
  (else e7 e8 e9))

; Function body (no begin needed)
(define (func)
  e1
  e2
  e3)

Chez Scheme Naming Conventions

Understanding Scheme Identifiers

Scheme has flexible rules for naming variables and functions.

Core principle: Names should be descriptive and follow consistent patterns.

Valid characters in identifiers:

Letters: a-z, A-Z
Digits: 0-9 (not at the start)
Special characters: ! $ % & * + - . / : < = > @ ^ _ ~

Examples of valid identifiers:

; All valid
x
my-variable
list->vector
string-ref
empty?
set!
<=
+
make-counter
file-exists?
*global-config*

Examples of invalid identifiers:

; Invalid - starts with digit
123abc

; Invalid - contains space
my variable

; Invalid - contains special chars not allowed
my#var
item[0]
value{x}

Predicate Naming Convention

Functions that return boolean values end with

Purpose: Immediately identifies a function as a test or check.

Standard library examples:

; Type predicates
(number? 42)        ; Returns: #t
(string? "hi")      ; Returns: #t
(list? '(1 2 3))    ; Returns: #t
(pair? '(a . b))    ; Returns: #t
(null? '())         ; Returns: #t

; Comparison predicates
(zero? 0)           ; Returns: #t
(positive? 5)       ; Returns: #t
(negative? -3)      ; Returns: #t
(even? 4)           ; Returns: #t
(odd? 7)            ; Returns: #t

; State predicates
(eof-object? x)     ; Checks for EOF
(file-exists? "test.txt")
(char-whitespace? #\space)

Creating your own predicates:

(define (adult? age)
  (>= age 18))

(define (valid-email? email)
  (and (string? email)
       (string-contains? email "@")))

(define (empty-list? lst)
  (null? lst))

; Using predicates
(adult? 25)                    ; Returns: #t
(valid-email? "test@test.com") ; Returns: #t
(empty-list? '())              ; Returns: #t

Mutating Function Convention

Functions that modify (mutate) their arguments end with !

Warning: The ! signals side effects - use with caution.

Standard library examples:

; Variable mutation
(define x 10)
(set! x 20)         ; Modifies x
x                   ; Returns: 20

; List mutation
(define lst '(1 2 3))
(set-car! lst 99)   ; Modifies first element
lst                 ; Returns: (99 2 3)

(set-cdr! lst '(8 9))
lst                 ; Returns: (99 8 9)

; Vector mutation
(define vec #(1 2 3))
(vector-set! vec 0 42)  ; Modifies element at index 0
vec                     ; Returns: #(42 2 3)

Creating your own mutators:

(define (reset-counter! counter)
  (set-car! counter 0))

(define (increment! counter)
  (set-car! counter (+ (car counter) 1)))

(define (update-status! object new-status)
  (set-car! (cdr object) new-status))

; Usage
(define my-counter (list 0))
(increment! my-counter)
my-counter              ; Returns: (1)

Contrast with non-mutating functions:

; Non-mutating - returns new value
(define (increment counter)
  (+ counter 1))

(define x 5)
(increment x)       ; Returns: 6
x                   ; Still: 5

; Mutating - modifies in place
(define (increment! counter-box)
  (set-car! counter-box
            (+ (car counter-box) 1)))

(define y (list 5))
(increment! y)      ; Modifies y
y                   ; Now: (6)

Type Conversion Convention

Conversion functions use -> pattern: source->target

Pattern: (type-a->type-b value) converts from type A to type B.

Standard library examples:

; Number conversions
(string->number "42")       ; Returns: 42
(number->string 123)        ; Returns: "123"
(char->integer #\A)         ; Returns: 65
(integer->char 65)          ; Returns: #\A

; List/vector conversions
(list->vector '(1 2 3))     ; Returns: #(1 2 3)
(vector->list #(a b c))     ; Returns: (a b c)
(list->string '(#\h #\i))   ; Returns: "hi"
(string->list "abc")        ; Returns: (#\a #\b #\c)

; Symbol conversions
(symbol->string 'hello)     ; Returns: "hello"
(string->symbol "world")    ; Returns: world

Creating your own converters:

(define (celsius->fahrenheit c)
  (+ (* c 9/5) 32))

(define (fahrenheit->celsius f)
  (* (- f 32) 5/9))

(define (list->set lst)
  ; Convert list to set (remove duplicates)
  (delete-duplicates lst))

(define (record->alist rec)
  ; Convert record to association list
  (map cons (record-field-names rec)
            (record-field-values rec)))

; Usage
(celsius->fahrenheit 100)   ; Returns: 212
(fahrenheit->celsius 32)    ; Returns: 0
(list->set '(1 2 2 3 3 3))  ; Returns: (1 2 3)

Multi-word Identifier Convention

Use kebab-case (words separated by hyphens) for multi-word names.

Scheme style: kebab-case is standard, NOT camelCase or snake_case

Standard library examples:

; Standard functions
string-length
string-append
list-ref
vector-set!
make-vector
call-with-current-continuation
call-with-input-file
read-char
write-char

Creating your own multi-word names:

; Variables
(define max-retry-count 5)
(define database-connection-string "localhost:5432")
(define user-input-buffer '())

; Functions
(define (calculate-total-price items tax-rate)
  (* (apply + items) (+ 1 tax-rate)))

(define (validate-user-credentials username password)
  (and (valid-username? username)
       (valid-password? password)))

(define (send-email-notification recipient subject body)
  (email-send recipient subject body))

; Usage
(calculate-total-price '(10 20 30) 0.1)  ; Returns: 66.0

Bad examples (don't do this):

; Wrong - camelCase (not Scheme style)
calculateTotalPrice
getUserInput
sendEmailNotification

; Wrong - snake_case (not Scheme style)
calculate_total_price
get_user_input
send_email_notification

; Right - kebab-case (Scheme style)
calculate-total-price
get-user-input
send-email-notification

Global Variable Convention

Global variables and parameters are sometimes surrounded by asterisks *name*

Note: This convention is not universal in Scheme, but common in some codebases.

Examples from libraries:

; Common in some Scheme systems
*random-state*
*default-input-port*
*default-output-port*
*error-port*
*command-line-args*

Creating your own globals:

(define *debug-mode* #f)
(define *max-connections* 100)
(define *database-url* "localhost:5432")
(define *application-version* "1.0.0")

; Usage
(when *debug-mode*
  (display "Debug: Processing request")
  (newline))

(if (< (connection-count) *max-connections*)
    (accept-connection)
    (reject-connection))

Alternative convention: Some prefer %name for internal/private globals

; Internal implementation details
(define %internal-cache (make-hash-table))
(define %debug-counter 0)
(define %temporary-buffer (make-vector 1024))

Constructor and Maker Convention

Constructor functions often use make- prefix.

Pattern: (make-type args...) creates a new instance of type.

Standard library examples:

; Creating data structures
(make-vector 10)                  ; Creates vector of size 10
(make-vector 5 'x)                ; Creates #(x x x x x)
(make-string 3 #\a)               ; Creates "aaa"
(make-hash-table)                 ; Creates hash table
(make-list 4 0)                   ; Creates (0 0 0 0)

Creating your own constructors:

(define (make-point x y)
  (cons x y))

(define (make-rectangle width height)
  (list 'rectangle width height))

(define (make-account name balance)
  (list name balance '()))  ; name, balance, transaction-history

(define (make-counter initial-value)
  (let ((count initial-value))
    (lambda ()
      (set! count (+ count 1))
      count)))

; Usage
(define p1 (make-point 10 20))
(define r1 (make-rectangle 100 50))
(define acc (make-account "John" 1000))
(define counter (make-counter 0))
(counter)  ; Returns: 1
(counter)  ; Returns: 2

Private/Internal Naming

Internal helper functions sometimes use % prefix or -internal suffix.

Purpose: Signals that a function is not part of the public API.

Using % prefix:

; Public API
(define (parse-expression expr)
  (%validate-syntax expr)
  (%transform-expr expr))

; Internal helpers (not for public use)
(define (%validate-syntax expr)
  ; Internal validation logic
  #t)

(define (%transform-expr expr)
  ; Internal transformation logic
  expr)

Using -internal suffix:

; Public API
(define (calculate-total items)
  (apply + (map calculate-price-internal items)))

; Internal helper
(define (calculate-price-internal item)
  (* (item-quantity item)
     (item-unit-price item)
     (+ 1 (item-tax-rate item))))

Nested definitions (alternative):

; Internal helpers defined inside public function
(define (process-data data)
  ; Helper only accessible within this function
  (define (validate item)
    (and (number? item) (positive? item)))

  (define (transform item)
    (* item 2))

  ; Use helpers
  (map transform (filter validate data)))

(process-data '(1 -2 3 4))  ; Returns: (2 6 8)

Common Naming Patterns Summary

Convention	Pattern	Examples
Predicates (boolean returns)	`name?`	`empty?`, `valid?`, `member?`
Mutating functions	`name!`	`set!`, `vector-set!`, `increment!`
Type conversions	`type-a->type-b`	`list->vector`, `string->number`
Multi-word names	`kebab-case`	`string-length`, `file-exists?`
Global variables	`name`	`debug-mode`, `max-size`
Constructors	`make-name`	`make-vector`, `make-point`
Internal/private	`%name` or `name-internal`	`%helper`, `parse-internal`

Complete example using multiple conventions:

; Global configuration
(define *max-retries* 3)

; Constructor
(define (make-connection host port)
  (list host port 'disconnected))

; Predicate
(define (connected? conn)
  (eq? (caddr conn) 'connected))

; Type conversion
(define (connection->string conn)
  (string-append (car conn) ":" (number->string (cadr conn))))

; Mutator
(define (connect! conn)
  (set-car! (cddr conn) 'connected))

; Multi-word function
(define (establish-secure-connection host port)
  (let ((conn (make-connection host port)))
    (when (%validate-host host)
      (connect! conn))
    conn))

; Internal helper
(define (%validate-host host)
  (and (string? host)
       (> (string-length host) 0)))

; Usage
(define my-conn (make-connection "localhost" 8080))
(connected? my-conn)                    ; Returns: #f
(connect! my-conn)
(connected? my-conn)                    ; Returns: #t
(connection->string my-conn)             ; Returns: "localhost:8080"

Interacting with Chez Scheme

Starting Chez Scheme

Interactive REPL and execution modes:

; Chez Scheme provides multiple entry points:
; - scheme: Full compiler and interpreter
; - petite: Interpreter-only (no compiler)
; - scheme-script: Script execution mode

; Each mode has different capabilities and use cases

Starting the REPL:

# Start interactive session (full Chez)
$ scheme
Chez Scheme Version 10.0.0
Copyright 1984-2024 Cisco Systems, Inc.

>

# Start without greeting
$ scheme -q
>

# Start interpreter-only version
$ petite
Petite Chez Scheme Version 10.0.0
Copyright 1984-2024 Cisco Systems, Inc.

>

# Display version and exit
$ scheme --version
10.0.0

# Display help
$ scheme --help

Basic REPL interaction:

; Arithmetic
> (+ 2 3)
5

> (* 7 8)
56

> (/ 22 7)
22/7

; String operations
> (string-append "Hello, " "World!")
"Hello, World!"

; List operations
> (cons 1 '(2 3))
(1 2 3)

> (car '(a b c))
a

; Define variables
> (define x 10)
> x
10

> (define name "Alice")
> name
"Alice"

; Define procedures
> (define (square x)
    (* x x))
> (square 5)
25

; Lambda expressions
> ((lambda (x y) (+ x y)) 3 4)
7

Multi-line input:

; REPL automatically handles incomplete expressions
> (define (factorial n)
    (if (= n 0)
        1
        (* n (factorial (- n 1)))))

; Prompt waits for closing parentheses
> (let ([x 10]
        [y 20])
    (+ x y))
30

; Nested structures
> (define person
    '((name . "John")
      (age . 30)
      (city . "Boston")))
> (assoc 'age person)
(age . 30)

Exiting the REPL:

; Method 1: exit procedure
> (exit)

; Method 2: exit with status code
> (exit 0)      ; Success
> (exit 1)      ; Error

; Method 3: Ctrl+D (Unix/Linux/macOS)
> ^D

; Method 4: Ctrl+Z then Enter (Windows)
> ^Z
<Enter>

; Emergency exit: Ctrl+C (may leave cleanup incomplete)
> ^C

REPL configuration:

; Check current settings
> (print-level)
#f                          ; Unlimited depth

> (print-length)
#f                          ; Unlimited length

; Set print depth
> (print-level 3)
> '(a (b (c (d (e)))))
(a (b (c ...)))             ; Truncated at level 3

; Set print length
> (print-length 5)
> (iota 20)
(0 1 2 3 4 ...)             ; Truncated at 5 elements

; Reset to unlimited
> (print-level #f)
> (print-length #f)

; Control greeting display
> (suppress-greeting #t)   ; For next startup

; Waiter prompt customization
> (waiter-prompt-string)
"> "
> (waiter-prompt-string "chez> ")
>
chez>

Startup files and initialization:

; Chez Scheme looks for startup files in order:
; 1. ./.schemerc               (current directory)
; 2. ~/.schemerc               (home directory)
; 3. ~/.chezscheme.rc          (alternative name)

; Example ~/.schemerc file:
(case-sensitive #t)
(optimize-level 2)
(print-gensym #t)

; Personal library paths
(library-directories
  (cons "~/scheme/lib" (library-directories)))

; Load utility functions
(when (file-exists? "~/scheme/utils.ss")
  (load "~/scheme/utils.ss"))

; Custom REPL prompt
(waiter-prompt-string "λ ")

; Suppress greeting for cleaner startup
(suppress-greeting #t)

; Print startup message
(printf "; Chez Scheme ~a~%" (scheme-version))
(printf "; Ready~%")

Loading and Compiling Files

Loading source files:

; Load evaluates all expressions in a file
> (load "myfile.ss")

; Load with different extensions
> (load "library.scm")
> (load "utils.sls")

; Load from specific path
> (load "/home/user/code/helpers.ss")

; Load relative to current directory
> (load "./lib/math.ss")
> (load "../common/io.ss")

; Load returns unspecified value
> (load "config.ss")
; File loaded, configuration set

; Check if file exists before loading
> (when (file-exists? "optional.ss")
    (load "optional.ss"))

What happens during load:

Example file to load:

; File: math-utils.ss
(printf "Loading math utilities...~%")

(define (square x)
  (* x x))

(define (cube x)
  (* x x x))

(define (hypotenuse a b)
  (sqrt (+ (square a) (square b))))

(define pi 3.141592653589793)

(define (circle-area r)
  (* pi (square r)))

(printf "Math utilities loaded.~%")
(printf "Available: square, cube, hypotenuse, circle-area~%")

; Loading the file in REPL
> (load "math-utils.ss")
Loading math utilities...
Math utilities loaded.
Available: square, cube, hypotenuse, circle-area

> (square 5)
25

> (cube 3)
27

> (hypotenuse 3 4)
5.0

> (circle-area 10)
314.1592653589793

> pi
3.141592653589793

Compiling files:

; compile-file compiles source to object file
> (compile-file "myfile.ss")

; Creates myfile.so (compiled object)
; Compilation uses current parameter settings

; Compile with specific options
> (parameterize ([optimize-level 3])
    (compile-file "myfile.ss"))

; Check if compilation is needed
> (define (compile-if-needed source)
    (let* ([source-file source]
           [object-file (path-replace-extension source ".so")])
      (when (or (not (file-exists? object-file))
                (file-modification-time> source-file object-file))
        (printf "Compiling ~a...~%" source)
        (compile-file source))))

> (compile-if-needed "myfile.ss")
Compiling myfile.ss...

; Compile multiple files
> (for-each compile-file
    '("module1.ss" "module2.ss" "module3.ss"))

; Compile with error handling
> (guard (ex [else
              (printf "Compilation failed: ~a~%" ex)
              #f])
    (compile-file "problematic.ss"))

Loading compiled files:

; Load compiled object file directly
> (load "myfile.so")

; load automatically prefers .so if available and newer
> (load "myfile")
; Loads myfile.so if it exists and is newer than myfile.ss

; Force source load even if .so exists
> (load "myfile.ss")

; Check which file would be loaded
> (define (which-file-loads? base)
    (let ([source (string-append base ".ss")]
          [object (string-append base ".so")])
      (cond
        [(not (file-exists? source)) object]
        [(not (file-exists? object)) source]
        [(file-modification-time> object source) object]
        [else source])))

> (which-file-loads? "myfile")
"myfile.so"

Compile-time vs load-time behavior:

; File: example.ss

; This runs at compile-time AND load-time
(define-syntax compile-time-info
  (lambda (x)
    (printf "Compiling at: ~a~%" (current-date))
    #'(begin)))

; This runs at load-time only
(printf "Loading at: ~a~%" (current-date))

(define (greet)
  (printf "Hello!~%"))

; Behavior:
; When compiling (compile-file "example.ss"):
;   - Prints "Compiling at: ..."
;   - Does NOT print "Loading at: ..."
;   - Does NOT execute (greet)

; When loading (load "example.so"):
;   - Does NOT print "Compiling at: ..."
;   - Prints "Loading at: ..."
;   - Defines greet procedure
;   - Does NOT execute (greet)

; When loading source (load "example.ss"):
;   - Prints "Compiling at: ..." (compile on fly)
;   - Prints "Loading at: ..."
;   - Defines greet procedure

Compilation workflow:

# Method 1: From REPL
$ scheme
> (compile-file "myfile.ss")
> (exit)

# Method 2: One-line compilation
$ echo '(compile-file "myfile.ss")' | scheme -q

# Method 3: Batch compile script
$ cat > compile-all.ss <<'EOF'
(for-each compile-file
  '("module1.ss"
    "module2.ss"
    "module3.ss"))
EOF
$ scheme --script compile-all.ss

# Method 4: Makefile integration
# In Makefile:
%.so: %.ss
	echo '(compile-file "$<")' | scheme -q

# Method 5: Using scheme command directly
$ scheme --eval '(compile-file "myfile.ss")' --eval '(exit)'

Compilation best practices:

; Always compile with consistent settings

; Development compilation
(define (compile-dev file)
  (parameterize ([optimize-level 1]
                 [debug-level 3]
                 [generate-inspector-information #t])
    (compile-file file)))

; Production compilation
(define (compile-prod file)
  (parameterize ([optimize-level 3]
                 [debug-level 0]
                 [generate-inspector-information #f])
    (compile-file file)))

; Compile project with dependencies
(define (compile-project)
  ; Compile in dependency order
  (compile-prod "utils.ss")
  (compile-prod "data-structures.ss")
  (compile-prod "algorithms.ss")
  (compile-prod "main.ss"))

; Clean compiled files
(define (clean-compiled)
  (for-each
    (lambda (file)
      (when (file-exists? file)
        (delete-file file)
        (printf "Deleted ~a~%" file)))
    (directory-list "." "*.so")))

Load vs revisit vs visit:

; load: Read and evaluate all expressions
(load "file.ss")                ; Interprets or compiles+runs

; revisit: Load run-time code from compiled library
(revisit "library.so")          ; Library runtime only

; visit: Load compile-time code from compiled library
(visit "library.so")            ; Library macros only

; Typical usage (handled automatically by import):
(import (mylib))
; Equivalent to:
;   (visit "mylib.so")    ; Load compile-time
;   (revisit "mylib.so")  ; Load run-time

; Manual control for advanced cases:
; Compile-time only (for macro definitions)
(visit "macros.so")

; Run-time only (for procedure definitions)
(revisit "procedures.so")

; Both (normal case)
(load "complete.so")

Command-Line Usage

Basic command-line modes:

Mode	Command	Behavior
Interactive	`scheme`	Start REPL
Script	`scheme --script file.ss`	Run as script, exit after
Program	`scheme --program file.ss`	Run as R6RS program, exit after
Eval	`scheme --eval 'expr'`	Evaluate expression, continue REPL
Load	`scheme file.ss`	Load file, then start REPL

Script execution:

# Execute script and exit
$ scheme --script myscript.ss

# With command-line arguments
$ scheme --script myscript.ss arg1 arg2 arg3

# Script receives arguments via command-line
# (command-line) returns ("myscript.ss" "arg1" "arg2" "arg3")

; File: greet.ss
#!/usr/bin/env scheme --script
(import (chezscheme))

(define args (cdr (command-line)))

(if (null? args)
    (printf "Usage: greet.ss <name> ...~%")
    (for-each
      (lambda (name)
        (printf "Hello, ~a!~%" name))
      args))

$ chmod +x greet.ss
$ ./greet.ss
Usage: greet.ss <name> ...

$ ./greet.ss Alice Bob Charlie
Hello, Alice!
Hello, Bob!
Hello, Charlie!

Program execution:

# Run as R6RS program
$ scheme --program myprogram.ss

# With arguments
$ scheme --program myprogram.ss --verbose --count 10

; File: myprogram.ss
#!r6rs
(import (rnrs)
        (chezscheme))

; R6RS programs must start with import form

(define (main)
  (let ([args (cdr (command-line))])
    (for-each
      (lambda (arg)
        (cond
          [(string=? arg "--verbose")
           (display "Verbose mode enabled\n")]
          [(string=? arg "--help")
           (display "Help requested\n")]
          [else
           (fprintf (current-output-port)
                    "Processing: ~a~%" arg)]))
      args)))

(main)

Loading files on startup:

# Load file then start REPL
$ scheme myfile.ss
; myfile.ss is loaded
>                              # Can use definitions from myfile.ss

# Load multiple files
$ scheme file1.ss file2.ss file3.ss
; All three files loaded
>

# Load and run expression
$ scheme myfile.ss --eval '(main)'
; Load file and call main procedure

# Load compiled file
$ scheme myfile.so
; Load compiled version (faster)
>

Complete command-line options:

Option	Description	Example
`-q, --quiet`	Suppress greeting message	`scheme -q`
`--script file`	Run file as script, exit when done	`scheme --script app.ss`
`--program file`	Run R6RS program, exit when done	`scheme --program app.ss`
`--libdirs dirs`	Set library directories (: separated)	`scheme --libdirs lib:vendor`
`--libexts exts`	Set library extensions	`scheme --libexts .ss:.sls`
`--compile-imported-libraries`	Compile imported libraries automatically	`scheme --compile-imported-libraries`
`--import-notify`	Print imports as they occur	`scheme --import-notify`
`--optimize-level n`	Set optimization level (0-3)	`scheme --optimize-level 3`
`--debug-on-exception`	Enter debugger on exception	`scheme --debug-on-exception`
`--eedisable`	Disable expression editor	`scheme --eedisable`
`--version`	Display version and exit	`scheme --version`
`--help`	Display help and exit	`scheme --help`

Executable script with shebang:

#!/usr/bin/env scheme --script
; File: calculator.ss
; Make executable with: chmod +x calculator.ss

(import (chezscheme))

(define (usage)
  (display "Usage: calculator.ss <operation> <num1> <num2>\n")
  (display "Operations: add, sub, mul, div\n")
  (exit 1))

(define (calculate op a b)
  (case (string->symbol op)
    [(add) (+ a b)]
    [(sub) (- a b)]
    [(mul) (* a b)]
    [(div) (if (zero? b)
               (begin
                 (display "Error: Division by zero\n")
                 (exit 1))
               (/ a b))]
    [else
     (display "Unknown operation\n")
     (usage)]))

(let ([args (cdr (command-line))])
  (if (not (= (length args) 3))
      (usage)
      (let ([op (car args)]
            [a (string->number (cadr args))]
            [b (string->number (caddr args))])
        (if (and a b)
            (printf "Result: ~a~%" (calculate op a b))
            (begin
              (display "Error: Invalid numbers\n")
              (exit 1))))))

$ chmod +x calculator.ss

$ ./calculator.ss add 10 20
Result: 30

$ ./calculator.ss mul 7 8
Result: 56

$ ./calculator.ss div 22 7
Result: 22/7

$ ./calculator.ss
Usage: calculator.ss <operation> <num1> <num2>
Operations: add, sub, mul, div

Complex command-line example:

# Set library paths, load config, compile imports, run program
$ scheme \
    --libdirs lib:vendor:~/.scheme/lib \
    --compile-imported-libraries \
    --optimize-level 3 \
    --eval '(load "config.ss")' \
    --program main.ss \
    --verbose \
    input.txt

# Debug mode with notifications
$ scheme \
    --debug-on-exception \
    --import-notify \
    --eval '(debug-level 3)' \
    --script test.ss

# Production mode (quiet, optimized)
$ scheme -q \
    --optimize-level 3 \
    --program app.ss \
    --port 8080 \
    --workers 4

REPL Features and Commands

Inspecting values:

; Display simple values
> 42
42

> "hello"
"hello"

> '(1 2 3)
(1 2 3)

; Inspect procedures
> car
#<procedure car>

> (lambda (x) (* x 2))
#<procedure>

; Inspect arity
> (procedure-arity car)
#<arity (1)>

> (procedure-arity +)
#<arity (n)>                   ; Variable arity

; Type checking
> (procedure? car)
#t

> (procedure? 42)
#f

; Get procedure name (if available)
> (procedure-name car)
car

; Inspect records/structures
> (define-record-type point (fields x y))
> (define p (make-point 10 20))
> p
#[point x:10 y:20]

; Pretty-print for complex structures
> (pretty-print
    '((name . "John")
      (address . ((street . "Main St")
                  (city . "Boston")
                  (zip . 02101)))))
((name . "John")
 (address
  (street . "Main St")
  (city . "Boston")
  (zip . 02101)))

Getting help and documentation:

; Display procedure information
> (describe '+)
+: procedure
  (+ number ...)
  Returns the sum of the arguments.

; Apropos - search for procedures by name pattern
> (apropos "list")
list
list?
list-ref
list-tail
list-head
list-copy
; ... and more

; Search in specific library
> (apropos "fold" 'rnrs)
fold-left
fold-right

; Help system (if loaded)
> (help 'map)
map: procedure
  (map procedure list1 list2 ...)
  Applies procedure element-wise to the lists.

; Inspect available bindings
> (environment-bindings (interaction-environment))
; Shows all defined names

; Check if bound
> (top-level-bound? 'car)
#t

> (top-level-bound? 'nonexistent)
#f

System information:

; Version information
> (scheme-version)
"10.0.0"

> (scheme-version-number)
#x0a000000                     ; Hex encoded version

; Machine type
> (machine-type)
'ta6le                         ; Threaded, AMD64, Linux

; Operating system
> (machine-type->os)
"Linux"

; Features available
> (features)
(threads 64-bit little-endian ...)

; Check for specific feature
> (threaded?)
#t

> (windows?)
#f

; Installation directory
> (scheme-directory)
"/usr/lib/csv10.0"

; Current directory
> (current-directory)
"/home/user/project"

; Change directory
> (current-directory "/tmp")
> (current-directory)
"/tmp"

; Environment variables
> (getenv "HOME")
"/home/user"

> (getenv "PATH")
"/usr/local/bin:/usr/bin:/bin"

; Set environment variable
> (putenv "MY_VAR" "value")
> (getenv "MY_VAR")
"value"

Timing and profiling:

; Time a single expression
> (time (+ 2 3))
(time (+ 2 3))
    no collections
    0.000001s elapsed cpu time
    0.000001s elapsed real time
    0 bytes allocated
5

; Time a longer computation
> (time (apply + (iota 1000000)))
(time (apply + (iota 1000000)))
    5 collections
    0.021456s elapsed cpu time
    0.021523s elapsed real time
    24000016 bytes allocated
499999500000

; Time with multiple iterations
> (define (benchmark proc n)
    (time
      (do ([i 0 (+ i 1)])
          ((= i n))
        (proc))))

> (benchmark (lambda () (apply + (iota 1000))) 10000)
(time (do ([i 0 (+ i 1)]) ((= i n)) (proc)))
    248 collections
    0.845123s elapsed cpu time
    0.846234s elapsed real time
    959997104 bytes allocated

; Measure memory only
> (collect)                    ; Force garbage collection
> (let ([before (bytes-allocated)])
    (make-list 1000000 0)
    (- (bytes-allocated) before))
8000016                        ; Bytes used

; Garbage collection statistics
> (collect)
> (statistics)
; Displays detailed GC statistics

Compiler parameters:

; Optimization level (0-3)
> (optimize-level)
2                              ; Default

> (optimize-level 3)
> (optimize-level)
3

; Debug level (0-3)
> (debug-level)
2                              ; Default

> (debug-level 3)              ; More debugging info

; Generate inspector information
> (generate-inspector-information)
#f                             ; Default

> (generate-inspector-information #t)

; Generate procedure source information
> (generate-procedure-source-information)
#f

> (generate-procedure-source-information #t)

; Enable compile-time folding
> (enable-cp0)
#t                             ; Default

; Track statistics
> (statistics-level)
0

> (statistics-level 3)
> (compile '(lambda (x) (* x x)))
; Shows detailed statistics

Expression editor (enhanced REPL):

; The expression editor provides:
; - Line editing with arrow keys
; - Multi-line input handling
; - History navigation (up/down arrows)
; - Tab completion (if enabled)
; - Parenthesis matching

; Check if enabled
> (ee-enabled?)
#t

; Disable expression editor
> (ee-disable)

; Re-enable
> (ee-enable)

; History navigation
; Press Up: previous expression
; Press Down: next expression

; Multi-line editing
; Opening ( waits for matching )
> (define (factorial n)    ; Press Enter
    (if (= n 0)             ; Press Enter
        1                   ; Press Enter
        (* n                ; Press Enter
           (factorial       ; Press Enter
             (- n 1)))))    ; Completes and evaluates

; Interrupt long-running computation
> (let loop () (loop))      ; Infinite loop
^C                           ; Ctrl+C interrupts
Exception: interrupted

; Reset REPL state
> (reset)
; Clears REPL state, restarts interaction

Multi-value returns:

; Expressions returning multiple values
> (values 1 2 3)
1
2
3

; REPL prints all values returned

> (let-values ([(a b c) (values 1 2 3)])
    (+ a b c))
6

; Multiple values from procedures
> (define (quotient-remainder a b)
    (values (quotient a b) (remainder a b)))

> (quotient-remainder 17 5)
3
2

> (call-with-values
    (lambda () (quotient-remainder 17 5))
    +)
5

; Using multiple values
> (let-values ([(q r) (quotient-remainder 17 5)])
    (printf "Quotient: ~a, Remainder: ~a~%" q r))
Quotient: 3, Remainder: 2

REPL visualization of features:

Working with Libraries and Imports

Defining a library:

; File: mylib.sls (Scheme Library Source)
(library (mylib)
  (export
    square
    cube
    double
    halve
    clamp)
  (import (chezscheme))

  (define (square x)
    "Return x squared"
    (* x x))

  (define (cube x)
    "Return x cubed"
    (* x x x))

  (define (double x)
    "Return double of x"
    (* 2 x))

  (define (halve x)
    "Return half of x"
    (/ x 2))

  (define (clamp x min max)
    "Clamp x between min and max"
    (cond
      [(< x min) min]
      [(> x max) max]
      [else x])))

Importing libraries:

; Import entire library
> (import (mylib))

> (square 5)
25

> (cube 3)
27

; Import only specific bindings
> (import (only (mylib) square cube))

> (square 4)
16

> (double 5)
Exception: undefined variable double

; Import all except specific bindings
> (import (except (mylib) double))

> (square 5)
25

> (double 5)
Exception: undefined variable double

; Import with renaming
> (import (rename (mylib) (square sq)))

> (sq 5)
25

> (square 5)
Exception: undefined variable square

; Import with prefix
> (import (prefix (mylib) math:))

> (math:square 5)
25

> (math:cube 3)
27

; Combine import forms
> (import (rename (only (mylib) square cube)
                  (square sq)
                  (cube cb)))

> (sq 4)
16

> (cb 2)
8

Standard library imports:

; R6RS base library
(import (rnrs base))

; R6RS specific libraries
(import (rnrs io simple))      ; Simple I/O
(import (rnrs io ports))       ; Port I/O
(import (rnrs files))          ; File operations
(import (rnrs programs))       ; exit, command-line
(import (rnrs arithmetic fixnums))  ; Fixnum operations
(import (rnrs arithmetic flonums))  ; Flonum operations
(import (rnrs bytevectors))    ; Byte vectors
(import (rnrs lists))          ; List utilities
(import (rnrs sorting))        ; Sorting
(import (rnrs records syntactic))   ; Record types
(import (rnrs hashtables))     ; Hash tables
(import (rnrs control))        ; when, unless, case-lambda
(import (rnrs exceptions))     ; Exception handling
(import (rnrs conditions))     ; Condition types

; Import entire R6RS
(import (rnrs))                ; All R6RS libraries

; Chez Scheme extensions
(import (chezscheme))          ; All Chez features

; Mixing R6RS and Chez
(import (rnrs base)
        (only (chezscheme) printf format))

; Multiple imports
(import (rnrs base)
        (rnrs io simple)
        (rnrs lists)
        (mylib))

Library search and configuration:

; Check library directories
> (library-directories)
(("." . "."))                  ; Default: current directory

; Add library directories
> (library-directories
    '(("." . ".")
      ("lib" . "lib/compiled")
      ("/usr/local/lib/scheme" . "/usr/local/lib/scheme/compiled")))

; Source and compiled directories can differ
; Format: (source-dir . compiled-dir)

; Library extensions
> (library-extensions)
((".chezscheme.sls" . ".chezscheme.so")
 (".ss" . ".so")
 (".sls" . ".so")
 (".scm" . ".so"))

; Chez checks each extension in order
; For (import (foo bar)):
;   foo/bar.chezscheme.sls → foo/bar.chezscheme.so
;   foo/bar.ss → foo/bar.so
;   foo/bar.sls → foo/bar.so
;   foo/bar.scm → foo/bar.so

; Add custom extension
> (library-extensions
    (cons '(".scheme" . ".so")
          (library-extensions)))

Library compilation:

; Compile a library
> (compile-library "mylib.sls")
; Creates mylib.so

; Compile with options
> (parameterize ([optimize-level 3])
    (compile-library "mylib.sls"))

; Auto-compile imported libraries
> (compile-imported-libraries #t)

; Now imports trigger compilation if needed
> (import (mylib))
; Compiles mylib.sls if mylib.so missing or outdated

; Check compilation status
> (compile-imported-libraries)
#f                             ; Not enabled by default

; Enable import notification
> (import-notify #t)

> (import (mylib))
importing (mylib) from mylib.so
; Shows what's being imported from where

Creating programs with libraries:

; File: myprogram.ss
#!chezscheme
(import (chezscheme)
        (mylib)
        (rnrs))

(define (main)
  (printf "Testing mylib:~%")
  (printf "  square(5) = ~a~%" (square 5))
  (printf "  cube(3) = ~a~%" (cube 3))
  (printf "  double(7) = ~a~%" (double 7))
  (printf "  clamp(15, 0, 10) = ~a~%" (clamp 15 0 10)))

(main)

# Run the program
$ scheme --program myprogram.ss
Testing mylib:
  square(5) = 25
  cube(3) = 27
  double(7) = 14
  clamp(15, 0, 10) = 10

Multi-file library structure:

project/
  lib/
    mathlib/
      core.sls           ; (mathlib core)
      advanced.sls       ; (mathlib advanced)
      utils.sls          ; (mathlib utils)
    stringlib/
      core.sls           ; (stringlib core)
      parse.sls          ; (stringlib parse)
  compiled/
    mathlib/
      core.so
      advanced.so
      utils.so
    stringlib/
      core.so
      parse.so

; Configure library paths
(library-directories
  '(("." . ".")
    ("lib" . "compiled")))

; Now can import
(import (mathlib core))
(import (mathlib advanced))
(import (stringlib parse))

Library dependencies:

; File: lib/mathlib/advanced.sls
(library (mathlib advanced)
  (export
    factorial
    fibonacci
    gcd)
  (import (chezscheme)
          (mathlib core))       ; Depends on (mathlib core)

  (define (factorial n)
    (if (zero? n)
        1
        (* n (factorial (- n 1)))))

  (define (fibonacci n)
    (if (<= n 1)
        n
        (+ (fibonacci (- n 1))
           (fibonacci (- n 2)))))

  (define (gcd a b)
    ; Uses square from (mathlib core)
    (if (zero? b)
        a
        (gcd b (remainder a b)))))

; Importing (mathlib advanced) automatically imports (mathlib core)
> (import (mathlib advanced))

> (factorial 5)
120

> (square 4)                   ; From (mathlib core)
16

Re-exporting from libraries:

; File: lib/mathlib.sls
; Convenience library that re-exports everything
(library (mathlib)
  (export
    ; Re-export from core
    (import (mathlib core))
    ; Re-export from advanced
    (import (mathlib advanced)))
  (import (mathlib core)
          (mathlib advanced)))

; Now can import everything at once
> (import (mathlib))

; Get everything from mathlib/core and mathlib/advanced
> (square 5)
25

> (factorial 5)
120

Import visualization:

Compilation and Optimization

Optimization levels:

Level	Compile Speed	Run Speed	Debug Info	Use Case
`0`	Fastest	Slowest	Full	Initial development, debugging
`1`	Fast	Moderate	Good	Active development
`2`	Moderate	Fast	Some	Default (balanced)
`3`	Slowest	Fastest	Minimal	Production, performance-critical

Setting optimization:

; Check current optimization level
> (optimize-level)
2                              ; Default

; Set optimization level
> (optimize-level 3)

; Compile with current level
> (compile-file "myfile.ss")
; Uses level 3

; Temporarily change for single compilation
> (parameterize ([optimize-level 0])
    (compile-file "debug.ss"))

; Back to level 3 after parameterize
> (optimize-level)
3

; Command-line optimization
$ scheme --optimize-level 3 --eval '(compile-file "myfile.ss")' --eval '(exit)'

Debug level control:

; Debug levels (0-3)
> (debug-level)
2                              ; Default

; Set debug level
> (debug-level 3)              ; Maximum debugging info

; Effects of debug level:
; Level 0: Minimal checks, minimal info
; Level 1: Basic checks, basic info
; Level 2: Standard checks, good info (default)
; Level 3: Extra checks, full info, stack traces

; Trade-off: higher debug = more info, slower execution

; Development setup
> (optimize-level 1)
> (debug-level 3)

; Production setup
> (optimize-level 3)
> (debug-level 0)

Additional compilation parameters:

; Generate inspector information
> (generate-inspector-information)
#f                             ; Default

> (generate-inspector-information #t)
; Enables runtime inspection of closures

; Generate procedure source information
> (generate-procedure-source-information)
#f                             ; Default

> (generate-procedure-source-information #t)
; Stores source location in procedures

; Example benefit:
> (define (factorial n)
    (if (= n 0) 1 (* n (factorial (- n 1)))))

> (procedure-source-information factorial)
#f                             ; Without generation

> (generate-procedure-source-information #t)
> (define (factorial n)
    (if (= n 0) 1 (* n (factorial (- n 1)))))

> (procedure-source-information factorial)
((line . 2) (column . 0) (file . "repl"))

; Enable compile-time constant folding
> (enable-cp0)
#t                             ; Default (recommended)

> (enable-cp0 #f)              ; Disable (rarely needed)

; Track compilation statistics
> (compile-time-statistics-level)
0                              ; Default (off)

> (compile-time-statistics-level 3)
> (compile-file "myfile.ss")
; Displays detailed compilation statistics

; Case sensitivity (standard Scheme is case-sensitive)
> (case-sensitive)
#t                             ; Default

> (case-sensitive #f)          ; Case-insensitive mode
> (eq? 'ABC 'abc)
#t

> (case-sensitive #t)          ; Restore case-sensitivity
> (eq? 'ABC 'abc)
#f

Whole-program optimization:

; Compile individual files normally first
> (compile-file "utils.ss")
> (compile-file "algorithms.ss")
> (compile-file "main.ss")

; Then compile as whole program
> (compile-whole-program "app.wpo" "main.ss")
; Creates app.wpo with cross-file optimizations

; Run whole-program compiled code
$ scheme --program app.wpo

; Benefits:
; - Cross-file inlining
; - Better dead code elimination
; - Global optimization
; - Smaller code size
; - Faster execution

; Build script for whole-program compilation
(parameterize ([optimize-level 3]
               [debug-level 0]
               [generate-inspector-information #f])
  ; Compile all modules
  (for-each compile-file
    '("utils.ss" "data.ss" "algorithms.ss"))

  ; Compile main as whole program
  (compile-whole-program "app.wpo" "main.ss")

  (printf "Build complete: app.wpo~%"))

Inline and constant folding:

; Example of optimization effects

; Original code
(define (compute x)
  (let ([a (* 2 3)]        ; Constant expression
        [b (+ x 10)])
    (+ a b)))

; Level 0: No optimization
; - Computes (* 2 3) every call
; - Allocates closure for let

; Level 2: Standard optimization
; - Folds (* 2 3) to 6 at compile time
; - Optimizes simple let binding

; Level 3: Aggressive optimization
; - Folds (* 2 3) to 6
; - Eliminates let binding entirely
; - May inline small procedures
; - Recognizes arithmetic patterns

; Marking for inlining
(define-inline (square x)
  (* x x))

; This encourages inlining at call sites
(square 5)                     ; May become (* 5 5) inline

; Discourage inlining (for large functions)
(define (big-function x)
  (define-inline-procedure (big-function$1 x)  ; Internal
    ...)
  (big-function$1 x))

Benchmarking optimization levels:

; Benchmark different optimization levels

(define (benchmark-levels file)
  (define (compile-and-time level)
    (parameterize ([optimize-level level])
      (let ([start (current-time)])
        (compile-file file)
        (let* ([compile-time (time-difference (current-time) start)]
               [compiled (path-replace-extension file ".so")]
               [start-run (current-time)])
          (load compiled)
          (test-function 10000)  ; Run benchmark
          (let ([run-time (time-difference (current-time) start-run)])
            (printf "Level ~a: compile=~as, run=~as~%"
                    level
                    (time-second compile-time)
                    (time-second run-time)))))))

  (for-each compile-and-time '(0 1 2 3)))

; Example output:
; Level 0: compile=0.12s, run=2.45s
; Level 1: compile=0.18s, run=1.23s
; Level 2: compile=0.25s, run=0.67s
; Level 3: compile=0.41s, run=0.48s

Optimization visualization:

Production build script:

; File: build-release.ss
#!/usr/bin/env scheme --script

(import (chezscheme))

(define (build-release)
  (printf "Building release version...~%")

  ; Set production parameters
  (optimize-level 3)
  (debug-level 0)
  (generate-inspector-information #f)
  (generate-procedure-source-information #f)

  ; Clean old compiled files
  (printf "Cleaning old builds...~%")
  (for-each
    (lambda (file)
      (when (file-exists? file)
        (delete-file file)))
    (directory-list "." "*.so"))

  ; Compile all source files
  (define sources
    '("utils.ss"
      "data-structures.ss"
      "algorithms.ss"
      "io.ss"
      "main.ss"))

  (printf "Compiling ~a files...~%" (length sources))
  (for-each
    (lambda (file)
      (printf "  Compiling ~a...~%" file)
      (compile-file file))
    sources)

  ; Create whole-program compilation
  (printf "Creating whole-program binary...~%")
  (compile-whole-program "app.wpo" "main.ss")

  ; Create launcher script
  (printf "Creating launcher...~%")
  (call-with-output-file "app"
    (lambda (port)
      (display "#!/bin/sh\n" port)
      (display "exec scheme --program app.wpo \"$@\"\n" port)))

  (system "chmod +x app")

  (printf "Build complete!~%")
  (printf "Run with: ./app~%"))

(build-release)

$ chmod +x build-release.ss
$ ./build-release.ss
Building release version...
Cleaning old builds...
Compiling 5 files...
  Compiling utils.ss...
  Compiling data-structures.ss...
  Compiling algorithms.ss...
  Compiling io.ss...
  Compiling main.ss...
Creating whole-program binary...
Creating launcher...
Build complete!
Run with: ./app

$ ./app
; Production-optimized application runs

Debugging and Error Handling

Understanding error messages:

; Basic error
> (car 42)
Exception: car: 42 is not a pair

; Error structure:
; - Exception: indicates an error occurred
; - car: the procedure that failed
; - "42 is not a pair": explanation

; Type errors
> (+ "hello" 5)
Exception: +: "hello" is not a number

; Undefined variable
> undefined-var
Exception: undefined variable undefined-var

; Arity errors
> (+ 1)
1                              ; + accepts any number of args

> (car)
Exception: car: incorrect number of arguments

> (car '(a b) '(c d))
Exception: car: incorrect number of arguments

Stack traces and context:

; Enable better stack traces
> (debug-level 3)
> (generate-procedure-source-information #t)

; Define nested procedures
> (define (a x) (b (* x 2)))
> (define (b x) (c (+ x 1)))
> (define (c x) (car x))

; Call and trigger error
> (a 5)
Exception in car: 11 is not a pair
  at c
  at b
  at a
  at top-level

; Shows call chain leading to error

; More detailed example
> (define (process-list lst)
    (if (null? lst)
        '()
        (cons (process-item (car lst))
              (process-list (cdr lst)))))

> (define (process-item x)
    (* x x))

> (process-list '(1 2 "three" 4))
Exception in *: "three" is not a number
  at process-item
  at process-list
  at top-level

; Stack trace shows:
; 1. Error in *
; 2. Called from process-item
; 3. Called from process-list
; 4. Called from REPL

Exception handling:

; guard for exception handling
> (guard (ex
          [(error-object? ex)
           (printf "Error: ~a~%" (error-object-message ex))
           #f]
          [else
           (printf "Unknown exception: ~a~%" ex)
           #f])
    (car 42))
Error: car: 42 is not a pair
#f

; Multiple condition clauses
> (guard (ex
          [(assertion-violation? ex)
           (display "Assertion violated!\n")
           'assertion]
          [(undefined-violation? ex)
           (display "Undefined variable!\n")
           'undefined]
          [(error-object? ex)
           (printf "General error: ~a~%" (error-object-message ex))
           'error]
          [else
           (printf "Other: ~a~%" ex)
           'other])
    (car 42))
General error: car: 42 is not a pair
error

; with-exception-handler
> (with-exception-handler
    (lambda (ex)
      (printf "Handler called: ~a~%" ex)
      'handled)
    (lambda ()
      (car 42)))
Handler called: Exception: car: 42 is not a pair
handled

; Nested handlers
> (with-exception-handler
    (lambda (ex)
      (printf "Outer handler~%")
      (raise ex))
    (lambda ()
      (with-exception-handler
        (lambda (ex)
          (printf "Inner handler~%")
          (raise ex))
        (lambda ()
          (car 42)))))
Inner handler
Outer handler
Exception: car: 42 is not a pair

Tracing procedures:

; Define a recursive function
> (define (factorial n)
    (if (= n 0)
        1
        (* n (factorial (- n 1)))))

; Trace it
> (trace factorial)

; Now calls show entry and exit
> (factorial 5)
|(factorial 5)
| (factorial 4)
| |(factorial 3)
| | (factorial 2)
| | |(factorial 1)
| | | (factorial 0)
| | | 1
| | |1
| | 2
| |6
| 24
|120
120

; Trace shows:
; - Each call with arguments
; - Indentation for depth
; - Return values

; Trace multiple procedures
> (trace factorial fibonacci)

; Untrace
> (untrace factorial)

; Untrace all
> (untrace)

; Check what's traced
> (traced?)
()                             ; Nothing traced

; Conditional tracing
> (define (traced-fact n)
    (when (> n 10)
      (trace factorial))
    (let ([result (factorial n)])
      (untrace factorial)
      result))

Break points and inspection:

; Insert breakpoint in code
> (define (compute x y)
    (let ([a (* x 2)]
          [b (+ y 3)])
      (break)                  ; Stop here
      (+ a b)))

; When break is hit
> (compute 5 10)
Break at:
  (+ a b)
debug>

; At debug prompt, inspect variables
debug> x
5

debug> y
10

debug> a
10

debug> b
13

; Evaluate expressions
debug> (+ a b)
23

; Continue execution
debug> (continue)
23

>                             ; Back to normal REPL

; Conditional breakpoints
> (define (process-list lst)
    (if (null? lst)
        '()
        (let ([item (car lst)])
          (when (not (number? item))
            (break))           ; Break only for non-numbers
          (cons (* item 2) (process-list (cdr lst))))))

> (process-list '(1 2 "three" 4))
Break at:
  (cons (* item 2) (process-list (cdr lst)))
debug> item
"three"

debug> lst
("three" 4)

Inspector system:

; Enable inspector information
> (generate-inspector-information #t)

; Define a closure
> (define (make-counter)
    (let ([count 0])
      (lambda ()
        (set! count (+ count 1))
        count)))

> (define counter (make-counter))

; Inspect the closure
> (inspect counter)
counter is a procedure
  closed over: count = 0

; Call and inspect again
> (counter)
1

> (inspect counter)
counter is a procedure
  closed over: count = 1

; Inspect data structures
> (define data '((name . "Alice")
                 (age . 30)
                 (city . "Boston")))

> (inspect data)
data is a list:
  ((name . "Alice")
   (age . 30)
   (city . "Boston"))

; Inspect records
> (define-record-type person
    (fields name age city))

> (define p (make-person "Bob" 25 "NYC"))

> (inspect p)
p is a person record:
  name: "Bob"
  age: 25
  city: "NYC"

Pretty-printing for debugging:

; Pretty-print nested structures
> (define complex-data
    '(define (long-function x y z)
       (let ([a (compute-alpha x)]
             [b (compute-beta y)]
             [c (compute-gamma z)])
         (if (valid? a b c)
             (process a b c)
             (fallback x y z)))))

> complex-data
; Without pretty-print (hard to read)
(define (long-function x y z) (let ([a ...]) ...))

> (pretty-print complex-data)
; With pretty-print (readable)
(define (long-function x y z)
  (let ([a (compute-alpha x)]
        [b (compute-beta y)]
        [c (compute-gamma z)])
    (if (valid? a b c)
        (process a b c)
        (fallback x y z))))

; Control pretty-printing
> (pretty-maximum-lines)
#f                             ; Unlimited

> (pretty-maximum-lines 10)
; Truncates after 10 lines

> (pretty-line-length)
80                             ; Characters per line

> (pretty-line-length 120)
; Wider lines

; Pretty-print to string
> (let ([str-port (open-output-string)])
    (parameterize ([current-output-port str-port])
      (pretty-print complex-data))
    (get-output-string str-port))
; Returns formatted string

Debugging visualization:

Creating Standalone Executables

Boot file creation:

; Boot files package compiled code and runtime
; They enable standalone deployment

; Create a boot file
(make-boot-file "myapp.boot"
                '()                ; List of additional boot files
                "main.ss")         ; Entry point

; This creates myapp.boot containing:
; - Compiled code from main.ss and dependencies
; - Chez runtime system
; - Everything needed to run independently

; With dependencies
(make-boot-file "myapp.boot"
                '()
                "main.ss"
                "utils.so"
                "data.so")

; Multiple entry points
(make-boot-file "myapp.boot"
                '()
                "init.ss"
                "main.ss"
                "cleanup.ss")

Running boot files:

# Run boot file directly
$ scheme -b myapp.boot

# Run with arguments
$ scheme -b myapp.boot arg1 arg2

# Specify entry point
$ scheme -b myapp.boot --eval '(main)'

# Silent mode
$ scheme -q -b myapp.boot

Creating shell wrapper:

#!/bin/sh
# File: myapp

# Find scheme executable
SCHEME=$(which scheme)
if [ -z "$SCHEME" ]; then
    echo "Error: Chez Scheme not found"
    exit 1
fi

# Get script directory
DIR="$(cd "$(dirname "$0")" && pwd)"

# Run boot file
exec "$SCHEME" -q -b "$DIR/myapp.boot" "$@"

# Make executable
$ chmod +x myapp

# Now can run like normal program
$ ./myapp
Hello from standalone app!

$ ./myapp arg1 arg2
Args: (arg1 arg2)

Complete application example:

; File: myapp.ss
#!chezscheme

(import (chezscheme))

; Application configuration
(define app-name "MyApp")
(define app-version "1.0.0")

; Main function
(define (main args)
  ; Print banner
  (printf "~a v~a~%" app-name app-version)
  (newline)

  ; Process arguments
  (let ([cmd-args (cdr args)])  ; Skip program name
    (cond
      [(null? cmd-args)
       (print-usage)]
      [(member "--help" cmd-args)
       (print-usage)]
      [(member "--version" cmd-args)
       (printf "Version: ~a~%" app-version)]
      [else
       (process-args cmd-args)])))

; Print usage information
(define (print-usage)
  (display "Usage: myapp [options] [arguments]\n")
  (display "\n")
  (display "Options:\n")
  (display "  --help       Show this help message\n")
  (display "  --version    Show version information\n")
  (display "  --verbose    Enable verbose output\n"))

; Process command-line arguments
(define (process-args args)
  (let ([verbose (member "--verbose" args)])
    (when verbose
      (display "Verbose mode enabled\n"))

    ; Filter out options
    (let ([inputs (filter
                    (lambda (arg)
                      (not (string-prefix? "--" arg)))
                    args)])
      (if (null? inputs)
          (display "No input files specified\n")
          (for-each process-file inputs)))))

; Process a single file
(define (process-file filename)
  (printf "Processing: ~a~%" filename)
  (if (file-exists? filename)
      (begin
        (printf "  Size: ~a bytes~%"
                (file-size filename))
        (display "  OK\n"))
      (printf "  Error: file not found~%")))

; Helper: check if string starts with prefix
(define (string-prefix? prefix str)
  (and (>= (string-length str)
            (string-length prefix))
       (string=? prefix
                 (substring str 0 (string-length prefix)))))

; Auto-run main
(main (command-line))

Building the standalone app:

# Build script: build.ss
#!/usr/bin/env scheme --script

(import (chezscheme))

(printf "Building MyApp...~%")

; Set production parameters
(optimize-level 3)
(debug-level 0)

; Compile main file
(printf "Compiling myapp.ss...~%")
(compile-file "myapp.ss")

; Create boot file
(printf "Creating boot file...~%")
(make-boot-file "myapp.boot" '() "myapp.so")

; Create wrapper script
(printf "Creating launcher...~%")
(call-with-output-file "myapp"
  (lambda (port)
    (fprintf port "#!/bin/sh~%")
    (fprintf port "exec scheme -q -b \"$(dirname \"$0\")/myapp.boot\" \"$@\"~%")))

(system "chmod +x myapp")

(printf "Build complete!~%")
(printf "Run with: ./myapp~%")

# Execute build
$ chmod +x build.ss
$ ./build.ss
Building MyApp...
Compiling myapp.ss...
Creating boot file...
Creating launcher...
Build complete!
Run with: ./myapp

# Test the application
$ ./myapp --help
MyApp v1.0.0

Usage: myapp [options] [arguments]

Options:
  --help       Show this help message
  --version    Show version information
  --verbose    Enable verbose output

$ ./myapp --verbose file1.txt file2.txt
MyApp v1.0.0

Verbose mode enabled
Processing: file1.txt
  Size: 1234 bytes
  OK
Processing: file2.txt
  Error: file not found

Deployment checklist:

Alternative: Fully static binary:

# For truly standalone binary (no Scheme installation needed)
# Requires Chez Scheme source and static build

# 1. Build Chez with static linking
$ cd ChezScheme
$ ./configure --disable-shared
$ make install

# 2. Create boot file with scheme.boot included
$ echo '(make-boot-file "standalone.boot"
                        (list (scheme-boot-file))
                        "myapp.so")' | scheme

# 3. Create custom executable
# This varies by platform and requires C compilation
# See Chez documentation for platform-specific instructions

# Result: single executable with no dependencies

Workflow Best Practices

Interactive development workflow:

; Recommended REPL-driven development process:

; 1. Start REPL with configuration
$ scheme -q

; 2. Load your code
> (load "mycode.ss")

; 3. Test functions interactively
> (my-function test-input)

; 4. Modify code in editor (keep REPL running)

; 5. Reload modified file
> (load "mycode.ss")

; 6. Test again immediately
> (my-function test-input)

; 7. Repeat steps 4-6 rapidly

; Benefits:
; - Fast iteration
; - Immediate feedback
; - No restart overhead
; - Keep state between reloads (if desired)

Library development workflow:

# Directory structure
project/
  lib/
    mylib.sls           # Library source
  test/
    test-mylib.ss       # Tests
  build.ss              # Build script

# Workflow:

# 1. Edit library
$ vim lib/mylib.sls

# 2. Compile library
$ echo '(compile-library "lib/mylib.sls")' | scheme -q

# 3. Run tests
$ scheme --script test/test-mylib.ss

# 4. Iterate on steps 1-3

# 5. When satisfied, commit changes
$ git add lib/mylib.sls
$ git commit -m "Add new feature"

Makefile-based workflow:

# Makefile for Scheme project

SCHEME = scheme
SOURCES = $(wildcard src/*.ss)
OBJECTS = $(SOURCES:.ss=.so)
LIBS = $(wildcard lib/*.sls)
LIB_OBJECTS = $(LIBS:.sls=.so)

.PHONY: all clean test run

all: $(OBJECTS) $(LIB_OBJECTS) app.boot

# Compile source files
%.so: %.ss
	@echo "Compiling $<..."
	@echo '(optimize-level 3) (compile-file "$<")' | $(SCHEME) -q

# Compile libraries
lib/%.so: lib/%.sls
	@echo "Compiling library $<..."
	@echo '(compile-library "$<")' | $(SCHEME) -q

# Create boot file
app.boot: $(OBJECTS) $(LIB_OBJECTS)
	@echo "Creating boot file..."
	@echo '(make-boot-file "app.boot" (quote ()) "src/main.so")' | $(SCHEME) -q

# Run tests
test: $(OBJECTS) $(LIB_OBJECTS)
	@echo "Running tests..."
	@$(SCHEME) --script test/run-tests.ss

# Run application
run: app.boot
	@$(SCHEME) -q -b app.boot

# Clean compiled files
clean:
	@echo "Cleaning..."
	@rm -f $(OBJECTS) $(LIB_OBJECTS) app.boot
	@rm -f src/*.so lib/*.so

# Development mode (no optimization)
dev:
	@$(MAKE) SCHEME="scheme -q --eval '(optimize-level 0)' --eval"

# Usage
$ make                  # Build everything
$ make test             # Run tests
$ make run              # Run application
$ make clean            # Clean compiled files
$ make dev              # Development build

Common pitfalls to avoid:

; PITFALL 1: Redefining with different signatures
; Don't:
> (define (func x) ...)         ; One parameter
> (define (func x y) ...)       ; Two parameters
; Old callers still use one parameter!

; Do: Restart REPL after signature changes
; Or use different names for experimentation

; PITFALL 2: Depending on load order side effects
; Don't:
; file1.ss:
(define x 10)
; file2.ss:
(define y (* x 2))              ; Depends on x from file1

; Do: Make dependencies explicit
; file2.ss:
(import (mylib))                ; Explicitly import
(define y (* (get-x) 2))

; PITFALL 3: Forgetting to recompile after changes
; Don't:
$ vim mylib.ss                  ; Edit source
$ scheme --script test.ss       ; Still loads old .so!

; Do: Recompile or delete .so files
$ rm mylib.so
$ scheme --script test.ss

; Or enable auto-compilation:
$ scheme --compile-imported-libraries --script test.ss

; PITFALL 4: Mixing development and production settings
; Don't:
(optimize-level 3)
; ... later ...
(load "debug-utils.ss")         ; Needs debug info!

; Do: Set parameters consistently
; Development:
(optimize-level 1)
(debug-level 3)

; Production:
(optimize-level 3)
(debug-level 0)

; PITFALL 5: Not handling exceptions in scripts
; Don't:
#!/usr/bin/env scheme --script
(import (chezscheme))
(process-files (command-line))  ; May fail

; Do: Add error handling
#!/usr/bin/env scheme --script
(import (chezscheme))
(guard (ex
        [else
         (fprintf (current-error-port)
                  "Error: ~a~%" ex)
         (exit 1)])
  (process-files (cdr (command-line))))

Productivity tips:

REPL shortcuts:
- Up/Down arrows: command history
- Ctrl+R: reverse history search
- Ctrl+C: interrupt computation
- Ctrl+D: exit REPL
Helper functions: Define utilities in startup file

; In ~/.schemerc
(define (reload file)
  (load file)
  (printf "Reloaded ~a~%" file))

(define (compile-and-load file)
  (compile-file file)
  (load (path-replace-extension file ".so")))

(define (time-n proc n)
  (time
    (do ([i 0 (+ i 1)])
        ((= i n))
      (proc))))

(define (show x)
  (pretty-print x)
  x)

Keep a scratch file: For quick experiments
Use version control: Commit frequently
Write tests early: Makes iteration faster
Profile before optimizing: Use time to find bottlenecks

Complete project template:

my-project/
  README.md
  LICENSE
  Makefile                      # Build automation
  .gitignore

  src/
    main.ss                     # Entry point
    utils.ss                    # Utilities
    core.ss                     # Core logic

  lib/
    myproject/
      math.sls                  # (myproject math)
      data.sls                  # (myproject data)
      io.sls                    # (myproject io)

  test/
    test-math.ss                # Math tests
    test-data.ss                # Data tests
    test-io.ss                  # I/O tests
    run-all.ss                  # Test runner

  scripts/
    build.ss                    # Build script
    benchmark.ss                # Benchmarks

  compiled/                     # .so files (gitignored)
    lib/
    src/

  docs/
    API.md                      # API documentation
    EXAMPLES.md                 # Usage examples

  app.boot                      # Compiled application (gitignored)
  app                           # Launcher script (gitignored)

Chez Scheme Command Line Options

Basic Invocation

Chez Scheme is invoked from the command line using scheme (full version) or petite (interpreter-only version).

General syntax:

# Start interactive REPL
$ scheme

# Start Petite Chez Scheme (no compiler)
$ petite

# Load files before entering REPL
$ scheme file1.scm file2.scm

# Run a script
$ scheme --script myscript.scm

# Run an R6RS program
$ scheme --program myprogram.scm

Execution Mode Options

--script file runs file as a Scheme shell script.

--program file runs file as an R6RS top-level program.

-q or --quiet suppresses greeting banner and prompts.

Script example:

#! /usr/bin/scheme --script
(display "Hello from script!")
(newline)
(display "Arguments: ")
(display (cdr (command-line)))
(newline)

R6RS program example:

#! /usr/bin/scheme --program
(import (rnrs))

(define (main args)
  (for-each
    (lambda (arg)
      (display arg)
      (newline))
    args))

(main (cdr (command-line)))

You can also use scheme-script as an alias for scheme --program:

#! /usr/bin/env scheme-script
(import (rnrs))
(display "Running as R6RS program")
(newline)

Library Options

--libdirs dir:... — Set library source/object directories.

--libexts ext:... — Set library file extensions.

--compile-imported-libraries — Compile libraries before loading them.

--import-notify — Print messages when searching for libraries.

Directory format uses colons (or semicolons on Windows) as separators:

# Set library directories
$ scheme --libdirs /path/to/libs:/another/path

# Set library extensions
$ scheme --libexts .sls:.scm

# Compile libraries automatically
$ scheme --compile-imported-libraries --program myapp.ss

# Debug library loading
$ scheme --import-notify --program myapp.ss

The source and object directories can be specified separately using double colons:

# source-dir::object-dir format
$ scheme --libdirs ./src::./obj:/usr/lib/scheme

Append to default directories by ending with a colon:

# Add to existing directories (note trailing colon)
$ scheme --libdirs /my/libs:

Optimization and Debugging Options

--optimize-level 0|1|2|3 — Set the optimization level (default: 0).

Levels 0, 1, 2: Safe code with full type and bounds checking
Level 3: Unsafe code, may omit checks for better performance

--debug-on-exception — Enter debugger on uncaught exceptions.

Examples:

# Maximum optimization (unsafe, for production)
$ scheme --optimize-level 3 --program myapp.ss

# Debug a script that's crashing
$ scheme --debug-on-exception --script buggy.ss

# Safe optimization for development
$ scheme --optimize-level 2 --program myapp.ss

When --debug-on-exception is active, exceptions enter the inspector:

$ scheme --debug-on-exception
> (car 5)
Exception in car: 5 is not a pair
Type (debug) to enter the debugger.
debug> i     ; inspect continuation
debug> ?     ; show help
debug> q     ; quit debugger

Expression Editor Options

--eedisable — Disable the expression editor (use plain input).

--eehistory off|file — Set history file location or disable history.

The expression editor provides:

Multi-line expression editing with auto-indentation
Emacs-style key bindings
History across sessions (stored in ~/.chezscheme_history)
Tab completion for identifiers
Parenthesis matching and auto-correction

Examples:

# Disable expression editor (useful for piped input)
$ scheme --eedisable

# Use custom history file
$ scheme --eehistory /tmp/my_history

# Disable history saving
$ scheme --eehistory off

# Piping input (editor auto-disabled)
$ echo '(+ 1 2)' | scheme -q

Boot File Options

-b file or --boot file — Load boot code from specified file.

--verbose — Trace the boot file search process.

Boot files contain compiled Scheme code implementing the system. By default, the system searches for boot files based on the executable name.

Examples:

# Use custom boot file
$ scheme -b /path/to/custom.boot

# Multiple boot files (order matters: dependencies first)
$ scheme -b petite.boot -b scheme.boot -b myapp.boot

# Trace boot file searching
$ scheme --verbose

# Custom application with boot file
$ scheme -b myapp.boot --program main.ss

Creating boot files programmatically:

; Create boot file depending on petite or scheme
(make-boot-file "myapp.boot"
                '("petite" "scheme")  ; alternatives
                "module1.so"
                "module2.so")

; Create standalone boot file (includes petite.boot)
(make-boot-file "standalone.boot"
                '()                    ; no dependencies
                "petite.boot"
                "myapp.so")

Other Options

--version — Print version information and exit.

--help — Print brief help message and exit.

-- — Pass all remaining arguments to Scheme (not processed as options).

--enable-object-counts — Have garbage collector maintain object counts.

--retain-static-relocation — Keep relocation info for compute-size, etc.

Examples:

# Check version
$ scheme --version
Chez Scheme Version 10.0.0

# Pass arguments that look like options to your script
$ scheme --script myapp.ss -- --my-flag --another-flag

# Enable object counting for memory profiling
$ scheme --enable-object-counts

Environment Variables

SCHEMEHEAPDIRS — Colon-separated list of directories to search for boot files.

%v is replaced by the version number
%m is replaced by the machine type
%% is replaced by a literal %

CHEZSCHEMELIBDIRS — Default value for --libdirs if not specified.

CHEZSCHEMELIBEXTS — Default value for --libexts if not specified.

CHEZSCHEME_HISTORY — Location of expression editor history file.

Examples:

# Set boot file search path
export SCHEMEHEAPDIRS="/opt/chez/%v/%m:/usr/lib/csv%v"

# Set default library directories
export CHEZSCHEMELIBDIRS="/home/user/scheme/libs:/usr/local/lib/scheme"

# Set custom history location
export CHEZSCHEME_HISTORY="$HOME/.config/chez_history"

Accessing Command Line Arguments in Scheme

Use (command-line) to get arguments as a list.

The first element is the script/program name, remaining elements are arguments.

Use (command-line-arguments) for just the arguments (Chez-specific).

Example script with argument parsing:

#! /usr/bin/scheme --script

(define args (command-line))

(display "Program: ")
(display (car args))
(newline)

(display "Arguments: ")
(display (cdr args))
(newline)

(display "Argument count: ")
(display (length (cdr args)))
(newline)

; Process arguments
(for-each
  (lambda (arg)
    (cond
      [(string=? arg "--help")
       (display "Usage: myscript [options]")
       (newline)
       (exit 0)]
      [(string=? arg "--verbose")
       (display "Verbose mode enabled")
       (newline)]
      [else
       (display "Unknown argument: ")
       (display arg)
       (newline)]))
  (cdr args))

$ chmod +x myscript.ss
$ ./myscript.ss --verbose foo bar
Program: ./myscript.ss
Arguments: (--verbose foo bar)
Argument count: 3
Verbose mode enabled
Unknown argument: foo
Unknown argument: bar

Quick Reference Table

Option	Description
`-q, --quiet`	Suppress greeting and prompts
`--script file`	Run file as shell script
`--program file`	Run file as R6RS program
`--libdirs dir:...`	Set library directories
`--libexts ext:...`	Set library extensions
`--compile-imported-libraries`	Compile libraries before loading
`--import-notify`	Trace library search
`--optimize-level n`	Set optimization (0-3)
`--debug-on-exception`	Enter debugger on exceptions
`--eedisable`	Disable expression editor
`--eehistory off\|file`	Set/disable history file
`-b, --boot file`	Load boot file
`--verbose`	Trace boot search
`--enable-object-counts`	Enable GC object counting
`--retain-static-relocation`	Keep relocation info
`--version`	Print version and exit
`--help`	Print help and exit
`--`	Pass remaining args to Scheme

R6RS in Chez Scheme

What is R6RS?

R6RS (Revised⁶ Report on the Algorithmic Language Scheme) is a major Scheme standard ratified in 2007.

Key features introduced by R6RS:

Standard library system for modular code
Unicode support for source code and strings
Exception handling and condition system
Record types with procedural and syntactic layers
Bytevectors for binary data
Hash tables
Hygienic macros via syntax-case
Full numeric tower requirement

Chez Scheme fully implements R6RS and its standard libraries.

R6RS Standard Libraries

R6RS organizes functionality into standard libraries that can be imported as needed:

Library	Description
`(rnrs base (6))`	Core language: define, lambda, if, let, etc.
`(rnrs lists (6))`	List operations: find, filter, fold-left, etc.
`(rnrs sorting (6))`	Sorting: list-sort, vector-sort
`(rnrs control (6))`	Control: when, unless, do, case-lambda
`(rnrs io simple (6))`	Simple I/O: read, write, display
`(rnrs io ports (6))`	Port-based I/O: binary/textual ports
`(rnrs files (6))`	File operations: file-exists?, delete-file
`(rnrs unicode (6))`	Unicode: char-upcase, string-normalize-nfc
`(rnrs bytevectors (6))`	Binary data: bytevector operations
`(rnrs hashtables (6))`	Hash tables: make-hashtable, hashtable-ref
`(rnrs records syntactic (6))`	Record definitions via define-record-type
`(rnrs records procedural (6))`	Procedural record creation
`(rnrs records inspection (6))`	Record introspection
`(rnrs conditions (6))`	Condition types for exceptions
`(rnrs exceptions (6))`	Exception handling: guard, raise
`(rnrs syntax-case (6))`	Procedural macros
`(rnrs arithmetic fixnums (6))`	Fixed-precision integer operations
`(rnrs arithmetic flonums (6))`	Floating-point operations
`(rnrs arithmetic bitwise (6))`	Bitwise operations
`(rnrs enums (6))`	Enumeration types
`(rnrs eval (6))`	Evaluation: eval, environment
`(rnrs mutable-pairs (6))`	set-car!, set-cdr!
`(rnrs mutable-strings (6))`	string-set!, string-fill!
`(rnrs programs (6))`	command-line, exit
`(rnrs r5rs (6))`	R5RS compatibility: delay, force, etc.
`(rnrs (6))`	Composite: exports all of the above

The version number (6) can usually be omitted:

; These are equivalent
(import (rnrs base (6)))
(import (rnrs base))

R6RS Top-Level Programs

An R6RS top-level program starts with an import form followed by a body:

#!r6rs
(import (rnrs))

(define (greet name)
  (display "Hello, ")
  (display name)
  (display "!")
  (newline))

(greet "World")

Run with the --program option:

$ scheme --program hello.ss
Hello, World!

Make it executable with a shebang:

#! /usr/bin/scheme --program
(import (rnrs))

(for-each
  (lambda (arg)
    (display arg)
    (newline))
  (cdr (command-line)))

$ chmod +x myprogram.ss
$ ./myprogram.ss arg1 arg2
arg1
arg2

Alternative shebang using env:

#! /usr/bin/env scheme-script
(import (rnrs))
(display "Portable shebang!")
(newline)

R6RS Library Definition

Libraries are defined with the library form:

(library (mylib utils)
  (export square cube average)
  (import (rnrs))

  (define (square x) (* x x))
  (define (cube x) (* x x x))
  (define (average x y) (/ (+ x y) 2)))

Save as mylib/utils.sls (directory structure matches library name).

Use the library in a program:

#!r6rs
(import (rnrs)
        (mylib utils))

(display (square 5))    ; 25
(newline)
(display (cube 3))      ; 27
(newline)

Library with versioning:

(library (mylib math (1 0 0))
  (export factorial fibonacci)
  (import (rnrs))

  (define (factorial n)
    (if (zero? n) 1 (* n (factorial (- n 1)))))

  (define (fibonacci n)
    (if (< n 2) n
        (+ (fibonacci (- n 1))
           (fibonacci (- n 2))))))

Import Specifications

R6RS provides several ways to control imports:

only — import specific identifiers:

(import (only (rnrs) define lambda if))

except — import all except specified:

(import (except (rnrs) set-car! set-cdr!))

prefix — add prefix to all imports:

(import (prefix (rnrs lists) list:))

(list:filter odd? '(1 2 3 4 5))  ; (1 3 5)

rename — rename specific imports:

(import (rename (rnrs)
                (display print)
                (newline nl)))

(print "Hello")
(nl)

Combinations:

(import (prefix (only (rnrs lists) filter map) list:))

(list:map square '(1 2 3))       ; (1 4 9)
(list:filter even? '(1 2 3 4))   ; (2 4)

Export Specifications

Control what a library exports:

Simple export:

(library (mylib)
  (export public-proc another-proc)
  (import (rnrs))

  (define (public-proc x) (helper x))
  (define (another-proc y) (* y 2))
  (define (helper x) (+ x 1)))  ; not exported

Export with renaming:

(library (mylib)
  (export (rename (internal-name external-name)
                  (proc1 public-proc1)))
  (import (rnrs))

  (define (internal-name x) ...)
  (define (proc1 x) ...))

Re-export from another library:

(library (mylib combined)
  (export
    ; Export from this library
    my-func
    ; Re-export from rnrs lists
    (import (rnrs lists)))
  (import (rnrs)
          (rnrs lists))

  (define (my-func x) ...))

R6RS Records

R6RS provides a powerful record system with syntactic and procedural layers.

Syntactic layer (most common):

#!r6rs
(import (rnrs))

; Define a point record
(define-record-type point
  (fields x y))

; Create instances
(define p1 (make-point 3 4))

; Access fields
(point-x p1)    ; 3
(point-y p1)    ; 4

; Type predicate
(point? p1)     ; #t
(point? 42)     ; #f

Mutable fields:

(define-record-type counter
  (fields (mutable value)))

(define c (make-counter 0))
(counter-value c)           ; 0
(counter-value-set! c 10)
(counter-value c)           ; 10

Record inheritance:

(define-record-type point
  (fields x y))

(define-record-type point3d
  (parent point)
  (fields z))

(define p (make-point3d 1 2 3))
(point-x p)      ; 1 (inherited)
(point-y p)      ; 2 (inherited)
(point3d-z p)    ; 3
(point? p)       ; #t
(point3d? p)     ; #t

Custom constructor:

(define-record-type person
  (fields name age)
  (protocol
    (lambda (new)
      (lambda (name birth-year)
        (new name (- 2025 birth-year))))))

(define p (make-person "Alice" 1990))
(person-name p)  ; "Alice"
(person-age p)   ; 35

Nongenerative records (same type across invocations):

(define-record-type point
  (nongenerative point-uid-12345)
  (fields x y))

Sealed and opaque records:

; Sealed: cannot be inherited
(define-record-type final-type
  (sealed #t)
  (fields value))

; Opaque: cannot be inspected
(define-record-type private-type
  (opaque #t)
  (fields secret))

R6RS Exception Handling

R6RS provides guard for exception handling:

#!r6rs
(import (rnrs))

(guard (ex
        [(error? ex)
         (display "Error: ")
         (display (condition-message ex))
         (newline)]
        [(assertion-violation? ex)
         (display "Assertion failed!")
         (newline)]
        [else
         (display "Unknown exception")
         (newline)])
  (assertion-violation 'test "something went wrong"))

Raising exceptions:

; Raise continuable exception
(raise-continuable (make-warning))

; Raise non-continuable exception
(raise (make-error))

; Convenience procedures
(error 'proc-name "message" irritant1 irritant2)
(assertion-violation 'proc-name "message" irritant)

Condition hierarchy (partial):

&condition
├── &warning
├── &serious
│   ├── &error
│   └── &violation
│       ├── &assertion
│       ├── &non-continuable
│       ├── &implementation-restriction
│       ├── &lexical
│       ├── &syntax
│       └── &undefined
├── &message
├── &irritants
└── &who

Creating compound conditions:

(define my-condition
  (condition
    (make-error)
    (make-who-condition 'my-proc)
    (make-message-condition "Something failed")
    (make-irritants-condition '(bad-value))))

(raise my-condition)

Defining custom condition types:

(define-condition-type &my-error &error
  make-my-error my-error?
  (code my-error-code))

(guard (ex
        [(my-error? ex)
         (display "My error with code: ")
         (display (my-error-code ex))])
  (raise (make-my-error 42)))

R6RS Bytevectors

Bytevectors are sequences of bytes for binary data:

#!r6rs
(import (rnrs))

; Create bytevector
(define bv (make-bytevector 10 0))  ; 10 bytes, filled with 0

; Direct creation
(define bv2 #vu8(1 2 3 4 5))

; Access bytes
(bytevector-u8-ref bv2 0)           ; 1
(bytevector-u8-set! bv 0 255)

; Length
(bytevector-length bv2)             ; 5

Multi-byte access with endianness:

; 16-bit access
(bytevector-u16-ref bv 0 (endianness big))
(bytevector-u16-set! bv 0 1000 (endianness little))

; 32-bit access
(bytevector-s32-ref bv 0 (endianness native))

; 64-bit access
(bytevector-u64-ref bv 0 (endianness big))

; Floating point
(bytevector-ieee-single-ref bv 0 (endianness native))
(bytevector-ieee-double-set! bv 0 3.14159 (endianness big))

String conversion:

; UTF-8
(string->utf8 "Hello")           ; #vu8(72 101 108 108 111)
(utf8->string #vu8(72 101 108 108 111))  ; "Hello"

; UTF-16
(string->utf16 "Hello" (endianness big))
(utf16->string bv (endianness little))

; UTF-32
(string->utf32 "Hello" (endianness native))

Bytevector operations:

; Copy
(bytevector-copy bv)
(bytevector-copy! src src-start dst dst-start count)

; Compare
(bytevector=? bv1 bv2)

; Fill
(bytevector-fill! bv 0)

R6RS Hash Tables

R6RS provides standard hash table operations:

#!r6rs
(import (rnrs))

; Create hash tables
(define ht (make-hashtable string-hash string=?))
(define eq-ht (make-eq-hashtable))
(define eqv-ht (make-eqv-hashtable))

; Set and get
(hashtable-set! ht "name" "Alice")
(hashtable-set! ht "age" 30)
(hashtable-ref ht "name" #f)        ; "Alice"
(hashtable-ref ht "missing" 'default) ; default

; Check existence
(hashtable-contains? ht "name")     ; #t

; Delete
(hashtable-delete! ht "age")

; Size
(hashtable-size ht)                 ; 1

Iteration:

; Get keys and values as vectors
(hashtable-keys ht)                 ; #("name")
(hashtable-entries ht)              ; #("name"), #("Alice")

; Process all entries
(let-values ([(keys vals) (hashtable-entries ht)])
  (vector-for-each
    (lambda (k v)
      (display k) (display ": ") (display v) (newline))
    keys vals))

Update operations:

; Update existing or insert
(hashtable-update! ht "count"
  (lambda (v) (+ v 1))
  0)  ; default if not present

; Clear all
(hashtable-clear! ht)

; Copy
(hashtable-copy ht)
(hashtable-copy ht #t)  ; mutable copy

Chez Scheme vs R6RS Mode

Chez Scheme extends R6RS with additional features. Use #!r6rs for strict R6RS mode:

; File starts in R6RS mode
#!r6rs
(import (rnrs))

; Only R6RS syntax allowed here
(define x 10)

Use #!chezscheme to enable Chez extensions:

#!chezscheme
(import (chezscheme))

; Chez-specific features available
(printf "~a~n" "Hello")
(define-syntax my-macro
  (syntax-rules ()
    [(_ x) x]))  ; fenders allowed

The (chezscheme) library provides all R6RS bindings plus Chez extensions:

; (rnrs) is strict R6RS
; (chezscheme) extends R6RS

; Some differences:
; - (chezscheme) syntax-rules allows fenders
; - (chezscheme) current-input-port accepts optional argument
; - (chezscheme) includes additional procedures

Chez also provides R6RS bindings with rnrs: prefix:

(import (chezscheme))

; Both available:
(current-input-port)       ; Chez version (can set port)
(rnrs:current-input-port)  ; Strict R6RS version

Compiling R6RS Programs

Compile libraries:

# Compile a library
$ echo '(compile-library "mylib.sls")' | scheme

# Compile with auto-compilation of dependencies
$ scheme --compile-imported-libraries --program main.ss

Compile top-level programs:

# compile-program preserves shebang line
$ echo '(compile-program "myapp.ss")' | scheme

# Result: myapp.so (compiled program)

Programmatic compilation:

; In REPL or build script
(compile-imported-libraries #t)  ; Auto-compile imports
(compile-library "mylib.sls")
(compile-program "main.ss")

Library search paths:

# Set library directories
$ scheme --libdirs ./src:./lib --program main.ss

# Set via environment
$ export CHEZSCHEMELIBDIRS="./src:./lib"
$ scheme --program main.ss

Portability Tips

R6RS does not guarantee argument evaluation order:

; Don't rely on left-to-right evaluation
(define counter 0)
(define (inc!) (set! counter (+ counter 1)) counter)

; Result is implementation-dependent!
(list (inc!) (inc!) (inc!))  ; Could be (1 2 3) or (3 2 1) etc.

Fixnum range varies by implementation:

; Minimum guaranteed: 24 bits (-8388608 to 8388607)
; Chez Scheme typically: 61 bits on 64-bit systems

; For portable code, use generic arithmetic for large numbers
(+ x y)  ; Always safe
(fx+ x y)  ; May overflow on small fixnum implementations

Specify endianness explicitly for binary data:

; Don't use (endianness native) for files/network
(bytevector-u32-set! bv 0 value (endianness big))  ; Portable

Use #!r6rs at the start of portable code to ensure strict compliance.

Control Flow in Chez Scheme

Conditional Expressions

if is the fundamental conditional:

; Basic if: (if test consequent alternative)
(if (> 5 3) 'yes 'no)           ; yes

; Without alternative (returns unspecified if false)
(if (> 5 3) (display "yes"))

; Nested if
(define (sign n)
  (if (> n 0)
      'positive
      (if (< n 0)
          'negative
          'zero)))

(sign 5)                        ; positive
(sign -3)                       ; negative
(sign 0)                        ; zero

; if is an expression, returns a value
(define abs-val
  (if (< x 0) (- x) x))

cond for multiple conditions:

; (cond [test expr ...] ... [else expr ...])
(define (grade score)
  (cond
    [(>= score 90) 'A]
    [(>= score 80) 'B]
    [(>= score 70) 'C]
    [(>= score 60) 'D]
    [else 'F]))

(grade 85)                      ; B
(grade 55)                      ; F

; cond with => (passes test result to procedure)
(cond
  [(assq 'b '((a 1) (b 2) (c 3))) => cadr]
  [else 'not-found])            ; 2

; Multiple expressions in clause
(cond
  [(even? x)
   (display "even")
   (newline)
   'even]
  [else 'odd])

; cond without else (returns unspecified if no match)
(cond
  [(= x 1) 'one]
  [(= x 2) 'two])

case for value matching:

; (case key [(datum ...) expr ...] ... [else expr ...])
(define (day-type day)
  (case day
    [(saturday sunday) 'weekend]
    [(monday tuesday wednesday thursday friday) 'weekday]
    [else 'unknown]))

(day-type 'saturday)            ; weekend
(day-type 'monday)              ; weekday

; case uses eqv? for comparison
(case (car '(a b))
  [(a) 'first]
  [(b) 'second]
  [else 'other])                ; first

; Multiple values in single clause
(define (vowel? c)
  (case c
    [(a e i o u A E I O U) #t]
    [else #f]))

; case with numeric values
(case (string-length s)
  [(0) 'empty]
  [(1 2 3) 'short]
  [(4 5 6 7 8 9 10) 'medium]
  [else 'long])

Conditional forms comparison:

when and unless for one-sided conditionals:

; when: execute body if test is true
(when (> x 0)
  (display "positive")
  (newline))

; unless: execute body if test is false
(unless (null? lst)
  (display "list is not empty")
  (process lst))

; Equivalent expansions:
; (when test body ...) = (if test (begin body ...))
; (unless test body ...) = (if (not test) (begin body ...))

; Common use cases
(when debug-mode
  (printf "Debug: x = ~a~n" x))

(unless (file-exists? filename)
  (error 'load "file not found" filename))

Boolean operations for control flow:

; and: returns first false value or last value
(and (> 5 3) (< 2 4) 'ok)       ; ok
(and (> 5 3) (< 4 2) 'ok)       ; #f
(and)                           ; #t (identity for and)

; or: returns first true value or last value
(or (> 1 5) (> 3 2) 'fallback)  ; #t
(or #f #f 'default)             ; default
(or)                            ; #f (identity for or)

; Short-circuit evaluation (key feature!)
(and (pair? x) (car x))         ; Safe: car only called if pair
(or (hashtable-ref ht key #f)
    (compute-default key))      ; compute only if not found

; Using and/or for control flow
(define (safe-car x)
  (and (pair? x) (car x)))      ; Returns #f or car

(define (get-or-default ht key default)
  (or (hashtable-ref ht key #f)
      default))

Sequencing

begin evaluates expressions in order:

; Returns the value of the last expression
(begin
  (display "one")
  (newline)
  (display "two")
  (newline)
  'done)                         ; displays "one" and "two", returns done

; Implicit begin in lambda, let, define, cond, etc.
(define (greet name)
  (display "Hello, ")            ; implicit begin in procedure body
  (display name)
  (newline))

; begin is often needed in conditionals
(if (check-condition)
    (begin
      (do-something)
      (do-another-thing)
      result)
    alternative)

; cond clauses have implicit begin
(cond
  [(positive? x)
   (display "positive")          ; multiple expressions OK
   (newline)
   x]
  [else 0])

begin0 returns the first value (Chez extension, but still evaluates all the expressions inside it):

; Returns value of FIRST expression (not last)
(begin0
  (get-result)                   ; This value is returned
  (cleanup)
  (log-completion))

; Useful for cleanup after getting a value
(define (pop! stack-box)
  (begin0
    (car (unbox stack-box))      ; Return the popped value
    (set-box! stack-box (cdr (unbox stack-box)))))

; Compare begin vs begin0
(begin  'a 'b 'c)                ; c (last)
(begin0 'a 'b 'c)                ; a (first)

; Practical example: read and advance
(define (read-next port)
  (begin0
    (read port)                  ; Return what we read
    (skip-whitespace port)))

Sequencing visualization:

Iteration with Named let

Named let creates a local recursive procedure:

; (let name ([var init] ...) body)
(let loop ([i 0])
  (when (< i 5)
    (display i)
    (newline)
    (loop (+ i 1))))
; Prints 0 1 2 3 4

; Equivalent to:
(letrec ([loop (lambda (i)
                 (when (< i 5)
                   (display i)
                   (newline)
                   (loop (+ i 1))))])
  (loop 0))

; Summing a list
(define (sum lst)
  (let loop ([lst lst] [acc 0])
    (if (null? lst)
        acc
        (loop (cdr lst) (+ acc (car lst))))))

(sum '(1 2 3 4 5))              ; 15

; Finding an element
(define (find pred lst)
  (let loop ([lst lst])
    (cond
      [(null? lst) #f]
      [(pred (car lst)) (car lst)]
      [else (loop (cdr lst))])))

Named let patterns:

; Building a result list (accumulator pattern)
(define (my-map f lst)
  (let loop ([lst lst] [acc '()])
    (if (null? lst)
        (reverse acc)
        (loop (cdr lst) (cons (f (car lst)) acc)))))

; Multiple accumulators (partition)
(define (partition pred lst)
  (let loop ([lst lst] [yes '()] [no '()])
    (cond
      [(null? lst)
       (values (reverse yes) (reverse no))]
      [(pred (car lst))
       (loop (cdr lst) (cons (car lst) yes) no)]
      [else
       (loop (cdr lst) yes (cons (car lst) no))])))

(partition even? '(1 2 3 4 5 6))
; Values: (2 4 6) (1 3 5)

; Index tracking
(define (list-index pred lst)
  (let loop ([lst lst] [i 0])
    (cond
      [(null? lst) #f]
      [(pred (car lst)) i]
      [else (loop (cdr lst) (+ i 1))])))

Named let visualization:

The do Loop

do provides traditional loop syntax:

; (do ([<var1> <init1> <step1>] ...)
;     (<test> <result ...>)
;   <body ...>)

; Simple counting loop
(do ([i 0 (+ i 1)])             ; var init step
    [(= i 5) 'done]             ; test result
  (display i)
  (newline))
; Prints 0 1 2 3 4, returns done

; Factorial with do
(define (factorial n)
  (do ([i n (- i 1)]
       [acc 1 (* acc i)])
      [(zero? i) acc]))

(factorial 5)                   ; 120

; Multiple variables with different steps
(do ([i 0 (+ i 1)]
     [j 10 (- j 1)])
    [(= i j) (list i j)]
  (printf "i=~a j=~a~n" i j))
; Prints pairs until i and j meet at 5

do loop structure visualization:

Building results with do:

; Map using do
(define (my-map f lst)
  (do ([lst lst (cdr lst)]
       [result '() (cons (f (car lst)) result)])
      [(null? lst) (reverse result)]))

(my-map (lambda (x) (* x x)) '(1 2 3 4 5))
; (1 4 9 16 25)

; Collect first n elements
(define (take n lst)
  (do ([i 0 (+ i 1)]
       [lst lst (cdr lst)]
       [acc '() (cons (car lst) acc)])
      [(or (= i n) (null? lst))
       (reverse acc)]))

(take 3 '(a b c d e))           ; (a b c)

; Variable without step (unchanged through loop)
(define (repeat-string s n)
  (do ([s s]                     ; No step - s stays same
       [i 0 (+ i 1)]
       [acc "" (string-append acc s)])
      [(= i n) acc]))

(repeat-string "ab" 3)          ; "ababab"

Higher-Order Iteration

for-each for side effects:

; Apply procedure to each element (for side effects)
(for-each display '(1 2 3 4 5))      ; Prints: 12345

(for-each
  (lambda (x) (printf "Item: ~a~n" x))
  '(a b c))
; Item: a
; Item: b
; Item: c

; Multiple lists (stops at shortest)
(for-each
  (lambda (x y) (printf "~a + ~a = ~a~n" x y (+ x y)))
  '(1 2 3)
  '(10 20 30))
; 1 + 10 = 11
; 2 + 20 = 22
; 3 + 30 = 33

; for-each returns unspecified value
; Use map if you need results

map transforms lists:

; Apply procedure and collect results
(map (lambda (x) (* x x)) '(1 2 3 4 5))
; (1 4 9 16 25)

; Multiple lists
(map + '(1 2 3) '(10 20 30))         ; (11 22 33)
(map cons '(a b c) '(1 2 3))         ; ((a . 1) (b . 2) (c . 3))
(map list '(a b c) '(1 2 3) '(x y z))
; ((a 1 x) (b 2 y) (c 3 z))

; Nested map
(map (lambda (row)
       (map (lambda (x) (* x x)) row))
     '((1 2) (3 4) (5 6)))
; ((1 4) (9 16) (25 36))

; Stops at shortest list
(map + '(1 2 3 4 5) '(10 20))        ; (11 22)

Folding operations:

; fold-left: accumulate left to right
; (fold-left <op> <init> <list>)
(fold-left + 0 '(1 2 3 4 5))         ; 15
; Computes: (+ (+ (+ (+ (+ 0 1) 2) 3) 4) 5)

(fold-left cons '() '(1 2 3))        ; ((((() . 1) . 2) . 3)
(fold-left (lambda (acc x) (cons x acc))
           '() '(1 2 3))              ; (3 2 1) - reverse!

; fold-right: accumulate right to left
(fold-right cons '() '(1 2 3))       ; (1 2 3) - copy
; Computes: (cons 1 (cons 2 (cons 3 '())))

(fold-right + 0 '(1 2 3 4 5))        ; 15

; Practical fold examples
(define (my-length lst)
  (fold-left (lambda (acc _) (+ acc 1)) 0 lst))

(define (my-reverse lst)
  (fold-left (lambda (acc x) (cons x acc)) '() lst))

(define (my-append lst1 lst2)
  (fold-right cons lst2 lst1))

(define (my-filter pred lst)
  (fold-right (lambda (x acc)
                (if (pred x) (cons x acc) acc))
              '() lst))

Fold direction visualization:

Filtering and searching:

; filter: keep matching elements
(filter even? '(1 2 3 4 5 6))        ; (2 4 6)
(filter (lambda (x) (> x 3)) '(1 2 3 4 5))
; (4 5)

; remp: remove matching (opposite of filter)
(remp even? '(1 2 3 4 5 6))          ; (1 3 5)

; find: first matching element (or #f)
(find even? '(1 3 4 5 6))            ; 4
(find even? '(1 3 5))                ; #f

; memp: find tail starting with match
(memp even? '(1 3 4 5 6))            ; (4 5 6)

; exists: any element matches? (short-circuits)
(exists even? '(1 3 4 5))            ; #t
(exists even? '(1 3 5))              ; #f

; for-all: all elements match? (short-circuits)
(for-all even? '(2 4 6))             ; #t
(for-all even? '(2 3 4))             ; #f

; partition: split by predicate
(partition even? '(1 2 3 4 5 6))
; Values: (2 4 6) (1 3 5)

Multiple Values

values returns multiple values:

; Return multiple values
(define (quotient-remainder n d)
  (values (quotient n d) (remainder n d)))

(quotient-remainder 17 5)       ; 3 and 2 (two values)

; values with any number of results
(values 1 2 3)                  ; Three values
(values)                        ; Zero values
(values 'single)                ; One value (same as just 'single)

; Built-in procedures returning multiple values
(div-and-mod 17 5)              ; 3 and 2
(exact-integer-sqrt 17)         ; 4 and 1 (sqrt and remainder)
(partition even? '(1 2 3 4))    ; (2 4) and (1 3)

Receiving multiple values:

; call-with-values: low-level interface
(call-with-values
  (lambda () (values 1 2 3))
  (lambda (a b c) (+ a b c)))    ; 6

(call-with-values
  (lambda () (quotient-remainder 17 5))
  (lambda (q r) (list 'quotient q 'remainder r)))
; (quotient 3 remainder 2)

; let-values: convenient syntax
(let-values ([(q r) (quotient-remainder 17 5)])
  (printf "17 = 5 * ~a + ~a~n" q r))
; 17 = 5 * 3 + 2

; Multiple clauses
(let-values ([(a b) (values 1 2)]
             [(x y z) (values 10 20 30)])
  (list a b x y z))             ; (1 2 10 20 30)

; let*-values: sequential binding
(let*-values ([(a b) (values 1 2)]
              [(c) (+ a b)])
  c)                            ; 3

define-values for top-level definitions:

; Define multiple bindings at once
(define-values (min-val max-val)
  (values 0 100))

min-val                         ; 0
max-val                         ; 100

; With rest argument
(define-values (head . tail)
  (values 1 2 3 4 5))

head                            ; 1
tail                            ; (2 3 4 5)

; From procedure call
(define-values (evens odds)
  (partition even? '(1 2 3 4 5 6)))

evens                           ; (2 4 6)
odds                            ; (1 3 5)

Continuations

(call/cc (lambda (k) body)) or (call-with-current-continuation (lambda (k) body)) captures the current continuation:

; call/cc = call-with-current-continuation
; Captures "what to do next" as a procedure

;; Without call/cc - must compute everything
(+ 1 2 (* 3 4))  ; 15

;; With call/cc - can bail out early
(+ 1 2 (call/cc (lambda (escape)
                  (escape 100)      ; Jump out with 100
                  (* 3 4))))        ; This is never executed
;; Returns: 103 (1 + 2 + 100)

;; Normal flow - continuation not called
(call/cc (lambda (k)
           (+ 1 2)))
;; Returns: 3

;; Jump with continuation
(call/cc (lambda (k)
           (k 100)
           (+ 1 2)))  ; Never reached
;; Returns: 100

; Early exit from computation
(define (find-first pred lst)
  (call/cc
    (lambda (return)
      (for-each
        (lambda (x)
          (when (pred x)
            (return x)))        ; Jump out immediately
        lst)
      #f)))                     ; Default if not found

(find-first even? '(1 3 5 4 7))  ; 4
(find-first even? '(1 3 5 7))    ; #f

; Product with early exit on zero
(define (product lst)
  (call/cc
    (lambda (return)
      (let loop ([lst lst] [acc 1])
        (cond
          [(null? lst) acc]
          [(zero? (car lst)) (return 0)]  ; Short-circuit!
          [else (loop (cdr lst) (* acc (car lst)))])))))

(product '(1 2 3 0 4 5))        ; 0 (doesn't multiply 4, 5)

Continuation as first-class value:

Saving and reusing continuations:

; Save continuation for later use
(define saved-k #f)

(+ 1 (call/cc
       (lambda (k)
         (set! saved-k k)
         2)))                   ; 3 (first time)

(saved-k 10)                    ; 11 (continues from capture point)
(saved-k 100)                   ; 101 (can call multiple times)

; Continuation remembers entire context
(let ([x 5])
  (+ x (call/cc
         (lambda (k)
           (set! saved-k k)
           10))))               ; 15

(saved-k 20)                    ; 25 (x is still 5 in that context)

;; --- --- --- --- ---

;; The continuation captures everything from the call/cc point all the way to the "end of the computation" - which could be:
;; - The outermost () in a REPL expression
;; - The end of a function body
;; - The end of a program

;; Step 1: Define a variable to save the continuation
(define saved-k #f)

;; Step 2: Execute the expression with call/cc
(* 2 (+ 3 (call/cc (lambda (k)
                     ;; At this point, k is the continuation
                     ;; k represents: "the rest of the computation"
                     ;; k captures: (* 2 (+ 3 ___))
                     ;; In other words, k is like:
                     ;;   (lambda (v) (* 2 (+ 3 v)))

                     ;; Save the continuation for later use
                     (set! saved-k k)

                     ;; Return 10 as the value
                     ;; This 10 fills the "hole" in (* 2 (+ 3 ___))
                     10))))

;; What happens during execution:
;; 1. call/cc captures the context: (* 2 (+ 3 ___))
;; 2. It creates a continuation k that represents this context
;; 3. The lambda is called with k
;; 4. We save k into saved-k
;; 5. The lambda returns 10
;; 6. The 10 goes into the hole: (* 2 (+ 3 10))
;; 7. Evaluate: (+ 3 10) = 13
;; 8. Evaluate: (* 2 13) = 26
;; Result: 26

;; ============================================
;; Now saved-k holds the continuation
;; ============================================

;; saved-k is essentially this function:
;;   (lambda (v)
;;     (+ 3 v)      ; First, add 3 to the argument
;;     (* 2 ...))   ; Then, multiply the result by 2

;; Or more precisely:
;;   (lambda (v) (* 2 (+ 3 v)))

;; ============================================
;; Calling the saved continuation later
;; ============================================

;; Call 1: Pass 5 to the continuation
(saved-k 5)
;; What happens:
;; 1. saved-k is called with argument 5
;; 2. It does the captured computation: (* 2 (+ 3 5))
;; 3. Evaluate: (+ 3 5) = 8
;; 4. Evaluate: (* 2 8) = 16
;; Result: 16

;; Call 2: Pass 100 to the continuation
(saved-k 100)
;; What happens:
;; 1. saved-k is called with argument 100
;; 2. It does the captured computation: (* 2 (+ 3 100))
;; 3. Evaluate: (+ 3 100) = 103
;; 4. Evaluate: (* 2 103) = 206
;; Result: 206

;; Call 3: Pass 0 to the continuation
(saved-k 0)
;; What happens:
;; 1. saved-k is called with argument 0
;; 2. It does the captured computation: (* 2 (+ 3 0))
;; 3. Evaluate: (+ 3 0) = 3
;; 4. Evaluate: (* 2 3) = 6
;; Result: 6

;; Call 4: Pass -10 to the continuation
(saved-k -10)
;; What happens:
;; 1. saved-k is called with argument -10
;; 2. It does the captured computation: (* 2 (+ 3 -10))
;; 3. Evaluate: (+ 3 -10) = -7
;; 4. Evaluate: (* 2 -7) = -14
;; Result: -14

;; ============================================
;; Visual representation
;; ============================================

;; Original expression:
;;   (* 2 (+ 3 [HOLE]))
;;         ^     ^
;;         |     |
;;         |     The hole where call/cc sits
;;         |
;;         The context that gets captured

;; The continuation k captures "what to do with the value":
;;   1. Take the value
;;   2. Add 3 to it
;;   3. Multiply that by 2
;;   4. Return the final result

Implementing control structures with continuations:

; Simple exception mechanism
(define (with-escape proc)
  (call/cc
    (lambda (escape)
      (proc escape))))

(with-escape
  (lambda (escape)
    (for-each
      (lambda (x)
        (when (negative? x)
          (escape 'found-negative)))
      '(1 2 -3 4 5))
    'all-positive))             ; found-negative

(define (find-first predicate lst)
  (with-escape
    (lambda (return)
      (for-each
        (lambda (x)
          (when (predicate x)
            (return x)))
        lst)
      #f)))  ; Return #f if not found

(find-first even? '(1 3 5 6 7 8))  ; 6
(find-first even? '(1 3 5 7))      ; #f

; Coroutine-style generator
(define (make-generator proc)
  (let ([resume #f])
    (lambda ()
      (call/cc
        (lambda (return)
          (if resume
              (resume 'continue)
              (proc (lambda (value)
                      (call/cc
                        (lambda (k)
                          (set! resume k)
                          (return value)))))))))))

(define counter
  (make-generator
    (lambda (yield)
      (let loop ([i 0])
        (yield i)
        (loop (+ i 1))))))

(counter)                       ; 0
(counter)                       ; 1
(counter)                       ; 2

Dynamic Wind

dynamic-wind ensures cleanup with continuations:

; (dynamic-wind <before> <thunk> <after>)
; <before>: called when entering
; <thunk>: the main body
; <after>: called when exiting (even via continuation!)

(dynamic-wind
  (lambda () (display "entering\n"))
  (lambda () (display "in body\n") 'result)
  (lambda () (display "leaving\n")))
; entering
; in body
; leaving
; Returns: result

; Crucial: <after> runs even if continuation jumps out
(define escape #f)

(dynamic-wind
  (lambda () (printf "open resource~n"))
  (lambda ()
    (call/cc (lambda (k)
                (set! escape k)
                'normal-exit)))
  (lambda () (printf "close resource~n")))
; open resource
; close resource
; Returns: normal-exit

(escape 'jumped)
; open resource    (re-entering!)
; close resource   (leaving again)
; Returns: jumped

Resource management pattern:

; Safe file handling
(define (with-input-file filename proc)
  (let ([port #f])
    (dynamic-wind
      (lambda () (set! port (open-input-file filename)))
      (lambda () (proc port))
      (lambda () (close-input-port port)))))

(with-input-file "data.txt"
  (lambda (port)
    (read port)))

; Even with early exit via continuation, port is closed!
(call/cc
  (lambda (escape)
    (with-input-file "data.txt"
      (lambda (port)
        (escape 'early-exit)))))
; Port properly closed despite jump

; Lock management
(define (with-lock mutex thunk)
  (dynamic-wind
    (lambda () (mutex-acquire mutex))
    thunk
    (lambda () (mutex-release mutex))))

Dynamic wind visualization:

Nesting dynamic-wind:

; Nested resource management
(define level 0)

(define (with-level name thunk)
  (dynamic-wind
    (lambda ()
      (set! level (+ level 1))
      (printf "~a: entering level ~a~n" name level))
    thunk
    (lambda ()
      (printf "~a: leaving level ~a~n" name level)
      (set! level (- level 1)))))

(with-level "outer"
  (lambda ()
    (with-level "inner"
      (lambda ()
        (printf "innermost, level = ~a~n" level)))))
; outer: entering level 1
; inner: entering level 2
; innermost, level = 2
; inner: leaving level 2
; outer: leaving level 1

Exception Handling

guard for structured exception handling:

; (guard (<var> <clause ...>) <body ...>)
(guard (exn
        [(error? exn)
         (display "An error occurred: ")
         (display (condition-message exn))
         (newline)
         'error-result]
        [(assertion-violation? exn)
         'assertion-failed]
        [else
         (raise exn)])           ; Re-raise if not handled
  (risky-operation))

; Practical example
(define (safe-divide a b)
  (guard (exn
          [(and (error? exn)
                (string=? (condition-message exn) "divide by zero"))
           +inf.0]
          [else (raise exn)])
    (/ a b)))

(safe-divide 10 0)              ; +inf.0
(safe-divide 10 2)              ; 5

; Nested guard
(guard (outer [else (display "outer caught it\n")])
  (guard (inner
          [(warning? inner) (display "just a warning\n")])
    (error 'test "something bad")))
; outer caught it

with-exception-handler for low-level handling:

; Handler receives exception, can return or re-raise
(with-exception-handler
  (lambda (exn)
    (display "Handler called\n")
    (display exn)
    (newline)
    (raise exn))                ; Re-raise to outer handler
  (lambda ()
    (error 'test "oops")))

; Handler that recovers
(with-exception-handler
  (lambda (exn)
    'recovered)                 ; Return value continues execution
  (lambda ()
    (raise-continuable 'minor-issue)
    (display "Continued!\n")
    'done))
; Continued!
; done

Exception hierarchy:

Creating and raising conditions:

; Raise simple error
(error 'my-proc "something went wrong")
(error 'my-proc "invalid argument" bad-value)

; Raise assertion violation
(assertion-violation 'my-proc "precondition failed")

; Create compound condition
(raise
  (condition
    (make-error)
    (make-message-condition "File not found")
    (make-irritants-condition (list filename))))

; Check condition types
(guard (c
        [(error? c) 'error]
        [(warning? c) 'warning]
        [(violation? c) 'violation])
  (error 'test "oops"))         ; 'error

; Extract information from conditions
(guard (c
        [(message-condition? c)
         (condition-message c)])
  (error 'test "the message"))  ; "the message"

Non-Local Exit Patterns

Early return from nested loops:

(define (find-in-matrix pred matrix)
  (call/cc
    (lambda (return)
      (for-each
        (lambda (row)
          (for-each
            (lambda (elem)
              (when (pred elem)
                (return elem)))
            row))
        matrix)
      #f)))

(find-in-matrix
  (lambda (x) (> x 10))
  '((1 2 3) (4 5 6) (7 8 15)))   ; 15

(find-in-matrix
  (lambda (x) (> x 100))
  '((1 2 3) (4 5 6)))           ; #f

Simulating break and continue:

; Simulating break
(define (process-until-done lst)
  (call/cc
    (lambda (break)
      (for-each
        (lambda (x)
          (if (eq? x 'stop)
              (break 'stopped)
              (begin
                (printf "Processing: ~a~n" x)
                (process x))))
        lst)
      'completed)))

(process-until-done '(a b stop c d))
; Processing: a
; Processing: b
; Returns: stopped

; Simulating continue
(define (process-skip-negatives lst)
  (for-each
    (lambda (x)
      (call/cc
        (lambda (continue)
          (when (< x 0)
            (printf "Skipping negative: ~a~n" x)
            (continue #f))
          (printf "Processing: ~a~n" x))))
    lst))

Multi-level return:

(define (deep-search tree target)
  (call/cc
    (lambda (found)
      (let search ([tree tree])
        (cond
          [(null? tree) #f]
          [(equal? (car tree) target)
           (found #t)]              ; Immediate exit from any depth
          [(pair? (car tree))
           (search (car tree))
           (search (cdr tree))]
          [else
           (search (cdr tree))]))
      #f)))

(deep-search '(a (b (c d)) (e (f target g))) 'target)
; #t (found deep in structure)

Tail Calls and Optimization

Scheme guarantees proper tail call optimization:

; This will NOT overflow the stack
(define (count-to n)
  (let loop ([i 0])
    (if (= i n)
        'done
        (loop (+ i 1)))))

(count-to 10000000)             ; Works fine!

; Tail recursive factorial
(define (factorial n)
  (let loop ([n n] [acc 1])
    (if (zero? n)
        acc
        (loop (- n 1) (* acc n)))))

; NOT tail recursive (multiplication AFTER recursive call)
(define (factorial-bad n)
  (if (zero? n)
      1
      (* n (factorial-bad (- n 1)))))  ; Will overflow eventually

What is a tail call?

Converting to tail recursive form:

; Non-tail recursive (builds up stack)
(define (sum-list lst)
  (if (null? lst)
      0
      (+ (car lst) (sum-list (cdr lst)))))

; Tail recursive with accumulator
(define (sum-list-tr lst)
  (let loop ([lst lst] [acc 0])
    (if (null? lst)
        acc
        (loop (cdr lst) (+ acc (car lst))))))

; The pattern: add an accumulator parameter
; Original: (f x) => result
; Tail-rec: (f x acc) => acc when done, (f x' acc') otherwise

; More examples
(define (length-tr lst)
  (let loop ([lst lst] [n 0])
    (if (null? lst)
        n
        (loop (cdr lst) (+ n 1)))))

(define (reverse-tr lst)
  (let loop ([lst lst] [acc '()])
    (if (null? lst)
        acc
        (loop (cdr lst) (cons (car lst) acc)))))

Mutual tail recursion:

; Mutually recursive, both in tail position
(define (my-even? n)
  (if (zero? n)
      #t
      (my-odd? (- n 1))))       ; Tail call to odd?

(define (my-odd? n)
  (if (zero? n)
      #f
      (my-even? (- n 1))))      ; Tail call to even?

(my-even? 1000000)              ; #t, no stack overflow

; State machine as mutual recursion
(define (state-a input)
  (if (null? input)
      'accept-a
      (case (car input)
        [(0) (state-b (cdr input))]
        [(1) (state-a (cdr input))])))

(define (state-b input)
  (if (null? input)
      'accept-b
      (case (car input)
        [(0) (state-a (cdr input))]
        [(1) (state-b (cdr input))])))

Fluid Bindings (Parameters)

Parameters provide dynamic scoping:

; Create a parameter
(define current-user (make-parameter "guest"))

(current-user)                  ; "guest"

; Set globally
(current-user "admin")
(current-user)                  ; "admin"

; Set temporarily with parameterize
(parameterize ([current-user "alice"])
  (printf "User: ~a~n" (current-user)))  ; "alice"

(current-user)                  ; "admin" (restored)

; Nested parameterize
(parameterize ([current-user "alice"])
  (printf "Outer: ~a~n" (current-user))
  (parameterize ([current-user "bob"])
    (printf "Inner: ~a~n" (current-user)))
  (printf "Back: ~a~n" (current-user)))
; Outer: alice
; Inner: bob
; Back: alice

Parameters with validation:

; Parameter with guard/filter procedure
(define current-level
  (make-parameter 0
    (lambda (v)
      (unless (and (integer? v) (>= v 0))
        (error 'current-level "must be non-negative integer" v))
      v)))

(current-level 5)               ; OK
(current-level -1)              ; Error!

; Parameter with transformation
(define current-directory
  (make-parameter "."
    (lambda (v)
      (if (string? v)
          (path-normalize v)
          (error 'current-directory "must be string" v)))))

Common built-in parameters:

; I/O parameters
(parameterize ([current-output-port (open-output-string)])
  (display "captured")
  (get-output-string (current-output-port)))

; Print parameters
(parameterize ([print-length 5]
               [print-level 3])
  (pretty-print deeply-nested-structure))

; Compilation parameters
(parameterize ([optimize-level 3]
               [debug-level 0])
  (compile-file "optimized.ss"))

; Useful Chez parameters
(source-directories)            ; Where to find source files
(library-directories)           ; Where to find libraries
(compile-profile)               ; Enable profiling
(collect-request-handler)       ; GC callback

Control Flow Summary

Construct	Purpose	Returns
`if`	Two-way branch	Consequent or alternative
`cond`	Multi-way branch on predicates	First matching clause
`case`	Match against literal values	Matching clause
`when`/`unless`	One-sided conditional	Body or unspecified
`and`/`or`	Short-circuit boolean	First false/true or last
`begin`	Sequence expressions	Last expression
`begin0`	Sequence with first value	First expression
Named `let`	Local recursion/iteration	Final result
`do`	Traditional loop	Result expression
`for-each`	Iterate for side effects	Unspecified
`map`	Transform list(s)	New list
`fold-left`/`fold-right`	Accumulate over list	Accumulated value
`values`	Return multiple values	Multiple values
`let-values`	Bind multiple values	Body result
`call/cc`	Capture continuation	Body or continuation result
`dynamic-wind`	Ensure cleanup	Body result
`guard`	Exception handling	Body or handler result
`parameterize`	Dynamic binding	Body result

Chez Scheme Debugging

Print Debugging with printf

The simplest debugging technique — insert print statements:

; printf works like C's printf but uses ~ instead of %
(define (factorial n)
  (printf "factorial called with n = ~a~n" n)
  (if (zero? n)
      1
      (* n (factorial (- n 1)))))

(factorial 5)
; factorial called with n = 5
; factorial called with n = 4
; factorial called with n = 3
; factorial called with n = 2
; factorial called with n = 1
; factorial called with n = 0
; 120

Common format directives:

Directive	Description
`~a`	Display (human-readable, no quotes on strings)
`~s`	Write (machine-readable, quotes on strings)
`~d`	Decimal integer
`~b`	Binary integer
`~x`	Hexadecimal integer
`~n` or `~%`	Newline
`~~`	Literal tilde

Examples:

(printf "~a~n" "hello")       ; hello
(printf "~s~n" "hello")       ; "hello"
(printf "~d in binary is ~b~n" 42 42)  ; 42 in binary is 101010
(printf "hex: ~x~n" 255)      ; hex: ff

; Multiple values
(printf "x=~a, y=~a, sum=~a~n" 3 4 (+ 3 4))
; x=3, y=4, sum=7

Using format to create strings:

; format returns a string instead of printing
(define msg (format "Value is ~a" 42))
msg  ; "Value is 42"

; Useful for logging
(define (log level msg . args)
  (printf "[~a] ~a~n" level (apply format msg args)))

(log 'INFO "Processing item ~a of ~a" 5 10)
; [INFO] Processing item 5 of 10

Tracing Procedures

trace shows procedure calls and return values:

(define (factorial n)
  (if (zero? n)
      1
      (* n (factorial (- n 1)))))

; Enable tracing
(trace factorial)  ; (factorial)

(factorial 5)
; |(factorial 5)
; | (factorial 4)
; | |(factorial 3)
; | | (factorial 2)
; | | |(factorial 1)
; | | | (factorial 0)
; | | | 1
; | | |1
; | | 2
; | |6
; | 24
; |120
; 120

; Disable tracing
(untrace factorial)

Trace multiple procedures including built-ins:

(trace factorial * -)  ; (factorial * -)

(factorial 3)
; |(factorial 3)
; | (factorial 2)
; | |(factorial 1)
; | | (factorial 0)
; | | 1
; | |(* 1 1)
; | |1
; | (* 2 1)
; | 2
; |(* 3 2)
; |6
; 6

; Untrace specific procedures
(untrace *)            ; (-)

; Untrace all
(untrace)              ; (factorial -)

Check what's being traced:

(trace)  ; Returns list of currently traced procedures

trace-define for inline tracing:

; Automatically traced when defined
(trace-define (sum-list lst)
  (if (null? lst)
      0
      (+ (car lst) (sum-list (cdr lst)))))

(sum-list '(1 2 3))
; |(sum-list (1 2 3))
; | (sum-list (2 3))
; | |(sum-list (3))
; | | (sum-list ())
; | | 0
; | |3
; | 5
; |6
; 6

trace-lambda for anonymous procedures:

(define factorial
  (trace-lambda fact (n)
    (if (zero? n)
        1
        (* n (fact (- n 1))))))

(factorial 4)
; |(fact 4)
; | (fact 3)
; | |(fact 2)
; | | (fact 1)
; | | |(fact 0)
; | | |1
; | | 1
; | |2
; | 6
; |24
; 24

trace-define-syntax for macros:

(trace-define-syntax my-or
  (syntax-rules ()
    [(_) #f]
    [(_ e) e]
    [(_ e1 e2 ...) (let ([t e1]) (if t t (my-or e2 ...)))]))

(my-or #f #f 'found)
; |(my-or (my-or #f #f 'found))
; |(let ((t #f)) (if t t (my-or #f 'found)))
; found

The Debugger

When an error occurs, Chez Scheme suggests entering the debugger:

> (car 5)
Exception in car: 5 is not a pair
Type (debug) to enter the debugger.
>

Enter the debugger with (debug):

> (debug)
debug>

Debugger commands (type to see):

Command	Description
	Show available commands
`i`	Inspect the raise continuation
`c`	Inspect the condition
`s`	Display the condition
`e`	Exit debugger, retain error continuation
`r`	Reset to REPL
`a`	Abort Scheme entirely
`n`	Enter a new café

Typical debugging session:

> (define (my-reverse lst)
    (if (null? lst)
        '()
        (append (my-reverse (cdr lst)) (car lst))))

> (my-reverse '(1 2 3))
Exception in append: 1 is not a proper list
Type (debug) to enter the debugger.

> (debug)
debug> i                    ; Inspect continuation
# :
debug> sf                   ; Show stack frames

The Inspector

After typing i in the debugger, you enter the inspector:

debug> i
# :

Inspector commands for continuations:

Command	Description
	Show commands for current object type
	Show navigation commands
`s` or `show`	Show code and free variables
`sf`	Show stack frames
`d` or `down`	Move down to next frame
`u` or `up`	Move up to previous frame
`r N` or `ref N`	Inspect Nth free variable
`code` or `c`	Inspect the procedure code
`call`	Inspect the pending call
`q` or `quit`	Exit inspector

Inspecting stack frames:

# : sf
0: #
1: #
2: #
3: #
4: #

# : s
continuation: #
procedure code: (lambda (lst) (if (null? lst) ... ...))
call code: (append (my-reverse (cdr lst)) (car lst))
free variables:
  0. lst: (1)

# : d    ; Move to next frame
# : s
free variables:
  0. lst: (2 1)

# : r 0  ; Inspect lst
(2 1) :

Directly inspect any object with inspect:

> (define (square x) (* x x))
> (inspect square)
# : ?
  show(s) .......... show code and free variables
  code(c) .......... inspect the code for the procedure
  ref(r) ........... inspect [nth] free variable
  length(l) ........ display number of free variables

# : c
(lambda (x) (* x x)) :

# : quit
>

Inspector commands for different object types:

; Lists
> (inspect '(1 2 3))
(1 2 3) : ?
  car .............. inspect car of pair
  cdr .............. inspect cdr of pair
  ref(r) ........... inspect [nth] car
  tail ............. inspect [nth] cdr
  show(s) .......... show [n] elements
  length(l) ........ display list length

(1 2 3) : car
1 :

; Vectors
> (inspect #(a b c))
#(a b c) : ref 1
b :

Breakpoints

Insert (break) to pause execution:

(define (process-items items)
  (for-each
    (lambda (item)
      (break)              ; Pause here
      (display item)
      (newline))
    items))

> (process-items '(a b c))
break>                     ; Execution paused

Break handler commands:

Command	Description
	Show options
`e`	Exit break and continue execution
`i`	Inspect current continuation
`r`	Reset to REPL
`a`	Abort Scheme
`n`	Enter new café
`s`	Display statistics

Break with a message:

(define (compute x y)
  (let ([sum (+ x y)]
        [product (* x y)])
    (break 'compute "checking values")
    (list sum product)))

> (compute 3 4)
break in compute: "checking values"
break> i
# : s
free variables:
  0. product: 12
  1. sum: 7
  2. y: 4
  3. x: 3
# : q
break> e              ; Continue execution
(7 12)

Conditional breakpoints:

(define (process n)
  (when (> n 100)        ; Only break on large values
    (break 'process "n is large"))
  (* n 2))

; Or using a helper
(define-syntax break-when
  (syntax-rules ()
    [(_ condition msg)
     (when condition (break 'break-when msg))]))

(define (search lst target)
  (break-when (> (length lst) 1000) "large list")
  (member target lst))

Interrupting Infinite Loops

Press Ctrl-C to interrupt a running computation:

(define (infinite-loop)
  (infinite-loop))

> (infinite-loop)
^C                         ; Press Ctrl-C
break>                     ; Enters break handler

From the break handler, inspect where you are:

break> i                   ; Inspect continuation
# : sf
0: #
1: #
2: #
... many frames ...

# : s
procedure code: (lambda () (infinite-loop))
call code: (infinite-loop)

break> r                   ; Reset to REPL
>

Finding where a loop is stuck:

(define (buggy-find x lst)
  (cond
    [(null? lst) #f]
    [(equal? x (car lst)) #t]
    [else (buggy-find x lst)]))  ; Bug: should be (cdr lst)

> (buggy-find 'z '(a b c))
^C
break> i
# : s
free variables:
  0. lst: (a b c)         ; lst never changes!
  1. x: z

Debug Parameters

debug-on-exception — enter debugger automatically:

; Enable automatic debugging
(debug-on-exception #t)

> (car 5)
Exception in car: 5 is not a pair
debug>                     ; Directly in debugger, no need for (debug)

; From command line
$ scheme --debug-on-exception --script buggy.ss

debug-level — control debug information (0-3):

; Higher levels retain more debug info
(debug-level 3)            ; Maximum debug info (default)
(debug-level 0)            ; Minimal debug info (faster)

; Check current level
(debug-level)              ; Returns current level

generate-inspector-information — control what's saved:

; Disable for production (smaller, faster code)
(parameterize ([generate-inspector-information #f])
  (compile-file "production.ss"))

; Enable for development (better debugging)
(parameterize ([generate-inspector-information #t])
  (compile-file "development.ss"))

debug-condition — access the last exception:

> (car 5)
Exception in car: 5 is not a pair
Type (debug) to enter the debugger.

> (debug-condition)
#

> (condition-message (debug-condition))
"~s is not a pair"

> (condition-irritants (debug-condition))
(5)

Pretty Printing

pretty-print for readable output:

(define complex-data
  '((name . "Alice")
    (scores . (90 85 92 88))
    (address . ((street . "123 Main")
                (city . "Boston")))))

> (write complex-data)
((name . "Alice") (scores 90 85 92 88) (address (street . "123 Main") (city . "Boston")))

> (pretty-print complex-data)
((name . "Alice")
 (scores 90 85 92 88)
 (address
   (street . "123 Main")
   (city . "Boston")))

Control pretty-print behavior:

; Limit depth
(parameterize ([print-level 2])
  (pretty-print '(a (b (c (d (e)))))))
; (a (b (#1=#2#)))

; Limit length
(parameterize ([print-length 3])
  (pretty-print '(1 2 3 4 5 6 7 8 9 10)))
; (1 2 3 ...)

; Both limits
(parameterize ([print-level 2]
               [print-length 5])
  (pretty-print deeply-nested-list))

pretty-format returns a string:

(define formatted (pretty-format '(define (f x) (+ x 1))))
; Returns formatted string instead of printing

Assertions and Contracts

assert for runtime checks:

(define (factorial n)
  (assert (and (integer? n) (>= n 0)))
  (if (zero? n)
      1
      (* n (factorial (- n 1)))))

> (factorial -1)
Exception: failed assertion (and (integer? n) (>= n 0))
Type (debug) to enter the debugger.

> (factorial 5)
120

Custom assertions with better messages:

(define-syntax assert-type
  (syntax-rules ()
    [(_ pred val msg)
     (unless (pred val)
       (assertion-violation 'assert-type msg val))]))

(define (process-list lst)
  (assert-type list? lst "expected a list")
  (map add1 lst))

> (process-list 5)
Exception in assert-type: expected a list
  irritants: 5

Design-by-contract style:

(define (divide x y)
  ; Preconditions
  (assert (number? x))
  (assert (number? y))
  (assert (not (zero? y)))

  (let ([result (/ x y)])
    ; Postcondition
    (assert (number? result))
    result))

Timing and Profiling

time measures execution:

> (time (factorial 10000))
(time (factorial 10000))
    no collections
    0.023756917s elapsed cpu time
    0.023821000s elapsed real time
    134696 bytes allocated
#

statistics for detailed info:

> (statistics)
    0 collections
    no time in collector
    0.156250000s elapsed cpu time
    1.234567000s elapsed real time
    1234567 bytes allocated

Manual timing:

(define (time-it thunk)
  (let ([start (current-time)])
    (let ([result (thunk)])
      (let ([end (current-time)])
        (printf "Elapsed: ~a seconds~n"
                (- (time-second end) (time-second start)))
        result))))

(time-it (lambda () (factorial 50000)))

Profile with profile (Chez-specific):

; Enable profiling
(compile-profile #t)

; Compile with profiling
(compile-file "mycode.ss")

; Run code
(load "mycode.so")
(my-function test-data)

; Show profile
(profile-dump-html "profile.html")

Café System

Chez Scheme uses "cafés" as nested REPL levels:

; One angle bracket = level 1
>

; Enter a new café
> (new-cafe)
>>                         ; Two brackets = level 2

; Exit back to level 1
>> (exit)
>

Each café has its own reset and exit:

> (new-cafe)
>> (new-cafe)
>>>                        ; Level 3

>>> (reset)                ; Reset level 3
>>>

>>> (exit)                 ; Exit to level 2
>>

>> (exit)                  ; Exit to level 1
>

From break/debug, n enters a new café for testing:

> (car 5)
Exception in car: 5 is not a pair
Type (debug) to enter the debugger.

> (debug)
debug> n                   ; New café
>>                         ; Can test things here
>> (+ 1 2)
3
>> (exit)                  ; Return to debug
debug> r                   ; Reset to main REPL
>

Common Debugging Patterns

Debug wrapper for procedures:

(define (debug-wrap name proc)
  (lambda args
    (printf "ENTER ~a: ~s~n" name args)
    (let ([result (apply proc args)])
      (printf "EXIT ~a: ~s~n" name result)
      result)))

(define my-add (debug-wrap 'add +))
> (my-add 1 2 3)
ENTER add: (1 2 3)
EXIT add: 6
6

Conditional debug output:

(define *debug* (make-parameter #f))

(define-syntax debug-print
  (syntax-rules ()
    [(_ fmt args ...)
     (when (*debug*)
       (printf fmt args ...))]))

(define (my-function x)
  (debug-print "Processing ~a~n" x)
  (* x 2))

; Enable debugging
(parameterize ([*debug* #t])
  (my-function 5))
; Processing 5
; 10

; Disable debugging
(my-function 5)
; 10

Safe evaluation for testing:

(define (safe-eval expr)
  (guard (ex
          [else
           (printf "Error: ~a~n" (condition-message ex))
           #f])
    (eval expr)))

> (safe-eval '(+ 1 2))
3
> (safe-eval '(car 5))
Error: ~s is not a pair
#f

Step-by-step execution helper:

(define-syntax step
  (syntax-rules ()
    [(_ label expr)
     (begin
       (printf "~a: ~s~n" label 'expr)
       (let ([result expr])
         (printf "  => ~s~n" result)
         result))]))

(define (calculate x)
  (step "square" (* x x))
  (step "add-one" (+ (* x x) 1))
  (step "final" (sqrt (+ (* x x) 1))))

> (calculate 3)
square: (* x x)
  => 9
add-one: (+ (* x x) 1)
  => 10
final: (sqrt (+ (* x x) 1))
  => 3.1622776601683795
3.1622776601683795

Foreign Interface in Chez Scheme

Subprocess Communication

Chez Scheme provides two ways to interact with external code: subprocess communication and direct foreign procedure calls.

system runs a shell command and waits for completion:

; Run a command, wait for it to finish
(system "ls -la")           ; Returns exit code

; Capture exit status
(let ([status (system "gcc -o myprogram myprogram.c")])
  (if (zero? status)
      (display "Compilation succeeded\n")
      (printf "Compilation failed with code ~a~n" status)))

; On Unix, negative return means signal termination
(system "sleep 100")        ; If killed by SIGTERM, returns -15

open-process-ports creates a subprocess with bidirectional communication:

; Returns 4 values: to-stdin, from-stdout, from-stderr, process-id
(define-values (to-stdin from-stdout from-stderr pid)
  (open-process-ports "cat" 'block (native-transcoder)))

; Write to subprocess
(display "Hello, subprocess!\n" to-stdin)
(flush-output-port to-stdin)

; Read from subprocess
(get-line from-stdout)      ; "Hello, subprocess!"

; Close ports when done
(close-port to-stdin)
(close-port from-stdout)
(close-port from-stderr)

process is a simpler variant returning a list:

; Returns (from-stdout to-stdin process-id)
(define proc (process "bc -l"))
(define from-stdout (car proc))
(define to-stdin (cadr proc))
(define pid (caddr proc))

; Interact with bc calculator
(display "2 + 3\n" to-stdin)
(flush-output-port to-stdin)
(get-line from-stdout)      ; "5"

(display "scale=10; 1/3\n" to-stdin)
(flush-output-port to-stdin)
(get-line from-stdout)      ; ".3333333333"

Using exec prefix for direct execution:

; "exec" causes shell to replace itself with the command
; This reduces subprocess count and gives correct PID
(define-values (in out err pid)
  (open-process-ports "exec python3" 'line (native-transcoder)))

Calling Out of Scheme

foreign-procedure creates a Scheme wrapper for a C function:

; Syntax: (foreign-procedure name (param-types ...) return-type)

; First, load the shared library
(load-shared-object "libc.so.6")  ; Linux
; (load-shared-object "libc.dylib")  ; macOS

; Create wrapper for strlen
(define c-strlen
  (foreign-procedure "strlen" (string) size_t))

(c-strlen "hello")          ; 5

; Create wrapper for getenv
(define c-getenv
  (foreign-procedure "getenv" (string) string))

(c-getenv "HOME")           ; "/home/username"
(c-getenv "NONEXISTENT")    ; #f (null pointer becomes #f)

Common parameter and return types:

Type	Description
`int`, `unsigned`	C int types
`integer-8`, `integer-16`, `integer-32`, `integer-64`	Fixed-size signed integers
`unsigned-8`, `unsigned-16`, `unsigned-32`, `unsigned-64`	Fixed-size unsigned integers
`double-float`, `single-float`	Floating-point types
`boolean`	#f ↔ 0, others ↔ 1
`char`, `wchar_t`	Character types
`string`, `wstring`	Null-terminated strings (UTF-8/wide)
`u8`, `u16`, `u32*`	Bytevector pointers
`void*`, `uptr`, `iptr`	Pointer/address types
`scheme-object`, `ptr`	Raw Scheme object (use carefully)
`void`	No return value
`(* ftype)`	Pointer to foreign type

More examples:

; Math functions
(define c-sin (foreign-procedure "sin" (double) double))
(define c-cos (foreign-procedure "cos" (double) double))
(define c-sqrt (foreign-procedure "sqrt" (double) double))

(c-sin 0.0)                 ; 0.0
(c-sqrt 2.0)                ; 1.4142135623730951

; Memory functions
(define c-malloc (foreign-procedure "malloc" (size_t) void*))
(define c-free (foreign-procedure "free" (void*) void))
(define c-memcpy (foreign-procedure "memcpy" (void* void* size_t) void*))

; System functions
(define c-getpid (foreign-procedure "getpid" () int))
(c-getpid)                  ; Current process ID

Creating procedure templates:

; Template for double -> double functions
(define (make-math-proc name)
  (foreign-procedure name (double) double))

(define sin (make-math-proc "sin"))
(define cos (make-math-proc "cos"))
(define tan (make-math-proc "tan"))
(define log (make-math-proc "log"))
(define exp (make-math-proc "exp"))

Checking if an entry exists:

(foreign-entry? "strlen")   ; #t if available
(foreign-entry? "nonexistent_function")  ; #f

; Get address of entry
(foreign-entry "strlen")    ; Address as exact integer

Calling Into Scheme

foreign-callable creates a C-callable wrapper for a Scheme procedure:

; Syntax: (foreign-callable proc (param-types ...) return-type)

; Create callable wrapper
(define scheme-callback
  (foreign-callable
    (lambda (x y)
      (printf "Scheme received: ~a, ~a~n" x y)
      (+ x y))
    (int int)
    int))

; Lock the code object (prevents garbage collection)
(lock-object scheme-callback)

; Get the entry point address for C code
(define callback-addr
  (foreign-callable-entry-point scheme-callback))

Example: Registering a callback with C code:

; Assume C code with:
; typedef void (*Callback)(char);
; void register_callback(char c, Callback cb);
; void trigger_callbacks(void);

(define register-callback
  (foreign-procedure "register_callback" (char void*) void))

(define trigger-callbacks
  (foreign-procedure "trigger_callbacks" () void))

; Create and register callbacks
(define (make-callback proc)
  (let ([code (foreign-callable proc (char) void)])
    (lock-object code)
    (foreign-callable-entry-point code)))

(define on-a-pressed
  (make-callback
    (lambda (c) (printf "Key 'a' pressed!~n"))))

(define on-b-pressed
  (make-callback
    (lambda (c) (printf "Key 'b' pressed!~n"))))

(register-callback #\a on-a-pressed)
(register-callback #\b on-b-pressed)

Unlocking when no longer needed:

; Convert address back to code object and unlock
(define (free-callback addr)
  (unlock-object
    (foreign-callable-code-object addr)))

; When done with callback
(free-callback on-a-pressed)

Using ftypes for callbacks:

; Define function type
(define-ftype callback-t (function (int int) int))

; Create ftype pointer from Scheme procedure
(define adder-fptr
  (make-ftype-pointer callback-t
    (lambda (x y) (+ x y))))

; Get address (code is auto-locked)
(ftype-pointer-address adder-fptr)

; Unlock when done
(unlock-object
  (foreign-callable-code-object
    (ftype-pointer-address adder-fptr)))

Continuations and Foreign Calls

Chez Scheme allows arbitrary nesting of Scheme and C calls, but continuations require care.

A foreign context becomes "stale" after returning through it:

; Scheme calls C calls Scheme calls C...
; Each C frame creates a "foreign context"

; Safe: Non-local exits (throw upward)
(call/cc
  (lambda (escape)
    (c-function-that-calls-scheme
      (lambda ()
        (escape 'early-exit)))))  ; OK: jumps out

; Dangerous: Returning to stale context
(define saved-k #f)
(c-function-that-calls-scheme
  (lambda ()
    (call/cc (lambda (k) (set! saved-k k)))))
; Later...
(saved-k 'value)  ; BAD: C context is stale!

Resetting C stack with continuations:

; Helper to reset C stack on continuation invocation
(define (with-exit-proc p)
  (define th (lambda () (call/cc p)))
  (define-ftype ->ptr (function () ptr))
  (let ([fptr (make-ftype-pointer ->ptr th)])
    (let ([v ((ftype-ref ->ptr () fptr))])
      (unlock-object
        (foreign-callable-code-object
          (ftype-pointer-address fptr)))
      v)))

; Usage: like call/cc but resets C stack
(with-exit-proc
  (lambda (exit)
    (process-items
      (lambda (item)
        (when (error-item? item)
          (exit 'error))))
    'success))

General rules:

Non-local exits (escape continuations) are always safe
Don't save continuations captured inside C callbacks for later use
If you must use general continuations, reset C stack first

Foreign Data

foreign-alloc and foreign-free manage foreign memory:

; Allocate 100 bytes
(define ptr (foreign-alloc 100))

; Use the memory...

; Free when done
(foreign-free ptr)

foreign-ref and foreign-set! read/write foreign memory:

; Allocate space for an int
(define int-ptr (foreign-alloc (foreign-sizeof 'int)))

; Write value
(foreign-set! 'int int-ptr 0 42)

; Read value
(foreign-ref 'int int-ptr 0)    ; 42

; Different types at different offsets
(define buf (foreign-alloc 24))
(foreign-set! 'integer-32 buf 0 100)
(foreign-set! 'double buf 8 3.14159)
(foreign-set! 'char buf 16 #\A)

(foreign-ref 'integer-32 buf 0)  ; 100
(foreign-ref 'double buf 8)      ; 3.14159
(foreign-ref 'char buf 16)       ; #\A

(foreign-free buf)

foreign-sizeof returns size of types:

(foreign-sizeof 'int)           ; 4 (typically)
(foreign-sizeof 'double)        ; 8
(foreign-sizeof 'void*)         ; 4 or 8 (platform-dependent)
(foreign-sizeof 'char)          ; 1

Defining foreign types with define-ftype:

; Simple struct
(define-ftype Point
  (struct
    [x double]
    [y double]))

(ftype-sizeof Point)            ; 16

; Nested structures
(define-ftype Rectangle
  (struct
    [top-left Point]
    [bottom-right Point]))

; Arrays
(define-ftype IntArray10
  (array 10 int))

; Pointers
(define-ftype PointPtr (* Point))

; Unions
(define-ftype Number
  (union
    [as-int integer-32]
    [as-float single-float]))

; Bit fields
(define-ftype Flags
  (bits
    [enabled unsigned 1]
    [mode unsigned 3]
    [priority unsigned 4]))

Using ftype pointers:

; Allocate and create pointer
(define p
  (make-ftype-pointer Point
    (foreign-alloc (ftype-sizeof Point))))

; Set fields
(ftype-set! Point (x) p 3.0)
(ftype-set! Point (y) p 4.0)

; Get fields
(ftype-ref Point (x) p)         ; 3.0
(ftype-ref Point (y) p)         ; 4.0

; Get address of field
(ftype-&ref Point (x) p)        ; Pointer to x field

; Convert to s-expression for debugging
(ftype-pointer->sexpr p)
; (struct [x 3.0] [y 4.0])

; Free when done
(foreign-free (ftype-pointer-address p))

Complex ftype example:

(define-ftype Person
  (struct
    [name (array 64 char)]
    [age integer-32]
    [height double]
    [next (* Person)]))         ; Linked list

; Allocate
(define person
  (make-ftype-pointer Person
    (foreign-alloc (ftype-sizeof Person))))

; Set fields
(ftype-set! Person (age) person 30)
(ftype-set! Person (height) person 1.75)
(ftype-set! Person (next) person
  (make-ftype-pointer Person 0))  ; null pointer

; Access array elements
(ftype-set! Person (name 0) person #\J)
(ftype-set! Person (name 1) person #\o)
(ftype-set! Person (name 2) person #\e)
(ftype-set! Person (name 3) person #\nul)

Foreign Arrays of Managed Objects

Arrays with pointers to Scheme objects require special care due to garbage collection.

Lock objects that foreign code will reference:

; Create array of Scheme objects for C access
(define (make-object-array objects)
  (let* ([n (length objects)]
         [ptr (foreign-alloc (* n (foreign-sizeof 'ptr)))])
    ; Store and lock each object
    (let loop ([objs objects] [i 0])
      (unless (null? objs)
        (let ([obj (car objs)])
          (lock-object obj)
          (foreign-set! 'ptr ptr (* i (foreign-sizeof 'ptr)) obj))
        (loop (cdr objs) (+ i 1))))
    ptr))

; Free and unlock
(define (free-object-array ptr n)
  (do ([i 0 (+ i 1)])
      ((= i n))
    (let ([obj (foreign-ref 'ptr ptr (* i (foreign-sizeof 'ptr)))])
      (unlock-object obj)))
  (foreign-free ptr))

Using bytevectors for binary data (automatically managed):

; Pass bytevector to C as u8*
(define bv (make-bytevector 100 0))

; C function receiving bytevector
(define fill-buffer
  (foreign-procedure "fill_buffer" (u8* size_t) int))

; Bytevector data is accessible during call
(fill-buffer bv (bytevector-length bv))

; Don't store bv pointer in C across Scheme calls!

Converting between strings and foreign memory:

; String to bytevector (for passing to C)
(define (string->foreign-utf8 str)
  (string->utf8 str))

; Bytevector from C (null-terminated)
(define (foreign-utf8->string bv)
  (let loop ([i 0])
    (if (zero? (bytevector-u8-ref bv i))
        (utf8->string (bytevector-copy bv 0 i))
        (loop (+ i 1)))))

Providing Access to Foreign Procedures

load-shared-object loads dynamic libraries:

; Load system libraries
(case (machine-type)
  [(i3le ti3le a6le ta6le)       ; Linux
   (load-shared-object "libc.so.6")
   (load-shared-object "libm.so.6")]
  [(i3osx ti3osx a6osx ta6osx)   ; macOS
   (load-shared-object "libc.dylib")]
  [(i3nt ti3nt a6nt ta6nt)       ; Windows
   (load-shared-object "msvcrt.dll")])

; Load custom library
(load-shared-object "./mylib.so")

; With path
(load-shared-object "/usr/local/lib/libfoo.so")

Building shared libraries:

# Linux
$ gcc -fPIC -shared -o mylib.so mylib.c

# macOS
$ gcc -dynamiclib -o mylib.dylib mylib.c

# Windows (Visual Studio)
$ cl -c mylib.c
$ link -dll -out:mylib.dll mylib.obj

Export symbols on Windows:

// mylib.c for Windows
#ifdef WIN32
#define EXPORT __declspec(dllexport)
#else
#define EXPORT
#endif

EXPORT int add(int x, int y) {
    return x + y;
}

Registering symbols manually:

; Check if entry exists
(foreign-entry? "my_function")  ; #t or #f

; Get address
(foreign-entry "my_function")   ; Address

; Get name from address
(foreign-address-name addr)     ; "my_function" or #f

; Remove entry (for cleanup)
(remove-foreign-entry "my_function")

Using Other Foreign Languages

Any language that follows C calling conventions can interoperate.

Name mangling considerations:

; C compilers may prepend underscore to names
; Use "=" prefix to bypass name interpretation
(foreign-entry? "foo")      ; May be false
(foreign-entry? "=foo")     ; Check raw name

; For assembly-coded procedures
(foreign-procedure "=_my_asm_proc" (int) int)

Calling conventions (Windows):

; Default (cdecl)
(foreign-procedure "func" (int) int)

; stdcall (Windows API)
(foreign-procedure __stdcall "MessageBoxA"
  (void* string string unsigned-32)
  int)

; COM interface
(foreign-procedure __com 12    ; vtable offset
  (iptr double-float)
  integer-32)

Interfacing with C++:

// C++ code - use extern "C" to disable name mangling
extern "C" {
    int my_function(int x) {
        return x * 2;
    }

    // Create/destroy C++ objects through C interface
    void* create_object() {
        return new MyClass();
    }

    void destroy_object(void* ptr) {
        delete static_cast<MyClass*>(ptr);
    }

    int call_method(void* ptr, int arg) {
        return static_cast<MyClass*>(ptr)->method(arg);
    }
}

; Scheme interface to C++ object
(load-shared-object "./myclass.so")

(define create-object
  (foreign-procedure "create_object" () void*))
(define destroy-object
  (foreign-procedure "destroy_object" (void*) void))
(define call-method
  (foreign-procedure "call_method" (void* int) int))

(define obj (create-object))
(call-method obj 42)
(destroy-object obj)

C Library Routines

Chez Scheme provides C-callable routines via scheme.h:

/* Include Chez Scheme header */
#include "scheme.h"

/* Predicates: check object types */
Sfixnump(obj)       /* Is obj a fixnum? */
Spairp(obj)         /* Is obj a pair? */
Sstringp(obj)       /* Is obj a string? */
Svectorp(obj)       /* Is obj a vector? */
Sprocedurep(obj)    /* Is obj a procedure? */

/* Accessors: extract values */
Sfixnum_value(fixnum)    /* fixnum -> C integer */
Schar_value(char)        /* character -> C char */
Sflonum_value(flonum)    /* flonum -> C double */
Scar(pair)               /* car of pair */
Scdr(pair)               /* cdr of pair */
Sstring_length(str)      /* string length */
Svector_ref(vec, i)      /* vector element */

Constructors:

/* Immediate values */
Snil                     /* Empty list */
Strue                    /* #t */
Sfalse                   /* #f */
Svoid                    /* void */

/* Create Scheme objects */
Sfixnum(n)               /* C int -> fixnum */
Schar(c)                 /* C char -> character */
Sflonum(x)               /* C double -> flonum */
Sstring(s)               /* C string -> Scheme string */
Scons(car, cdr)          /* Create pair */
Sbox(obj)                /* Create box */
Smake_string(n, c)       /* Make string of length n */
Smake_vector(n, obj)     /* Make vector of length n */
Sinteger(n)              /* C int -> exact integer (any size) */
Sstring_to_symbol(s)     /* C string -> symbol */

Calling Scheme from C:

/* Call with 0-3 arguments */
ptr Scall0(ptr proc);
ptr Scall1(ptr proc, ptr arg1);
ptr Scall2(ptr proc, ptr arg1, ptr arg2);
ptr Scall3(ptr proc, ptr arg1, ptr arg2, ptr arg3);

/* General call interface */
void Sinitframe(iptr n);          /* Initialize for n args */
void Sput_arg(iptr i, ptr arg);   /* Set argument i */
ptr Scall(ptr proc, iptr n);      /* Call with n args */

/* Example: call Scheme + from C */
ptr plus = Stop_level_value(Sstring_to_symbol("+"));
ptr result = Scall2(plus, Sfixnum(3), Sfixnum(4));
/* result is Scheme 7 */

Locking objects:

/* Prevent GC from moving/collecting object */
void Slock_object(ptr obj);
void Sunlock_object(ptr obj);

/* Must lock Scheme objects that C code retains
   across calls back into Scheme */
ptr str = Sstring("hello");
Slock_object(str);
/* ... use str, possibly calling Scheme ... */
Sunlock_object(str);

Registering foreign symbols:

/* Make C function visible to Scheme */
void Sforeign_symbol(const char * name, void * addr);
void Sregister_symbol(const char * name, void * addr);

/* Example */
int my_add(int x, int y) { return x + y; }

void init_my_lib(void) {
    Sregister_symbol("my_add", (void*)my_add);
}

Embedding Chez Scheme:

/* Initialize Scheme */
Sscheme_init(NULL);

/* Register boot file */
Sregister_boot_file("petite.boot");
Sregister_boot_file("scheme.boot");

/* Build heap */
Sbuild_heap(NULL, NULL);

/* Run Scheme code */
ptr result = Scall1(
    Stop_level_value(Sstring_to_symbol("eval")),
    Scons(Sstring_to_symbol("+"),
          Scons(Sfixnum(1),
                Scons(Sfixnum(2), Snil))));

/* Cleanup */
Sscheme_deinit();

Example: Socket Operations

C helper code (csocket.c):

/* csocket.c */
#include <sys/types.h>
#include <sys/socket.h>
#include <sys/un.h>
#include <string.h>
#include <errno.h>
#include <unistd.h>
#include <sys/ioctl.h>

/* Write entire buffer, handling interrupts */
int c_write(int fd, char *buf, unsigned n) {
    unsigned i, m;
    m = n;
    while (m > 0) {
        if ((i = write(fd, buf, m)) < 0) {
            if (errno != EAGAIN && errno != EINTR)
                return i;
        } else {
            m -= i;
            buf += i;
        }
    }
    return n;
}

/* Read handling interrupts */
int c_read(int fd, char *buf, unsigned n) {
    int i;
    for (;;) {
        i = read(fd, buf, n);
        if (i >= 0) return i;
        if (errno != EAGAIN && errno != EINTR) return -1;
    }
}

/* Check if data available */
int bytes_ready(int fd) {
    int n;
    ioctl(fd, FIONREAD, &n);
    return n;
}

/* Create Unix domain socket */
int do_socket(void) {
    return socket(AF_UNIX, SOCK_STREAM, 0);
}

/* Bind socket to name */
int do_bind(int s, char * name) {
    struct sockaddr_un sun;
    sun.sun_family = AF_UNIX;
    strcpy(sun.sun_path, name);
    return bind(s, (struct sockaddr*)&sun,
                sizeof(sun.sun_family) + strlen(name) + 1);
}

/* Accept connection */
int do_accept(int s) {
    struct sockaddr_un sun;
    socklen_t len = sizeof(sun);
    return accept(s, (struct sockaddr*)&sun, &len);
}

/* Connect to server */
int do_connect(int s, char * name) {
    struct sockaddr_un sun;
    sun.sun_family = AF_UNIX;
    strcpy(sun.sun_path, name);
    return connect(s, (struct sockaddr*)&sun,
                   sizeof(sun.sun_family) + strlen(name) + 1);
}

/* Get error string */
char* get_error(void) {
    return strerror(errno);
}

Compile the C code:

# Linux
$ gcc -fPIC -shared -o csocket.so csocket.c

# macOS
$ gcc -dynamiclib -o csocket.so csocket.c

Scheme socket interface:

;;; socket.ss

;; Load libraries
(load-shared-object "libc.so.6")  ; or libc.dylib on macOS
(load-shared-object "./csocket.so")

;; Basic C library functions
(define close (foreign-procedure "close" (int) int))
(define dup (foreign-procedure "dup" (int) int))
(define fork (foreign-procedure "fork" () int))
(define listen (foreign-procedure "listen" (int int) int))
(define unlink (foreign-procedure "unlink" (string) int))

;; Socket functions from csocket.c
(define socket (foreign-procedure "do_socket" () int))
(define bind (foreign-procedure "do_bind" (int string) int))
(define accept (foreign-procedure "do_accept" (int) int))
(define connect (foreign-procedure "do_connect" (int string) int))
(define c-read (foreign-procedure "c_read" (int string int) int))
(define c-write (foreign-procedure "c_write" (int string int) int))
(define bytes-ready? (foreign-procedure "bytes_ready" (int) boolean))
(define c-error (foreign-procedure "get_error" () string))

;; Error checking helper
(define (check who x)
  (if (< x 0)
      (errorf who "~a" (c-error))
      x))

;; Set up server socket
(define (setup-server-socket name)
  (let ([sock (check 'socket (socket))])
    (unlink name)
    (check 'bind (bind sock name))
    (check 'listen (listen sock 1))
    sock))

;; Set up client socket
(define (setup-client-socket name)
  (let ([sock (check 'socket (socket))])
    (check 'connect (connect sock name))
    sock))

;; Accept a connection
(define (accept-socket sock)
  (check 'accept (accept sock)))

;; Read from socket
(define (socket-read sock max-bytes)
  (let ([buf (make-string max-bytes)])
    (let ([n (c-read sock buf max-bytes)])
      (if (< n 0)
          (errorf 'socket-read "~a" (c-error))
          (substring buf 0 n)))))

;; Write to socket
(define (socket-write sock str)
  (let ([n (c-write sock str (string-length str))])
    (if (< n 0)
        (errorf 'socket-write "~a" (c-error))
        n)))

Example usage - Echo server:

(load "socket.ss")

(define (run-echo-server socket-name)
  (let ([server-sock (setup-server-socket socket-name)])
    (printf "Server listening on ~a~n" socket-name)
    (let ([client-sock (accept-socket server-sock)])
      (printf "Client connected~n")
      (let loop ()
        (when (bytes-ready? client-sock)
          (let ([data (socket-read client-sock 1024)])
            (unless (string=? data "")
              (printf "Received: ~a" data)
              (socket-write client-sock data)
              (loop)))))
      (close client-sock))
    (close server-sock)
    (unlink socket-name)))

; Run with: (run-echo-server "/tmp/echo.sock")

Example usage - Client:

(load "socket.ss")

(define (run-echo-client socket-name message)
  (let ([sock (setup-client-socket socket-name)])
    (socket-write sock message)
    (let ([response (socket-read sock 1024)])
      (printf "Response: ~a~n" response))
    (close sock)))

; Run with: (run-echo-client "/tmp/echo.sock" "Hello!\n")

Creating a process port (bidirectional communication with subprocess):

;; Create port that wraps socket I/O
(define (make-socket-port sock)
  (define (read! bv start count)
    (let ([buf (make-string count)])
      (let ([n (c-read sock buf count)])
        (do ([i 0 (+ i 1)])
            ((= i n) n)
          (bytevector-u8-set! bv (+ start i)
            (char->integer (string-ref buf i)))))))

  (define (write! bv start count)
    (let ([str (make-string count)])
      (do ([i 0 (+ i 1)])
          ((= i count))
        (string-set! str i
          (integer->char (bytevector-u8-ref bv (+ start i)))))
      (c-write sock str count)))

  (define (close-proc)
    (close sock))

  (make-custom-binary-input/output-port
    "socket-port"
    read!
    write!
    #f      ; get-position
    #f      ; set-position
    close-proc))

Binding Forms in Chez Scheme

Definitions

The define form creates bindings for variables and procedures:

; Variable definition
(define x 42)
(define greeting "Hello, World!")

; Procedure definition (full form)
(define square
  (lambda (x)
    (* x x)))

; Procedure definition (shorthand)
(define (square x)
  (* x x))

; Shorthand with multiple parameters
(define (add a b)
  (+ a b))

; Shorthand with rest parameter
(define (sum . numbers)
  (apply + numbers))

(sum 1 2 3 4 5)             ; 15

; Shorthand with required and rest parameters
(define (format-message prefix . args)
  (apply format prefix args))

let creates local bindings evaluated in parallel:

; Basic let
(let ([x 10]
      [y 20])
  (+ x y))                  ; 30

; Bindings are parallel - can't reference each other
(let ([x 5]
      [y x])                ; ERROR: x not yet bound
  (+ x y))

; Shadowing outer bindings
(define x 100)
(let ([x 1])
  x)                        ; 1 (inner x shadows outer)
x                           ; 100 (outer x unchanged)

let* creates sequential bindings:

; Bindings are sequential - later can reference earlier
(let* ([x 5]
       [y (* x 2)]          ; Can use x
       [z (+ x y)])         ; Can use x and y
  z)                        ; 15

; Equivalent to nested lets
(let ([x 5])
  (let ([y (* x 2)])
    (let ([z (+ x y)])
      z)))

; Useful for step-by-step computation
(let* ([input "  hello world  "]
       [trimmed (string-trim input)]
       [upper (string-upcase trimmed)]
       [words (string-split upper " ")])
  words)                    ; ("HELLO" "WORLD")

letrec creates mutually recursive bindings:

; Mutually recursive procedures
(letrec ([even? (lambda (n)
                  (or (zero? n)
                      (odd? (- n 1))))]
         [odd? (lambda (n)
                 (and (not (zero? n))
                      (even? (- n 1))))])
  (list (even? 10) (odd? 10)))  ; (#t #f)

; Self-recursive procedure
(letrec ([factorial
          (lambda (n)
            (if (zero? n)
                1
                (* n (factorial (- n 1)))))])
  (factorial 5))            ; 120

; All bindings in scope for all right-hand sides
(letrec ([a (lambda () (b))]
         [b (lambda () 42)])
  (a))                      ; 42

letrec* combines letrec semantics with left-to-right evaluation:

; Guaranteed left-to-right evaluation
(letrec* ([x 1]
          [y (+ x 1)]       ; Can reference x's value
          [z (+ y 1)])      ; Can reference y's value
  (list x y z))             ; (1 2 3)

; Useful when initialization order matters
(letrec* ([counter 0]
          [inc! (lambda ()
                  (set! counter (+ counter 1))
                  counter)]
          [first (inc!)]    ; Evaluated first
          [second (inc!)])  ; Evaluated second
  (list first second counter))  ; (1 2 2)

Binding evaluation order visualization:

Named let for recursive iteration:

; Named let creates a recursive procedure
(let factorial ([n 5] [acc 1])
  (if (zero? n)
      acc
      (factorial (- n 1) (* n acc))))  ; 120

; Equivalent to:
(letrec ([factorial (lambda (n acc)
                 (if (zero? n)
                     acc
                     (factorial (- n 1) (* n acc))))])
  (factorial 5 1))

; List processing with named let
(let factorial ([lst '(1 2 3 4 5)] [sum 0])
  (if (null? lst)
      sum
      (factorial (cdr lst) (+ sum (car lst)))))  ; 15

; Building a result list
(let factorial ([n 5] [result '()])
  (if (zero? n)
      result
      (factorial (- n 1) (cons n result))))  ; (1 2 3 4 5)

Multiple-value Definitions

define-values binds multiple variables from a multiple-value expression:

; Basic define-values
(define-values (quotient remainder)
  (div-and-mod 17 5))

quotient                    ; 3
remainder                   ; 2

; From partition
(define-values (evens odds)
  (partition even? '(1 2 3 4 5 6)))

evens                       ; (2 4 6)
odds                        ; (1 3 5)

; Multiple return values from custom procedure
(define (min-max lst)
  (values (apply min lst)
          (apply max lst)))

(define-values (lo hi)
  (min-max '(3 1 4 1 5 9 2 6)))

lo                          ; 1
hi                          ; 9

let-values creates local multiple-value bindings:

; Basic let-values
(let-values ([(q r) (div-and-mod 17 5)])
  (printf "~a with remainder ~a~n" q r))

; Multiple clauses
(let-values ([(a b) (values 1 2)]
             [(x y z) (values 10 20 30)])
  (+ a b x y z))            ; 63

; Combining with regular values (use extra parens)
(let-values ([(q r) (div-and-mod 100 7)]
             [(name) (values "test")])
  (list name q r))          ; ("test" 14 2)

; Single value (equivalent to let)
(let-values ([(x) (values 42)])
  x)                        ; 42

let*-values for sequential multiple-value bindings:

; Sequential binding - later can reference earlier
(let*-values ([(a b) (values 2 3)]
              [(c) (values (* a b))]
              [(d e) (values (+ c 1) (- c 1))])
  (list a b c d e))         ; (2 3 6 7 5)

; Useful for chained transformations
(define (parse-and-validate input)
  (let*-values ([(parsed ok?) (parse input)]
                [(validated valid?)
                 (if ok?
                     (validate parsed)
                     (values #f #f))])
    (values validated (and ok? valid?))))

Multiple values flow visualization:

Using (call-with-values <producer> <consumer>) directly:

; Explicit call-with-values
(call-with-values
  (lambda () (values 1 2 3))
  (lambda (a b c) (+ a b c)))  ; 6

; Equivalent let-values
(let-values ([(a b c) (values 1 2 3)])
  (+ a b c))                ; 6

; Useful for inline value handling
(call-with-values
  (lambda () (partition even? '(1 2 3 4 5)))
  (lambda (evens odds)
    (printf "Evens: ~a, Odds: ~a~n" evens odds)))

Patterns with multiple values:

; Ignoring some values
(let-values ([(_ remainder) (div-and-mod 17 5)])
  remainder)                ; 2

; Collecting extra values with rest
(define (first-and-rest producer)
  (call-with-values producer
    (lambda (first . rest)
      (values first rest))))

(first-and-rest (lambda () (values 1 2 3 4)))
; Returns: 1 and (2 3 4)

; Zero values
(let-values ([() (values)])  ; No bindings
  'done)                     ; done

; Handling unknown number of values
(call-with-values
  (lambda () (values 1 2 3 4 5))
  list)                     ; (1 2 3 4 5)

Recursive Bindings

letrec allows procedures to reference themselves and each other:

; Self-reference
(letrec ([count-down
          (lambda (n)
            (if (zero? n)
                'done
                (begin
                  (printf "~a~n" n)
                  (count-down (- n 1)))))])
  (count-down 3))
; Prints: 3 2 1
; Returns: done

; Mutual recursion
(letrec ([ping (lambda (n)
                 (if (zero? n)
                     'ping
                     (pong (- n 1))))]
         [pong (lambda (n)
                 (if (zero? n)
                     'pong
                     (ping (- n 1))))])
  (list (ping 5) (pong 5)))  ; (pong ping)

Mutual recursion visualization:

State machines with letrec:

; Simple state machine for parsing numbers
(define (parse-number str)
  (letrec
    ([start (lambda (chars)
              (cond
                [(null? chars) #f]
                [(char=? (car chars) #\-)
                 (digits (cdr chars) '() #t)]
                [(char-numeric? (car chars))
                 (digits chars '() #f)]
                [else #f]))]
     [digits (lambda (chars acc neg?)
               (cond
                 [(null? chars)
                  (if (null? acc)
                      #f
                      (let ([n (string->number
                                 (list->string (reverse acc)))])
                        (if neg? (- n) n)))]
                 [(char-numeric? (car chars))
                  (digits (cdr chars) (cons (car chars) acc) neg?)]
                 [else #f]))])
    (start (string->list str))))

(parse-number "123")        ; 123
(parse-number "-456")       ; -456
(parse-number "abc")        ; #f

rec for single self-recursive bindings:

; rec creates single recursive binding
(define factorial
  (rec fact
    (lambda (n)
      (if (zero? n)
          1
          (* n (fact (- n 1)))))))

(factorial 5)               ; 120

; Useful for anonymous recursive procedures
(map (rec sum-tree
       (lambda (tree)
         (if (pair? tree)
             (+ (sum-tree (car tree))
                (sum-tree (cdr tree)))
             (if (number? tree) tree 0))))
     '((1 2) (3 (4 5)) ((6))))
; (3 12 6)

; rec is essentially:
; (rec name expr) = (letrec ([name expr]) name)

Internal definitions (implicitly letrec*):

; Internal defines in procedure body
(define (process-tree tree)
  ; These are like letrec* bindings
  (define (leaf? x) (not (pair? x)))
  (define (process-node node)
    (if (leaf? node)
        (handle-leaf node)
        (handle-branch node)))
  (define (handle-leaf x) (* x 2))
  (define (handle-branch node)
    (cons (process-node (car node))
          (process-node (cdr node))))
  ; Body starts here
  (process-node tree))

(process-tree '(1 (2 3) 4))  ; (2 (4 6) 8)

; Internal defines can reference later definitions
(define (example)
  (define (a) (b))          ; References b defined below
  (define (b) 42)
  (a))

(example)                   ; 42

Avoiding evaluation order issues:

; Problematic: referencing value during initialization
(letrec ([x (+ y 1)]        ; ERROR: y not yet initialized
         [y 5])
  x)

; Solution 1: use lambda to delay evaluation
(letrec ([x (lambda () (+ (y) 1))]
         [y (lambda () 5)])
  ((x)))                    ; 6

; Solution 2: use letrec* with proper order
(letrec* ([y 5]
          [x (+ y 1)])
  x)                        ; 6

; Rule of thumb:
; - letrec: for mutually recursive PROCEDURES
; - letrec*: when you need ordered VALUE initialization
; - let/let*: when recursion isn't needed

Fluid Bindings

Parameters provide dynamically-scoped (fluid) bindings:

; Create a parameter with initial value
(define current-user (make-parameter "guest"))

; Access current value
(current-user)              ; "guest"

; Set globally
(current-user "admin")
(current-user)              ; "admin"

; Dynamic binding with parameterize
(parameterize ([current-user "alice"])
  (current-user))           ; "alice"

(current-user)              ; "admin" (restored)

Dynamic vs lexical scope visualization:

parameterize creates dynamic extent bindings:

; Dynamic scope in action
(define current-indent (make-parameter 0))

(define (print-indented msg)
  (display (make-string (current-indent) #\space))
  (display msg)
  (newline))

(define (print-tree tree)
  (cond
    [(pair? tree)
     (print-indented "(")
     (parameterize ([current-indent (+ (current-indent) 2)])
       (for-each print-tree tree))
     (print-indented ")")]
    [else
     (print-indented tree)]))

(print-tree '(a (b c) d))
; (
;   a
;   (
;     b
;     c
;   )
;   d
; )

Parameter validation with guard procedures:

; Parameter with validation
(define current-verbosity
  (make-parameter 0
    (lambda (v)
      (unless (and (integer? v) (<= 0 v 3))
        (error 'current-verbosity
               "must be integer 0-3, got ~s" v))
      v)))

(current-verbosity 2)       ; OK
(current-verbosity 5)       ; ERROR: must be integer 0-3

; Parameter with transformation
(define current-output-file
  (make-parameter "output.txt"
    (lambda (v)
      (if (string? v)
          v
          (format "~a.txt" v)))))

(current-output-file 'data)
(current-output-file)       ; "data.txt"

; Parameter that normalizes input
(define current-path
  (make-parameter "."
    (lambda (p)
      (path-normalize p))))

Nested and multiple parameter bindings:

; Multiple parameters
(define debug-mode (make-parameter #f))
(define trace-calls (make-parameter #f))

(parameterize ([debug-mode #t]
               [trace-calls #t])
  (when (trace-calls)
    (display "Tracing enabled\n"))
  (when (debug-mode)
    (display "Debug mode\n")))

; Nested parameterize
(define level (make-parameter 0))

(parameterize ([level 1])
  (printf "Level: ~a~n" (level))    ; 1
  (parameterize ([level 2])
    (printf "Level: ~a~n" (level))) ; 2
  (printf "Level: ~a~n" (level)))   ; 1

; Parameters restored even on error
(define p (make-parameter 'initial))

(guard (c [else 'caught])
  (parameterize ([p 'temporary])
    (error 'test "oops")))

(p)                         ; 'initial (restored)

Parameters and continuations:

; Parameters are saved/restored with continuations
(define p (make-parameter 'initial))

(define saved-k #f)

(parameterize ([p 'inside])
  (call/cc (lambda (k)
             (set! saved-k k)
             (p))))              ; 'inside

(p)                             ; 'initial

; Re-entering the parameterize restores the binding
(saved-k 'ignored)              ; 'inside

; dynamic-wind ensures proper parameter handling
(define log-output (make-parameter '()))

(define (with-logging thunk)
  (parameterize ([log-output '()])
    (thunk)
    (reverse (log-output))))

(define (log msg)
  (log-output (cons msg (log-output))))

Common built-in parameters:

; I/O parameters
(current-input-port)
(current-output-port)
(current-error-port)

(parameterize ([current-output-port (open-output-string)])
  (display "captured")
  (get-output-string (current-output-port)))  ; "captured"

; Print parameters
(print-level)               ; Max nesting depth to print
(print-length)              ; Max list elements to print

(parameterize ([print-length 3])
  (printf "~s~n" '(1 2 3 4 5)))  ; (1 2 3 ...)

; Compilation parameters
(optimize-level)            ; 0-3
(debug-level)               ; 0-3
(compile-interpret-simple)  ; #t/#f

; Other useful parameters
(interaction-environment)   ; Current REPL environment
(source-directories)        ; Where to find source files
(library-directories)       ; Where to find libraries

Top-Level Bindings

Top-level define creates or modifies bindings:

; Create new binding
(define x 10)

; Redefine (modify) existing binding
(define x 20)

; Top-level defines are mutable
(set! x 30)

; Procedure definitions at top level
(define (greet name)
  (printf "Hello, ~a!~n" name))

; Top-level vs local semantics
; At top-level, define can redefine
; In local scope, define creates new binding

top-level-value and set-top-level-value! for programmatic access:

; Get value of top-level binding
(define x 42)
(top-level-value 'x)        ; 42

; Set top-level binding
(set-top-level-value! 'y 100)
y                           ; 100

; Check if bound
(top-level-bound? 'x)       ; #t
(top-level-bound? 'nonexistent)  ; #f

; Dynamic binding creation
(define (create-binding name value)
  (set-top-level-value! name value))

(create-binding 'dynamic-var 999)
dynamic-var                 ; 999

; Useful for REPL utilities and metaprogramming
(define (show-binding name)
  (if (top-level-bound? name)
      (printf "~a = ~s~n" name (top-level-value name))
      (printf "~a is unbound~n" name)))

define-top-level-value for explicit top-level definition:

; Explicitly define at top level (even from nested context)
(let ([x 10])
  (define-top-level-value 'from-let (* x 2)))

from-let                    ; 20

; Useful in macros that need to create top-level bindings
(define-syntax def-constant
  (syntax-rules ()
    [(_ name value)
     (define-top-level-value 'name value)]))

(def-constant PI 3.14159)
PI                          ; 3.14159

Interaction environment bindings:

; The interaction environment contains REPL bindings
(interaction-environment)   ; Returns the environment

; Evaluate in specific environment
(define env (interaction-environment))

(eval '(define z 50) env)
(eval 'z env)               ; 50

; Create new environment (copy of scheme-environment)
(define my-env (copy-environment (scheme-environment)))
(eval '(define private 42) my-env)

; private visible in my-env but not globally
(eval 'private my-env)      ; 42
; private                   ; ERROR: unbound in interaction-environment

; Environment hierarchy
(scheme-environment)        ; Built-in bindings
(interaction-environment)   ; REPL bindings (includes scheme-environment)

alias creates alternative names for bindings:

; Create an alias (both names refer to same binding)
(define original-name 42)
(alias new-name original-name)

new-name                    ; 42
(set! new-name 100)
original-name               ; 100 (same binding!)

; Alias for imported procedure
(alias λ lambda)
(define add (λ (x y) (+ x y)))
(add 3 4)                   ; 7

; Alias for keyword
(alias fn define)
(fn (square x) (* x x))
(square 5)                  ; 25

; Note: alias creates true alias, not copy
; Modifying one affects the other

Top-level syntax definitions:

; Define syntax at top level
(define-syntax when
  (syntax-rules ()
    [(_ test body ...)
     (if test (begin body ...))]))

; Syntax is also a top-level binding
(top-level-bound? 'when)    ; #t

; But top-level-value doesn't work for syntax
; (top-level-value 'when)   ; ERROR: not a variable

; Check if identifier is bound to syntax
(top-level-syntax? 'when)   ; #t
(top-level-syntax? 'car)    ; #f (car is a procedure)

; Redefining syntax
(define-syntax my-if
  (syntax-rules ()
    [(_ test then else)
     (if test then else)]))

; Later, can redefine
(define-syntax my-if
  (syntax-rules ()
    [(_ test then else)
     (cond [test then] [else else])]))

Forward references at top level:

; Top-level allows forward references
(define (f x) (g x))        ; References g not yet defined
(define (g x) (* x 2))      ; Now defined
(f 21)                      ; 42

; This works because:
; 1. define creates a binding location
; 2. The lambda body isn't evaluated until f is called
; 3. By then, g is defined

; Be careful with immediate evaluation
; (define a (+ b 1))        ; ERROR: b not defined
; (define b 10)

; Solution: use thunks or proper ordering
(define b 10)
(define a (+ b 1))          ; OK now

; Or use a thunk for delayed evaluation
(define a-thunk (lambda () (+ b 1)))
(define b 10)
(a-thunk)                   ; 11

Additional Binding Forms

fluid-let for temporary mutation (deprecated, prefer parameters):

; fluid-let temporarily changes a variable's value
(define counter 0)

(fluid-let ([counter 100])
  (set! counter (+ counter 1))
  counter)                  ; 101

counter                     ; 0 (restored)

; Warning: fluid-let has issues with:
; - Continuations (may not restore properly)
; - Multiple threads (race conditions)

; Prefer make-parameter and parameterize instead:
(define counter-param (make-parameter 0))

(parameterize ([counter-param 100])
  (counter-param (+ (counter-param) 1))
  (counter-param))          ; 101

(counter-param)             ; 0 (properly restored)

let-syntax and letrec-syntax for local macros:

; Local syntax binding
(let-syntax ([swap!
              (syntax-rules ()
                [(_ a b)
                 (let ([tmp a])
                   (set! a b)
                   (set! b tmp))])])
  (define x 1)
  (define y 2)
  (swap! x y)
  (list x y))               ; (2 1)

; swap! not visible outside the let-syntax

; letrec-syntax for mutually recursive macros
(letrec-syntax
  ([my-or
    (syntax-rules ()
      [(_) #f]
      [(_ e) e]
      [(_ e1 e2 ...)
       (let ([t e1])
         (if t t (my-or e2 ...)))])]
   [my-and
    (syntax-rules ()
      [(_) #t]
      [(_ e) e]
      [(_ e1 e2 ...)
       (if e1 (my-and e2 ...) #f)])])
  (my-and (my-or #f 1) (my-or 2 #f)))  ; 2

case-lambda for variable arity:

; Different bodies for different arities
(define greet
  (case-lambda
    [() (greet "World")]
    [(name) (printf "Hello, ~a!~n" name)]
    [(greeting name) (printf "~a, ~a!~n" greeting name)]))

(greet)                     ; "Hello, World!"
(greet "Alice")             ; "Hello, Alice!"
(greet "Goodbye" "Bob")     ; "Goodbye, Bob!"

; With rest arguments
(define sum
  (case-lambda
    [() 0]
    [(x) x]
    [(x y) (+ x y)]
    [(x y . rest) (apply + x y rest)]))

(sum)                       ; 0
(sum 1)                     ; 1
(sum 1 2)                   ; 3
(sum 1 2 3 4 5)             ; 15

; Efficient dispatch based on argument count
(define make-point
  (case-lambda
    [(x y) (cons x y)]
    [(x y z) (vector x y z)]))

receive for multiple values (SRFI-8 style):

; receive binds multiple values more concisely
; (not built-in, but commonly defined)
(define-syntax receive
  (syntax-rules ()
    [(_ formals expr body ...)
     (call-with-values
       (lambda () expr)
       (lambda formals body ...))]))

(receive (q r) (div-and-mod 17 5)
  (printf "~a remainder ~a~n" q r))

; With rest parameter
(receive (first . rest) (values 1 2 3 4)
  (list first rest))        ; (1 (2 3 4))

; More concise than let-values for simple cases
(receive (a b c) (values 1 2 3)
  (+ a b c))                ; 6

do for iterative binding:

; do combines binding with iteration
(do ([i 0 (+ i 1)]          ; (var init step)
     [sum 0 (+ sum i)])     ; Multiple variables
    [(>= i 5) sum]          ; (test result)
  ; Optional body (side effects)
  (printf "i=~a sum=~a~n" i sum))
; Prints: i=0 sum=0, i=1 sum=0, i=2 sum=1, ...
; Returns: 10

; Building a list
(do ([i 5 (- i 1)]
     [lst '() (cons i lst)])
    [(zero? i) lst])        ; (1 2 3 4 5)

; Without step (variable unchanged)
(do ([x 10]                 ; No step = unchanged
     [i 0 (+ i 1)])
    [(>= i 3) x])           ; 10

Binding Forms Comparison

Form	Scope	Evaluation	Use Case
`define`	Top-level or local	Immediate	Variables and procedures
`let`	Local (lexical)	Parallel	Independent bindings
`let*`	Local (lexical)	Sequential	Dependent bindings
`letrec`	Local (lexical)	Recursive	Mutually recursive procedures
`letrec*`	Local (lexical)	Sequential + recursive	Recursive with order guarantees
`let-values`	Local (lexical)	Parallel	Multiple value bindings
`let*-values`	Local (lexical)	Sequential	Chained multiple values
`define-values`	Top-level or local	Immediate	Multiple value definitions
`parameterize`	Dynamic	For dynamic extent	Fluid/dynamic bindings
`let-syntax`	Local (lexical)	Compile-time	Local macros
`letrec-syntax`	Local (lexical)	Compile-time	Mutually recursive local macros
`case-lambda`	N/A (creates procedure)	Immediate	Multi-arity procedures
`do`	Local (lexical)	Iterative	Loop with bindings

Decision tree for choosing binding forms:

Best practices for binding forms:

; 1. Use the simplest form that works
(let ([x 1] [y 2]) ...)     ; Prefer over let* when order doesn't matter

; 2. Use let* for step-by-step transformations
(let* ([raw (read-input)]
       [parsed (parse raw)]
       [validated (validate parsed)])
  (process validated))

; 3. Use letrec only for recursive procedures
(letrec ([f (lambda (n) ...)])   ; Good: f calls itself
  ...)

; 4. Use internal defines for cleaner code
(define (process data)
  (define (helper x) ...)   ; Cleaner than letrec
  (define (another y) ...)
  (helper (another data)))

; 5. Prefer parameters over fluid-let
(define config (make-parameter default-config))
(parameterize ([config special-config])
  (do-work))                ; Safe with continuations

; 6. Use case-lambda for optional arguments
(define greet
  (case-lambda
    [() (greet "World")]
    [(name) (printf "Hello, ~a!~n" name)]))

; 7. Named let for simple loops
(let loop ([lst items] [acc '()])
  (if (null? lst)
      (reverse acc)
      (loop (cdr lst) (cons (f (car lst)) acc))))

Control Structures in Chez Scheme

Conditionals

and and or with short-circuit evaluation:

; and returns first false value or last value
(and #t #t #t)              ; #t
(and #t #f #t)              ; #f
(and 1 2 3)                 ; 3
(and)                       ; #t

; Short-circuit: stops at first false
(and (pair? x)
     (number? (car x))
     (> (car x) 0))         ; Safe - checks pair? first

; or returns first true value or last value
(or #f #f #t)               ; #t
(or #f #f #f)               ; #f
(or 1 2 3)                  ; 1
(or #f 'default)            ; default
(or)                        ; #f

; Short-circuit: stops at first true
(or (cached-value key)
    (compute-expensive-value key))

; Default values pattern
(define (greet name)
  (printf "Hello, ~a!~n" (or name "World")))

(greet "Alice")             ; Hello, Alice!
(greet #f)                  ; Hello, World!

; Validation chains
(define (valid-input? x)
  (and (string? x)
       (> (string-length x) 0)
       (< (string-length x) 100)
       (string-alphabetic? x)))

not and boolean conversions:

; not negates boolean
(not #f)                    ; #t
(not #t)                    ; #f
(not '())                   ; #f (only #f is false)
(not 0)                     ; #f (only #f is false)

; Double negation for boolean conversion
(not (not 'anything))       ; #t
(not (not #f))              ; #f

; Explicit boolean check
(define (boolean-value x)
  (if x #t #f))

; In Scheme, only #f is false
(if '() 'true 'false)       ; true
(if 0 'true 'false)         ; true
(if "" 'true 'false)        ; true

exclusive-cond (Chez extension) for exhaustive cases:

; exclusive-cond requires exactly one clause to match
; Useful for ensuring complete case coverage

(define (classify n)
  (exclusive-cond
    [(negative? n) 'negative]
    [(zero? n) 'zero]
    [(positive? n) 'positive]))

; Raises exception if no clause matches or multiple match

Mapping and Folding

map variants and andmap/ormap:

; andmap - like for-all but returns last value
(andmap even? '(2 4 6))     ; #t
(andmap values '(1 2 3))    ; 3

; ormap - like exists but returns the actual value
(ormap (lambda (x) (and (even? x) x))
       '(1 3 5 6 7))        ; 6

; vector-map for vectors
(vector-map add1 '#(1 2 3 4))
; #(2 3 4 5)

(vector-map + '#(1 2 3) '#(10 20 30))
; #(11 22 33)

; string-map for strings (character by character)
(define (string-map proc str)
  (list->string
    (map proc (string->list str))))

; hash table mapping
(define ht (make-eq-hashtable))
(hashtable-set! ht 'a 1)
(hashtable-set! ht 'b 2)

(vector-map
  (lambda (k) (cons k (hashtable-ref ht k #f)))
  (hashtable-keys ht))

List comprehension patterns:

; Cartesian product
(define (cartesian-product lst1 lst2)
  (apply append
    (map (lambda (x)
           (map (lambda (y) (list x y))
                lst2))
         lst1)))

(cartesian-product '(a b) '(1 2 3))
; ((a 1) (a 2) (a 3) (b 1) (b 2) (b 3))

; Filter-map (map + filter)
(define (filter-map proc lst)
  (fold-right
    (lambda (x acc)
      (let ([result (proc x)])
        (if result
            (cons result acc)
            acc)))
    '()
    lst))

(filter-map (lambda (x)
              (and (even? x) (* x 2)))
            '(1 2 3 4 5))   ; (4 8)

; Zip multiple lists
(define (zip . lists)
  (apply map list lists))

(zip '(1 2 3) '(a b c) '(x y z))
; ((1 a x) (2 b y) (3 c z))

; Enumerate with index
(define (enumerate lst)
  (let loop ([lst lst] [i 0])
    (if (null? lst)
        '()
        (cons (cons i (car lst))
              (loop (cdr lst) (+ i 1))))))

(enumerate '(a b c))        ; ((0 . a) (1 . b) (2 . c))

Continuations

call/cc (call-with-current-continuation) captures control:

; Basic call/cc
(call/cc
  (lambda (k)
    (+ 1 (k 42))))          ; 42 (jumps out, skipping + 1)

; Early exit from recursion
(define (find-first pred lst)
  (call/cc
    (lambda (return)
      (for-each
        (lambda (x)
          (when (pred x)
            (return x)))
        lst)
      #f)))

(find-first even? '(1 3 5 6 7 8))  ; 6

; The continuation represents "the rest of the computation"
(+ 1 (call/cc (lambda (k) (* 2 (k 3)))))
; k is "add 1 to the result"
; (k 3) means "add 1 to 3" = 4

Saving and reusing continuations:

; Store continuation for later use
(define saved-k #f)

(+ 1 (call/cc
       (lambda (k)
         (set! saved-k k)
         2)))               ; 3

; Resume the computation with different value
(saved-k 10)                ; 11
(saved-k 100)               ; 101

; Continuations can be called multiple times
(define (make-generator lst)
  (define current lst)
  (lambda ()
    (call/cc
      (lambda (return)
        (for-each
          (lambda (x)
            (call/cc
              (lambda (resume)
                (set! current resume)
                (return x))))
          current)
        (return 'done)))))

(define gen (make-generator '(1 2 3)))
(gen)                       ; 1
(gen)                       ; 2
(gen)                       ; 3
(gen)                       ; done

Implementing control structures with continuations:

; Return (early exit)
(define (process-items items)
  (call/cc
    (lambda (return)
      (for-each
        (lambda (item)
          (when (error-item? item)
            (return 'error))
          (process item))
        items)
      'success)))

; Break and continue for loops
(define-syntax while-break
  (syntax-rules ()
    [(_ test body ...)
     (call/cc
       (lambda (break)
         (let loop ()
           (when test
             body ...
             (loop)))))]))

; Exception-like behavior
(define (with-exception-handler handler thunk)
  (call/cc
    (lambda (k)
      (let ([raise (lambda (exn) (k (handler exn)))])
        (thunk raise)))))

(with-exception-handler
  (lambda (e) (printf "Error: ~a~n" e) 'error)
  (lambda (raise)
    (raise "something went wrong")
    'never-reached))

call/1cc for one-shot continuations:

; call/1cc creates a one-shot continuation (more efficient)
(call/1cc
  (lambda (k)
    (k 42)))                ; 42

; One-shot means it can only be called once
(define one-shot-k #f)

(call/1cc
  (lambda (k)
    (set! one-shot-k k)
    'initial))              ; initial

(one-shot-k 'resumed)       ; resumed
; (one-shot-k 'again)       ; ERROR: already used

; Use call/1cc when you only need escape continuation
(define (find-first-1cc pred lst)
  (call/1cc
    (lambda (return)
      (for-each
        (lambda (x)
          (when (pred x) (return x)))
        lst)
      #f)))

dynamic-wind for guaranteed cleanup:

; (dynamic-wind before thunk after)
; before and after run on entry/exit, even with continuations

(dynamic-wind
  (lambda () (display "entering\n"))
  (lambda () (display "body\n") 42)
  (lambda () (display "leaving\n")))
; Prints: entering, body, leaving
; Returns: 42

; Resource management
(define (with-file filename proc)
  (let ([port #f])
    (dynamic-wind
      (lambda () (set! port (open-input-file filename)))
      (lambda () (proc port))
      (lambda () (close-port port)))))

(with-file "data.txt"
  (lambda (port)
    (get-line port)))

; Re-entry also triggers before/after
(define k #f)
(dynamic-wind
  (lambda () (printf "enter~n"))
  (lambda ()
    (call/cc (lambda (c) (set! k c)))
    (printf "body~n"))
  (lambda () (printf "exit~n")))
; First: enter, body, exit

(k 'resume)
; Re-entry: enter, body, exit

Continuation marks (for stack inspection):

; Continuation marks attach data to continuations
(define trace-key (make-continuation-mark-key 'trace))

(define (traced-call name thunk)
  (with-continuation-mark trace-key name
    (thunk)))

(define (get-trace)
  (continuation-mark-set->list
    (current-continuation-marks)
    trace-key))

(traced-call 'outer
  (lambda ()
    (traced-call 'middle
      (lambda ()
        (traced-call 'inner
          (lambda ()
            (get-trace)))))))
; (inner middle outer)

; Useful for debugging, profiling, dynamic scope

let/cc and let/1cc shorthand:

; Chez provides convenient shorthand
(let/cc k
  (+ 1 (k 42)))             ; 42

; Equivalent to:
(call/cc (lambda (k) (+ 1 (k 42))))

; One-shot version
(let/1cc k
  (when (problem?)
    (k 'error))
  'success)

; Common idiom: early return
(define (validate data)
  (let/cc return
    (unless (list? data)
      (return "must be a list"))
    (unless (> (length data) 0)
      (return "must be non-empty"))
    (unless (for-all number? data)
      (return "must contain only numbers"))
    #t))

Coroutines with continuations:

; Simple coroutine implementation
(define (make-coroutine proc)
  (let ([local-cont #f]
        [resume-cont #f])

    (define (yield value)
      (call/cc
        (lambda (k)
          (set! local-cont k)
          (resume-cont value))))

    (define (resume value)
      (call/cc
        (lambda (k)
          (set! resume-cont k)
          (if local-cont
              (local-cont value)
              (proc yield)))))

    resume))

; Usage
(define counter
  (make-coroutine
    (lambda (yield)
      (let loop ([n 0])
        (yield n)
        (loop (+ n 1))))))

(counter 'start)            ; 0
(counter 'next)             ; 1
(counter 'next)             ; 2

Engines

Engines provide timed preemption for computations:

; (make-engine thunk) creates an engine
; An engine is a computation with a fuel limit

(define eng
  (make-engine
    (lambda ()
      (let loop ([n 0])
        (loop (+ n 1))))))  ; Infinite loop

; Run engine with fuel (ticks)
; Returns via complete or expire procedure
(eng 1000
     (lambda (ticks value)     ; complete: finished with fuel left
       (printf "Completed with ~a ticks, value: ~a~n" ticks value))
     (lambda (new-engine)      ; expire: ran out of fuel
       (printf "Expired, can resume~n")
       new-engine))

; The engine mechanism:
; - Allocate fuel (ticks)
; - Run until fuel exhausted or computation completes
; - If expired, get new engine to continue

Basic engine usage:

; Engine that completes
(define eng1
  (make-engine
    (lambda ()
      (+ 1 2 3))))

(eng1 100
      (lambda (ticks val)
        (printf "Done! Result: ~a, Remaining: ~a~n" val ticks))
      (lambda (e)
        (printf "Expired~n")))
; Done! Result: 6, Remaining: ~90

; Engine that needs more fuel
(define eng2
  (make-engine
    (lambda ()
      (let loop ([n 0] [sum 0])
        (if (= n 1000000)
            sum
            (loop (+ n 1) (+ sum n)))))))

; May need multiple runs
(define (run-to-completion engine fuel)
  (engine fuel
          (lambda (ticks value)
            (printf "Complete: ~a~n" value)
            value)
          (lambda (new-engine)
            (printf "Continuing...~n")
            (run-to-completion new-engine fuel))))

(run-to-completion eng2 10000)

Implementing timeouts with engines:

; Run computation with timeout
(define (with-timeout fuel thunk default)
  ((make-engine thunk)
   fuel
   (lambda (ticks value) value)
   (lambda (engine) default)))

; Examples
(with-timeout 1000
              (lambda () (+ 1 2 3))
              'timeout)     ; 6

(with-timeout 100
              (lambda ()
                (let loop () (loop)))
              'timeout)     ; timeout

; Timeout with continuation for resumption
(define (with-timeout/resume fuel thunk)
  (let ([result #f]
        [remaining-engine #f])
    ((make-engine thunk)
     fuel
     (lambda (ticks value)
       (set! result (cons 'complete value)))
     (lambda (engine)
       (set! result 'expired)
       (set! remaining-engine engine)))
    (values result remaining-engine)))

Nested engines:

; Engines can be nested
(define outer-engine
  (make-engine
    (lambda ()
      (define inner-engine
        (make-engine
          (lambda ()
            (let loop ([n 0])
              (if (= n 100)
                  'inner-done
                  (loop (+ n 1)))))))

      ; Run inner engine with portion of outer's fuel
      (inner-engine 50
                    (lambda (t v) (cons 'inner-complete v))
                    (lambda (e) 'inner-expired)))))

; Timer ticks are shared hierarchically
(outer-engine 200
              (lambda (t v) (printf "Outer complete: ~a~n" v))
              (lambda (e) (printf "Outer expired~n")))

Engine-based round-robin scheduler:

; Simple cooperative multitasking
(define (make-scheduler quantum)
  (let ([ready-queue '()])

    (define (add-task thunk)
      (set! ready-queue
            (append ready-queue
                    (list (make-engine thunk)))))

    (define (run)
      (unless (null? ready-queue)
        (let ([current (car ready-queue)])
          (set! ready-queue (cdr ready-queue))
          (current quantum
                   (lambda (ticks value)
                     (printf "Task completed: ~a~n" value)
                     (run))
                   (lambda (new-engine)
                     (set! ready-queue
                           (append ready-queue (list new-engine)))
                     (run))))))

    (values add-task run)))

; Usage
(define-values (add-task run-scheduler)
  (make-scheduler 100))

(add-task (lambda () (printf "Task 1 running~n") 'task1))
(add-task (lambda () (printf "Task 2 running~n") 'task2))
(add-task (lambda ()
            (let loop ([n 3])
              (when (> n 0)
                (printf "Task 3 iteration ~a~n" n)
                (loop (- n 1))))
            'task3))

(run-scheduler)

engine-block for voluntary yielding:

; engine-block causes immediate expiration
(define yielding-engine
  (make-engine
    (lambda ()
      (printf "Phase 1~n")
      (engine-block)        ; Yield to scheduler
      (printf "Phase 2~n")
      (engine-block)
      (printf "Phase 3~n")
      'done)))

; Each run does one phase
(define (step engine)
  (engine 1000000           ; Plenty of fuel
          (lambda (t v) (printf "Complete: ~a~n" v) #f)
          (lambda (e) (printf "Yielded~n") e)))

(define e1 (step yielding-engine))  ; Phase 1, Yielded
(define e2 (step e1))               ; Phase 2, Yielded
(define e3 (step e2))               ; Phase 3, Complete: done

engine-return for early completion:

; engine-return immediately completes with value
(define early-exit-engine
  (make-engine
    (lambda ()
      (let loop ([n 0])
        (when (= n 50)
          (engine-return 'found-it))
        (loop (+ n 1))))))

(early-exit-engine 10000
                   (lambda (t v) (printf "Result: ~a~n" v))
                   (lambda (e) (printf "Expired~n")))
; Result: found-it

Timed computations with engines:

; Benchmark with fixed fuel
(define (benchmark-ticks fuel thunk)
  (let ([start-fuel fuel])
    ((make-engine thunk)
     fuel
     (lambda (remaining-ticks value)
       (values value (- start-fuel remaining-ticks)))
     (lambda (engine)
       (values 'incomplete fuel)))))

(let-values ([(result ticks) (benchmark-ticks 10000
                                               (lambda ()
                                                 (fold-left + 0
                                                            (iota 1000))))])
  (printf "Result: ~a, Ticks used: ~a~n" result ticks))

; Adaptive execution - run until consistent result
(define (stable-compute thunk max-fuel tolerance)
  (let loop ([fuel 100])
    (if (> fuel max-fuel)
        'no-stable-result
        (let-values ([(r1 t1) (benchmark-ticks fuel thunk)]
                     [(r2 t2) (benchmark-ticks fuel thunk)])
          (if (and (not (eq? r1 'incomplete))
                   (not (eq? r2 'incomplete))
                   (equal? r1 r2))
              r1
              (loop (* fuel 2)))))))

Comparing engines with threads:

Feature	Engines	Threads
Preemption	Tick-based (deterministic)	Time-based (non-deterministic)
Scheduling	Explicit in Scheme	OS/runtime managed
Parallelism	None (cooperative)	True parallelism possible
State sharing	Sequential access	Concurrent (needs synchronization)
Debugging	Deterministic, reproducible	Race conditions possible
Use case	Timeouts, simulation, fair scheduling	I/O parallelism, CPU parallelism

Delayed Evaluation

delay and force for lazy evaluation:

; delay creates a promise
(define p (delay (begin (display "Computing!") (+ 1 2))))
; Nothing printed yet

; force evaluates the promise
(force p)                   ; Prints "Computing!", returns 3
(force p)                   ; Returns 3 (cached, no recomputation)

; Lazy infinite sequences
(define (integers-from n)
  (cons n (delay (integers-from (+ n 1)))))

(define naturals (integers-from 0))

(car naturals)              ; 0
(car (force (cdr naturals))) ; 1
(car (force (cdr (force (cdr naturals))))) ; 2

; Take from lazy list
(define (take-lazy n lazy-list)
  (if (zero? n)
      '()
      (cons (car lazy-list)
            (take-lazy (- n 1) (force (cdr lazy-list))))))

(take-lazy 10 naturals)     ; (0 1 2 3 4 5 6 7 8 9)

Streams (SRFI-41 style):

; Stream primitives
(define-syntax stream-cons
  (syntax-rules ()
    [(_ a b) (cons a (delay b))]))

(define stream-car car)
(define (stream-cdr s) (force (cdr s)))
(define stream-null '())
(define stream-null? null?)

; Infinite stream of ones
(define ones (stream-cons 1 ones))

; Fibonacci stream
(define fibs
  (stream-cons 0
    (stream-cons 1
      (let loop ([a 0] [b 1])
        (let ([c (+ a b)])
          (stream-cons c (loop b c)))))))

; Stream operations
(define (stream-take n s)
  (if (or (zero? n) (stream-null? s))
      '()
      (cons (stream-car s)
            (stream-take (- n 1) (stream-cdr s)))))

(define (stream-filter pred s)
  (cond
    [(stream-null? s) stream-null]
    [(pred (stream-car s))
     (stream-cons (stream-car s)
                  (stream-filter pred (stream-cdr s)))]
    [else (stream-filter pred (stream-cdr s))]))

(stream-take 10 fibs)       ; (0 1 1 2 3 5 8 13 21 34)
(stream-take 5 (stream-filter even? fibs))  ; (0 2 8 34 144)

Memoization patterns:

; Simple memoization with delay
(define (memoize thunk)
  (let ([promise (delay (thunk))])
    (lambda () (force promise))))

; Memoized expensive computation
(define expensive
  (memoize
    (lambda ()
      (display "Computing expensive result...")
      (newline)
      (fold-left + 0 (iota 1000000)))))

(expensive)                 ; Computes first time
(expensive)                 ; Returns cached value

; Memoization with arguments
(define (memoize-proc proc)
  (let ([cache (make-hashtable equal-hash equal?)])
    (lambda args
      (let ([cached (hashtable-ref cache args 'not-found)])
        (if (eq? cached 'not-found)
            (let ([result (apply proc args)])
              (hashtable-set! cache args result)
              result)
            cached)))))

(define fib
  (memoize-proc
    (lambda (n)
      (if (< n 2)
          n
          (+ (fib (- n 1)) (fib (- n 2)))))))

(fib 100)                   ; Fast due to memoization

Operations on Objects in Chez Scheme

Missing R6RS Type Predicates

Chez Scheme provides additional type predicates beyond R6RS:

; Atom predicate (not a pair)
(atom? 'x)                  ; #t
(atom? 5)                   ; #t
(atom? '())                 ; #t
(atom? '(a b))              ; #f

; List predicates
(list? '(1 2 3))            ; #t
(list? '(1 . 2))            ; #f (improper list)
(list? '())                 ; #t

; Proper list check (terminates with null)
(proper-list? '(1 2 3))     ; #t (from Chez, not in all Schemes)

; Chez-specific gensym predicate
(gensym? (gensym))          ; #t
(gensym? 'regular)          ; #f

; Mutable vs immutable
(mutable-string? (string #\a #\b))  ; #t
(immutable-string? "hello")         ; #t (literal strings)
(mutable-vector? (vector 1 2 3))    ; #t
(mutable-bytevector? (make-bytevector 10))  ; #t

Numeric type predicates:

; Fixnum - small exact integers (fast)
(fixnum? 42)                ; #t
(fixnum? (expt 2 100))      ; #f (bignum)

; Bignum - arbitrary precision integers
(bignum? (expt 2 100))      ; #t
(bignum? 42)                ; #f

; Ratnum - exact rationals
(ratnum? 3/4)               ; #t
(ratnum? 0.75)              ; #f (flonum)

; Flonum - floating point
(flonum? 3.14)              ; #t
(flonum? 3)                 ; #f

; Cflonum - complex with flonum parts
(cflonum? 1.0+2.0i)         ; #t
(cflonum? 1+2i)             ; #f (exact complex)

; Fixnum range
(greatest-fixnum)           ; Platform dependent (e.g., 1152921504606846975)
(least-fixnum)              ; Platform dependent (e.g., -1152921504606846976)
(fixnum-width)              ; Usually 61 on 64-bit systems

Port and procedure predicates:

; Port predicates
(port? (current-input-port))         ; #t
(input-port? (current-input-port))   ; #t
(output-port? (current-output-port)) ; #t
(binary-port? (open-bytevector-input-port #vu8()))  ; #t
(textual-port? (current-input-port)) ; #t

; Procedure predicates
(procedure? car)            ; #t
(procedure? (lambda (x) x)) ; #t
(procedure? 'car)           ; #f

; Code object (compiled procedure)
(code? (closure-code car))  ; #t

; Continuation predicates
(continuation? (call/cc values))  ; #t

Record and ftype predicates:

; General record predicate
(record? (make-point 1 2))  ; #t (if point is a record type)

; Record-type descriptor
(record-type-descriptor? (record-rtd some-record))  ; #t

; Ftype pointer
(ftype-pointer? ptr)        ; #t if ftype pointer

; Condition predicates (from exception system)
(condition? (make-who-condition 'test))  ; #t
(who-condition? (make-who-condition 'test))  ; #t

Miscellaneous predicates:

; Eq-hashtable vs general hashtable
(eq-hashtable? (make-eq-hashtable))       ; #t
(hashtable? (make-eq-hashtable))          ; #t
(hashtable? (make-hashtable equal-hash equal?))  ; #t

; Box predicate
(box? (box 42))             ; #t
(box? 42)                   ; #f

; Weak pair
(weak-pair? (weak-cons 'a 'b))  ; #t
(weak-pair? (cons 'a 'b))       ; #f

; Ephemeron
(ephemeron-pair? (ephemeron-cons 'key 'value))  ; #t

; Thread predicates
(thread? (fork-thread (lambda () #t)))  ; #t (in threaded Chez)
(mutex? (make-mutex))       ; #t
(condition? (make-condition))  ; #t (thread condition, not exception)

Pairs and Lists

Basic pair operations:

; Construction
(cons 'a 'b)                ; (a . b)
(cons 1 (cons 2 (cons 3 '())))  ; (1 2 3)

; Access
(car '(a b c))              ; a
(cdr '(a b c))              ; (b c)

; Mutation
(define p (cons 1 2))
(set-car! p 10)
p                           ; (10 . 2)
(set-cdr! p 20)
p                           ; (10 . 20)

; Composition accessors
(caar '((a b) c))           ; a
(cadr '(a b c))             ; b
(cdar '((a b) c))           ; (b)
(cddr '(a b c))             ; (c)

; Up to four levels
(caaddr '(a (b (c d))))     ; c
(cddddr '(1 2 3 4 5 6))     ; (5 6)

List construction:

; list creates a proper list
(list 1 2 3)                ; (1 2 3)
(list)                      ; ()
(list 'a (+ 1 2) "hello")   ; (a 3 "hello")

; list* creates improper list (last element is cdr)
(list* 1 2 3)               ; (1 2 . 3)
(list* 1 2 '(3 4))          ; (1 2 3 4)
(list* 'a)                  ; a

; cons* is alias for list*
(cons* 1 2 3 '())           ; (1 2 3)

; make-list creates list of repeated elements
(make-list 5 'x)            ; (x x x x x)
(make-list 3 0)             ; (0 0 0)

; iota creates numeric sequence (Chez extension)
(iota 5)                    ; (0 1 2 3 4)
(iota 5 1)                  ; (1 2 3 4 5)
(iota 5 0 2)                ; (0 2 4 6 8) - start, step

List access and search:

; Length
(length '(a b c d))         ; 4
(length '())                ; 0

; Indexing
(list-ref '(a b c d) 2)     ; c
(list-tail '(a b c d) 2)    ; (c d)

; First and last
(car '(a b c))              ; a
(last-pair '(a b c))        ; (c)
(list-head '(a b c d) 2)    ; (a b) - Chez extension

; Membership (returns tail starting at match)
(memq 'b '(a b c))          ; (b c)
(memv 2 '(1 2 3))           ; (2 3)
(member "b" '("a" "b" "c")) ; ("b" "c")

(memp even? '(1 3 4 5))     ; (4 5)

; Association lists
(assq 'b '((a . 1) (b . 2) (c . 3)))   ; (b . 2)
(assv 2 '((1 . a) (2 . b) (3 . c)))    ; (2 . b)
(assoc "b" '(("a" . 1) ("b" . 2)))     ; ("b" . 2)

(assp (lambda (x) (> x 5)) '((3 . a) (7 . b) (2 . c)))  ; (7 . b)

List manipulation:

; Append (creates new pairs except last)
(append '(a b) '(c d))      ; (a b c d)
(append '(a) '(b) '(c))     ; (a b c)
(append '(a b) 'c)          ; (a b . c)

; Reverse
(reverse '(a b c))          ; (c b a)

; Copy
(list-copy '(a b c))        ; New copy of list

; Sublist operations (Chez extensions)
(sublist '(a b c d e) 1 4)  ; (b c d)

; Remove elements
(remq 'b '(a b c b d))      ; (a c d)
(remv 2 '(1 2 3 2 4))       ; (1 3 4)
(remove "b" '("a" "b" "c")) ; ("a" "c")
(remp odd? '(1 2 3 4 5))    ; (2 4)

; Remove duplicates
(remq-duplicates '(a b a c b))  ; (a b c) - Chez extension

List transformation:

; Flatten (Chez extension)
(flatten '((a b) (c (d e)) f))  ; (a b c d e f)

; Transpose
(define (transpose matrix)
  (apply map list matrix))
(transpose '((1 2 3) (4 5 6)))  ; ((1 4) (2 5) (3 6))

; Partition
(partition even? '(1 2 3 4 5 6))
; Values: (2 4 6) (1 3 5)

; Split at index
(split-at '(a b c d e) 3)   ; Values: (a b c) (d e) - SRFI-1 style

; Take and drop
(define (take lst n)
  (if (or (zero? n) (null? lst))
      '()
      (cons (car lst) (take (cdr lst) (- n 1)))))

(define (drop lst n)
  (if (or (zero? n) (null? lst))
      lst
      (drop (cdr lst) (- n 1))))

(take '(a b c d e) 3)       ; (a b c)
(drop '(a b c d e) 3)       ; (d e)

Weak pairs and ephemerons:

; Weak pairs - car can be collected if not referenced elsewhere
(define wp (weak-cons 'key 'value))
(weak-pair? wp)             ; #t
(car wp)                    ; key (or #!bwp if collected)
(cdr wp)                    ; value
(bwp-object? (car wp))      ; #t if car was collected

; Ephemerons - value kept alive only if key is alive
(define ep (ephemeron-cons 'key 'value))
(ephemeron-pair? ep)        ; #t
(car ep)                    ; key
(cdr ep)                    ; value (collected with key)

Characters

Character predicates:

; Basic predicate
(char? #\a)                 ; #t
(char? "a")                 ; #f

; Classification
(char-alphabetic? #\a)      ; #t
(char-numeric? #\5)         ; #t
(char-whitespace? #\space)  ; #t
(char-whitespace? #\tab)    ; #t
(char-whitespace? #\newline) ; #t

(char-upper-case? #\A)      ; #t
(char-lower-case? #\a)      ; #t
(char-title-case? #\x01C5)  ; #t (Unicode titlecase)

; General category
(char-general-category #\a) ; Ll (lowercase letter)
(char-general-category #\A) ; Lu (uppercase letter)
(char-general-category #\5) ; Nd (decimal number)
(char-general-category #\space)  ; Zs (space separator)

Character comparison:

; Case-sensitive
(char=? #\a #\a)            ; #t
(char<? #\a #\b)            ; #t
(char<=? #\a #\a)           ; #t
(char>? #\b #\a)            ; #t
(char>=? #\b #\a)           ; #t

; Multiple arguments
(char<? #\a #\b #\c)        ; #t

; Case-insensitive
(char-ci=? #\a #\A)         ; #t
(char-ci<? #\a #\B)         ; #t
(char-ci<=? #\A #\a)        ; #t
(char-ci>? #\B #\a)         ; #t
(char-ci>=? #\A #\a)        ; #t

Character conversion:

; Case conversion
(char-upcase #\a)           ; #\A
(char-downcase #\A)         ; #\a
(char-titlecase #\a)        ; #\A
(char-foldcase #\A)         ; #\a

; Integer conversion (Unicode code point)
(char->integer #\a)         ; 97
(char->integer #\λ)         ; 955
(integer->char 97)          ; #\a
(integer->char 955)         ; #\λ

; Common conversions
(char->integer #\0)         ; 48
(char->integer #\9)         ; 57
(char->integer #\A)         ; 65
(char->integer #\Z)         ; 90
(char->integer #\a)         ; 97
(char->integer #\z)         ; 122

; Digit conversion helper
(define (char->digit c)
  (- (char->integer c) (char->integer #\0)))
(char->digit #\7)           ; 7

Special character literals:

; Named characters
#\nul                       ; Null (0)
#\alarm                     ; Bell (7)
#\backspace                 ; Backspace (8)
#\tab                       ; Tab (9)
#\linefeed                  ; Newline (10)
#\newline                   ; Newline (10)
#\vtab                      ; Vertical tab (11)
#\page                      ; Form feed (12)
#\return                    ; Carriage return (13)
#\esc                       ; Escape (27)
#\space                     ; Space (32)
#\delete                    ; Delete (127)

; Hex notation
#\x41                       ; #\A
#\x03BB                     ; #\λ (lambda)
#\x1F600                    ; 😀 (emoji)

; Unicode names (Chez extension)
#\GREEK_SMALL_LETTER_LAMBDA ; #\λ

Strings

String construction:

; Literal strings (immutable)
"hello"
"hello\nworld"              ; With newline
"tab\there"                 ; With tab
"quote: \"text\""           ; With escaped quotes

; Make mutable string
(make-string 5 #\x)         ; "xxxxx"
(make-string 10)            ; 10 unspecified chars

; From characters
(string #\h #\e #\l #\l #\o)  ; "hello"

; From list
(list->string '(#\a #\b #\c))  ; "abc"

; Copy (creates mutable copy)
(string-copy "hello")       ; "hello" (mutable)

; Substring
(substring "hello world" 0 5)  ; "hello"
(substring "hello world" 6 11) ; "world"

String access and modification:

; Length
(string-length "hello")     ; 5

; Access
(string-ref "hello" 1)      ; #\e

; Mutation (mutable strings only)
(define s (string-copy "hello"))
(string-set! s 0 #\H)
s                           ; "Hello"

; Fill
(define s (make-string 5))
(string-fill! s #\x)
s                           ; "xxxxx"

; Copy region
(define src "source")
(define dst (make-string 10 #\-))
(string-copy! src 0 dst 2 6)
dst                         ; "--source--"

String comparison:

; Case-sensitive
(string=? "hello" "hello")  ; #t
(string<? "abc" "abd")      ; #t
(string<=? "abc" "abc")     ; #t
(string>? "xyz" "abc")      ; #t
(string>=? "xyz" "xyz")     ; #t

; Case-insensitive
(string-ci=? "Hello" "hello")  ; #t
(string-ci<? "ABC" "abd")      ; #t

; Multiple arguments
(string<? "a" "b" "c")      ; #t

String searching and manipulation:

; Append
(string-append "hello" " " "world")  ; "hello world"

; Concatenate (from list)
(apply string-append '("a" "b" "c"))  ; "abc"

; Case conversion
(string-upcase "hello")     ; "HELLO"
(string-downcase "HELLO")   ; "hello"
(string-titlecase "hello world")  ; "Hello World"
(string-foldcase "Hello")   ; "hello"

; Trimming (Chez extensions)
(string-trim "  hello  ")   ; "hello"
(string-trim-left "  hello")   ; "hello"
(string-trim-right "hello  ")  ; "hello"

; Searching
(define (string-contains haystack needle)
  (let ([h-len (string-length haystack)]
        [n-len (string-length needle)])
    (let loop ([i 0])
      (cond
        [(> (+ i n-len) h-len) #f]
        [(string=? (substring haystack i (+ i n-len)) needle) i]
        [else (loop (+ i 1))]))))

(string-contains "hello world" "wor")  ; 6

String conversion:

; To/from list
(string->list "hello")      ; (#\h #\e #\l #\l #\o)
(list->string '(#\a #\b #\c))  ; "abc"

; To/from symbol
(string->symbol "hello")    ; hello
(symbol->string 'hello)     ; "hello"

; To/from number
(string->number "123")      ; 123
(string->number "3.14")     ; 3.14
(string->number "ff" 16)    ; 255
(string->number "101" 2)    ; 5
(string->number "not-a-number")  ; #f

(number->string 123)        ; "123"
(number->string 255 16)     ; "ff"
(number->string 5 2)        ; "101"

; Format to string
(format "~a + ~a = ~a" 1 2 3)  ; "1 + 2 = 3"

String encoding:

; UTF-8
(string->utf8 "hello")      ; #vu8(104 101 108 108 111)
(utf8->string #vu8(104 101 108 108 111))  ; "hello"

; UTF-16
(string->utf16 "hello" 'little)  ; Little-endian
(string->utf16 "hello" 'big)     ; Big-endian
(utf16->string bv 'little)

; UTF-32
(string->utf32 "hello" 'little)
(utf32->string bv 'little)

; Latin-1 (Chez extension)
(string->bytevector "hello" (make-transcoder (latin-1-codec)))
(bytevector->string bv (make-transcoder (latin-1-codec)))

Vectors

Vector construction:

; Literal vector
'#(1 2 3)                   ; #(1 2 3)
#(a b c)                    ; #(a b c)

; Make vector
(make-vector 5)             ; #(0 0 0 0 0) or unspecified
(make-vector 5 'x)          ; #(x x x x x)

; From elements
(vector 1 2 3)              ; #(1 2 3)
(vector 'a (+ 1 2) "hello") ; #(a 3 "hello")

; From list
(list->vector '(a b c))     ; #(a b c)

; Copy
(vector-copy '#(1 2 3))     ; #(1 2 3) (mutable)

Vector access and modification:

; Length
(vector-length '#(a b c d)) ; 4

; Access
(vector-ref '#(a b c d) 2)  ; c

; Mutation
(define v (vector 1 2 3))
(vector-set! v 1 'x)
v                           ; #(1 x 3)

; Fill
(define v (make-vector 5))
(vector-fill! v 'z)
v                           ; #(z z z z z)

; Copy region
(define src '#(a b c d e))
(define dst (make-vector 5 '-))
(vector-copy! src 1 dst 2 3)
dst                         ; #(- - b c d)

Vector operations:

; Append (Chez extension)
(vector-append '#(1 2) '#(3 4))  ; #(1 2 3 4)

; To/from list
(vector->list '#(a b c))    ; (a b c)
(list->vector '(1 2 3))     ; #(1 2 3)

; Map (R6RS)
(vector-map add1 '#(1 2 3)) ; #(2 3 4)
(vector-map + '#(1 2 3) '#(10 20 30))  ; #(11 22 33)

; For-each
(vector-for-each
  (lambda (x) (printf "~a " x))
  '#(a b c))                ; Prints: a b c

; Sort (Chez extension)
(vector-sort < '#(3 1 4 1 5))  ; #(1 1 3 4 5)
(vector-sort! < (vector 3 1 4 1 5))  ; Sorts in place

; Subvector (Chez extension)
(subvector '#(a b c d e) 1 4)  ; #(b c d)

Immutable vectors:

; Check mutability
(mutable-vector? (vector 1 2 3))      ; #t
(immutable-vector? '#(1 2 3))         ; Depends on context

; Create immutable copy
(vector->immutable-vector (vector 1 2 3))

; Attempting to mutate immutable vector raises exception
; (vector-set! '#(1 2 3) 0 'x)  ; Error

Bytevectors

Bytevector construction:

; Literal
#vu8(1 2 3 255)             ; Bytevector of 4 bytes

; Make bytevector
(make-bytevector 10)        ; 10 bytes, unspecified values
(make-bytevector 10 0)      ; 10 zero bytes

; From u8 list
(u8-list->bytevector '(1 2 3 4))  ; #vu8(1 2 3 4)

; Copy
(bytevector-copy #vu8(1 2 3))

Single-byte access:

; Length
(bytevector-length #vu8(1 2 3 4))  ; 4

; Unsigned byte access (0-255)
(bytevector-u8-ref #vu8(1 2 255) 2)   ; 255
(define bv (make-bytevector 4 0))
(bytevector-u8-set! bv 0 255)
bv                          ; #vu8(255 0 0 0)

; Signed byte access (-128 to 127)
(bytevector-s8-ref #vu8(255) 0)  ; -1 (two's complement)
(bytevector-s8-set! bv 1 -1)
bv                          ; #vu8(255 255 0 0)

Multi-byte access:

; 16-bit access
(define bv (make-bytevector 8 0))

; Native endianness
(bytevector-u16-native-set! bv 0 1000)
(bytevector-u16-native-ref bv 0)   ; 1000

; Explicit endianness
(bytevector-u16-set! bv 2 1000 'little)
(bytevector-u16-set! bv 4 1000 'big)
(bytevector-u16-ref bv 2 'little)  ; 1000
(bytevector-u16-ref bv 4 'big)     ; 1000

; Signed 16-bit
(bytevector-s16-ref bv 0 'little)
(bytevector-s16-set! bv 0 -1000 'little)

; 32-bit and 64-bit similar
(bytevector-u32-ref bv 0 'little)
(bytevector-u32-set! bv 0 value 'little)
(bytevector-u64-ref bv 0 'little)
(bytevector-u64-set! bv 0 value 'little)

; Floating point
(bytevector-ieee-single-ref bv 0 'little)
(bytevector-ieee-single-set! bv 0 3.14 'little)
(bytevector-ieee-double-ref bv 0 'little)
(bytevector-ieee-double-set! bv 0 3.14159 'little)

Bytevector operations:

; Copy region
(define src #vu8(1 2 3 4 5))
(define dst (make-bytevector 10 0))
(bytevector-copy! src 0 dst 5 5)
dst                         ; #vu8(0 0 0 0 0 1 2 3 4 5)

; Fill
(bytevector-fill! dst 255)
dst                         ; All 255s

; Equality
(bytevector=? #vu8(1 2 3) #vu8(1 2 3))  ; #t

; Conversion to/from list
(bytevector->u8-list #vu8(1 2 3))  ; (1 2 3)
(u8-list->bytevector '(1 2 3))    ; #vu8(1 2 3)

; Append (Chez extension)
(bytevector-append #vu8(1 2) #vu8(3 4))  ; #vu8(1 2 3 4)

; Truncate/extend (Chez extension)
(bytevector-truncate! bv 5)  ; Shorten to 5 bytes

Bytevector compression (Chez extension):

; Compress bytevector
(define data #vu8(1 2 3 4 5 1 2 3 4 5 1 2 3 4 5))
(define compressed (bytevector-compress data))

; Uncompress
(define restored (bytevector-uncompress compressed))
(bytevector=? data restored)  ; #t

Stencil Vectors

Stencil vectors are specialized sparse vectors:

; Stencil vectors store only non-default elements
; The "stencil" is a bitmask indicating which positions have values

; Create stencil vector
; Mask indicates which of 0-57 positions have values
(define sv (stencil-vector #b10101 'a 'b 'c))
; Positions 0, 2, 4 have values 'a, 'b, 'c

; Check if stencil vector
(stencil-vector? sv)        ; #t

; Get the mask
(stencil-vector-mask sv)    ; #b10101 = 21

; Length (number of actual values stored)
(stencil-vector-length sv)  ; 3

; Reference by stencil bit position
(stencil-vector-ref sv #b00001)  ; 'a (bit 0)
(stencil-vector-ref sv #b00100)  ; 'b (bit 2)
(stencil-vector-ref sv #b10000)  ; 'c (bit 4)

Stencil vector operations:

; Update creates new stencil vector (immutable style)
(define sv2 (stencil-vector-update sv #b00010 'new))
; Now has values at positions 0, 1, 2, 4

; Truncate mask (remove positions)
(define sv3 (stencil-vector-truncate sv #b00101))
; Only positions 0 and 2 remain

; Check for specific bits
(fxlogbit? 0 (stencil-vector-mask sv))  ; #t
(fxlogbit? 1 (stencil-vector-mask sv))  ; #f
(fxlogbit? 2 (stencil-vector-mask sv))  ; #t

; Iterate over stencil vector
(define (stencil-vector-for-each proc sv)
  (let ([mask (stencil-vector-mask sv)])
    (let loop ([bit 0] [idx 0])
      (when (< bit 58)
        (when (fxlogbit? bit mask)
          (proc bit (stencil-vector-ref sv (fxsll 1 bit)))
          (loop (+ bit 1) (+ idx 1)))
        (unless (fxlogbit? bit mask)
          (loop (+ bit 1) idx))))))

Use cases for stencil vectors:

; Stencil vectors are useful for:
; - Sparse data with known position range (0-57)
; - Record-like structures with optional fields
; - Compact representation of small sets

; Example: optional configuration fields
(define config-keys
  '((debug . 0) (verbose . 1) (output-file . 2)
    (input-file . 3) (timeout . 4)))

(define (make-config . options)
  (let loop ([opts options] [mask 0] [values '()])
    (if (null? opts)
        (apply stencil-vector mask (reverse values))
        (let* ([key (caar opts)]
               [val (cdar opts)]
               [bit (cdr (assq key config-keys))])
          (loop (cdr opts)
                (fxlogior mask (fxsll 1 bit))
                (cons val values))))))

(define cfg (make-config '(debug . #t) '(timeout . 30)))
(stencil-vector-mask cfg)   ; Shows which options are set

Boxes

Boxes are single-element mutable containers:

; Create box
(box 42)                    ; #&42
(box 'hello)                ; #&hello
(box (list 1 2 3))          ; #&(1 2 3)

; Check if box
(box? (box 42))             ; #t
(box? 42)                   ; #f

; Access content
(unbox (box 42))            ; 42

; Modify content
(define b (box 1))
(set-box! b 2)
(unbox b)                   ; 2

Boxes for mutable state:

; Counter using box
(define (make-counter)
  (let ([count (box 0)])
    (lambda ()
      (let ([current (unbox count)])
        (set-box! count (+ current 1))
        current))))

(define counter (make-counter))
(counter)                   ; 0
(counter)                   ; 1
(counter)                   ; 2

; Memoization cell
(define (make-lazy thunk)
  (let ([cell (box #f)]
        [computed? (box #f)])
    (lambda ()
      (unless (unbox computed?)
        (set-box! cell (thunk))
        (set-box! computed? #t))
      (unbox cell))))

(define expensive
  (make-lazy
    (lambda ()
      (display "Computing...")
      42)))

(expensive)                 ; Computing... 42
(expensive)                 ; 42 (cached)

Immutable boxes (Chez extension):

; Create immutable box
(define ib (box-immutable 42))

; Check
(box? ib)                   ; #t
(immutable-box? ib)         ; #t
(mutable-box? ib)           ; #f

; Unbox works
(unbox ib)                  ; 42

; set-box! would raise exception
; (set-box! ib 100)         ; Error

Symbols

Symbol basics:

; Symbol literals
'hello                      ; hello
'with-hyphen                ; with-hyphen
'CamelCase                  ; CamelCase (case preserved)
'|with spaces|              ; |with spaces|
'|has "quotes"|             ; |has "quotes"|

; Check if symbol
(symbol? 'hello)            ; #t
(symbol? "hello")           ; #f

; Convert to/from string
(symbol->string 'hello)     ; "hello"
(string->symbol "hello")    ; hello

; Symbols are interned (eq? comparable)
(eq? 'hello 'hello)         ; #t
(eq? (string->symbol "hello")
     (string->symbol "hello"))  ; #t

Gensyms (unique symbols):

; Generate unique symbol
(gensym)                    ; #{g0}
(gensym)                    ; #{g1}

; With prefix
(gensym "temp")             ; #{temp2}

; With specific name
(gensym "x" "unique-id")    ; #{x unique-id}

; Check if gensym
(gensym? (gensym))          ; #t
(gensym? 'regular)          ; #f

; Gensyms are unique
(eq? (gensym) (gensym))     ; #f

; Get gensym components
(define g (gensym "prefix"))
(gensym->unique-string g)   ; The unique identifier part

; Gensyms in macros (hygiene)
(define-syntax with-temp
  (lambda (stx)
    (syntax-case stx ()
      [(_ body ...)
       (with-syntax ([temp (datum->syntax #'body (gensym "temp"))])
         #'(let ([temp #f])
             body ...))])))

Symbol properties (Chez extension):

; Attach property to symbol
(putprop 'my-symbol 'color 'red)
(putprop 'my-symbol 'size 42)

; Retrieve property
(getprop 'my-symbol 'color)  ; red
(getprop 'my-symbol 'size)   ; 42
(getprop 'my-symbol 'missing)  ; #f

; Remove property
(remprop 'my-symbol 'color)
(getprop 'my-symbol 'color)  ; #f

; List all properties
(property-list 'my-symbol)  ; ((size . 42))

; Use case: metadata storage
(define (define-type name . properties)
  (for-each
    (lambda (prop)
      (putprop name (car prop) (cdr prop)))
    properties))

(define-type 'person
  '(fields . (name age))
  '(constructor . make-person))

Oblist (symbol table):

; Access all interned symbols
(oblist)                    ; List of all symbols

; Find symbols matching pattern
(define (find-symbols pred)
  (filter pred (oblist)))

(find-symbols
  (lambda (s)
    (let ([str (symbol->string s)])
      (and (> (string-length str) 5)
           (char=? (string-ref str 0) #\m)))))
; All symbols starting with 'm' longer than 5 chars

Void

The void object represents "no useful value":

; Void is the return value of side-effecting procedures
(void)                      ; #
(display "hi")              ; Returns #
(set! x 10)                 ; Returns #
(vector-set! v 0 'x)        ; Returns #

; Check for void
(void? (void))              ; #t (Chez extension)
(void? 42)                  ; #f
(void? #f)                  ; #f

; Create void explicitly
(void)                      ; #

; Note: void is NOT false
(if (void) 'yes 'no)        ; yes
(not (void))                ; #f

; Common pattern: suppress return value
(define (do-something)
  (perform-action)
  (void))  ; Explicitly return void

Void vs other "nothing" values:

; Different "empty" values
(void)                      ; # - no return value
'()                         ; () - empty list
#f                          ; #f - boolean false
(eof-object)                ; #!eof - end of file

; All are distinct
(eq? (void) '())            ; #f
(eq? (void) #f)             ; #f
(null? (void))              ; #f
(not (void))                ; #f (void is truthy!)

; Only #f is false in conditionals
(if (void) 'truthy 'falsy)       ; truthy
(if '() 'truthy 'falsy)          ; truthy
(if #f 'truthy 'falsy)           ; falsy
(if (eof-object) 'truthy 'falsy) ; truthy

Sorting

List sorting:

; sort (stable sort)
(sort < '(3 1 4 1 5 9 2 6)) ; (1 1 2 3 4 5 6 9)
(sort > '(3 1 4 1 5 9 2 6)) ; (9 6 5 4 3 2 1 1)

; With custom comparator
(sort (lambda (a b) (< (abs a) (abs b)))
      '(3 -1 4 -1 5 -9 2 6))
; (-1 -1 2 3 4 5 6 -9)

; Sort strings
(sort string<? '("banana" "apple" "cherry"))
; ("apple" "banana" "cherry")

(sort string-ci<? '("Banana" "apple" "CHERRY"))
; ("apple" "Banana" "CHERRY")

; Sort by key
(define (sort-by key lst)
  (sort (lambda (a b) (< (key a) (key b))) lst))

(sort-by car '((3 a) (1 b) (2 c)))
; ((1 b) (2 c) (3 a))

(sort-by string-length '("aaa" "b" "cc"))
; ("b" "cc" "aaa")

Vector sorting:

; vector-sort returns new sorted vector
(vector-sort < '#(3 1 4 1 5 9 2 6))
; #(1 1 2 3 4 5 6 9)

; vector-sort! sorts in place
(define v (vector 3 1 4 1 5 9 2 6))
(vector-sort! < v)
v                           ; #(1 1 2 3 4 5 6 9)

; Partial sort (Chez extension)
(define v (vector 5 3 8 1 9 2 7 4 6))
(vector-sort! < v 2 7)      ; Sort only indices 2-6
v                           ; #(5 3 1 2 7 8 9 4 6)

Merge operations:

; merge combines two sorted lists
(merge < '(1 3 5 7) '(2 4 6 8))
; (1 2 3 4 5 6 7 8)

; merge! destructively merges (Chez extension)
(define lst1 (list 1 3 5))
(define lst2 (list 2 4 6))
(merge! < lst1 lst2)        ; (1 2 3 4 5 6)

; Merge sort implementation
(define (merge-sort lst)
  (if (or (null? lst) (null? (cdr lst)))
      lst
      (let-values ([(left right) (split-list lst)])
        (merge < (merge-sort left) (merge-sort right)))))

(define (split-list lst)
  (let loop ([slow lst] [fast lst] [acc '()])
    (if (or (null? fast) (null? (cdr fast)))
        (values (reverse acc) slow)
        (loop (cdr slow) (cddr fast) (cons (car slow) acc)))))

Sorting stability:

; Chez's sort is stable - equal elements maintain order
(sort (lambda (a b) (< (car a) (car b)))
      '((1 first) (2 second) (1 third) (2 fourth)))
; ((1 first) (1 third) (2 second) (2 fourth))

; Use for multi-key sorting
(define (multi-sort comparators lst)
  (fold-right
    (lambda (cmp lst)
      (sort cmp lst))
    lst
    comparators))

; Sort by name, then by age
(define people
  '((alice 30) (bob 25) (alice 25) (bob 30)))

(multi-sort
  (list (lambda (a b) (< (cadr a) (cadr b)))      ; age
        (lambda (a b) (string<? (symbol->string (car a))
                                (symbol->string (car b))))) ; name
  people)
; ((alice 25) (alice 30) (bob 25) (bob 30))

Hashtables

Creating hashtables:

; Eq hashtable (uses eq? for comparison)
(define ht-eq (make-eq-hashtable))

; Eqv hashtable (uses eqv?)
(define ht-eqv (make-eqv-hashtable))

; General hashtable (custom hash and equal)
(define ht-equal
  (make-hashtable equal-hash equal?))

; String hashtable
(define ht-string
  (make-hashtable string-hash string=?))

; Case-insensitive string hashtable
(define ht-ci
  (make-hashtable string-ci-hash string-ci=?))

; Symbol hashtable (Chez extension)
(define ht-sym (make-eq-hashtable))  ; Use eq? for symbols

; With initial size hint
(make-eq-hashtable 1000)    ; Preallocate for ~1000 entries

Basic operations:

; Set value
(hashtable-set! ht 'key 'value)
(hashtable-set! ht "name" "Alice")
(hashtable-set! ht 42 "forty-two")

; Get value
(hashtable-ref ht 'key #f)  ; value or #f
(hashtable-ref ht 'missing #f)  ; #f
(hashtable-ref ht 'missing 'default)  ; default

; Check existence
(hashtable-contains? ht 'key)  ; #t
(hashtable-contains? ht 'missing)  ; #f

; Delete
(hashtable-delete! ht 'key)

; Size
(hashtable-size ht)         ; Number of entries

; Clear
(hashtable-clear! ht)

Hashtable iteration:

; Get all keys
(hashtable-keys ht)         ; Returns vector of keys

; Get all values
(hashtable-values ht)       ; Returns vector of values

; Get entries (keys and values)
(hashtable-entries ht)      ; Returns 2 values: keys-vec, values-vec

; Iterate with for-each
(let-values ([(keys vals) (hashtable-entries ht)])
  (vector-for-each
    (lambda (k v)
      (printf "~a: ~a~n" k v))
    keys vals))

; Convert to association list
(define (hashtable->alist ht)
  (let-values ([(keys vals) (hashtable-entries ht)])
    (vector->list
      (vector-map cons keys vals))))

; Create from association list
(define (alist->hashtable alist)
  (let ([ht (make-eq-hashtable)])
    (for-each
      (lambda (pair)
        (hashtable-set! ht (car pair) (cdr pair)))
      alist)
    ht))

Update operations:

; Update with procedure
(hashtable-update! ht 'count add1 0)
; If exists: apply add1 to current value
; If missing: use 0 as initial value

; Increment counter pattern
(define (increment-count! ht key)
  (hashtable-update! ht key add1 0))

(define counts (make-eq-hashtable))
(increment-count! counts 'a)  ; 1
(increment-count! counts 'a)  ; 2
(increment-count! counts 'b)  ; 1

; Accumulate in list
(define (add-to-list! ht key value)
  (hashtable-update! ht key
    (lambda (lst) (cons value lst))
    '()))

; Set if absent (Chez extension)
(hashtable-ref-cell ht 'key)  ; Returns cell or #f

; Cell operations for atomic updates
(define cell (hashtable-cell ht 'key 'default))
(car cell)                  ; key
(cdr cell)                  ; value
(set-cdr! cell 'new-value)  ; Update atomically

Weak and ephemeron hashtables:

; Weak hashtable - keys can be garbage collected
(define wht (make-weak-eq-hashtable))
(hashtable-set! wht some-key 'value)
; If some-key becomes unreachable, entry is removed

; Weak-eqv hashtable
(define wht-eqv (make-weak-eqv-hashtable))

; Ephemeron hashtable - values kept only if keys alive
(define eht (make-ephemeron-eq-hashtable))
(define eht-eqv (make-ephemeron-eqv-hashtable))

; Use case: caching with automatic cleanup
(define cache (make-weak-eq-hashtable))

(define (cached-compute key compute-proc)
  (or (hashtable-ref cache key #f)
      (let ([result (compute-proc key)])
        (hashtable-set! cache key result)
        result)))

Hashtable copying and equivalence:

; Copy hashtable
(hashtable-copy ht)         ; Immutable copy
(hashtable-copy ht #t)      ; Mutable copy

; Check equivalence
(hashtable-equivalence-function ht)  ; Returns equal?
(hashtable-hash-function ht)         ; Returns hash proc

; Check mutability
(hashtable-mutable? ht)     ; #t or #f

; Hashtable type predicates
(hashtable? ht)             ; #t
(eq-hashtable? ht-eq)       ; #t
(eqv-hashtable? ht-eqv)     ; #t (Chez extension)

Record Types

R6RS syntactic layer records:

; Basic record definition
(define-record-type point
  (fields x y))

; Create instance
(make-point 3 4)            ; #

; Access fields
(point-x (make-point 3 4))  ; 3
(point-y (make-point 3 4))  ; 4

; Predicate
(point? (make-point 3 4))   ; #t

; With mutable fields
(define-record-type mpoint
  (fields (mutable x)
          (mutable y)))

(define p (make-mpoint 1 2))
(mpoint-x-set! p 10)
(mpoint-x p)                ; 10

Record inheritance:

; Parent record
(define-record-type shape
  (fields (immutable color)))

; Child record
(define-record-type (circle shape)
  (fields (immutable radius)))

(define c (make-circle 'red 5))
(shape-color c)             ; red
(circle-radius c)           ; 5
(shape? c)                  ; #t
(circle? c)                 ; #t

; Multiple inheritance levels
(define-record-type (filled-circle circle)
  (fields (immutable fill-pattern)))

(define fc (make-filled-circle 'blue 10 'solid))
(shape-color fc)            ; blue
(circle-radius fc)          ; 10
(filled-circle-fill-pattern fc)  ; solid

Custom constructors and protocols:

; Custom constructor with protocol
(define-record-type point3d
  (fields x y z)
  (protocol
    (lambda (new)
      (case-lambda
        [(x y) (new x y 0)]         ; Default z to 0
        [(x y z) (new x y z)]))))

(make-point3d 1 2)          ; z defaults to 0
(make-point3d 1 2 3)        ; All specified

; Protocol with parent
(define-record-type (named-point point)
  (fields name)
  (protocol
    (lambda (pnew)
      (lambda (name x y)
        ((pnew x y) name)))))

(define np (make-named-point "origin" 0 0))
(point-x np)                ; 0
(named-point-name np)       ; "origin"

; Validation in protocol
(define-record-type positive-point
  (fields x y)
  (protocol
    (lambda (new)
      (lambda (x y)
        (unless (and (positive? x) (positive? y))
          (error 'make-positive-point "values must be positive"))
        (new x y)))))

Nongenerative and sealed records:

; Nongenerative - same definition produces same type
(define-record-type point-ng
  (nongenerative point-ng-uid)
  (fields x y))

; Two definitions with same UID are the same type
; Useful for separate compilation

; Sealed - cannot be inherited
(define-record-type final-record
  (sealed #t)
  (fields value))

; (define-record-type (child final-record) ...)  ; Error!

; Opaque - internal structure hidden
(define-record-type opaque-record
  (opaque #t)
  (fields secret))

; record? returns #f for opaque records
; But type predicate still works

Chez Scheme record extensions:

; Define-record (Chez legacy syntax)
(define-record person (name age))

; Automatically creates:
; make-person, person?, person-name, person-age
; set-person-name!, set-person-age! (mutable by default)

; Record type descriptors
(define rtd (record-type-descriptor person))
(record-type-name rtd)      ; person
(record-type-parent rtd)    ; #f
(record-type-field-names rtd)  ; (name age)

; Reflection
(record-rtd (make-person "Alice" 30))  ; Get RTD from instance

; Create record dynamically
(define p ((record-constructor rtd) "Bob" 25))
((record-accessor rtd 0) p) ; "Bob"
((record-mutator rtd 1) p 26)  ; Set age to 26

Record printing (Chez extension):

; Custom record writer
(define-record-type point
  (fields x y))

(record-writer (record-type-descriptor point)
  (lambda (r port write?)
    (fprintf port "#"
             (point-x r) (point-y r))))

(make-point 3 4)            ; #

; Generic record printing
(record-print-procedure)    ; Current print procedure
(parameterize ([print-record #t])
  (printf "~s" (make-point 3 4)))  ; Shows structure

Record Equality and Hashing

Default record equality:

; By default, records use eq? (identity)
(define-record-type point (fields x y))

(define p1 (make-point 3 4))
(define p2 (make-point 3 4))

(eq? p1 p1)                 ; #t
(eq? p1 p2)                 ; #f (different objects)
(eqv? p1 p2)                ; #f
(equal? p1 p2)              ; #f (by default)

Custom equality with record-equal-procedure:

; Set custom equality for record type
(define-record-type point
  (fields x y))

(record-type-equal-procedure
  (record-type-descriptor point)
  (lambda (p1 p2 equal?)
    (and (equal? (point-x p1) (point-x p2))
         (equal? (point-y p1) (point-y p2)))))

; Now equal? works on points
(define p1 (make-point 3 4))
(define p2 (make-point 3 4))
(equal? p1 p2)              ; #t

; Recursive equality with equal? parameter
(define-record-type tree
  (fields value left right))

(record-type-equal-procedure
  (record-type-descriptor tree)
  (lambda (t1 t2 equal?)
    (and (equal? (tree-value t1) (tree-value t2))
         (equal? (tree-left t1) (tree-left t2))
         (equal? (tree-right t1) (tree-right t2)))))

Custom hashing with record-hash-procedure:

; Set custom hash for record type
(record-type-hash-procedure
  (record-type-descriptor point)
  (lambda (p hash)
    (fxxor (hash (point-x p))
           (fxsll (hash (point-y p)) 16))))

; Now points can be hashtable keys with equal-hash
(define ht (make-hashtable equal-hash equal?))
(hashtable-set! ht (make-point 1 2) 'value)
(hashtable-ref ht (make-point 1 2) #f)  ; 'value

; Combined equal and hash for complex record
(define-record-type person
  (fields name age address))

(record-type-equal-procedure
  (record-type-descriptor person)
  (lambda (p1 p2 equal?)
    (and (equal? (person-name p1) (person-name p2))
         (equal? (person-age p1) (person-age p2))
         (equal? (person-address p1) (person-address p2)))))

(record-type-hash-procedure
  (record-type-descriptor person)
  (lambda (p hash)
    (fxxor (hash (person-name p))
           (fxxor (hash (person-age p))
                  (hash (person-address p))))))

Generic record comparison helpers:

; Helper to compare all fields
(define (make-record-equal rtd)
  (let ([accessors (map (lambda (i)
                          (record-accessor rtd i))
                        (iota (length (record-type-field-names rtd))))])
    (lambda (r1 r2 equal?)
      (for-all (lambda (acc)
                 (equal? (acc r1) (acc r2)))
               accessors))))

; Helper to hash all fields
(define (make-record-hash rtd)
  (let ([accessors (map (lambda (i)
                          (record-accessor rtd i))
                        (iota (length (record-type-field-names rtd))))])
    (lambda (r hash)
      (fold-left (lambda (h acc)
                   (fxxor h (hash (acc r))))
                 0
                 accessors))))

; Apply to a record type
(let ([rtd (record-type-descriptor my-record)])
  (record-type-equal-procedure rtd (make-record-equal rtd))
  (record-type-hash-procedure rtd (make-record-hash rtd)))

Structural equality considerations:

; Be careful with mutable fields
(define-record-type mutable-point
  (fields (mutable x) (mutable y)))

; If using as hashtable key, mutating changes hash!
(define ht (make-hashtable equal-hash equal?))
(define mp (make-mutable-point 1 2))

(hashtable-set! ht mp 'value)
(hashtable-ref ht mp #f)    ; 'value

(mutable-point-x-set! mp 100)  ; Mutation!
(hashtable-ref ht mp #f)    ; #f - hash changed!

; Solution: use immutable records as keys, or
; hash only immutable fields

Procedures

Procedure basics:

; Check if procedure
(procedure? car)            ; #t
(procedure? (lambda (x) x)) ; #t
(procedure? '+)             ; #f (symbol, not procedure)
(procedure? +)              ; #t

; Apply procedure
(apply + '(1 2 3))          ; 6
(apply + 1 2 '(3 4))        ; 10
(apply list 'a 'b '(c d))   ; (a b c d)

; Procedure arity (Chez extension)
(procedure-arity car)       ; 1
(procedure-arity cons)      ; 2
(procedure-arity list)      ; -1 (variadic)
(procedure-arity +)         ; -1

Procedure introspection (Chez extensions):

; Get procedure name
(define (my-proc x) x)
(#%$procedure-name my-proc)  ; my-proc (internal)

; Procedure source information
(#%$procedure-source-object my-proc)

; Get code object
(closure-code my-proc)      ; #<code>

; Code object properties
(define code (closure-code car))
(code? code)                ; #t

; Inspect closure variables
(define (make-adder n)
  (lambda (x) (+ x n)))

(define add5 (make-adder 5))
; add5 closes over n=5

Procedure composition:

; Compose procedures (right to left)
(define (compose . procs)
  (if (null? procs)
      values
      (let ([proc (car procs)]
            [rest (apply compose (cdr procs))])
        (lambda args
          (call-with-values
            (lambda () (apply rest args))
            proc)))))

(define add1-then-double
  (compose (lambda (x) (* x 2)) add1))

(add1-then-double 5)        ; 12 = (5+1)*2

; Pipeline (left to right)
(define (pipe . procs)
  (apply compose (reverse procs)))

(define process
  (pipe string->list
        (lambda (lst) (filter char-alphabetic? lst))
        list->string
        string-upcase))

(process "Hello, World! 123")  ; "HELLOWORLD"

Currying and partial application:

; Curry a binary procedure
(define (curry2 proc)
  (lambda (x)
    (lambda (y)
      (proc x y))))

(define currried-add (curry2 +))
((curried-add 3) 4)         ; 7

; Partial application
(define (partial proc . args)
  (lambda more-args
    (apply proc (append args more-args))))

(define add10 (partial + 10))
(add10 5)                   ; 15

(define greet (partial format "Hello, ~a!"))
(greet "World")             ; "Hello, World!"

; Right partial application
(define (partial-right proc . args)
  (lambda more-args
    (apply proc (append more-args args))))

(define halve (partial-right / 2))
(halve 10)                  ; 5

Higher-order procedure utilities:

; Negate a predicate
(define (negate pred)
  (lambda args
    (not (apply pred args))))

(define not-null? (negate null?))
(not-null? '(1 2))          ; #t
(not-null? '())             ; #f

; Complement (alias for negate)
(define complement negate)

; Conjoin predicates (and)
(define (conjoin . preds)
  (lambda (x)
    (for-all (lambda (p) (p x)) preds)))

(define positive-even?
  (conjoin positive? even?))

(positive-even? 4)          ; #t
(positive-even? -4)         ; #f

; Disjoin predicates (or)
(define (disjoin . preds)
  (lambda (x)
    (exists (lambda (p) (p x)) preds)))

(define number-or-string?
  (disjoin number? string?))

(number-or-string? 42)      ; #t
(number-or-string? "hi")    ; #t
(number-or-string? 'sym)    ; #f

Procedure caching and memoization:

; Simple memoization
(define (memoize proc)
  (let ([cache (make-hashtable equal-hash equal?)])
    (lambda args
      (let ([cached (hashtable-ref cache args 'not-found)])
        (if (eq? cached 'not-found)
            (let ([result (apply proc args)])
              (hashtable-set! cache args result)
              result)
            cached)))))

(define slow-fib
  (lambda (n)
    (if (< n 2)
        n
        (+ (slow-fib (- n 1))
           (slow-fib (- n 2))))))

(define fast-fib (memoize slow-fib))

(time (slow-fib 35))        ; Slow
(time (fast-fib 35))        ; Fast (cached)

; Memoization with weak references
(define (memoize-weak proc)
  (let ([cache (make-weak-eq-hashtable)])
    (lambda args
      (let ([key (if (= (length args) 1)
                     (car args)
                     args)])
        (or (hashtable-ref cache key #f)
            (let ([result (apply proc args)])
              (hashtable-set! cache key result)
              result))))))

Procedure tracing and debugging:

; Wrap procedure with tracing
(define (trace-proc name proc)
  (lambda args
    (printf "~a called with ~s~n" name args)
    (let ([result (apply proc args)])
      (printf "~a returned ~s~n" name result)
      result)))

(define traced-add (trace-proc 'add +))
(traced-add 1 2 3)
; add called with (1 2 3)
; add returned 6

; Built-in trace (Chez)
(trace +)                   ; Enable tracing
(+ 1 2 3)                   ; Shows trace
(untrace +)                 ; Disable tracing

; Trace multiple
(trace car cdr cons)
(untrace car cdr cons)

; Count calls
(define (counted proc)
  (let ([count (box 0)])
    (values
      (lambda args
        (set-box! count (+ (unbox count) 1))
        (apply proc args))
      (lambda () (unbox count)))))

(define-values (counted-add get-count) (counted +))
(counted-add 1 2)
(counted-add 3 4)
(get-count)                 ; 2

Numeric Operations in Chez Scheme

Numeric Type Predicates

General numeric predicates:

; Check if number
(number? 42)                ; #t
(number? 3.14)              ; #t
(number? 3+4i)              ; #t
(number? "42")              ; #f

; Complex numbers (all numbers are complex)
(complex? 42)               ; #t
(complex? 3.14)             ; #t
(complex? 3+4i)             ; #t

; Real numbers (no imaginary part)
(real? 42)                  ; #t
(real? 3.14)                ; #t
(real? 3+4i)                ; #f
(real? 3+0i)                ; #t (imaginary part is 0)

; Rational numbers (exact ratio)
(rational? 42)              ; #t
(rational? 3/4)             ; #t
(rational? 3.14)            ; #t (flonums are rational)
(rational? +inf.0)          ; #f
(rational? +nan.0)          ; #f

; Integer (whole numbers)
(integer? 42)               ; #t
(integer? 42.0)             ; #t
(integer? 3.14)             ; #f
(integer? 3/4)              ; #f

Exactness predicates:

; Exact numbers (precise representation)
(exact? 42)                 ; #t
(exact? 3/4)                ; #t
(exact? 3+4i)               ; #t (exact complex)
(exact? 3.14)               ; #f

; Inexact numbers (floating-point)
(inexact? 3.14)             ; #t
(inexact? 42)               ; #f
(inexact? 3.0+4.0i)         ; #t

; Exact integer predicate
(exact-integer? 42)         ; #t
(exact-integer? 42.0)       ; #f
(exact-integer? 3/4)        ; #f

; Exact non-negative integer
(exact-nonnegative-integer? 42)   ; #t
(exact-nonnegative-integer? -42)  ; #f
(exact-nonnegative-integer? 0)    ; #t

; Exact positive integer
(exact-positive-integer? 42)  ; #t
(exact-positive-integer? 0)   ; #f

Chez-specific type predicates:

; Fixnum - small exact integers (fast)
(fixnum? 42)                ; #t
(fixnum? (expt 2 100))      ; #f (too large)
(fixnum? 3.14)              ; #f

; Fixnum bounds (platform-dependent)
(greatest-fixnum)           ; e.g., 1152921504606846975 (60-bit)
(least-fixnum)              ; e.g., -1152921504606846976
(fixnum-width)              ; e.g., 61 (including sign)

(fixnum? (greatest-fixnum)) ; #t
(fixnum? (+ (greatest-fixnum) 1))  ; #f (becomes bignum)

; Bignum - arbitrary precision integers
(bignum? (expt 2 100))      ; #t
(bignum? 42)                ; #f (fits in fixnum)

; Ratnum - exact ratios (not integers)
(ratnum? 3/4)               ; #t
(ratnum? 4/2)               ; #f (reduces to integer 2)
(ratnum? 0.75)              ; #f (flonum)

; Flonum - floating-point numbers
(flonum? 3.14)              ; #t
(flonum? 42)                ; #f
(flonum? 42.0)              ; #t
(flonum? +inf.0)            ; #t
(flonum? +nan.0)            ; #t

; Cflonum - complex with flonum parts
(cflonum? 3.0+4.0i)         ; #t
(cflonum? 3+4i)             ; #f (exact complex)
(cflonum? 3.14)             ; #f (real flonum)

Sign and comparison predicates:

; Sign predicates
(positive? 42)              ; #t
(positive? -42)             ; #f
(positive? 0)               ; #f

(negative? -42)             ; #t
(negative? 42)              ; #f
(negative? 0)               ; #f

(zero? 0)                   ; #t
(zero? 0.0)                 ; #t
(zero? 0+0i)                ; #t
(zero? 1)                   ; #f

(nonnegative? 0)            ; #t (Chez extension)
(nonnegative? 42)           ; #t
(nonnegative? -1)           ; #f

(nonpositive? 0)            ; #t (Chez extension)
(nonpositive? -42)          ; #t
(nonpositive? 1)            ; #f

; Even and odd (integers only)
(even? 42)                  ; #t
(even? 43)                  ; #f
(odd? 43)                   ; #t
(odd? 42)                   ; #f

; Finite and infinite
(finite? 42)                ; #t
(finite? 3.14)              ; #t
(finite? +inf.0)            ; #f
(finite? -inf.0)            ; #f
(finite? +nan.0)            ; #f

(infinite? +inf.0)          ; #t
(infinite? -inf.0)          ; #t
(infinite? 42)              ; #f

(nan? +nan.0)               ; #t
(nan? 42)                   ; #f

Numeric comparison:

; Equality
(= 42 42)                   ; #t
(= 42 42.0)                 ; #t (cross-type)
(= 1/2 0.5)                 ; #t
(= 1 2 3)                   ; #f
(= 5 5 5 5)                 ; #t

; Ordering (real numbers only)
(< 1 2 3)                   ; #t
(<= 1 1 2)                  ; #t
(> 3 2 1)                   ; #t
(>= 3 3 2)                  ; #t

; Mixed exact/inexact
(< 1 2.5 3)                 ; #t
(= 1 1.0)                   ; #t

; Special values
(< -inf.0 0 +inf.0)         ; #t
(= +nan.0 +nan.0)           ; #f (NaN ≠ NaN)

Fixnum Operations

Fixnum arithmetic:

; Basic fixnum operations (fast, no overflow checking)
(fx+ 10 20)                 ; 30
(fx- 30 10)                 ; 20
(fx* 6 7)                   ; 42
(fxdiv 17 5)                ; 3 (truncated quotient)
(fxmod 17 5)                ; 2 (remainder)
(fxdiv-and-mod 17 5)        ; Returns 2 values: 3, 2

; Euclidean division
(fxdiv0 -17 5)              ; -4
(fxmod0 -17 5)              ; 3
(fxdiv0-and-mod0 -17 5)     ; Returns 2 values: -4, 3

; Negation and absolute value
(fx- 42)                    ; -42 (unary minus)
(fxabs -42)                 ; 42

; Increment/decrement
(fx1+ 41)                   ; 42
(fx1- 43)                   ; 42

; Quotient and remainder (R6RS)
(fxquotient 17 5)           ; 3
(fxremainder 17 5)          ; 2
(fxremainder -17 5)         ; -2

Fixnum with overflow checking:

; These raise exception on overflow
(fx+/carry 10 20 0)         ; Returns 2 values: sum, carry
(fx-/carry 10 20 0)         ; Returns 2 values: diff, borrow
(fx*/carry 1000000 1000000 0)  ; Returns 2 values: low, high

; Safe operations (return #f on overflow)
(fx+? 10 20)                ; 30 (Chez extension)
(fx+? (greatest-fixnum) 1)  ; #f (would overflow)
(fx-? 10 20)                ; -10
(fx*? 6 7)                  ; 42

; Example: checked addition
(define (safe-fx+ a b)
  (or (fx+? a b)
      (+ a b)))             ; Fall back to generic

Fixnum comparison:

; Equality and ordering
(fx=? 42 42)                ; #t
(fx<? 1 2 3)                ; #t
(fx<=? 1 1 2)               ; #t
(fx>? 3 2 1)                ; #t
(fx>=? 3 3 2)               ; #t

; Min and max
(fxmin 3 1 4 1 5)           ; 1
(fxmax 3 1 4 1 5)           ; 5

; Sign predicates
(fxzero? 0)                 ; #t
(fxpositive? 42)            ; #t
(fxnegative? -42)           ; #t
(fxnonnegative? 0)          ; #t
(fxnonpositive? 0)          ; #t
(fxeven? 42)                ; #t
(fxodd? 43)                 ; #t

Fixnum bitwise operations:

; Logical operations
(fxlogand #b1100 #b1010)    ; #b1000 = 8
(fxlogior #b1100 #b1010)    ; #b1110 = 14
(fxlogxor #b1100 #b1010)    ; #b0110 = 6
(fxlognot #b1100)           ; Complement (all bits flipped)

; Aliases
(fxand #b1100 #b1010)       ; Same as fxlogand
(fxior #b1100 #b1010)       ; Same as fxlogior
(fxxor #b1100 #b1010)       ; Same as fxlogxor
(fxnot #b1100)              ; Same as fxlognot

; Shift operations
(fxsll 1 4)                 ; 16 (shift left logical)
(fxsrl 16 2)                ; 4 (shift right logical)
(fxsra -16 2)               ; -4 (shift right arithmetic)

; Arithmetic shift
(fxarithmetic-shift 1 4)    ; 16 (left by positive)
(fxarithmetic-shift 16 -2)  ; 4 (right by negative)
(fxarithmetic-shift-left 1 4)   ; 16
(fxarithmetic-shift-right 16 2) ; 4

; Rotate
(fxrotate-bit-field #b110010 1 5 2)  ; Rotate bits 1-4

Fixnum bit manipulation:

; Bit testing
(fxlogbit? 0 #b1010)        ; #f (bit 0 is 0)
(fxlogbit? 1 #b1010)        ; #t (bit 1 is 1)
(fxlogbit? 3 #b1010)        ; #t (bit 3 is 1)

; Bit counting
(fxbit-count #b1010)        ; 2 (number of 1 bits)
(fxbit-count -1)            ; -1 (for negative, returns -(1+count of 0s))

(fxlength #b1010)           ; 4 (bits needed to represent)
(fxlength 0)                ; 0
(fxlength -1)               ; 0

(fxfirst-bit-set #b1010)    ; 1 (index of lowest 1 bit)
(fxfirst-bit-set 0)         ; -1

; Bit field operations
(fxbit-field #b110101 2 5)  ; #b101 = 5 (extract bits 2-4)
(fxbit-field-set #b110101 2 5 #b010)  ; Replace bits 2-4

; Copy bit
(fxcopy-bit 0 #b1010 #t)    ; #b1011 (set bit 0)
(fxcopy-bit 1 #b1010 #f)    ; #b1000 (clear bit 1)

; If operation (bitwise)
(fxif #b1100 #b1010 #b0110) ; #b1010 (where mask=1, use arg1; else arg2)

Fixnum vector operations:

; Fxvector (vector of fixnums, compact storage)
(fxvector 1 2 3 4 5)        ; #vfx(1 2 3 4 5)
(make-fxvector 5 0)         ; #vfx(0 0 0 0 0)

; Access
(fxvector-length '#vfx(1 2 3))  ; 3
(fxvector-ref '#vfx(10 20 30) 1)  ; 20

; Mutation
(define fxv (fxvector 1 2 3))
(fxvector-set! fxv 1 200)
fxv                         ; #vfx(1 200 3)

; Fill
(fxvector-fill! fxv 0)
fxv                         ; #vfx(0 0 0)

; Copy
(fxvector-copy '#vfx(1 2 3))

; Conversion
(fxvector->list '#vfx(1 2 3))   ; (1 2 3)
(list->fxvector '(1 2 3))       ; #vfx(1 2 3)

Flonum Operations

Flonum arithmetic:

; Basic flonum operations
(fl+ 1.5 2.5)               ; 4.0
(fl- 5.0 2.0)               ; 3.0
(fl* 3.0 4.0)               ; 12.0
(fl/ 10.0 4.0)              ; 2.5

; Multiple arguments
(fl+ 1.0 2.0 3.0 4.0)       ; 10.0
(fl* 1.0 2.0 3.0 4.0)       ; 24.0

; Unary operations
(fl- 3.14)                  ; -3.14 (negation)
(fl/ 2.0)                   ; 0.5 (reciprocal)
(flabs -3.14)               ; 3.14

; Division operations
(fldiv 17.0 5.0)            ; 3.0
(flmod 17.0 5.0)            ; 2.0
(fldiv-and-mod 17.0 5.0)    ; Returns: 3.0, 2.0

(fldiv0 -17.0 5.0)          ; -4.0 (Euclidean)
(flmod0 -17.0 5.0)          ; 3.0
(fldiv0-and-mod0 -17.0 5.0) ; Returns: -4.0, 3.0

Flonum comparison:

; Equality and ordering
(fl=? 3.14 3.14)            ; #t
(fl<? 1.0 2.0 3.0)          ; #t
(fl<=? 1.0 1.0 2.0)         ; #t
(fl>? 3.0 2.0 1.0)          ; #t
(fl>=? 3.0 3.0 2.0)         ; #t

; Min and max
(flmin 3.0 1.0 4.0)         ; 1.0
(flmax 3.0 1.0 4.0)         ; 4.0

; Sign predicates
(flzero? 0.0)               ; #t
(flpositive? 3.14)          ; #t
(flnegative? -3.14)         ; #t
(flnonnegative? 0.0)        ; #t
(flnonpositive? 0.0)        ; #t

; Special value predicates
(flfinite? 3.14)            ; #t
(flfinite? +inf.0)          ; #f
(flinfinite? +inf.0)        ; #t
(flinfinite? -inf.0)        ; #t
(flnan? +nan.0)             ; #t
(flnan? 3.14)               ; #f

; Integer check
(flinteger? 3.0)            ; #t
(flinteger? 3.14)           ; #f

; Even/odd (for integer flonums)
(fleven? 4.0)               ; #t
(flodd? 3.0)                ; #t

Flonum mathematical functions:

; Exponential and logarithm
(flexp 1.0)                 ; 2.718281828... (e^x)
(fllog 2.718281828)         ; ~1.0 (natural log)
(fllog 100.0 10.0)          ; 2.0 (log base 10)

; Powers and roots
(flexpt 2.0 10.0)           ; 1024.0
(flsqrt 16.0)               ; 4.0

; Trigonometric
(flsin 0.0)                 ; 0.0
(flcos 0.0)                 ; 1.0
(fltan 0.0)                 ; 0.0

; Inverse trigonometric
(flasin 0.0)                ; 0.0
(flacos 1.0)                ; 0.0
(flatan 0.0)                ; 0.0
(flatan 1.0 1.0)            ; 0.785... (atan2)

; Hyperbolic
(flsinh 0.0)                ; 0.0
(flcosh 0.0)                ; 1.0
(fltanh 0.0)                ; 0.0

; Inverse hyperbolic
(flasinh 0.0)               ; 0.0
(flacosh 1.0)               ; 0.0
(flatanh 0.0)               ; 0.0

Flonum rounding:

; Floor (toward -infinity)
(flfloor 3.7)               ; 3.0
(flfloor -3.7)              ; -4.0

; Ceiling (toward +infinity)
(flceiling 3.2)             ; 4.0
(flceiling -3.7)            ; -3.0

; Truncate (toward zero)
(fltruncate 3.7)            ; 3.0
(fltruncate -3.7)           ; -3.0

; Round (to nearest, ties to even)
(flround 3.5)               ; 4.0
(flround 4.5)               ; 4.0 (ties to even)
(flround 3.4)               ; 3.0

; Numerator and denominator (for exact conversion)
(flnumerator 3.5)           ; 7.0
(fldenominator 3.5)         ; 2.0

Flonum special values and IEEE operations:

; Special values
+inf.0                      ; Positive infinity
-inf.0                      ; Negative infinity
+nan.0                      ; Not a number
-0.0                        ; Negative zero

; Checking special values
(fl=? +inf.0 +inf.0)        ; #t
(fl=? +nan.0 +nan.0)        ; #f (NaN never equal)
(fl<? -inf.0 +inf.0)        ; #t

; Negative zero
(fl=? 0.0 -0.0)             ; #t
(eqv? 0.0 -0.0)             ; #f (different representations)
(flnegative? -0.0)          ; #f (negative zero is not negative!)

; Decode flonum (IEEE representation)
(fldecode 3.14)             ; Returns: mantissa, exponent, sign
(flencode 0.785 2 1)        ; Encode mantissa, exp, sign

; Integer decode
(flinteger-decode 3.14)     ; Integer mantissa, exp, sign

Flonum vector operations:

; Flvector (vector of flonums, compact storage)
(flvector 1.0 2.0 3.0)      ; #vfl(1.0 2.0 3.0)
(make-flvector 5 0.0)       ; #vfl(0.0 0.0 0.0 0.0 0.0)

; Access
(flvector-length '#vfl(1.0 2.0 3.0))  ; 3
(flvector-ref '#vfl(1.0 2.0 3.0) 1)   ; 2.0

; Mutation
(define flv (flvector 1.0 2.0 3.0))
(flvector-set! flv 1 20.0)
flv                         ; #vfl(1.0 20.0 3.0)

; Fill and copy
(flvector-fill! flv 0.0)
(flvector-copy '#vfl(1.0 2.0 3.0))

; Conversion
(flvector->list '#vfl(1.0 2.0 3.0))  ; (1.0 2.0 3.0)
(list->flvector '(1.0 2.0 3.0))      ; #vfl(1.0 2.0 3.0)

Inexact Complex Operations

Complex number basics:

; Complex literals
3+4i                        ; Exact complex
3.0+4.0i                    ; Inexact complex (cflonum)
0+1i                        ; Pure imaginary
1+0i                        ; Complex with zero imaginary

; Construction
(make-rectangular 3 4)      ; 3+4i
(make-rectangular 3.0 4.0)  ; 3.0+4.0i
(make-polar 5.0 0.927)      ; ~3.0+4.0i (magnitude, angle)

; Accessors
(real-part 3+4i)            ; 3
(imag-part 3+4i)            ; 4
(magnitude 3+4i)            ; 5.0
(angle 3+4i)                ; 0.927... (radians)

; Type check
(complex? 3+4i)             ; #t
(cflonum? 3.0+4.0i)         ; #t (Chez extension)
(cflonum? 3+4i)             ; #f (exact complex)

Cflonum operations (Chez extension):

; Cflonum arithmetic
(cfl+ 1.0+2.0i 3.0+4.0i)    ; 4.0+6.0i
(cfl- 5.0+6.0i 2.0+3.0i)    ; 3.0+3.0i
(cfl* 1.0+2.0i 3.0+4.0i)    ; -5.0+10.0i
(cfl/ 1.0+2.0i 3.0+4.0i)    ; 0.44+0.08i

; Unary operations
(cfl- 3.0+4.0i)             ; -3.0-4.0i (negation)
(cfl/ 1.0+0.0i)             ; 1.0+0.0i (reciprocal)

; Conjugate (flip imaginary sign)
(conjugate 3.0+4.0i)        ; 3.0-4.0i
(fl-make-rectangular
  (real-part z)
  (fl- (imag-part z)))      ; Manual conjugate

; Magnitude and angle for cflonums
(cfl-magnitude 3.0+4.0i)    ; 5.0
(cfl-angle 3.0+4.0i)        ; 0.927...

; Real and imaginary parts
(cfl-real-part 3.0+4.0i)    ; 3.0
(cfl-imag-part 3.0+4.0i)    ; 4.0

Complex mathematical functions:

; Exponential and logarithm (work with complex)
(exp 0+3.14159i)            ; -1.0+0.0i (Euler's identity)
(log -1)                    ; 0.0+3.14159i

; Powers
(expt 2.71828 0+3.14159i)   ; -1.0+0.0i
(sqrt -1)                   ; 0.0+1.0i

; Trigonometric (extended to complex)
(sin 0+1i)                  ; 0.0+1.1752i
(cos 0+1i)                  ; 1.5431+0.0i

; Inverse trig (return complex)
(asin 2)                    ; 1.5708-1.317i
(acos 2)                    ; 0.0+1.317i

; Hyperbolic
(sinh 0+1i)                 ; 0.0+0.8414i
(cosh 0+1i)                 ; 0.5403+0.0i

Complex comparisons:

; Equality only (complex numbers aren't ordered)
(= 3+4i 3+4i)               ; #t
(= 3+4i 3.0+4.0i)           ; #t

; Can't use < > with complex
; (< 1+2i 3+4i)             ; Error!

; Compare by magnitude
(define (complex<? a b)
  (< (magnitude a) (magnitude b)))

(complex<? 1+1i 3+4i)       ; #t (1.41 < 5)

; Compare by real part, then imaginary
(define (complex-compare a b)
  (let ([ra (real-part a)] [rb (real-part b)])
    (if (= ra rb)
        (< (imag-part a) (imag-part b))
        (< ra rb))))

Conversion between exact and inexact complex:

; To inexact
(inexact 3+4i)              ; 3.0+4.0i
(exact->inexact 3+4i)       ; 3.0+4.0i

; To exact (if possible)
(exact 3.0+4.0i)            ; 3+4i
(inexact->exact 3.0+4.0i)   ; 3+4i

; Rationalize real and imaginary parts
(define (rationalize-complex z tolerance)
  (make-rectangular
    (rationalize (real-part z) tolerance)
    (rationalize (imag-part z) tolerance)))

(rationalize-complex 3.14159+2.71828i 0.01)
; 22/7+193/71i (approximate)

; Check if effectively real
(define (effectively-real? z)
  (< (abs (imag-part z)) 1e-10))

(effectively-real? 3.0+1e-15i)  ; #t

Bitwise and Logical Operators

Generic bitwise operations (arbitrary precision):

; Logical AND
(bitwise-and #b1100 #b1010)     ; #b1000 = 8
(logand #b1100 #b1010)          ; Same (alias)

; Logical OR
(bitwise-ior #b1100 #b1010)     ; #b1110 = 14
(logior #b1100 #b1010)          ; Same (alias)
(bitwise-or #b1100 #b1010)      ; Same

; Logical XOR
(bitwise-xor #b1100 #b1010)     ; #b0110 = 6
(logxor #b1100 #b1010)          ; Same (alias)

; Logical NOT (one's complement)
(bitwise-not 0)                 ; -1
(bitwise-not #b1010)            ; ...11110101 (infinite 1s)
(lognot #b1010)                 ; Same (alias)

; Multiple arguments
(bitwise-and #b1111 #b1100 #b1010)  ; #b1000
(bitwise-ior #b0001 #b0010 #b0100)  ; #b0111

Bitwise shift operations:

; Arithmetic shift (preserves sign)
(bitwise-arithmetic-shift 1 4)      ; 16 (shift left)
(bitwise-arithmetic-shift 16 -2)    ; 4 (shift right)
(ash 1 4)                           ; 16 (alias)

(bitwise-arithmetic-shift-left 1 4)     ; 16
(bitwise-arithmetic-shift-right 16 2)   ; 4

; Negative numbers
(bitwise-arithmetic-shift -8 -1)    ; -4 (preserves sign)
(ash -8 -1)                         ; -4

; Large shifts
(bitwise-arithmetic-shift 1 100)    ; 2^100
(ash 1 100)                         ; Same

; Logical shift (Chez extension for fixnums)
(fxsrl -1 1)                        ; Large positive (sign not preserved)

Bit testing and manipulation:

; Test if bit is set
(bitwise-bit-set? #b1010 1)         ; #t (bit 1 is 1)
(bitwise-bit-set? #b1010 2)         ; #f (bit 2 is 0)
(logbit? 1 #b1010)                  ; #t (alias, args reversed)

; Count bits
(bitwise-bit-count #b1010)          ; 2 (number of 1s)
(logcount #b1010)                   ; 2 (alias)
(bitwise-bit-count -1)              ; -1 (infinite 1s)

; Bit length (minimum bits to represent)
(bitwise-length #b1010)             ; 4
(integer-length #b1010)             ; 4 (alias)
(bitwise-length 0)                  ; 0
(bitwise-length -1)                 ; 0
(bitwise-length -8)                 ; 3

; First bit set (lowest)
(bitwise-first-bit-set #b1010)      ; 1
(bitwise-first-bit-set #b1000)      ; 3
(bitwise-first-bit-set 0)           ; -1

; Copy bit (set or clear specific bit)
(bitwise-copy-bit 0 #b1010 1)       ; #b1011 (set bit 0)
(bitwise-copy-bit 1 #b1010 0)       ; #b1000 (clear bit 1)

Bit field operations:

; Extract bit field
(bitwise-bit-field #b110101 2 5)    ; #b101 = 5 (bits 2-4)
(bit-field #b110101 2 5)            ; Same (alias)

; Bit field width = 5-2 = 3 bits extracted
; Position 2 becomes position 0 in result

; Replace bit field
(bitwise-copy-bit-field #b110101 2 5 #b010)  ; #b101001
; Replaces bits 2-4 with #b010

; Rotate bit field
(bitwise-rotate-bit-field #b110101 2 5 1)
; Rotate bits 2-4 left by 1

; Reverse bit field
(bitwise-reverse-bit-field #b110101 0 6)
; Reverse bits 0-5

; Practical example: extract RGB from 24-bit color
(define (color-rgb color)
  (values
    (bitwise-bit-field color 16 24)  ; Red
    (bitwise-bit-field color 8 16)   ; Green
    (bitwise-bit-field color 0 8)))  ; Blue

(color-rgb #xFF8040)        ; Values: 255, 128, 64

Bitwise conditionals:

; Bitwise if (ternary)
(bitwise-if #b1100 #b1010 #b0110)   ; #b1010
; Where mask=1, take from arg2; where mask=0, take from arg3

; Equivalently:
(bitwise-ior
  (bitwise-and #b1100 #b1010)       ; Bits from arg2 where mask=1
  (bitwise-and (bitwise-not #b1100) #b0110))  ; Bits from arg3 where mask=0

; NAND, NOR, etc. (combinations)
(define (bitwise-nand a b)
  (bitwise-not (bitwise-and a b)))

(define (bitwise-nor a b)
  (bitwise-not (bitwise-ior a b)))

(define (bitwise-xnor a b)
  (bitwise-not (bitwise-xor a b)))

(define (bitwise-andc1 a b)  ; AND with complement of first
  (bitwise-and (bitwise-not a) b))

(define (bitwise-orc1 a b)   ; OR with complement of first
  (bitwise-ior (bitwise-not a) b))

Binary representation utilities:

; Convert to binary string
(number->string 42 2)               ; "101010"
(number->string -42 2)              ; "-101010"

; Parse binary string
(string->number "101010" 2)         ; 42

; Hex representation
(number->string 255 16)             ; "ff"
(string->number "ff" 16)            ; 255
(format "~x" 255)                   ; "ff"
(format "~b" 42)                    ; "101010"

; Pretty print binary with grouping
(define (binary-string n width)
  (let* ([s (number->string (if (negative? n)
                                (+ (expt 2 width) n)
                                n) 2)]
         [padded (string-append
                   (make-string (- width (string-length s)) #\0)
                   s)])
    padded))

(binary-string 42 8)                ; "00101010"
(binary-string -1 8)                ; "11111111"

Random Number Generation

Basic random number generation:

; Random integer in range [0, n)
(random 100)                ; 0-99
(random 6)                  ; 0-5 (dice roll - 1)

; Random real in [0.0, 1.0)
(random 1.0)                ; e.g., 0.7234...

; Random exact rational
(random 1/1)                ; Exact rational in [0, 1)

; Multiple calls give different values
(list (random 100) (random 100) (random 100))
; e.g., (42 17 89)

Random state management:

; Get current random state
(random-seed)               ; Current seed (implementation-dependent)

; Set random seed (for reproducibility)
(random-seed 12345)
(random 100)                ; Same result every time with same seed

; Save and restore state
(define saved-seed (random-seed))
(list (random 100) (random 100))  ; e.g., (42 17)

(random-seed saved-seed)
(list (random 100) (random 100))  ; Same: (42 17)

; Different seed, different sequence
(random-seed 99999)
(list (random 100) (random 100))  ; Different values

Random distributions and utilities:

; Random in range [a, b)
(define (random-range a b)
  (+ a (random (- b a))))

(random-range 10 20)        ; 10-19

; Random float in range [a, b)
(define (random-float-range a b)
  (+ a (* (random 1.0) (- b a))))

(random-float-range 0.0 100.0)  ; e.g., 47.23...

; Random boolean
(define (random-bool)
  (zero? (random 2)))

(random-bool)               ; #t or #f

; Random choice from list
(define (random-choice lst)
  (list-ref lst (random (length lst))))

(random-choice '(red green blue))  ; Random element

; Random sample (n items without replacement)
(define (random-sample lst n)
  (let loop ([remaining lst] [count n] [result '()])
    (cond
      [(or (zero? count) (null? remaining)) (reverse result)]
      [(< (random 1.0) (/ count (length remaining)))
       (loop (cdr remaining) (- count 1) (cons (car remaining) result))]
      [else
       (loop (cdr remaining) count result)])))

(random-sample '(1 2 3 4 5 6 7 8 9 10) 3)  ; e.g., (2 5 9)

Shuffling:

; Fisher-Yates shuffle (vector)
(define (vector-shuffle! vec)
  (let ([n (vector-length vec)])
    (do ([i (- n 1) (- i 1)])
        ((< i 1) vec)
      (let* ([j (random (+ i 1))]
             [temp (vector-ref vec i)])
        (vector-set! vec i (vector-ref vec j))
        (vector-set! vec j temp)))))

(define v (vector 1 2 3 4 5))
(vector-shuffle! v)
v                           ; e.g., #(3 1 5 2 4)

; Shuffle list
(define (shuffle lst)
  (let ([vec (list->vector lst)])
    (vector-shuffle! vec)
    (vector->list vec)))

(shuffle '(1 2 3 4 5))      ; e.g., (4 2 5 1 3)

; Shuffle immutably (returns new vector)
(define (vector-shuffle vec)
  (let ([copy (vector-copy vec)])
    (vector-shuffle! copy)
    copy))

Probability distributions:

; Uniform distribution is built-in with (random)

; Normal (Gaussian) distribution - Box-Muller transform
(define (random-normal mean std-dev)
  (let ([u1 (random 1.0)]
        [u2 (random 1.0)])
    (+ mean
       (* std-dev
          (sqrt (* -2.0 (log u1)))
          (cos (* 2.0 3.14159265 u2))))))

(random-normal 0.0 1.0)     ; Standard normal

; Exponential distribution
(define (random-exponential rate)
  (/ (- (log (random 1.0))) rate))

(random-exponential 1.0)    ; Mean = 1/rate

; Weighted random choice
(define (weighted-choice items weights)
  (let* ([total (apply + weights)]
         [r (* (random 1.0) total)])
    (let loop ([items items] [weights weights] [sum 0])
      (let ([new-sum (+ sum (car weights))])
        (if (< r new-sum)
            (car items)
            (loop (cdr items) (cdr weights) new-sum))))))

(weighted-choice '(rare common) '(1 9))  ; common 90% of time

; Bernoulli trial
(define (bernoulli p)
  (< (random 1.0) p))

(bernoulli 0.7)             ; #t with 70% probability

; Geometric distribution (number of trials until success)
(define (random-geometric p)
  (let loop ([count 1])
    (if (bernoulli p)
        count
        (loop (+ count 1)))))

Cryptographically secure randomness (if available):

; Read from /dev/urandom (Unix-like systems)
(define (crypto-random-bytes n)
  (call-with-port (open-file-input-port "/dev/urandom")
    (lambda (port)
      (get-bytevector-n port n))))

(crypto-random-bytes 16)    ; 16 random bytes

; Convert to integer
(define (crypto-random-integer n)
  (let* ([bytes-needed (ceiling (/ (integer-length n) 8))]
         [bv (crypto-random-bytes bytes-needed)]
         [value (bytevector-uint-ref bv 0 'big bytes-needed)])
    (mod value n)))

(crypto-random-integer 1000000)  ; Cryptographically random

; UUID generation
(define (random-uuid)
  (let ([bv (crypto-random-bytes 16)])
    ; Set version 4 and variant bits
    (bytevector-u8-set! bv 6
      (fxior #x40 (fxand #x0f (bytevector-u8-ref bv 6))))
    (bytevector-u8-set! bv 8
      (fxior #x80 (fxand #x3f (bytevector-u8-ref bv 8))))
    (format "~8,'0x-~4,'0x-~4,'0x-~4,'0x-~12,'0x"
            (bytevector-u32-ref bv 0 'big)
            (bytevector-u16-ref bv 4 'big)
            (bytevector-u16-ref bv 6 'big)
            (bytevector-u16-ref bv 8 'big)
            (+ (ash (bytevector-u32-ref bv 10 'big) 16)
               (bytevector-u16-ref bv 14 'big)))))

Miscellaneous Numeric Operations

Type conversion:

; Exact to inexact
(inexact 42)                ; 42.0
(exact->inexact 3/4)        ; 0.75
(inexact 3+4i)              ; 3.0+4.0i

; Inexact to exact
(exact 42.0)                ; 42
(inexact->exact 0.5)        ; 1/2
(exact 3.14)                ; 7070651414971679/2251799813685248

; Rationalize (find simple approximation)
(rationalize 3.14159 0.001) ; 22/7
(rationalize 0.333 0.01)    ; 1/3

; Round to integer
(round 3.5)                 ; 4.0 (or 4 for exact)
(floor 3.7)                 ; 3.0
(ceiling 3.2)               ; 4.0
(truncate 3.9)              ; 3.0
(truncate -3.9)             ; -3.0

; Exact round
(exact (round 3.5))         ; 4

Arithmetic operations:

; Basic operations (generic)
(+ 1 2 3 4 5)               ; 15
(- 10 3 2)                  ; 5
(* 2 3 4)                   ; 24
(/ 24 4 2)                  ; 3

; Unary minus and reciprocal
(- 42)                      ; -42
(/ 4)                       ; 1/4

; Division variants
(quotient 17 5)             ; 3 (truncate toward zero)
(remainder 17 5)            ; 2 (sign follows dividend)
(modulo 17 5)               ; 2 (sign follows divisor)

(quotient -17 5)            ; -3
(remainder -17 5)           ; -2
(modulo -17 5)              ; 3

; Euclidean division
(div 17 5)                  ; 3
(mod 17 5)                  ; 2
(div-and-mod 17 5)          ; Returns: 3, 2

(div0 -17 5)                ; -4
(mod0 -17 5)                ; 3
(div0-and-mod0 -17 5)       ; Returns: -4, 3

; Absolute value
(abs -42)                   ; 42
(abs -3.14)                 ; 3.14
(abs 3+4i)                  ; 5.0 (magnitude)

Powers and logarithms:

; Exponentiation
(expt 2 10)                 ; 1024
(expt 2 -1)                 ; 1/2
(expt 2 1/2)                ; 1.414... (sqrt 2)
(expt -1 1/2)               ; 0.0+1.0i
(expt 2.0 10.0)             ; 1024.0

; Square root
(sqrt 16)                   ; 4
(sqrt 2)                    ; 1.414...
(sqrt -1)                   ; 0.0+1.0i

; Exact integer square root (Chez extension)
(isqrt 17)                  ; 4 (floor of sqrt)
(exact-integer-sqrt 17)     ; Returns: 4, 1 (root and remainder)

; Natural logarithm
(log 2.71828)               ; ~1.0
(log (exp 1))               ; 1.0

; Logarithm with base
(log 100 10)                ; 2.0
(log 8 2)                   ; 3.0

; Exponential
(exp 1)                     ; 2.71828... (e)
(exp 0)                     ; 1

Trigonometric functions:

; Basic trig (radians)
(sin 0)                     ; 0
(cos 0)                     ; 1
(tan 0)                     ; 0

; Pi constant
(define pi 3.141592653589793)
(sin pi)                    ; ~0 (small floating-point error)
(cos pi)                    ; -1.0

; Inverse trig
(asin 0)                    ; 0
(acos 1)                    ; 0
(atan 1)                    ; 0.785... (pi/4)
(atan 1 1)                  ; 0.785... (atan2)
(atan 1 -1)                 ; 2.356... (3*pi/4)

; Hyperbolic
(sinh 0)                    ; 0
(cosh 0)                    ; 1
(tanh 0)                    ; 0

; Inverse hyperbolic
(asinh 0)                   ; 0
(acosh 1)                   ; 0
(atanh 0)                   ; 0

; Degrees conversion helpers
(define (degrees->radians d)
  (* d (/ pi 180)))
(define (radians->degrees r)
  (* r (/ 180 pi)))

(sin (degrees->radians 90)) ; 1.0

GCD, LCM, and modular arithmetic:

; Greatest common divisor
(gcd 48 18)                 ; 6
(gcd 48 18 12)              ; 6
(gcd)                       ; 0

; Least common multiple
(lcm 4 6)                   ; 12
(lcm 4 6 8)                 ; 24
(lcm)                       ; 1

; Numerator and denominator
(numerator 3/4)             ; 3
(denominator 3/4)           ; 4
(numerator 3)               ; 3
(denominator 3)             ; 1

; Modular exponentiation (efficient)
(define (mod-expt base exp mod)
  (let loop ([base (modulo base mod)]
             [exp exp]
             [result 1])
    (cond
      [(zero? exp) result]
      [(odd? exp)
       (loop (modulo (* base base) mod)
             (quotient exp 2)
             (modulo (* result base) mod))]
      [else
       (loop (modulo (* base base) mod)
             (quotient exp 2)
             result)])))

(mod-expt 2 100 1000000007) ; Efficient large power mod prime

; Modular inverse (extended Euclidean algorithm)
(define (mod-inverse a m)
  (let loop ([old-r m] [r a] [old-s 0] [s 1])
    (if (zero? r)
        (if (= old-r 1)
            #f  ; No inverse
            (modulo old-s m))
        (let ([q (quotient old-r r)])
          (loop r (- old-r (* q r))
                s (- old-s (* q s)))))))

Number theoretic functions:

; Primality test (simple)
(define (prime? n)
  (cond
    [(< n 2) #f]
    [(= n 2) #t]
    [(even? n) #f]
    [else
     (let ([limit (isqrt n)])
       (let loop ([d 3])
         (cond
           [(> d limit) #t]
           [(zero? (modulo n d)) #f]
           [else (loop (+ d 2))])))]))

(filter prime? (iota 30 2))  ; (2 3 5 7 11 13 17 19 23 29)

; Prime factorization
(define (prime-factors n)
  (let loop ([n n] [d 2] [factors '()])
    (cond
      [(= n 1) (reverse factors)]
      [(> (* d d) n) (reverse (cons n factors))]
      [(zero? (modulo n d))
       (loop (/ n d) d (cons d factors))]
      [else
       (loop n (if (= d 2) 3 (+ d 2)) factors)])))

(prime-factors 360)         ; (2 2 2 3 3 5)

; Euler's totient function
(define (totient n)
  (let ([factors (remove-duplicates (prime-factors n))])
    (fold-left
      (lambda (result p)
        (* result (- p 1) (/ n p) (/ 1 (- (/ n (expt p (count-factor n p))) 1))))
      n
      factors)))

; Simpler totient
(define (totient n)
  (length (filter (lambda (k) (= 1 (gcd k n)))
                  (iota n 1))))

(totient 12)                ; 4 (1, 5, 7, 11 are coprime to 12)

Numeric precision and limits:

; Fixnum limits (platform-dependent)
(greatest-fixnum)           ; Largest fixnum
(least-fixnum)              ; Smallest fixnum
(fixnum-width)              ; Bit width

; Flonum limits
(define fl-max 1.7976931348623157e+308)
(define fl-min 2.2250738585072014e-308)
(define fl-epsilon 2.220446049250313e-16)

; Machine epsilon
(let loop ([eps 1.0])
  (if (= 1.0 (+ 1.0 eps))
      (* eps 2.0)
      (loop (/ eps 2.0))))  ; ~2.22e-16

; Check if flonum operations would overflow
(define (fl-overflow? x y op)
  (let ([result (op x y)])
    (or (infinite? result) (nan? result))))

; Arbitrary precision
(expt 10 100)               ; Exact 10^100
(factorial 100)             ; Huge exact integer

; Working with big numbers
(define (factorial n)
  (if (<= n 1)
      1
      (* n (factorial (- n 1)))))

(integer-length (factorial 100))  ; 525 bits needed

; String representation of large numbers
(number->string (factorial 50))   ; Long exact decimal

Numeric string formatting:

; Basic number to string
(number->string 42)         ; "42"
(number->string 3.14159)    ; "3.14159"
(number->string 3+4i)       ; "3+4i"

; With radix
(number->string 255 16)     ; "ff"
(number->string 255 2)      ; "11111111"
(number->string 255 8)      ; "377"

; Format with precision
(format "~,2f" 3.14159)     ; "3.14"
(format "~,5f" 3.14159)     ; "3.14159"
(format "~e" 12345.6)       ; "1.23456e4"

; Padding and alignment
(format "~8d" 42)           ; "      42"
(format "~8,'0d" 42)        ; "00000042"
(format "~8,2f" 3.14)       ; "    3.14"

; Hex and binary formatting
(format "~x" 255)           ; "ff"
(format "~X" 255)           ; "FF"
(format "~b" 42)            ; "101010"
(format "~o" 64)            ; "100"

; Custom decimal formatting
(define (format-decimal n places)
  (let* ([factor (expt 10 places)]
         [rounded (/ (round (* n factor)) factor)])
    (format "~v,vf" (+ places 3) places rounded)))

(format-decimal 3.14159 2)  ; "3.14"

Numeric utilities:

; Min and max
(min 3 1 4 1 5)             ; 1
(max 3 1 4 1 5)             ; 5
(min 1.0 2 3/4)             ; 0.75 (mixed types)

; Clamping
(define (clamp x lo hi)
  (max lo (min hi x)))

(clamp 5 0 10)              ; 5
(clamp -5 0 10)             ; 0
(clamp 15 0 10)             ; 10

; Linear interpolation
(define (lerp a b t)
  (+ a (* t (- b a))))

(lerp 0 100 0.5)            ; 50.0
(lerp 0 100 0.25)           ; 25.0

; Map value from one range to another
(define (map-range x in-min in-max out-min out-max)
  (+ out-min
     (* (- out-max out-min)
        (/ (- x in-min)
           (- in-max in-min)))))

(map-range 50 0 100 0 1)    ; 0.5

; Sign function
(define (sgn x)
  (cond
    [(positive? x) 1]
    [(negative? x) -1]
    [else 0]))

(sgn -42)                   ; -1
(sgn 42)                    ; 1
(sgn 0)                     ; 0

; Sum and product of lists
(define (sum lst) (apply + lst))
(define (product lst) (apply * lst))

(sum '(1 2 3 4 5))          ; 15
(product '(1 2 3 4 5))      ; 120

; Average
(define (average lst)
  (/ (sum lst) (length lst)))

(average '(1 2 3 4 5))      ; 3

Input/Output Operations in Chez Scheme

Generic Ports

Ports are the abstraction for I/O in Scheme:

; Port type hierarchy
; - Input ports (for reading)
; - Output ports (for writing)
; - Input/output ports (bidirectional)
; - Binary ports (raw bytes)
; - Textual ports (characters with encoding)

; Standard ports
(current-input-port)        ; stdin
(current-output-port)       ; stdout
(current-error-port)        ; stderr

; Port predicates
(port? (current-input-port))         ; #t
(input-port? (current-input-port))   ; #t
(output-port? (current-output-port)) ; #t
(binary-port? port)                  ; #t if binary
(textual-port? port)                 ; #t if textual

; Input/output port check
(input-port? (open-input-output-file "test.txt"))   ; #t
(output-port? (open-input-output-file "test.txt"))  ; #t

Port direction and type combinations:

; Four main combinations:
; 1. Textual input port - reads characters
; 2. Textual output port - writes characters
; 3. Binary input port - reads bytes
; 4. Binary output port - writes bytes

; Plus bidirectional versions:
; 5. Textual input/output port
; 6. Binary input/output port

; Check port capabilities
(define (port-info port)
  (printf "Input: ~a~n" (input-port? port))
  (printf "Output: ~a~n" (output-port? port))
  (printf "Binary: ~a~n" (binary-port? port))
  (printf "Textual: ~a~n" (textual-port? port)))

; Example
(port-info (current-input-port))
; Input: #t
; Output: #f
; Binary: #f
; Textual: #t

Port parameters:

; Rebind standard ports temporarily
(parameterize ([current-output-port (open-output-file "log.txt")])
  (display "This goes to log.txt")
  (newline))

; Redirect error output
(parameterize ([current-error-port (current-output-port)])
  (error 'test "error message"))  ; Goes to stdout

; Console ports (Chez extension)
(console-input-port)        ; Direct console input
(console-output-port)       ; Direct console output
(console-error-port)        ; Direct console error

; These bypass any redirection

File Options

File options control how files are opened:

; file-options creates a file-options object
(file-options)              ; No options (default behavior)

; Available options:
; no-create    - Don't create if doesn't exist
; no-fail      - Don't fail if exists (for output)
; no-truncate  - Don't truncate existing file
; append       - Append to existing file
; exclusive    - Fail if file exists
; compressed   - Use compression (Chez extension)
; replace      - Replace existing file

; Common combinations for output:
(file-options no-fail)      ; Overwrite if exists, create if not
(file-options no-fail no-truncate)  ; Keep existing content
(file-options append)       ; Append to file
(file-options exclusive)    ; Create new only, fail if exists

; For input (fewer options matter):
(file-options)              ; Normal open
(file-options compressed)   ; Open compressed file

Using file options:

; Default output: fail if exists
(open-file-output-port "new.txt")  ; Error if file exists

; Allow overwriting
(open-file-output-port "new.txt"
  (file-options no-fail))

; Append mode
(open-file-output-port "log.txt"
  (file-options no-fail append))

; Exclusive creation
(open-file-output-port "unique.txt"
  (file-options exclusive))  ; Fail if exists

; Keep existing content, write at beginning
(open-file-output-port "data.txt"
  (file-options no-fail no-truncate))

; Compressed file (Chez extension)
(open-file-output-port "data.gz"
  (file-options no-fail compressed))

Buffer modes:

; Buffer mode affects when data is actually written
; - none: Write immediately (unbuffered)
; - line: Write when newline encountered
; - block: Write when buffer full (default)

; Specify buffer mode when opening
(open-file-output-port "file.txt"
  (file-options no-fail)
  'line)                    ; Line buffering

(open-file-output-port "file.txt"
  (file-options no-fail)
  'none)                    ; Unbuffered

(open-file-output-port "file.txt"
  (file-options no-fail)
  'block)                   ; Block buffered (default)

; Buffer mode affects:
; - Performance (buffered is faster)
; - When output becomes visible
; - Behavior with multiple writers

Transcoders

Transcoders convert between bytes and characters:

; A transcoder combines:
; - Codec (encoding): UTF-8, UTF-16, Latin-1, etc.
; - EOL style: lf, cr, crlf, nel, crnel, ls, none
; - Error handling mode: ignore, raise, replace

; Create transcoder
(make-transcoder (utf-8-codec))

(make-transcoder
  (utf-8-codec)
  'lf                       ; EOL style
  'replace)                 ; Error mode

; Available codecs
(utf-8-codec)               ; UTF-8 encoding
(utf-16-codec)              ; UTF-16 with BOM
(utf-16le-codec)            ; UTF-16 little-endian
(utf-16be-codec)            ; UTF-16 big-endian
(latin-1-codec)             ; ISO-8859-1
(native-transcoder)         ; Platform default

EOL (end-of-line) styles:

; EOL styles for line ending conversion
; 'none   - No conversion
; 'lf     - Unix style (linefeed)
; 'cr     - Old Mac style (carriage return)
; 'crlf   - Windows style (carriage return + linefeed)
; 'nel    - Unicode next line
; 'crnel  - CR + NEL
; 'ls     - Unicode line separator

; Native EOL style
(native-eol-style)          ; 'lf on Unix, 'crlf on Windows

; Create transcoder with specific EOL
(make-transcoder
  (utf-8-codec)
  'crlf)                    ; Windows-style line endings

; EOL conversion on input:
; - All EOL sequences converted to #\newline
; EOL conversion on output:
; - #\newline converted to specified style

Error handling modes:

; Error modes for invalid byte sequences
; 'ignore  - Skip invalid bytes
; 'raise   - Raise exception
; 'replace - Insert replacement character (U+FFFD)

; Strict transcoder (raise on error)
(make-transcoder
  (utf-8-codec)
  'none
  'raise)

; Lenient transcoder (replace invalid)
(make-transcoder
  (utf-8-codec)
  'none
  'replace)

; Using transcoders with ports
(open-file-input-port "data.txt"
  (file-options)
  'block
  (make-transcoder (utf-8-codec)))

; Transcoded port (wrap binary port)
(define bin-port (open-file-input-port "data.txt"))
(define text-port
  (transcoded-port bin-port (make-transcoder (utf-8-codec))))

; Get transcoder from port
(port-transcoder text-port)  ; Returns transcoder or #f

Transcoder inspection:

; Extract components from transcoder
(define tc (make-transcoder (utf-8-codec) 'crlf 'replace))

(transcoder-codec tc)       ; UTF-8 codec
(transcoder-eol-style tc)   ; crlf
(transcoder-error-handling-mode tc)  ; replace

; Check if Latin-1 codec
(define (latin-1-transcoder? tc)
  (eq? (transcoder-codec tc) (latin-1-codec)))

; Create matching transcoder with different EOL
(define (transcoder-with-eol tc eol)
  (make-transcoder
    (transcoder-codec tc)
    eol
    (transcoder-error-handling-mode tc)))

Port Operations

Opening and closing ports:

; Close any port
(close-port port)

; Close specific direction
(close-input-port port)     ; Close input side
(close-output-port port)    ; Close output side

; Check if port is closed (Chez extension)
(port-closed? port)         ; #t if closed

; Ports and garbage collection
; Ports are closed when garbage collected, but
; explicit closing is recommended for resources

; Safe port handling with dynamic-wind
(define (call-with-port port proc)
  (dynamic-wind
    (lambda () #f)
    (lambda () (proc port))
    (lambda () (close-port port))))

; Built-in call-with-* procedures
(call-with-input-file "data.txt"
  (lambda (port)
    (get-line port)))

(call-with-output-file "data.txt"
  (lambda (port)
    (display "Hello" port)))

Port positioning:

; Check if port supports positioning
(port-has-port-position? port)
(port-has-set-port-position!? port)

; Get current position
(port-position port)        ; Returns position

; Set position
(set-port-position! port 0)  ; Go to beginning
(set-port-position! port 100) ; Go to byte/char 100

; Position is in:
; - Bytes for binary ports
; - Characters for some textual ports
; - May be opaque for textual ports (codec-dependent)

; Seek from different origins (Chez extension)
(file-position port)        ; Current position
(file-position port 0)      ; Seek to beginning
(file-position port pos)    ; Seek to position

; File length (Chez extension)
(file-length port)          ; Total length in bytes

Port buffer control:

; Flush output buffer
(flush-output-port port)
(flush-output-port)         ; Flush current-output-port

; Check for available input
(input-port-ready? port)    ; #t if data available without blocking

; Clear input buffer (Chez extension)
(clear-input-port port)
(clear-input-port)          ; Clear current-input-port

; Clear output buffer without writing (Chez extension)
(clear-output-port port)
(clear-output-port)         ; Clear current-output-port

; Port buffer mode
(output-port-buffer-mode port)  ; 'none, 'line, or 'block

; Set buffer mode (Chez extension)
(set-port-output-buffer-mode! port 'line)

Port names and information:

; Get port name (for error messages, debugging)
(port-name port)            ; Returns string

; Chez extensions for port info
(port-file-descriptor port) ; OS file descriptor (if applicable)

; Check port EOF status
(port-eof? port)            ; #t if at end of file

; Mark port as EOF (Chez extension)
(set-port-eof! port #t)

; Input port position tracking
(port-has-port-length? port)  ; Can get length?
(port-length port)            ; Get length if available

String Ports

String input ports:

; Create input port from string
(open-input-string "Hello, World!")

; Read from string
(let ([port (open-input-string "Hello, World!")])
  (get-line port))          ; "Hello, World!"

; Parse data from string
(let ([port (open-input-string "(1 2 3) (4 5 6)")])
  (list (read port) (read port)))
; ((1 2 3) (4 5 6))

; Read multiple values
(let ([port (open-input-string "42 3.14 hello")])
  (let* ([a (read port)]
         [b (read port)]
         [c (read port)])
    (list a b c)))          ; (42 3.14 hello)

; Useful for testing
(define (parse-expression str)
  (read (open-input-string str)))

(parse-expression "(+ 1 2)")  ; (+ 1 2)

String output ports:

; Create output port to string
(open-output-string)

; Write to string
(let ([port (open-output-string)])
  (display "Hello, " port)
  (display "World!" port)
  (get-output-string port)) ; "Hello, World!"

; Get accumulated output
(define port (open-output-string))
(display "Line 1\n" port)
(display "Line 2\n" port)
(get-output-string port)    ; "Line 1\nLine 2\n"

; get-output-string can be called multiple times
(display "More" port)
(get-output-string port)    ; "Line 1\nLine 2\nMore"

; Build formatted string
(let ([port (open-output-string)])
  (fprintf port "Name: ~a~n" "Alice")
  (fprintf port "Age: ~a~n" 30)
  (get-output-string port))
; "Name: Alice\nAge: 30\n"

with-output-to-string and with-input-from-string:

; Capture output to string (Chez extension)
(with-output-to-string
  (lambda ()
    (display "Hello")
    (newline)
    (display "World")))
; "Hello\nWorld"

; Read from string as current input (Chez extension)
(with-input-from-string "(1 2 3)"
  (lambda ()
    (read)))                ; (1 2 3)

; Capture pretty-printed output
(with-output-to-string
  (lambda ()
    (pretty-print '(define (factorial n)
                     (if (zero? n) 1 (* n (factorial (- n 1))))))))

; Parse multiple items from string
(with-input-from-string "1 2 3 4 5"
  (lambda ()
    (let loop ([acc '()])
      (let ([x (read)])
        (if (eof-object? x)
            (reverse acc)
            (loop (cons x acc)))))))

Bytevector ports:

; Binary input from bytevector
(open-bytevector-input-port #vu8(1 2 3 4 5))

(let ([port (open-bytevector-input-port #vu8(72 101 108 108 111))])
  (get-bytevector-all port))
; #vu8(72 101 108 108 111)

; Binary output to bytevector
(let ([port (open-bytevector-output-port)])
  (put-u8 port 72)
  (put-u8 port 105)
  (get-output-bytevector port))
; #vu8(72 105)

; With extraction procedure
(let-values ([(port extract) (open-bytevector-output-port)])
  (put-bytevector port #vu8(1 2 3))
  (put-bytevector port #vu8(4 5 6))
  (extract))                ; #vu8(1 2 3 4 5 6)

; Transcoded bytevector port
(let ([port (open-bytevector-input-port
              (string->utf8 "Hello"))])
  (let ([tport (transcoded-port port (native-transcoder))])
    (get-line tport)))      ; "Hello"

File Ports

Opening files for input:

; Simple file input (textual)
(open-input-file "data.txt")

; Binary file input
(open-file-input-port "data.bin")

; With transcoder (textual)
(open-file-input-port "data.txt"
  (file-options)
  'block
  (native-transcoder))

; Read entire file
(define (read-file filename)
  (call-with-input-file filename
    (lambda (port)
      (get-string-all port))))

(read-file "data.txt")      ; Entire file as string

; Read lines
(define (read-lines filename)
  (call-with-input-file filename
    (lambda (port)
      (let loop ([lines '()])
        (let ([line (get-line port)])
          (if (eof-object? line)
              (reverse lines)
              (loop (cons line lines))))))))

(read-lines "data.txt")     ; List of lines

Opening files for output:

; Simple file output (textual)
(open-output-file "output.txt")  ; Fails if exists

; With options
(open-output-file "output.txt"
  '(mode #o644))            ; Unix permissions (Chez)

; Binary file output
(open-file-output-port "data.bin")

; Allow overwrite
(open-file-output-port "data.bin"
  (file-options no-fail))

; Append mode
(open-file-output-port "log.txt"
  (file-options no-fail append))

; With transcoder
(open-file-output-port "data.txt"
  (file-options no-fail)
  'block
  (make-transcoder (utf-8-codec)))

; Write entire file
(define (write-file filename content)
  (call-with-output-file filename
    (lambda (port)
      (display content port))
    '(replace)))            ; Replace if exists

(write-file "output.txt" "Hello, World!")

Bidirectional file ports:

; Open for both input and output
(open-file-input/output-port "data.txt"
  (file-options no-fail no-truncate))

; Chez extension
(open-input-output-file "data.txt")

; Use cases:
; - In-place file modification
; - Database-like random access
; - Log files with read-back

; Example: read, modify, write back
(let ([port (open-file-input/output-port "counter.txt"
              (file-options no-fail no-truncate)
              'block
              (native-transcoder))])
  (let ([value (read port)])
    (set-port-position! port 0)
    (write (+ value 1) port)
    (truncate-port port)    ; Remove excess
    (close-port port)))

; truncate-port cuts file at current position (Chez extension)
(truncate-port port)

Compressed files (Chez extension):

; Write compressed file
(let ([port (open-file-output-port "data.gz"
              (file-options no-fail compressed))])
  (put-bytevector port (string->utf8 "Lots of repeated text... "))
  ; ... write more data
  (close-port port))

; Read compressed file
(let ([port (open-file-input-port "data.gz"
              (file-options compressed))])
  (let ([data (get-bytevector-all port)])
    (close-port port)
    data))

; Note: Compressed ports may not support positioning

Custom Ports

Custom binary input ports:

; make-custom-binary-input-port
; Arguments:
;   id          - string identifier
;   read!       - (bytevector start count) -> bytes-read
;   get-position - () -> position, or #f
;   set-position! - (position) -> void, or #f
;   close       - () -> void, or #f

(define (make-repeating-port byte count)
  (let ([pos 0])
    (make-custom-binary-input-port
      "repeating-byte"
      (lambda (bv start n)          ; read!
        (let ([to-read (min n (- count pos))])
          (do ([i 0 (+ i 1)])
              ((= i to-read)
               (set! pos (+ pos to-read))
               to-read)
            (bytevector-u8-set! bv (+ start i) byte))))
      (lambda () pos)               ; get-position
      (lambda (p) (set! pos p))     ; set-position!
      #f)))                         ; close

(define port (make-repeating-port 65 10))  ; 10 'A's
(get-bytevector-all port)   ; #vu8(65 65 65 65 65 65 65 65 65 65)

Custom binary output ports:

; make-custom-binary-output-port
; Arguments:
;   id           - string identifier
;   write!       - (bytevector start count) -> bytes-written
;   get-position - () -> position, or #f
;   set-position! - (position) -> void, or #f
;   close        - () -> void, or #f

; Port that counts bytes written
(define (make-counting-port)
  (let ([count 0])
    (values
      (make-custom-binary-output-port
        "counting"
        (lambda (bv start n)        ; write!
          (set! count (+ count n))
          n)                        ; Return bytes "written"
        #f                          ; get-position
        #f                          ; set-position!
        #f)                         ; close
      (lambda () count))))          ; Get count

(define-values (port get-count) (make-counting-port))
(put-bytevector port #vu8(1 2 3 4 5))
(put-bytevector port #vu8(6 7 8))
(get-count)                 ; 8

Custom textual ports:

; make-custom-textual-input-port
(define (make-string-generator-port generator)
  (let ([buffer ""]
        [pos 0])
    (make-custom-textual-input-port
      "generator"
      (lambda (str start count)     ; read!
        (when (>= pos (string-length buffer))
          (set! buffer (generator))
          (set! pos 0))
        (if (string? buffer)
            (let ([available (- (string-length buffer) pos)])
              (let ([to-copy (min count available)])
                (string-copy! buffer pos str start to-copy)
                (set! pos (+ pos to-copy))
                to-copy))
            0))                     ; EOF
      #f                            ; get-position
      #f                            ; set-position!
      #f)))                         ; close

; make-custom-textual-output-port
(define (make-line-collector)
  (let ([lines '()])
    (values
      (make-custom-textual-output-port
        "line-collector"
        (lambda (str start count)   ; write!
          (let ([s (substring str start (+ start count))])
            (set! lines (cons s lines)))
          count)
        #f #f #f)
      (lambda () (reverse lines)))))  ; Get lines

Custom input/output ports:

; make-custom-binary-input/output-port
; Combines read! and write! procedures

(define (make-memory-port size)
  (let ([buffer (make-bytevector size 0)]
        [pos 0])
    (make-custom-binary-input/output-port
      "memory"
      (lambda (bv start count)      ; read!
        (let ([to-read (min count (- size pos))])
          (bytevector-copy! buffer pos bv start to-read)
          (set! pos (+ pos to-read))
          to-read))
      (lambda (bv start count)      ; write!
        (let ([to-write (min count (- size pos))])
          (bytevector-copy! bv start buffer pos to-write)
          (set! pos (+ pos to-write))
          to-write))
      (lambda () pos)               ; get-position
      (lambda (p) (set! pos p))     ; set-position!
      (lambda () #f))))             ; close

(define mem (make-memory-port 100))
(put-bytevector mem #vu8(1 2 3 4 5))
(set-port-position! mem 0)
(get-bytevector-n mem 5)    ; #vu8(1 2 3 4 5)

Input Operations

Reading bytes (binary input):

; Read single byte
(get-u8 port)               ; Returns byte (0-255) or eof-object

; Lookahead (don't consume)
(lookahead-u8 port)         ; Peek at next byte

; Read multiple bytes
(get-bytevector-n port 10)  ; Read exactly 10 bytes (or less at EOF)
(get-bytevector-n! port bv start count)  ; Read into existing bytevector

; Read all remaining bytes
(get-bytevector-all port)   ; Returns bytevector or eof-object

; Read some bytes (may return fewer)
(get-bytevector-some port)  ; Read available bytes, at least 1

; Example
(let ([port (open-bytevector-input-port #vu8(1 2 3 4 5))])
  (list (get-u8 port)       ; 1
        (get-u8 port)       ; 2
        (get-bytevector-n port 2)))  ; #vu8(3 4)

Reading characters (textual input):

; Read single character
(get-char port)             ; Returns char or eof-object
(read-char port)            ; R5RS name, same behavior
(read-char)                 ; From current-input-port

; Lookahead
(lookahead-char port)       ; Peek at next character
(peek-char port)            ; R5RS name

; Read string of fixed length
(get-string-n port 10)      ; Read 10 characters
(get-string-n! port str start count)  ; Into existing string

; Read all remaining characters
(get-string-all port)       ; Entire remaining content

; Read some characters
(get-string-some port)      ; Read available, at least 1

; Example
(let ([port (open-input-string "Hello")])
  (list (get-char port)     ; #\H
        (lookahead-char port) ; #\e (not consumed)
        (get-char port)))   ; #\e

Reading lines:

; Read line (until newline or EOF)
(get-line port)             ; Returns string without newline
(read-line port)            ; Chez extension, same as get-line
(read-line)                 ; From current-input-port

; Example
(let ([port (open-input-string "Line 1\nLine 2\nLine 3")])
  (list (get-line port)     ; "Line 1"
        (get-line port)     ; "Line 2"
        (get-line port)     ; "Line 3"
        (get-line port)))   ; #!eof

; Read all lines
(define (port->lines port)
  (let loop ([lines '()])
    (let ([line (get-line port)])
      (if (eof-object? line)
          (reverse lines)
          (loop (cons line lines))))))

; With continuation for each line
(define (for-each-line port proc)
  (let loop ()
    (let ([line (get-line port)])
      (unless (eof-object? line)
        (proc line)
        (loop)))))

Reading Scheme data:

; Read Scheme datum
(read port)                 ; Parse one Scheme object
(read)                      ; From current-input-port

; Examples
(read (open-input-string "42"))        ; 42
(read (open-input-string "(+ 1 2)"))   ; (+ 1 2)
(read (open-input-string "#(1 2 3)"))  ; #(1 2 3)
(read (open-input-string "'hello"))    ; 'hello = (quote hello)

; Read multiple datums
(let ([port (open-input-string "1 2 3")])
  (list (read port) (read port) (read port)))
; (1 2 3)

; Read with shared structure
(let ([port (open-input-string "#0=(1 . #0#)")])
  (read port))              ; Circular list

; Chez extensions
(get-datum port)            ; Same as read
(get-datum/annotations port)  ; With source annotations

Reading with parameters:

; Control read behavior with parameters
(parameterize ([case-sensitive #t])  ; Preserve symbol case
  (read (open-input-string "Hello")))  ; Hello (not hello)

; Read with source information (Chez extension)
(read-token port)           ; Returns token type and value

; Skip whitespace and comments
(define (skip-whitespace port)
  (let ([c (lookahead-char port)])
    (when (and (char? c) (char-whitespace? c))
      (get-char port)
      (skip-whitespace port))))

; Check for EOF
(eof-object? (read port))   ; #t at end of file
(port-eof? port)            ; #t if at EOF (Chez extension)

Output Operations

Writing bytes (binary output):

; Write single byte
(put-u8 port 65)            ; Write byte 65 ('A')

; Write bytevector
(put-bytevector port #vu8(1 2 3 4 5))

; Write portion of bytevector
(put-bytevector port bv start count)

; Example
(let ([port (open-bytevector-output-port)])
  (put-u8 port 72)          ; H
  (put-u8 port 105)         ; i
  (get-output-bytevector port))
; #vu8(72 105)

Writing characters (textual output):

; Write single character
(put-char port #\A)
(write-char #\A port)       ; R5RS name
(write-char #\A)            ; To current-output-port

; Write string
(put-string port "Hello")
(put-string port str start count)  ; Portion of string

; Write newline
(newline port)
(newline)                   ; To current-output-port

; Example
(let ([port (open-output-string)])
  (put-char port #\H)
  (put-string port "ello")
  (newline port)
  (get-output-string port)) ; "Hello\n"

Display and write:

; display - human-readable output
(display "Hello" port)      ; Hello (no quotes)
(display 42 port)           ; 42
(display #\A port)          ; A (no #\)
(display '(1 2 3) port)     ; (1 2 3)

; write - machine-readable output (can be read back)
(write "Hello" port)        ; "Hello" (with quotes)
(write 42 port)             ; 42
(write #\A port)            ; #\A
(write '(1 2 3) port)       ; (1 2 3)

; Difference
(let ([port (open-output-string)])
  (display "Hello\n" port)
  (get-output-string port)) ; "Hello\n" (actual newline)

(let ([port (open-output-string)])
  (write "Hello\n" port)
  (get-output-string port)) ; "\"Hello\\n\"" (escaped)

; write output can be read back
(equal? '(1 2 3)
        (read (open-input-string
                (with-output-to-string
                  (lambda () (write '(1 2 3)))))))
; #t

Put-datum and write variants:

; put-datum - R6RS standard write
(put-datum port '(1 2 3))

; print - Chez extension, like write but handles cycles
(print '(1 2 3) port)

; Write with shared structure
(let ([x (list 1 2 3)])
  (set-car! (cddr x) x)     ; Create cycle
  (parameterize ([print-graph #t])
    (write x)))             ; #0=(1 2 #0#)

; printf for formatted output
(printf "Hello, ~a!~n" "World")

; fprintf to specific port
(fprintf port "Value: ~a~n" 42)

Input/Output Operations

Standard I/O shortcuts:

; These use current-input-port or current-output-port

; Input shortcuts
(read)                      ; (read (current-input-port))
(read-char)                 ; (read-char (current-input-port))
(peek-char)                 ; (peek-char (current-input-port))
(read-line)                 ; (read-line (current-input-port))

; Output shortcuts
(display x)                 ; (display x (current-output-port))
(write x)                   ; (write x (current-output-port))
(newline)                   ; (newline (current-output-port))
(write-char c)              ; (write-char c (current-output-port))

; Flush
(flush-output-port)         ; Flush current-output-port

File copy operations:

; Copy file (binary)
(define (copy-binary-file src dst)
  (call-with-port (open-file-input-port src)
    (lambda (in)
      (call-with-port (open-file-output-port dst
                        (file-options no-fail))
        (lambda (out)
          (let ([buffer (make-bytevector 4096)])
            (let loop ()
              (let ([n (get-bytevector-n! in buffer 0 4096)])
                (unless (eof-object? n)
                  (put-bytevector out buffer 0 n)
                  (loop))))))))))

; Copy file (textual)
(define (copy-text-file src dst)
  (call-with-input-file src
    (lambda (in)
      (call-with-output-file dst
        (lambda (out)
          (let loop ()
            (let ([line (get-line in)])
              (unless (eof-object? line)
                (put-string out line)
                (newline out)
                (loop)))))
        '(replace)))))

Transcoding between ports:

; Convert file encoding
(define (convert-encoding input-file output-file
                          input-codec output-codec)
  (let ([in (open-file-input-port input-file
              (file-options)
              'block
              (make-transcoder input-codec))]
        [out (open-file-output-port output-file
               (file-options no-fail)
               'block
               (make-transcoder output-codec))])
    (let loop ()
      (let ([s (get-string-some in)])
        (unless (eof-object? s)
          (put-string out s)
          (loop))))
    (close-port in)
    (close-port out)))

; UTF-8 to Latin-1
(convert-encoding "utf8.txt" "latin1.txt"
                  (utf-8-codec) (latin-1-codec))

Interactive I/O:

; Prompt and read
(define (prompt-read prompt)
  (display prompt)
  (flush-output-port)
  (read-line))

(define name (prompt-read "Enter your name: "))

; Yes/no prompt
(define (yes-or-no? prompt)
  (display prompt)
  (display " (yes/no) ")
  (flush-output-port)
  (let ([response (read-line)])
    (cond
      [(member response '("yes" "y" "Y" "YES")) #t]
      [(member response '("no" "n" "N" "NO")) #f]
      [else
       (display "Please answer yes or no.\n")
       (yes-or-no? prompt)])))

; Read with default
(define (prompt-with-default prompt default)
  (printf "~a [~a]: " prompt default)
  (flush-output-port)
  (let ([response (read-line)])
    (if (string=? response "")
        default
        response)))

Non-Unicode Bytevector/String Conversions

Legacy encoding conversions:

; Latin-1 (ISO-8859-1) conversions
(define (string->latin-1 str)
  (let ([bv (make-bytevector (string-length str))])
    (do ([i 0 (+ i 1)])
        ((= i (string-length str)) bv)
      (let ([c (char->integer (string-ref str i))])
        (if (> c 255)
            (bytevector-u8-set! bv i #x3F)  ; '?' for unmappable
            (bytevector-u8-set! bv i c))))))

(define (latin-1->string bv)
  (let ([str (make-string (bytevector-length bv))])
    (do ([i 0 (+ i 1)])
        ((= i (bytevector-length bv)) str)
      (string-set! str i
        (integer->char (bytevector-u8-ref bv i))))))

; Using transcoders
(define (string->bytevector/transcoder str tc)
  (call-with-bytevector-output-port
    (lambda (port)
      (put-string (transcoded-port port tc) str))))

(string->bytevector/transcoder "Hello"
  (make-transcoder (latin-1-codec)))

ASCII conversions:

; ASCII string to bytevector
(define (string->ascii str)
  (let ([bv (make-bytevector (string-length str))])
    (do ([i 0 (+ i 1)])
        ((= i (string-length str)) bv)
      (let ([c (char->integer (string-ref str i))])
        (bytevector-u8-set! bv i (fxand c #x7F))))))

; Bytevector to ASCII string
(define (ascii->string bv)
  (let ([str (make-string (bytevector-length bv))])
    (do ([i 0 (+ i 1)])
        ((= i (bytevector-length bv)) str)
      (string-set! str i
        (integer->char (bytevector-u8-ref bv i))))))

; Check if string is ASCII-safe
(define (ascii-string? str)
  (let loop ([i 0])
    (or (= i (string-length str))
        (and (< (char->integer (string-ref str i)) 128)
             (loop (+ i 1))))))

Bytevector encoding utilities:

; Hex encoding
(define (bytevector->hex-string bv)
  (let ([str (make-string (* 2 (bytevector-length bv)))])
    (do ([i 0 (+ i 1)])
        ((= i (bytevector-length bv)) str)
      (let* ([b (bytevector-u8-ref bv i)]
             [hi (fxsrl b 4)]
             [lo (fxand b #xF)])
        (string-set! str (* i 2)
          (string-ref "0123456789abcdef" hi))
        (string-set! str (+ (* i 2) 1)
          (string-ref "0123456789abcdef" lo))))))

(bytevector->hex-string #vu8(255 128 0))  ; "ff8000"

; Hex decoding
(define (hex-string->bytevector str)
  (let* ([len (quotient (string-length str) 2)]
         [bv (make-bytevector len)])
    (do ([i 0 (+ i 1)])
        ((= i len) bv)
      (let ([hi (string-ref str (* i 2))]
            [lo (string-ref str (+ (* i 2) 1))])
        (bytevector-u8-set! bv i
          (+ (* 16 (hex-digit hi))
             (hex-digit lo)))))))

(define (hex-digit c)
  (cond
    [(char<=? #\0 c #\9) (- (char->integer c) 48)]
    [(char<=? #\a c #\f) (+ 10 (- (char->integer c) 97))]
    [(char<=? #\A c #\F) (+ 10 (- (char->integer c) 65))]
    [else (error 'hex-digit "invalid hex digit" c)]))

Base64 encoding:

; Base64 encoding
(define base64-chars
  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")

(define (bytevector->base64 bv)
  (let* ([len (bytevector-length bv)]
         [out-len (* 4 (ceiling (/ len 3)))]
         [str (make-string out-len #\=)])
    (let loop ([i 0] [j 0])
      (when (< i len)
        (let* ([b0 (bytevector-u8-ref bv i)]
               [b1 (if (< (+ i 1) len)
                       (bytevector-u8-ref bv (+ i 1)) 0)]
               [b2 (if (< (+ i 2) len)
                       (bytevector-u8-ref bv (+ i 2)) 0)]
               [n (+ (ash b0 16) (ash b1 8) b2)])
          (string-set! str j
            (string-ref base64-chars (fxand (fxsrl n 18) #x3F)))
          (string-set! str (+ j 1)
            (string-ref base64-chars (fxand (fxsrl n 12) #x3F)))
          (when (< (+ i 1) len)
            (string-set! str (+ j 2)
              (string-ref base64-chars (fxand (fxsrl n 6) #x3F))))
          (when (< (+ i 2) len)
            (string-set! str (+ j 3)
              (string-ref base64-chars (fxand n #x3F))))
          (loop (+ i 3) (+ j 4)))))
    str))

(bytevector->base64 #vu8(72 101 108 108 111))  ; "SGVsbG8="

Pretty Printing

Basic pretty printing:

; pretty-print formats Scheme data nicely
(pretty-print '(define (factorial n)
                 (if (zero? n)
                     1
                     (* n (factorial (- n 1))))))
; Prints with proper indentation

; Compare with write
(write '(define (factorial n) (if (zero? n) 1 (* n (factorial (- n 1))))))
; Prints on one line

; Pretty-print to specific port
(pretty-print datum port)

; Pretty-print to string
(with-output-to-string
  (lambda ()
    (pretty-print '(1 2 3))))

Pretty printing parameters:

; Line width
(pretty-line-length)        ; Get current (default 75)
(pretty-line-length 100)    ; Set to 100

(parameterize ([pretty-line-length 40])
  (pretty-print long-expression))

; Initial indentation
(pretty-initial-indent 4)   ; Start with 4 spaces

; One-line limit (try to fit on one line if under this)
(pretty-one-line-limit)     ; Get
(pretty-one-line-limit 60)  ; Set

; Maximum depth
(print-level)               ; Maximum nesting depth
(parameterize ([print-level 3])
  (pretty-print deeply-nested))  ; Shows ... for deeper

; Maximum length
(print-length)              ; Maximum list length
(parameterize ([print-length 10])
  (pretty-print long-list))      ; Shows ... after 10

Pretty format control:

; pretty-format sets formatting for specific forms
(pretty-format 'my-special-form
  '(my-special-form (bracket x ...) #f body ...))

; Format specifiers:
; (bracket x ...)  - arguments on same line
; #f               - break here
; body ...         - indented body expressions

; Built-in formats
(pretty-format 'define)     ; See how define is formatted
(pretty-format 'lambda)     ; See how lambda is formatted
(pretty-format 'let)        ; See how let is formatted

; Custom formatting for DSL
(pretty-format 'when-valid
  '(when-valid test #f body ...))

; Reset to default
(pretty-format 'my-form #f)

Print parameters affecting output:

; print-graph - handle shared/cyclic structure
(parameterize ([print-graph #t])
  (let ([x (list 1 2 3)])
    (set-cdr! (cddr x) x)
    (pretty-print x)))      ; #0=(1 2 3 . #0#)

; print-vector-length - show vector length
(parameterize ([print-vector-length #t])
  (pretty-print '#(1 2 3))) ; #3(1 2 3)

; print-gensym - how to print gensyms
(parameterize ([print-gensym #t])
  (pretty-print (gensym "x")))  ; #{x n}

; print-brackets - use [ ] for some forms
(parameterize ([print-brackets #t])
  (pretty-print '(let ([x 1] [y 2]) (+ x y))))
; (let ([x 1] [y 2]) (+ x y))

; print-unicode - use Unicode escapes
(parameterize ([print-unicode #f])
  (write #\λ))              ; #\x3BB

Formatted Output

Format strings with format and printf:

; format returns string
(format "Hello, ~a!" "World")   ; "Hello, World!"

; printf prints to current-output-port
(printf "Hello, ~a!~n" "World")

; fprintf prints to specific port
(fprintf port "Value: ~a~n" 42)

; errorf prints to current-error-port and raises error
(errorf 'proc "Error: ~a" message)

; warningf prints warning
(warningf 'proc "Warning: ~a" message)

Common format directives:

; ~a - display (aesthetic, human-readable)
(format "~a" "hello")       ; "hello" (no quotes)
(format "~a" 42)            ; "42"
(format "~a" '(1 2 3))      ; "(1 2 3)"

; ~s - write (machine-readable)
(format "~s" "hello")       ; "\"hello\"" (with quotes)
(format "~s" #\a)           ; "#\\a"

; ~d - decimal integer
(format "~d" 42)            ; "42"

; ~b - binary
(format "~b" 42)            ; "101010"

; ~o - octal
(format "~o" 42)            ; "52"

; ~x - hexadecimal (lowercase)
(format "~x" 255)           ; "ff"

; ~X - hexadecimal (uppercase)
(format "~X" 255)           ; "FF"

; ~c - character
(format "~c" #\A)           ; "A"

; ~% or ~n - newline
(format "Line 1~%Line 2")   ; "Line 1\nLine 2"
(format "Line 1~nLine 2")   ; Same

; ~~ - literal tilde
(format "50~~")             ; "50~"

Numeric formatting:

; Width specification
(format "~5d" 42)           ; "   42" (right-aligned)
(format "~5,'0d" 42)        ; "00042" (zero-padded)

; Floating point
(format "~f" 3.14159)       ; "3.14159"
(format "~,2f" 3.14159)     ; "3.14" (2 decimal places)
(format "~8,2f" 3.14159)    ; "    3.14" (width 8)

; Scientific notation
(format "~e" 12345.6)       ; "1.23456e4"
(format "~,2e" 12345.6)     ; "1.23e4"

; General (chooses f or e)
(format "~g" 0.0001)        ; Uses exponential
(format "~g" 3.14)          ; Uses fixed

; With sign
(format "~@d" 42)           ; "+42"
(format "~@d" -42)          ; "-42"

; Comma separation (Chez extension)
(format "~:d" 1000000)      ; "1,000,000"

Padding and alignment:

; Right-align (default)
(format "~10a" "hello")     ; "     hello"

; Left-align with @
(format "~10@a" "hello")    ; "hello     "

; Custom padding character
(format "~10,'*a" "hello")  ; "*****hello"

; Truncation
(format "~5a" "hello world") ; "hello" (truncated)

; Combining width and precision
(format "~10,5a" "hello world")  ; Truncate to 5, pad to 10

; Multiple values
(format "~a ~a ~a" 1 2 3)   ; "1 2 3"

; Using * for computed width
(format "~va" 10 "hello")   ; "     hello" (width from arg)

Conditional and iteration directives:

; ~[ ~] - conditional
(format "~[zero~;one~;two~]" 1)     ; "one"
(format "~[zero~;one~;two~:;many~]" 5)  ; "many" (default)

; ~{ ~} - iteration
(format "~{~a ~}" '(1 2 3)) ; "1 2 3 "
(format "~{~a~^, ~}" '(1 2 3))  ; "1, 2, 3" (no trailing comma)

; ~? or ~@ - recursive format
(format "~?" "~a + ~a" '(1 2))  ; "1 + 2"

; ~* - skip argument
(format "~a ~* ~a" 1 2 3)   ; "1  3"

; ~p - plural
(format "~d item~p" 1)      ; "1 item"
(format "~d item~p" 2)      ; "2 items"
(format "~d ~:p" 2)         ; "2 ies" (y -> ies)

; ~r - radix
(format "~2r" 42)           ; "101010" (binary)
(format "~16r" 255)         ; "ff" (hex)
(format "~r" 42)            ; "forty-two" (English)

Input/Output Control Operations

Buffer control:

; Flush output buffer
(flush-output-port port)
(flush-output-port)         ; Current output port

; Get buffer mode
(output-port-buffer-mode port)  ; 'none, 'line, 'block

; Block vs line buffering
; - block: flush when buffer full
; - line: flush on newline
; - none: write immediately

; Example: ensure prompt appears before input
(display "Enter name: ")
(flush-output-port)
(read-line)

; Clear input buffer (Chez extension)
(clear-input-port port)     ; Discard buffered input

; Clear output buffer (Chez extension)
(clear-output-port port)    ; Discard without writing

Port positioning:

; File position
(file-position port)        ; Get current position

(file-position port 0)      ; Seek to beginning
(file-position port 100)    ; Seek to byte 100

; Chez extension: seek from end
(file-position port (- (file-length port) 10))  ; 10 from end

; Standard R6RS positioning
(port-has-port-position? port)  ; Can get position?
(port-position port)            ; Get position

(port-has-set-port-position!? port)  ; Can set?
(set-port-position! port 0)          ; Set position

; Truncate file at current position (Chez extension)
(truncate-port port)

; File length (Chez extension)
(file-length port)          ; Total file size

; Set file length (Chez extension)
(set-file-length! port 100) ; Truncate or extend to 100 bytes

Port status and information:

; Check for available input (non-blocking)
(input-port-ready? port)    ; #t if data available
(char-ready? port)          ; Same for textual ports

; Check for EOF
(port-eof? port)            ; #t if at end of file

; Port name (for error messages)
(port-name port)            ; Returns string

; Port file descriptor (Chez extension)
(port-file-descriptor port) ; OS file descriptor or #f

; Check if port is a file port
(file-port? port)           ; #t if backed by file

; Mark port as closed state
(mark-port-closed! port)    ; Chez extension

Timeout operations (Chez extension):

; Set read timeout
(set-port-input-timeout! port seconds)

; Non-blocking mode
(set-port-input-timeout! port 0)  ; Return immediately

; Example: read with timeout
(define (read-with-timeout port seconds)
  (set-port-input-timeout! port seconds)
  (let ([result (guard (c [#t #f])
                  (read port))])
    (set-port-input-timeout! port #f)  ; Reset
    result))

; Check if input ready before blocking read
(define (safe-read port)
  (if (input-port-ready? port)
      (read port)
      'no-input))

Fasl Output

Fasl (Fast Load) format:

; Fasl is a compact binary format for Scheme data
; Used for compiled files, faster than text read/write

; Write fasl output
(fasl-write datum port)

; Read fasl input
(fasl-read port)            ; Returns datum

; Example: save and restore data
(call-with-port
  (open-file-output-port "data.fasl"
    (file-options no-fail))
  (lambda (port)
    (fasl-write '(1 2 3 4 5) port)
    (fasl-write '#(a b c) port)))

(call-with-port
  (open-file-input-port "data.fasl")
  (lambda (port)
    (list (fasl-read port)
          (fasl-read port))))
; ((1 2 3 4 5) #(a b c))

Fasl for compiled code:

; Compile to fasl file
(compile-file "source.ss")  ; Creates source.so

; Compile to specific output
(compile-file "source.ss" "output.so")

; Compile library
(compile-library "mylib.ss")

; Compile whole program
(compile-program "main.ss")

; Load compiled file
(load "source.so")          ; Load fasl file
(load-library "mylib.so")

; Visit (load but don't instantiate)
(visit "mylib.so")

; Revisit (visit again)
(revisit "mylib.so")

Fasl compression:

; Compressed fasl output
(parameterize ([fasl-compressed #t])
  (fasl-write large-datum port))

; Check compression setting
(fasl-compressed)           ; #t or #f

; Compression level (Chez extension)
(fasl-compressed 'lz4)      ; Fast compression
(fasl-compressed 'gzip)     ; Better compression

; Compile with compression
(parameterize ([compile-compressed #t])
  (compile-file "source.ss"))

Fasl version and compatibility:

; Fasl version (Chez extension)
(fasl-version)              ; Current fasl format version

; Cross-compilation fasl
; Fasl files are platform-specific by default

; Strip fasl file (remove debugging info)
(strip-fasl-file "input.so" "output.so")

; Fasl can store most Scheme objects:
; - Lists, vectors, bytevectors
; - Strings, symbols, numbers
; - Records (with proper setup)
; - Procedures (as compiled code)
; - Hashtables

; Cannot store:
; - Ports
; - Foreign pointers
; - Locked objects

File System Interface

File existence and type:

; Check file existence
(file-exists? "data.txt")   ; #t if exists

; File type
(file-regular? "data.txt")  ; #t if regular file
(file-directory? "mydir")   ; #t if directory
(file-symbolic-link? "link") ; #t if symlink

; Get file type
(file-type "path")          ; 'regular, 'directory, 'symbolic-link,
                            ; 'char-device, 'block-device,
                            ; 'fifo, 'socket

; Follow symlinks
(file-type "path" #t)       ; Follow symlinks

File information:

; File size
(file-size "data.txt")      ; Size in bytes (Chez extension)

; Modification time
(file-modification-time "data.txt")  ; Time value

; Access time
(file-access-time "data.txt")

; Change time
(file-change-time "data.txt")

; Compare times
(time<? (file-modification-time "a.txt")
        (file-modification-time "b.txt"))

; Convert to date
(date-and-time (file-modification-time "data.txt"))

File operations:

; Delete file
(delete-file "data.txt")
(delete-file "data.txt" #f)  ; Don't error if missing

; Rename/move file
(rename-file "old.txt" "new.txt")

; Copy file (Chez extension)
(copy-file "src.txt" "dst.txt")

; Create symbolic link (Unix)
(create-symbolic-link "target" "link")

; Read symbolic link
(read-symbolic-link "link") ; Returns target path

; File permissions (Unix)
(chmod "file.txt" #o644)    ; Chez extension
(file-permissions "file.txt")  ; Get permissions

Directory operations:

; Create directory
(mkdir "newdir")
(mkdir "newdir" #o755)      ; With permissions

; Delete directory (must be empty)
(rmdir "emptydir")
(delete-directory "emptydir")

; Delete directory recursively (Chez extension)
(delete-directory "dir" #t)

; List directory contents
(directory-list ".")        ; List of filenames
(directory-list "." #t)     ; Include hidden files (Chez)

; Example: find all .ss files
(filter (lambda (f) (string-suffix? ".ss" f))
        (directory-list "."))

; Current directory
(current-directory)         ; Get current directory
(current-directory "/tmp")  ; Change directory

; Path manipulation (Chez extensions)
(path-last "a/b/c.txt")     ; "c.txt"
(path-parent "a/b/c.txt")   ; "a/b"
(path-extension "file.txt") ; "txt"
(path-root "file.txt")      ; "file"

Path utilities:

; Combine path components
(define (path-join . parts)
  (let loop ([parts parts] [acc ""])
    (if (null? parts)
        acc
        (let ([part (car parts)])
          (loop (cdr parts)
                (if (string=? acc "")
                    part
                    (string-append acc "/" part)))))))

(path-join "a" "b" "c.txt") ; "a/b/c.txt"

; Absolute path check
(define (absolute-path? path)
  (and (> (string-length path) 0)
       (char=? (string-ref path 0) #\/)))

; Normalize path (remove . and ..)
(define (normalize-path path)
  (let loop ([parts (string-split path "/")]
             [acc '()])
    (cond
      [(null? parts)
       (string-join (reverse acc) "/")]
      [(string=? (car parts) ".")
       (loop (cdr parts) acc)]
      [(and (string=? (car parts) "..")
            (pair? acc)
            (not (string=? (car acc) "..")))
       (loop (cdr parts) (cdr acc))]
      [else
       (loop (cdr parts) (cons (car parts) acc))])))

; Get absolute path (Chez extension)
(cd "relative")             ; Alias for current-directory
(current-directory)

Temporary files:

; Create temporary file name
(tmpnam)                    ; Deprecated, returns temp filename

; Open temporary file (Chez extension)
(open-temporary-file)       ; Returns port and filename

; Better: use standard temp directory
(define (temp-directory)
  (or (getenv "TMPDIR")
      (getenv "TMP")
      (getenv "TEMP")
      "/tmp"))

; Create temporary file with prefix
(define (make-temp-file prefix)
  (let loop ([n 0])
    (let ([name (format "~a/~a~a" (temp-directory) prefix n)])
      (if (file-exists? name)
          (loop (+ n 1))
          name))))

; Clean up temporary files
(define (with-temp-file prefix proc)
  (let ([filename (make-temp-file prefix)])
    (dynamic-wind
      (lambda () #f)
      (lambda () (proc filename))
      (lambda ()
        (when (file-exists? filename)
          (delete-file filename))))))

Generic Port Examples

Logging port wrapper:

; Create a port that logs all output
(define (make-logging-port underlying-port log-port)
  (make-custom-textual-output-port
    "logging-port"
    (lambda (str start count)       ; write!
      (put-string underlying-port str start count)
      (put-string log-port str start count)
      (flush-output-port log-port)
      count)
    #f                              ; get-position
    #f                              ; set-position!
    (lambda ()                      ; close
      (close-port underlying-port))))

; Usage
(define log-file (open-output-file "output.log" '(replace)))
(define logged-output
  (make-logging-port (current-output-port) log-file))

(parameterize ([current-output-port logged-output])
  (display "This goes to both console and log\n"))

(close-port log-file)

Counting port:

; Port that tracks lines and characters
(define (make-counting-input-port port)
  (let ([line 1]
        [col 0])
    (values
      (make-custom-textual-input-port
        "counting"
        (lambda (str start count)   ; read!
          (let ([n (get-string-n! port str start count)])
            (when (and (fixnum? n) (> n 0))
              (do ([i start (+ i 1)])
                  ((= i (+ start n)))
                (let ([c (string-ref str i)])
                  (if (char=? c #\newline)
                      (begin (set! line (+ line 1))
                             (set! col 0))
                      (set! col (+ col 1))))))
            n))
        #f #f
        (lambda () (close-port port)))
      (lambda () (values line col)))))  ; get-position

; Usage
(define-values (port get-pos)
  (make-counting-input-port
    (open-input-string "hello\nworld")))

(get-string-n port 7)       ; "hello\nw"
(get-pos)                   ; Values: 2, 1

Broadcast port (tee):

; Write to multiple ports simultaneously
(define (make-broadcast-port . ports)
  (make-custom-textual-output-port
    "broadcast"
    (lambda (str start count)       ; write!
      (for-each
        (lambda (port)
          (put-string port str start count))
        ports)
      count)
    #f                              ; get-position
    #f                              ; set-position!
    (lambda ()                      ; close
      (for-each close-port ports))))

; Usage: write to file and console
(define both
  (make-broadcast-port
    (current-output-port)
    (open-output-file "copy.txt" '(replace))))

(display "This goes everywhere\n" both)
(close-port both)

Process port:

; Create bidirectional port to subprocess
(define (open-process-port* command)
  (let-values ([(to-stdin from-stdout from-stderr pid)
                (open-process-ports command 'block (native-transcoder))])
    ; Create combined I/O port
    (make-custom-textual-input/output-port
      (format "process:~a" command)
      (lambda (str start count)     ; read!
        (if (input-port-ready? from-stdout)
            (get-string-n! from-stdout str start count)
            0))
      (lambda (str start count)     ; write!
        (put-string to-stdin str start count)
        (flush-output-port to-stdin)
        count)
      #f                            ; get-position
      #f                            ; set-position!
      (lambda ()                    ; close
        (close-port to-stdin)
        (close-port from-stdout)
        (close-port from-stderr)))))

; Usage
(define bc (open-process-port* "bc -l"))
(put-string bc "2 + 3\n")
(flush-output-port bc)
(get-line bc)               ; "5"
(close-port bc)

Limited input port:

; Port that limits bytes read
(define (make-limited-input-port port limit)
  (let ([remaining limit])
    (make-custom-binary-input-port
      "limited"
      (lambda (bv start count)      ; read!
        (if (<= remaining 0)
            0                       ; EOF
            (let* ([to-read (min count remaining)]
                   [n (get-bytevector-n! port bv start to-read)])
              (if (eof-object? n)
                  (begin (set! remaining 0) 0)
                  (begin (set! remaining (- remaining n)) n)))))
      #f                            ; get-position
      #f                            ; set-position!
      (lambda () (close-port port)))))

; Usage: read only first 100 bytes
(define limited
  (make-limited-input-port
    (open-file-input-port "large-file.bin")
    100))

(get-bytevector-all limited) ; At most 100 bytes

Socket port example:

; TCP socket ports (using foreign interface)
; Simplified example - see Foreign Interface chapter for details

(define (make-socket-port fd)
  (let ([closed? #f])
    (make-custom-binary-input/output-port
      (format "socket:~a" fd)
      (lambda (bv start count)      ; read!
        (if closed?
            0
            (let ([n (socket-read fd bv start count)])
              (if (<= n 0) 0 n))))
      (lambda (bv start count)      ; write!
        (if closed?
            0
            (socket-write fd bv start count)))
      #f                            ; get-position
      #f                            ; set-position!
      (lambda ()                    ; close
        (set! closed? #t)
        (socket-close fd)))))

; With transcoder for text
(define (open-text-socket-port fd)
  (transcoded-port
    (make-socket-port fd)
    (make-transcoder (utf-8-codec) 'none 'replace)))

Filtering port:

; Transform input as it's read
(define (make-uppercase-port port)
  (make-custom-textual-input-port
    "uppercase"
    (lambda (str start count)       ; read!
      (let ([n (get-string-n! port str start count)])
        (when (fixnum? n)
          (do ([i start (+ i 1)])
              ((= i (+ start n)))
            (string-set! str i
              (char-upcase (string-ref str i)))))
        n))
    #f #f
    (lambda () (close-port port))))

; Usage
(define upper
  (make-uppercase-port
    (open-input-string "hello world")))

(get-string-all upper)      ; "HELLO WORLD"

; Transforming output port
(define (make-rot13-port port)
  (define (rot13-char c)
    (cond
      [(char<=? #\a c #\m) (integer->char (+ (char->integer c) 13))]
      [(char<=? #\n c #\z) (integer->char (- (char->integer c) 13))]
      [(char<=? #\A c #\M) (integer->char (+ (char->integer c) 13))]
      [(char<=? #\N c #\Z) (integer->char (- (char->integer c) 13))]
      [else c]))
  (make-custom-textual-output-port
    "rot13"
    (lambda (str start count)
      (let ([rotated (make-string count)])
        (do ([i 0 (+ i 1)])
            ((= i count))
          (string-set! rotated i
            (rot13-char (string-ref str (+ start i)))))
        (put-string port rotated)
        count))
    #f #f
    (lambda () (close-port port))))

Libraries and Top-level Programs in Chez Scheme

Built-in Libraries

R6RS standard libraries:

; Core library (base language)
(import (rnrs))             ; All R6RS bindings

; Individual R6RS libraries
(import (rnrs base))        ; Core syntax and procedures
(import (rnrs lists))       ; List utilities
(import (rnrs sorting))     ; Sorting procedures
(import (rnrs records syntactic))   ; Record types
(import (rnrs records procedural))  ; Procedural records
(import (rnrs records inspection))  ; Record inspection
(import (rnrs exceptions))  ; Exception handling
(import (rnrs conditions))  ; Condition types
(import (rnrs io simple))   ; Simple I/O
(import (rnrs io ports))    ; Port I/O
(import (rnrs files))       ; File system operations
(import (rnrs control))     ; Control structures
(import (rnrs unicode))     ; Unicode operations
(import (rnrs bytevectors)) ; Bytevector operations
(import (rnrs hashtables))  ; Hash tables
(import (rnrs enums))       ; Enumerations
(import (rnrs syntax-case)) ; Macro system
(import (rnrs mutable-pairs))    ; set-car!, set-cdr!
(import (rnrs mutable-strings))  ; string-set!
(import (rnrs r5rs))        ; R5RS compatibility
(import (rnrs eval))        ; eval procedure
(import (rnrs programs))    ; command-line, exit
(import (rnrs arithmetic fixnums))   ; Fixnum operations
(import (rnrs arithmetic flonums))   ; Flonum operations
(import (rnrs arithmetic bitwise))   ; Bitwise operations

Chez Scheme library:

; Complete Chez Scheme functionality
(import (chezscheme))

; This provides everything in (rnrs) plus Chez extensions:
; - Additional I/O procedures
; - Compilation and evaluation
; - Foreign function interface
; - Threading support
; - Debugging and inspection
; - System interface
; - Engine support
; - Extended record facilities
; - Hash table extensions
; - And much more

; Common pattern: use chezscheme for full access
(library (my-library)
  (export my-proc)
  (import (chezscheme))     ; Full Chez Scheme

  (define (my-proc x)
    (printf "Processing ~a~n" x)  ; Chez extension
    (* x 2)))

SRFI libraries:

; Some SRFIs are built-in or easily available

; SRFI-1: List library (partial support via rnrs)
(import (rnrs lists))

; Using Chez's built-in equivalents
(import (chezscheme))
; Provides: fold-left, fold-right, filter, partition,
;           find, exists, for-all, memp, remp, assp, etc.

; Pattern for SRFI compatibility
(library (srfi :1)
  (export
    ; List constructors
    cons list
    ; Selectors
    car cdr
    ; ... etc
    )
  (import (rnrs) (rnrs lists)))

; Some Chez installations include SRFI collections
; Check your installation for available SRFIs

Library naming conventions:

; Library names are lists of identifiers
(import (rnrs))             ; Single identifier
(import (rnrs base))        ; Two identifiers
(import (rnrs io ports))    ; Three identifiers

; With version
(import (rnrs (6)))         ; Version 6
(import (rnrs base (6)))    ; rnrs base version 6

; Version matching
(import (rnrs (>= 6)))      ; Version 6 or higher
(import (mylib (and (>= 1) (< 2))))  ; 1.x versions

; Common naming patterns
(library (company project module) ...)
(library (myapp utils string) ...)
(library (web server http) ...)

Library summary table:

Library	Description
`(rnrs)`	Complete R6RS standard library
`(rnrs base)`	Core syntax, procedures, basic types
`(rnrs lists)`	List operations: find, filter, fold, etc.
`(rnrs io ports)`	Port-based I/O system
`(rnrs io simple)`	Simple I/O: read, write, display
`(rnrs records syntactic)`	define-record-type syntax
`(rnrs exceptions)`	guard, raise, with-exception-handler
`(rnrs hashtables)`	Hash table operations
`(rnrs syntax-case)`	Macro system
`(chezscheme)`	Full Chez Scheme with extensions

Running Top-level Programs

Top-level program structure:

; A top-level program starts with import and has a body
; File: hello.ss

#!r6rs
(import (rnrs))

(display "Hello, World!")
(newline)

; Or with Chez Scheme extensions
#!chezscheme
(import (chezscheme))

(printf "Hello, World!~n")

Running programs from command line:

# Run as script
$ scheme --script hello.ss

# Run as program (R6RS compliant)
$ scheme --program hello.ss

# With arguments
$ scheme --script myprogram.ss arg1 arg2 arg3

# Using petite (no compiler)
$ petite --script hello.ss

# Make executable script (Unix)
$ chmod +x hello.ss
$ ./hello.ss

Shebang for executable scripts:

#!/usr/bin/env scheme-script
(import (chezscheme))

; Access command-line arguments
(define args (command-line-arguments))
(printf "Arguments: ~a~n" args)

; Program name
(printf "Program: ~a~n" (car (command-line)))

; Exit with status
(exit 0)

; Alternative shebangs:
; #!/usr/bin/scheme --script
; #!/usr/local/bin/scheme --script
; #!/usr/bin/env scheme --script

Accessing command-line arguments:

#!/usr/bin/env scheme-script
(import (chezscheme))

; (command-line) returns all arguments including program name
(define all-args (command-line))
; ("program-name" "arg1" "arg2" ...)

; (command-line-arguments) returns just the arguments
(define args (command-line-arguments))
; ("arg1" "arg2" ...)

; Example: process arguments
(define (main args)
  (cond
    [(null? args)
     (display "Usage: program \n")
     (exit 1)]
    [(string=? (car args) "--help")
     (display "Help message here\n")
     (exit 0)]
    [else
     (process-file (car args))
     (exit 0)]))

(main (command-line-arguments))

Program exit and return codes:

; Exit normally
(exit)                      ; Exit with status 0
(exit 0)                    ; Same

; Exit with error
(exit 1)                    ; Non-zero indicates error

; Exit with any value (Chez extension)
(exit 'some-value)          ; Converted to exit status

; Graceful shutdown
(define (cleanup-and-exit status)
  (close-all-ports)
  (delete-temp-files)
  (exit status))

; Handling errors at top level
(guard (c
        [(error? c)
         (display "Error: " (current-error-port))
         (display (condition-message c) (current-error-port))
         (newline (current-error-port))
         (exit 1)])
  (main (command-line-arguments)))

Running programs from REPL:

; Load and run program
(load-program "myprogram.ss")

; Load compiled program
(load-program "myprogram.so")

; Run with custom arguments
(parameterize ([command-line '("prog" "arg1" "arg2")])
  (load-program "myprogram.ss"))

; Compile program
(compile-program "myprogram.ss")     ; Creates myprogram.so
(compile-program "myprogram.ss" "out.so")  ; Custom output

; Compile and load
(load (compile-program "myprogram.ss"))

Library and Top-level Program Forms

Library form syntax:

; Basic library structure
(library (library-name)
  (export export-spec ...)
  (import import-spec ...)

  ; Library body: definitions
  definition ...

  ; Optional: expressions (run when library instantiated)
  expression ...)

; Complete example
(library (math arithmetic)
  (export add subtract multiply divide
          square cube)
  (import (rnrs))

  (define (add a b) (+ a b))
  (define (subtract a b) (- a b))
  (define (multiply a b) (* a b))
  (define (divide a b) (/ a b))

  (define (square x) (* x x))
  (define (cube x) (* x x x)))

Export specifications:

(library (my-library)
  (export
    ; Simple export
    proc1
    proc2

    ; Renamed export
    (rename (internal-name external-name))
    (rename (my-map map) (my-filter filter))

    ; Export imported binding
    string-append              ; Re-export from import

    ; Export syntax
    my-macro
    )
  (import (rnrs))

  (define (proc1 x) ...)
  (define (proc2 x) ...)
  (define (internal-name x) ...)
  (define (my-map f lst) ...)
  (define (my-filter p lst) ...)

  (define-syntax my-macro
    (syntax-rules ()
      [(_ x) (list x)])))

Import specifications:

(library (my-library)
  (export ...)
  (import
    ; Simple import
    (rnrs)

    ; Import specific bindings only
    (only (rnrs lists) filter map fold-left)

    ; Import all except some
    (except (rnrs) set-car! set-cdr!)

    ; Import with prefix
    (prefix (rnrs lists) list:)
    ; Now use: list:filter, list:map, etc.

    ; Import with rename
    (rename (rnrs) (lambda fn) (define def))
    ; Now use: (fn (x) ...), (def name value)

    ; Combine specifications
    (prefix (only (rnrs lists) filter map) l:)
    ; Now use: l:filter, l:map

    ; Version specification
    (rnrs (6))
    (mylib (>= 1 2))        ; Version 1.2 or higher
    )
  ...)

Top-level program form:

; Top-level program structure
#!r6rs
(import import-spec ...)

; Program body
definition ...
expression ...

; Example program
#!r6rs
(import
  (rnrs)
  (rnrs programs)           ; For command-line, exit
  (my-library))

; Definitions
(define (process-file filename)
  (call-with-input-file filename
    (lambda (port)
      (let loop ([line (get-line port)])
        (unless (eof-object? line)
          (display line)
          (newline)
          (loop (get-line port)))))))

; Main code
(let ([args (command-line-arguments)])
  (when (null? args)
    (display "No file specified\n")
    (exit 1))
  (for-each process-file args))

Library with initialization:

; Libraries can have expressions that run on instantiation
(library (config loader)
  (export get-config config-loaded?)
  (import (chezscheme))

  ; Private state
  (define config-data #f)
  (define loaded? #f)

  ; Exported procedures
  (define (get-config key)
    (and loaded? (assq key config-data)))

  (define (config-loaded?)
    loaded?)

  ; Initialization code (runs when library first used)
  (display "Loading configuration...\n")
  (set! config-data
    (if (file-exists? "config.scm")
        (with-input-from-file "config.scm" read)
        '()))
  (set! loaded? #t)
  (printf "Config loaded: ~a entries~n"
          (length config-data)))

Nested library definitions (Chez extension):

; Define library at REPL or in another file
(define-library (my utils)
  (export helper-proc)
  (import (chezscheme))
  (begin
    (define (helper-proc x)
      (* x 2))))

; R7RS-style library syntax (limited support)
(define-library (my-r7rs-lib)
  (export foo bar)
  (import (scheme base))
  (begin
    (define (foo x) x)
    (define (bar x) (+ x 1))))

Standalone Import and Export Forms

Interactive imports at REPL:

; Import at top level (REPL)
(import (rnrs))
(import (chezscheme))

; Import specific bindings
(import (only (rnrs lists) filter partition))

; Import with prefix
(import (prefix (rnrs hashtables) ht:))
(ht:make-eq-hashtable)      ; Use prefixed name

; Multiple imports
(import (rnrs) (rnrs mutable-pairs))

; Re-import to update (after library recompile)
(import (my-library))

Implicit exports (Chez extension):

; implicit-exports parameter controls default export behavior
(implicit-exports)          ; Check current setting

; When #t (default), all definitions are implicitly exported
; unless explicitly listed in export clause

(parameterize ([implicit-exports #f])
  ; In this context, only explicit exports are visible
  (eval '(library (strict-lib)
           (export public-proc)  ; Only this is exported
           (import (chezscheme))
           (define (public-proc x) (private-proc x))
           (define (private-proc x) (* x 2)))
        (interaction-environment)))

Export from REPL (Chez extension):

; Define at top level
(define (my-utility x)
  (+ x 1))

; This is available in the interaction environment
; but not as a proper library export

; To make definitions available as a library,
; create a proper library file

; Or use top-level-program for scripts
(top-level-program
  (import (chezscheme))
  (define (helper x) (* x 2))
  (printf "Result: ~a~n" (helper 21)))

Indirect exports:

(library (shapes)
  (export make-shape shape? shape-area
          make-circle circle?
          make-rectangle rectangle?)
  (import (chezscheme))

  ; Parent record type
  (define-record-type shape
    (fields (immutable type)))

  ; Circle - extends shape conceptually
  (define-record-type circle
    (fields radius))

  (define-record-type rectangle
    (fields width height))

  ; Generic area procedure
  (define (shape-area s)
    (cond
      [(circle? s)
       (* 3.14159 (square (circle-radius s)))]
      [(rectangle? s)
       (* (rectangle-width s) (rectangle-height s))]
      [else (error 'shape-area "unknown shape" s)]))

  (define (square x) (* x x)))

; User imports make-circle but also gets circle?
; through the export list

Import levels:

; Import levels control when bindings are available
; Level 0: run time (default)
; Level 1: expand time (macro expansion)

(library (my-macros)
  (export define-checked)
  (import
    (rnrs)
    (for (rnrs syntax-case) expand)  ; Need at expand time
    (for (rnrs base) run expand))    ; Need at both times

  (define-syntax define-checked
    (lambda (stx)
      (syntax-case stx ()
        [(_ (name arg ...) pred body ...)
         #'(define (name arg ...)
             (unless (and (pred arg) ...)
               (error 'name "invalid argument"))
             body ...)]))))

; Shorthand for common cases
(import (for (my-helper) expand))   ; Only at expand time
(import (for (my-helper) run))      ; Only at run time (default)
(import (for (my-helper) (meta 2))) ; Two levels up

Explicitly Invoking Libraries

Library invocation basics:

; Libraries are normally invoked automatically on import
; But can be controlled explicitly

; Visit: evaluate syntax definitions only
(visit "my-library.so")
(visit "my-library.ss")

; Revisit: visit again (re-evaluate)
(revisit "my-library.so")

; Load library (Chez extension)
(load-library "my-library.ss")

; Invoke library explicitly
(invoke-library '(my-library))

Library phases:

; Library lifecycle:
; 1. Loading - read source/compiled code
; 2. Visiting - evaluate syntax definitions
; 3. Invoking - evaluate variable definitions and expressions

; When you import a library:
; - It's visited if macros are used
; - It's invoked if run-time values are used

; Force visit (for macro-only libraries)
(import (for (macro-library) expand))

; Example showing phases
(library (phase-demo)
  (export get-value demo-macro)
  (import (chezscheme))

  ; This runs during visit (syntax definition)
  (define-syntax demo-macro
    (begin
      (printf "Defining macro (visit time)~n")
      (syntax-rules ()
        [(_ x) (list 'demo x)])))

  ; This runs during invoke (variable definition)
  (define get-value
    (begin
      (printf "Defining procedure (invoke time)~n")
      (lambda () 42)))

  ; This expression runs during invoke
  (printf "Library body expression (invoke time)~n"))

Controlling library instantiation:

; library-list: get list of loaded libraries
(library-list)              ; ((rnrs) (chezscheme) ...)

; Check if library is loaded
(member '(my-library) (library-list))

; library-exports: get exported bindings
(library-exports '(rnrs lists))
; (find for-all exists filter partition ...)

; library-requirements: get dependencies
(library-requirements '(my-library))
; Returns list of required libraries

; library-object-filename: get compiled file path
(library-object-filename '(my-library))

; library-version: get version if specified
(library-version '(rnrs))   ; (6)

Library reloading:

; During development, you may need to reload libraries

; Reload source file
(load "my-library.ss")

; Recompile and reload
(compile-library "my-library.ss")
(load "my-library.so")

; Reset library to force re-instantiation (Chez extension)
(library-requirements-options 'no-invoke)
; Then re-import

; Clear all libraries (drastic, use carefully)
; Not directly supported - restart Scheme

; Practical reloading workflow
(define (reload-library libname filename)
  (compile-library filename)
  (load (path-root filename) ".so")
  (eval `(import ,libname)
        (interaction-environment)))

Conditional library loading:

; Load library only if needed
(define (ensure-library-loaded libname)
  (unless (member libname (library-list))
    (eval `(import ,libname)
          (interaction-environment))))

; Dynamic library loading
(define (load-plugin name)
  (let ([lib-name (list 'plugins (string->symbol name))]
        [filename (format "plugins/~a.ss" name)])
    (when (file-exists? filename)
      (load filename)
      (eval `(import ,lib-name)
            (interaction-environment))
      #t)))

; Feature-based imports
(meta-cond
  [(threaded?)
   (import (chezscheme) (threads))]
  [else
   (import (chezscheme))])

Library Parameters

Library search paths:

; library-directories: where to look for libraries
(library-directories)       ; List of (source . object) pairs

; Add search path
(library-directories
  (cons '("./lib" . "./lib")
        (library-directories)))

; Typical setup
(library-directories
  '(("." . ".")                    ; Current directory
    ("./src" . "./lib")            ; Source in src, compiled in lib
    ("/usr/local/lib/scheme" .
     "/usr/local/lib/scheme")))    ; System libraries

; Source directories only
(source-directories)        ; List of source directories
(source-directories '("." "./src" "../common"))

; Library extensions
(library-extensions)        ; File extensions to try
; Default: ((".chezscheme.sls" . ".chezscheme.so")
;           (".ss" . ".so") (".sls" . ".so") ...)

; Add extension
(library-extensions
  (cons '(".scm" . ".so")
        (library-extensions)))

Compilation parameters:

; compile-imported-libraries: auto-compile dependencies
(compile-imported-libraries #t)  ; Enable auto-compilation

; When enabled, importing a library will:
; 1. Check if source is newer than compiled
; 2. Recompile if necessary
; 3. Load the compiled version

; import-notify: print when importing
(import-notify #t)          ; Show import progress

; With both enabled:
; > (import (my-library))
; compiling my-library.ss with output to my-library.so
; >

; library-search-handler: customize search
(library-search-handler
  (lambda (who path dir*)
    ; Custom search logic
    ...))

; compile-library-handler: customize compilation
(compile-library-handler
  (lambda (source-path dest-path)
    (printf "Compiling ~a to ~a~n" source-path dest-path)
    (compile-library source-path dest-path)))

Library output options:

; Where to put compiled libraries
(compile-library "source.ss")           ; Same directory
(compile-library "source.ss" "lib/")    ; Different directory

; Control object file location via library-directories
(library-directories
  '(("src" . "build")))     ; Source in src/, output to build/

; generate-wpo-files: whole-program optimization
(generate-wpo-files #t)     ; Generate .wpo files

; compile-whole-library: optimize entire library
(compile-whole-library "input.wpo" "output.so")

; Library compression
(compile-compressed #t)     ; Compress compiled output

; Strip source info from compiled files
(generate-inspector-information #f)
(generate-procedure-source-information #f)

Library requirements options:

; library-requirements-options controls dependency handling
(library-requirements-options)  ; Get current options

; Available options (can be combined):
; - 'none: default behavior
; - 'no-invoke: don't invoke dependencies automatically
; - 'no-visit: don't visit dependencies automatically

(parameterize ([library-requirements-options 'no-invoke])
  ; Import only visits, doesn't invoke
  (import (my-library)))

; Use case: delay initialization
(library-requirements-options 'no-invoke)
(import (expensive-initialization-library))
; ... later, when ready ...
(invoke-library '(expensive-initialization-library))

Interaction between parameters:

; Typical development setup
(compile-imported-libraries #t)  ; Auto-compile
(import-notify #t)               ; Show progress
(library-directories
  '(("." . ".")
    ("src" . "build")))

; Typical production setup
(compile-imported-libraries #f)  ; Use pre-compiled
(import-notify #f)               ; Quiet
(library-directories
  '(("lib" . "lib")))           ; Single optimized location

; Debugging setup
(compile-imported-libraries #t)
(import-notify #t)
(generate-inspector-information #t)
(debug-on-exception #t)

; Helper to configure environment
(define (setup-development)
  (compile-imported-libraries #t)
  (import-notify #t)
  (library-directories
    (cons '("./dev" . "./dev")
          (library-directories))))

(define (setup-production)
  (compile-imported-libraries #f)
  (optimize-level 3))

Library Inspection

Listing loaded libraries:

; Get all loaded libraries
(library-list)
; ((rnrs) (rnrs base) (chezscheme) (my-library) ...)

; Filter by pattern
(filter (lambda (lib)
          (and (pair? lib)
               (eq? (car lib) 'my-project)))
        (library-list))

; Count loaded libraries
(length (library-list))

; Check if specific library is loaded
(define (library-loaded? name)
  (and (member name (library-list)) #t))

(library-loaded? '(rnrs))   ; #t
(library-loaded? '(nonexistent))  ; #f

Examining library exports:

; Get exported bindings
(library-exports '(rnrs lists))
; (find for-all exists filter partition
;  fold-left fold-right remp remove remv remq
;  memp member memv memq assp assoc assv assq cons*)

; Get exports with details (Chez extension)
(library-exports '(my-library))

; Check if binding is exported
(define (library-exports? lib binding)
  (and (member binding (library-exports lib)) #t))

(library-exports? '(rnrs lists) 'filter)  ; #t
(library-exports? '(rnrs lists) 'map)     ; #f (in rnrs base)

; Find which library exports a binding
(define (find-exporting-library binding)
  (filter (lambda (lib)
            (member binding (library-exports lib)))
          (library-list)))

Library dependencies:

; Get direct dependencies
(library-requirements '(my-library))
; ((rnrs) (rnrs lists) (utils))

; Different requirement types
(library-requirements '(my-library) 'all)      ; All requirements
(library-requirements '(my-library) 'import)   ; Import requirements
(library-requirements '(my-library) 'visit)    ; Visit requirements
(library-requirements '(my-library) 'invoke)   ; Invoke requirements

; Build dependency tree
(define (dependency-tree lib)
  (let ([deps (library-requirements lib)])
    (cons lib
          (map dependency-tree deps))))

; Flatten dependencies (all transitive)
(define (all-dependencies lib)
  (let ([direct (library-requirements lib)])
    (append direct
            (append-map all-dependencies direct))))

(remove-duplicates (all-dependencies '(my-app)))

Library version and location:

; Get library version
(library-version '(rnrs))   ; (6)
(library-version '(my-library))  ; () if no version

; Get object (compiled) filename
(library-object-filename '(my-library))
; "/path/to/my-library.so" or #f

; Get source filename (if known)
; Not directly available, but can derive:
(define (library-source-filename lib)
  (let ([obj (library-object-filename lib)])
    (and obj
         (let ([base (path-root obj)])
           (find file-exists?
                 (map (lambda (ext) (string-append base ext))
                      '(".ss" ".sls" ".scm")))))))

; Check if library is from file vs built-in
(define (file-library? lib)
  (and (library-object-filename lib) #t))

Advanced library inspection:

; Inspect library at compile time
(define (analyze-library filename)
  (call-with-input-file filename
    (lambda (port)
      (let ([form (read port)])
        (and (pair? form)
             (eq? (car form) 'library)
             (let ([name (cadr form)])
               (let loop ([rest (cddr form)]
                          [exports '()]
                          [imports '()])
                 (cond
                   [(null? rest)
                    `((name . ,name)
                      (exports . ,exports)
                      (imports . ,imports))]
                   [(and (pair? (car rest))
                         (eq? (caar rest) 'export))
                    (loop (cdr rest)
                          (cdar rest)
                          imports)]
                   [(and (pair? (car rest))
                         (eq? (caar rest) 'import))
                    (loop (cdr rest)
                          exports
                          (cdar rest))]
                   [else
                    (loop (cdr rest) exports imports)]))))))))

(analyze-library "my-library.ss")
; ((name my-library)
;  (exports proc1 proc2 ...)
;  (imports (rnrs) (utils) ...))

; Print library summary
(define (describe-library lib)
  (printf "Library: ~a~n" lib)
  (printf "Version: ~a~n" (library-version lib))
  (printf "Exports: ~a~n" (length (library-exports lib)))
  (printf "Dependencies: ~a~n"
          (length (library-requirements lib)))
  (let ([file (library-object-filename lib)])
    (when file
      (printf "Object file: ~a~n" file))))

Library debugging:

; Trace library loading
(import-notify #t)

; Verbose library search
(parameterize ([import-notify #t])
  (import (my-library)))

; Debug library compilation issues
(define (debug-compile-library filename)
  (parameterize ([compile-imported-libraries #t]
                 [import-notify #t]
                 [optimize-level 0]
                 [generate-inspector-information #t])
    (guard (c [#t (display-condition c)
                  #f])
      (compile-library filename)
      #t)))

; Check for circular dependencies
(define (check-circular lib visited)
  (cond
    [(member lib visited)
     (error 'check-circular "circular dependency" lib visited)]
    [else
     (let ([visited (cons lib visited)])
       (for-each
         (lambda (dep)
           (check-circular dep visited))
         (library-requirements lib)))]))

; Find missing libraries
(define (find-missing-libraries lib)
  (filter (lambda (dep)
            (not (library-loaded? dep)))
          (library-requirements lib)))

Library management utilities:

; List all library files in directory
(define (find-library-files dir)
  (filter (lambda (f)
            (or (string-suffix? ".ss" f)
                (string-suffix? ".sls" f)
                (string-suffix? ".scm" f)))
          (directory-list dir)))

; Compile all libraries in directory
(define (compile-all-libraries dir)
  (for-each
    (lambda (file)
      (let ([path (string-append dir "/" file)])
        (printf "Compiling ~a...~n" path)
        (guard (c [#t (printf "  Error: ~a~n"
                              (condition-message c))])
          (compile-library path)
          (printf "  Done.~n"))))
    (find-library-files dir)))

; Clean compiled files
(define (clean-compiled-files dir)
  (for-each
    (lambda (file)
      (when (string-suffix? ".so" file)
        (delete-file (string-append dir "/" file))))
    (directory-list dir)))

; Generate library documentation skeleton
(define (document-library lib)
  (let ([exports (library-exports lib)])
    (printf ";; Library: ~a~n" lib)
    (printf ";; Exports:~n")
    (for-each
      (lambda (exp)
        (printf ";;   ~a - TODO: document~n" exp))
      exports)))

Complete Library Example

Multi-file library project structure:

my-project/
├── src/
│   ├── my-project/
│   │   ├── core.ss
│   │   ├── utils.ss
│   │   └── main.ss
│   └── my-project.ss        ; Re-exports all modules
├── test/
│   └── test-core.ss
├── build/                    ; Compiled files
├── run.ss                    ; Top-level program
└── Makefile

Core module (src/my-project/core.ss):

(library (my-project core)
  (export
    make-widget
    widget?
    widget-name
    widget-value
    widget-process)
  (import (chezscheme))

  (define-record-type widget
    (fields name value))

  (define (widget-process w)
    (printf "Processing widget: ~a~n" (widget-name w))
    (* (widget-value w) 2)))

Utilities module (src/my-project/utils.ss):

(library (my-project utils)
  (export
    string-split
    string-join
    string-trim
    with-timing)
  (import (chezscheme))

  (define (string-split str delim)
    (let loop ([chars (string->list str)]
               [current '()]
               [result '()])
      (cond
        [(null? chars)
         (reverse (cons (list->string (reverse current)) result))]
        [(char=? (car chars) delim)
         (loop (cdr chars)
               '()
               (cons (list->string (reverse current)) result))]
        [else
         (loop (cdr chars)
               (cons (car chars) current)
               result)])))

  (define (string-join strs delim)
    (if (null? strs)
        ""
        (fold-left
          (lambda (acc s) (string-append acc delim s))
          (car strs)
          (cdr strs))))

  (define (string-trim str)
    (list->string
      (reverse
        (drop-while char-whitespace?
          (reverse
            (drop-while char-whitespace?
              (string->list str)))))))

  (define (drop-while pred lst)
    (cond
      [(null? lst) '()]
      [(pred (car lst)) (drop-while pred (cdr lst))]
      [else lst]))

  (define-syntax with-timing
    (syntax-rules ()
      [(_ body ...)
       (let ([start (current-time)])
         (let ([result (begin body ...)])
           (let ([end (current-time)])
             (printf "Elapsed: ~a ms~n"
                     (time-difference end start))
             result)))])))

Main module (src/my-project/main.ss):

(library (my-project main)
  (export
    run
    process-all)
  (import
    (chezscheme)
    (my-project core)
    (my-project utils))

  (define (process-all widgets)
    (with-timing
      (map widget-process widgets)))

  (define (run args)
    (printf "Starting my-project with args: ~a~n" args)
    (let ([widgets (map (lambda (name)
                          (make-widget name (random 100)))
                        args)])
      (let ([results (process-all widgets)])
        (printf "Results: ~a~n" results)
        results))))

Combined library (src/my-project.ss):

; Re-export all public bindings
(library (my-project)
  (export
    ; From core
    make-widget widget? widget-name widget-value widget-process
    ; From utils
    string-split string-join string-trim with-timing
    ; From main
    run process-all)
  (import
    (my-project core)
    (my-project utils)
    (my-project main)))

Top-level program (run.ss):

#!/usr/bin/env scheme-script
#!chezscheme

(import
  (chezscheme)
  (my-project))

; Setup library path
(library-directories
  (cons '("src" . "build")
        (library-directories)))

; Main entry point
(define (main args)
  (cond
    [(null? args)
     (display "Usage: run.ss \n")
     (exit 1)]
    [(string=? (car args) "--help")
     (display "my-project: Process widgets\n")
     (display "Usage: run.ss name1 name2 ...\n")
     (exit 0)]
    [(string=? (car args) "--test")
     (run-tests)
     (exit 0)]
    [else
     (run args)
     (exit 0)]))

(define (run-tests)
  (printf "Running tests...~n")
  (let ([w (make-widget "test" 42)])
    (assert (widget? w))
    (assert (= (widget-value w) 42))
    (assert (= (widget-process w) 84)))
  (printf "All tests passed.~n"))

(main (command-line-arguments))

Makefile for building:

# Makefile for my-project

SCHEME = scheme
SRC_DIR = src
BUILD_DIR = build
SOURCES = $(wildcard $(SRC_DIR)/my-project/*.ss) \
          $(SRC_DIR)/my-project.ss

.PHONY: all clean test run

all: $(BUILD_DIR)
	$(SCHEME) --compile-imported-libraries \
	          --libdirs "$(SRC_DIR):$(BUILD_DIR)" \
	          --program run.ss

$(BUILD_DIR):
	mkdir -p $(BUILD_DIR)

compile: $(BUILD_DIR)
	$(SCHEME) -q <<EOF
	(library-directories '(("$(SRC_DIR)" . "$(BUILD_DIR)")))
	(compile-imported-libraries #t)
	(import (my-project))
	EOF

test:
	$(SCHEME) --script run.ss --test

run:
	$(SCHEME) --script run.ss widget1 widget2 widget3

clean:
	rm -rf $(BUILD_DIR)
	rm -f $(SRC_DIR)/*.so $(SRC_DIR)/my-project/*.so

Syntactic Extension and Modules in Chez Scheme

Fluid Keyword Bindings

Fluid keywords with fluid-let-syntax:

; fluid-let-syntax temporarily rebinds keywords
; Similar to parameterize but for syntax

; Basic usage
(let-syntax ([when (syntax-rules ()
                     [(_ test e1 e2 ...)
                      (if test (begin e1 e2 ...))])])
  (fluid-let-syntax ([when (syntax-rules ()
                             [(_ test e1 e2 ...)
                              (begin
                                (display "checking...\n")
                                (if test (begin e1 e2 ...)))])])
    (when #t (display "hello\n"))))
; Output:
; checking...
; hello

; After fluid-let-syntax, original binding restored
(when #t (display "normal\n"))  ; Uses original when

Use cases for fluid keywords:

; Debugging macros
(define-syntax with-debug-macros
  (syntax-rules ()
    [(_ body ...)
     (fluid-let-syntax
       ([define (syntax-rules ()
                  [(_ (name . args) . body)
                   (define (name . args)
                     (printf "Entering ~a~n" 'name)
                     (let ([result (begin . body)])
                       (printf "Leaving ~a: ~a~n" 'name result)
                       result))]
                  [(_ name val)
                   (define name val)])])
       body ...)]))

(with-debug-macros
  (define (factorial n)
    (if (zero? n) 1 (* n (factorial (- n 1)))))
  (factorial 3))

; Domain-specific language contexts
(define-syntax in-sql-context
  (syntax-rules ()
    [(_ body ...)
     (fluid-let-syntax
       ([select (syntax-rules () ...)]
        [from (syntax-rules () ...)]
        [where (syntax-rules () ...)])
       body ...)]))

Interaction with macro expansion:

; fluid-let-syntax affects nested macro calls
(define-syntax outer
  (syntax-rules ()
    [(_ x) (inner x)]))

(define-syntax inner
  (syntax-rules ()
    [(_ x) (list 'inner x)]))

; Normal expansion
(outer 1)                   ; (inner 1)

; With fluid binding
(fluid-let-syntax ([inner (syntax-rules ()
                            [(_ x) (list 'modified x)])])
  (outer 1))                ; (modified 1)

; The fluid binding affects inner called from outer

Splicing fluid-let-syntax:

; splicing-fluid-let-syntax splices into surrounding context
(define-syntax with-alternative-if
  (syntax-rules ()
    [(_ body ...)
     (splicing-fluid-let-syntax
       ([if (syntax-rules ()
              [(_ test then else)
               (cond [test then] [else else])])])
       body ...)]))

; Can be used at top level or in definition context
(with-alternative-if
  (define (safe-divide a b)
    (if (zero? b)
        'undefined
        (/ a b))))

; splicing version allows definitions to escape

Syntax-Rules Transformers

Basic syntax-rules:

; syntax-rules creates pattern-based macros
(define-syntax my-when
  (syntax-rules ()
    [(_ test body ...)
     (if test (begin body ...))]))

(my-when (> 5 3)
  (display "yes")
  (newline))

; Multiple patterns
(define-syntax my-cond
  (syntax-rules (else =>)
    [(_ [else e1 e2 ...])
     (begin e1 e2 ...)]
    [(_ [test => proc])
     (let ([t test])
       (if t (proc t)))]
    [(_ [test e1 e2 ...])
     (if test (begin e1 e2 ...))]
    [(_ [test e1 e2 ...] clause ...)
     (if test
         (begin e1 e2 ...)
         (my-cond clause ...))]))

(my-cond
  [(assq 'a '((a . 1) (b . 2))) => cdr]
  [else 'not-found])            ; 1

Pattern variables and ellipsis:

; ... matches zero or more
(define-syntax my-list
  (syntax-rules ()
    [(_ x ...)
     (list x ...)]))

(my-list 1 2 3)             ; (1 2 3)
(my-list)                   ; ()

; Nested ellipsis
(define-syntax my-let*
  (syntax-rules ()
    [(_ () body ...)
     (begin body ...)]
    [(_ ([var val] rest ...) body ...)
     (let ([var val])
       (my-let* (rest ...) body ...))]))

; Ellipsis in both pattern and template
(define-syntax swap-pairs
  (syntax-rules ()
    [(_ (a b) ...)
     (list (list b a) ...)]))

(swap-pairs (1 2) (3 4) (5 6))  ; ((2 1) (4 3) (6 5))

Literal identifiers:

; Literals match exactly (compared with free-identifier=?)
(define-syntax my-case
  (syntax-rules (else)      ; else is a literal
    [(_ expr [else e1 e2 ...])
     (begin e1 e2 ...)]
    [(_ expr [(datum ...) e1 e2 ...])
     (if (memv expr '(datum ...))
         (begin e1 e2 ...))]
    [(_ expr [(datum ...) e1 e2 ...] clause ...)
     (let ([t expr])
       (if (memv t '(datum ...))
           (begin e1 e2 ...)
           (my-case t clause ...)))]))

; Multiple literals
(define-syntax for
  (syntax-rules (in from to by)
    [(_ var in lst body ...)
     (for-each (lambda (var) body ...) lst)]
    [(_ var from start to end body ...)
     (do ([var start (+ var 1)])
         ((> var end))
       body ...)]
    [(_ var from start to end by step body ...)
     (do ([var start (+ var step)])
         ((> var end))
       body ...)]))

(for i in '(1 2 3) (display i))
(for i from 1 to 5 (display i))
(for i from 0 to 10 by 2 (display i))

Underscore and ellipsis escaping:

; _ matches anything but doesn't bind
(define-syntax first-of-two
  (syntax-rules ()
    [(_ a _) a]))           ; Second element ignored

(first-of-two 1 2)          ; 1

; Escape ellipsis with (... ...)
(define-syntax define-quoter
  (syntax-rules ()
    [(_ name)
     (define-syntax name
       (syntax-rules ()
         [(_ x (... ...))    ; Escaped ellipsis
          '(x (... ...))]))]))

(define-quoter my-quote)
(my-quote a b c)            ; (a b c)

; Alternative ellipsis (Chez extension)
(define-syntax my-macro
  (syntax-rules ::: ()      ; Use ::: instead of ...
    [(_ a :::)
     (list a :::)]))

(my-macro 1 2 3)            ; (1 2 3)

Hygiene and syntax-rules:

; Syntax-rules is automatically hygienic
(define-syntax swap!
  (syntax-rules ()
    [(_ a b)
     (let ([temp a])        ; temp is hygienic
       (set! a b)
       (set! b temp))]))

(let ([temp 1] [x 2])
  (swap! temp x)            ; Works! temp in macro is different
  (list temp x))            ; (2 1)

; Introduced identifiers are renamed
(define-syntax capture-free
  (syntax-rules ()
    [(_ x e)
     (let ([x 'captured])   ; This x is hygienic
       e)]))

(let ([y 1])
  (capture-free y (list y)))  ; (1) - y not captured

; Use syntax-case for intentional capture

Syntax-Case Transformers

Basic syntax-case:

; syntax-case provides more control than syntax-rules
(define-syntax my-when
  (lambda (stx)
    (syntax-case stx ()
      [(_ test body ...)
       #'(if test (begin body ...))])))

; Explicit syntax object construction
(define-syntax my-or
  (lambda (stx)
    (syntax-case stx ()
      [(_) #'#f]
      [(_ e) #'e]
      [(_ e1 e2 ...)
       #'(let ([t e1])
           (if t t (my-or e2 ...)))])))

; Access to raw syntax objects
(define-syntax show-syntax
  (lambda (stx)
    (syntax-case stx ()
      [(_ x)
       (begin
         (printf "Syntax: ~s~n" (syntax->datum #'x))
         #'(quote x))])))

Fenders (guards):

; Fenders add conditions to patterns
(define-syntax const
  (lambda (stx)
    (syntax-case stx ()
      [(_ x)
       (number? (syntax->datum #'x))  ; Fender
       #'x]
      [(_ x)
       (string? (syntax->datum #'x))
       #'x]
      [(_ x)
       (syntax-error #'x "expected constant")])))

; More complex fender
(define-syntax assert-identifier
  (lambda (stx)
    (syntax-case stx ()
      [(_ name)
       (identifier? #'name)          ; Check it's an identifier
       #'(void)]
      [(_ name)
       (syntax-error #'name "expected identifier")])))

; Multiple conditions
(define-syntax literal-string
  (lambda (stx)
    (syntax-case stx ()
      [(_ s)
       (and (string? (syntax->datum #'s))
            (< (string-length (syntax->datum #'s)) 100))
       #'s])))

Syntax manipulation procedures:

; Convert between syntax and data
(syntax->datum #'(a b c))   ; (a b c)
(datum->syntax #'here '(a b c))  ; #<syntax (a b c)>

; Check syntax object type
(identifier? #'foo)         ; #t
(identifier? #'(a b))       ; #f

; Compare identifiers
(free-identifier=? #'car #'car)   ; #t
(bound-identifier=? #'x #'x)      ; #t in same binding

; Generate unique identifier
(generate-temporaries '(a b c))  ; (#<syntax t1> #<syntax t2> #<syntax t3>)

; Syntax lists
(syntax->list #'(a b c))    ; (#<syntax a> #<syntax b> #<syntax c>)

; with-syntax for binding patterns
(define-syntax my-let
  (lambda (stx)
    (syntax-case stx ()
      [(_ ([var val] ...) body ...)
       (with-syntax ([(t ...) (generate-temporaries #'(var ...))])
         #'(let ([t val] ...)
             (let ([var t] ...)
               body ...)))])))

Breaking hygiene:

; datum->syntax inherits lexical context
(define-syntax define-struct
  (lambda (stx)
    (syntax-case stx ()
      [(_ name (field ...))
       (with-syntax ([make-name (datum->syntax #'name
                                  (string->symbol
                                    (string-append "make-"
                                      (symbol->string
                                        (syntax->datum #'name)))))]
                     [name? (datum->syntax #'name
                              (string->symbol
                                (string-append
                                  (symbol->string
                                    (syntax->datum #'name))
                                  "?")))])
         #'(begin
             (define (make-name field ...)
               (vector 'name field ...))
             (define (name? x)
               (and (vector? x)
                    (eq? (vector-ref x 0) 'name)))))])))

(define-struct point (x y))
(define p (make-point 3 4))
(point? p)                  ; #t

; Intentional capture with datum->syntax
(define-syntax aif
  (lambda (stx)
    (syntax-case stx ()
      [(_ test then else)
       (with-syntax ([it (datum->syntax #'test 'it)])
         #'(let ([it test])
             (if it then else)))]))

(aif (assq 'a '((a . 1)))
     (cdr it)               ; it is captured
     'not-found)            ; 1

Recursive and helper macros:

; Helper procedure at expand time
(define-syntax define-enum
  (lambda (stx)
    (define (make-constant name index)
      (datum->syntax name
        (string->symbol
          (string-append
            (symbol->string (syntax->datum name))
            "-value"))))
    (syntax-case stx ()
      [(_ name ...)
       (with-syntax ([(index ...)
                      (datum->syntax #'(name ...)
                        (iota (length (syntax->list #'(name ...)))))]
                     [(const ...)
                      (map make-constant
                           (syntax->list #'(name ...))
                           (iota (length (syntax->list #'(name ...)))))])
         #'(begin
             (define name index) ...
             (define const index) ...))])))

(define-enum RED GREEN BLUE)
RED                         ; 0
GREEN                       ; 1
BLUE-value                  ; 2

; Recursive macro expansion
(define-syntax my-let*
  (lambda (stx)
    (syntax-case stx ()
      [(_ () body ...)
       #'(let () body ...)]
      [(_ ([var val] . rest) body ...)
       #'(let ([var val])
           (my-let* rest body ...))])))

Syntax errors and source location:

; Raise syntax error with location
(define-syntax check-args
  (lambda (stx)
    (syntax-case stx ()
      [(_ proc (arg ...))
       (let ([args (syntax->list #'(arg ...))])
         (for-each
           (lambda (a)
             (unless (identifier? a)
               (syntax-error a "expected identifier")))
           args)
         #'(proc arg ...))])))

; Custom error messages
(define-syntax my-define
  (lambda (stx)
    (syntax-case stx ()
      [(_ (name . args) body ...)
       (if (identifier? #'name)
           #'(define (name . args) body ...)
           (syntax-error #'name
             "expected identifier for function name"))]
      [(_ name value)
       (if (identifier? #'name)
           #'(define name value)
           (syntax-error #'name
             "expected identifier for variable name"))]
      [_
       (syntax-error stx "invalid define syntax")])))

; Get source location
(define-syntax where-am-i
  (lambda (stx)
    (let ([src (syntax->source-info stx)])
      #`(quote #,(or src 'unknown)))))

Compile-time Values and Properties

define-property:

; Attach properties to identifiers at compile time
(define-syntax define-constant
  (lambda (stx)
    (syntax-case stx ()
      [(_ name value)
       #'(begin
           (define-property name constant-value 'value)
           (define name value))])))

(define-syntax get-constant
  (lambda (stx)
    (syntax-case stx ()
      [(_ name)
       (let ([val (lookup-property #'name 'constant-value)])
         (if val
             (datum->syntax #'name val)
             (syntax-error #'name "not a constant")))])))

(define-constant PI 3.14159)
(get-constant PI)           ; 3.14159 (at compile time)

; Properties for type information
(define-syntax define-typed
  (lambda (stx)
    (syntax-case stx (:)
      [(_ name : type value)
       #'(begin
           (define-property name type-info 'type)
           (define name value))])))

Compile-time computation with define-syntax:

; Compute at compile time
(define-syntax compile-time-factorial
  (lambda (stx)
    (define (fact n)
      (if (zero? n) 1 (* n (fact (- n 1)))))
    (syntax-case stx ()
      [(_ n)
       (let ([val (fact (syntax->datum #'n))])
         (datum->syntax #'n val))])))

(compile-time-factorial 10) ; 3628800 (computed at compile time)

; Lookup tables at compile time
(define-syntax day->number
  (let ([table '((sunday . 0) (monday . 1) (tuesday . 2)
                 (wednesday . 3) (thursday . 4)
                 (friday . 5) (saturday . 6))])
    (lambda (stx)
      (syntax-case stx ()
        [(_ day)
         (let ([val (assq (syntax->datum #'day) table)])
           (if val
               (datum->syntax #'day (cdr val))
               (syntax-error #'day "unknown day")))]))))

(day->number monday)        ; 1

Storing values with define-integrable:

; define-integrable allows inline expansion
(define-syntax define-integrable
  (syntax-rules ()
    [(_ (name arg ...) body ...)
     (begin
       (define-syntax name
         (syntax-rules ()
           [(_ arg ...) (begin body ...)]
           [_ name-procedure]))
       (define name-procedure
         (lambda (arg ...) body ...))
       (define name name-procedure))]))

(define-integrable (square x)
  (* x x))

(square 5)                  ; Inlined: (* 5 5)
(map square '(1 2 3))       ; Uses procedure version

; Chez Scheme's built-in integrable definitions
; Many primitives like car, cdr, cons are integrable

Expand-time environment:

; Access expand-time environment
(define-syntax check-bound
  (lambda (stx)
    (syntax-case stx ()
      [(_ id)
       (if (identifier? #'id)
           (let ([binding (identifier-binding #'id)])
             (if binding
                 #'(quote bound)
                 #'(quote unbound)))
           (syntax-error #'id "expected identifier"))])))

; identifier-binding returns:
; #f if unbound
; 'lexical if lexically bound
; (library . name) if from library

; Check binding in specific environment
(define-syntax in-environment
  (lambda (stx)
    (syntax-case stx ()
      [(_ env expr)
       (let ([e (syntax->datum #'env)])
         ; Use environment for expansion
         #'(eval 'expr env))])))

Modules

Module basics:

; Modules group definitions with controlled exports
; Different from libraries - modules are local scoping

(module math-ops (add subtract multiply)
  (define (add a b) (+ a b))
  (define (subtract a b) (- a b))
  (define (multiply a b) (* a b))
  (define (helper x) (* x x)))  ; Not exported

; Import module bindings
(import math-ops)
(add 1 2)                   ; 3
(multiply 3 4)              ; 12
; (helper 5)                ; Error: helper not exported

; Selective import
(import (only math-ops add))
(import (except math-ops multiply))
(import (rename math-ops (add plus)))

Anonymous modules:

; Module without name - just for scoping
(module (get-counter increment!)
  (define count 0)
  (define (get-counter) count)
  (define (increment!)
    (set! count (+ count 1))))

(import (get-counter increment!))  ; Import anonymous module
(get-counter)               ; 0
(increment!)
(get-counter)               ; 1

; Private state via closure in module
(module (make-counter)
  (define (make-counter initial)
    (let ([count initial])
      (lambda (msg)
        (case msg
          [(get) count]
          [(inc) (set! count (+ count 1))]
          [(dec) (set! count (- count 1))])))))

Nested modules:

; Modules can be nested
(module outer (public-a inner-export)
  (define private-x 10)

  (define (public-a)
    private-x)

  (module inner (inner-proc)
    (define (inner-proc)
      (* private-x 2)))   ; Can access outer's private

  (import inner)
  (define (inner-export)
    (inner-proc)))

(import outer)
(public-a)                  ; 10
(inner-export)              ; 20

; Re-exporting from nested module
(module container (inner-fn)
  (module hidden (inner-fn)
    (define (inner-fn x) (* x 3)))
  (import hidden))

Module with interfaces:

; Define interface separately
(define-syntax define-interface
  (syntax-rules ()
    [(_ name (export ...))
     (define-syntax name
       (syntax-rules ()
         [(_ . body)
          (module (export ...) . body)]))]))

(define-interface stack-interface
  (make-stack push! pop! empty?))

(stack-interface
  (define (make-stack)
    (let ([items '()])
      (vector
        (lambda (x) (set! items (cons x items)))   ; push!
        (lambda ()
          (let ([top (car items)])
            (set! items (cdr items))
            top))                                   ; pop!
        (lambda () (null? items)))))               ; empty?

  (define (push! stack x)
    ((vector-ref stack 0) x))

  (define (pop! stack)
    ((vector-ref stack 1)))

  (define (empty? stack)
    ((vector-ref stack 2))))

Module with syntax exports:

; Modules can export syntax
(module utility-macros (when-let unless-let)
  (define-syntax when-let
    (syntax-rules ()
      [(_ ([var expr]) body ...)
       (let ([var expr])
         (when var body ...))]))

  (define-syntax unless-let
    (syntax-rules ()
      [(_ ([var expr]) body ...)
       (let ([var expr])
         (unless var body ...))])))

(import utility-macros)
(when-let ([x (assq 'a '((a . 1)))])
  (display (cdr x)))        ; 1

; Mixed exports (values and syntax)
(module mixed (value-export syntax-export)
  (define value-export 42)
  (define-syntax syntax-export
    (syntax-rules ()
      [(_ x) (list 'syntax x)])))

Standalone Import and Export Forms

Top-level import:

; Import at top level or in bodies
(import (rnrs))             ; Import library
(import my-module)          ; Import module

; Import forms
(import (only module-name id ...))
(import (except module-name id ...))
(import (rename module-name (old new) ...))
(import (prefix module-name prefix))

; Multiple imports
(import (rnrs) (rnrs lists) (chezscheme))

; Combining import modifiers
(import (prefix (only (rnrs lists) filter map) list:))
; Now use list:filter, list:map

; Import into local scope
(let ()
  (import (only (rnrs) display))
  (display "hello"))        ; Only display is imported here

Indirect exports:

; indirect-export makes helper visible to macros
(module m (transform)
  (indirect-export transform helper)

  (define (helper x)
    (* x 2))

  (define-syntax transform
    (syntax-rules ()
      [(_ x) (helper x)])))

(import m)
(transform 5)               ; 10
; helper is available because of indirect-export

; Without indirect-export, helper would not be
; visible when transform expands in importing context

; Multiple indirect exports
(module m2 (my-macro)
  (indirect-export my-macro h1 h2 h3)
  (define (h1 x) ...)
  (define (h2 x) ...)
  (define (h3 x) ...)
  (define-syntax my-macro ...))

Export forms in modules:

; Explicit export list in module form
(module name (export1 export2)
  ...)

; Export everything defined
(module name *
  ...)                      ; All definitions exported

; Selective re-export
(module wrapper (public-fn)
  (import internal-module)
  ; Only re-export public-fn from internal-module
  (define public-fn internal-fn))

; Renaming exports
(module m ((rename internal-name external-name))
  (define (internal-name x) ...))

; After import, use external-name

Import and export interaction:

; Import for re-export
(module aggregator (a b c d)
  (import module-1)         ; Provides a, b
  (import module-2)         ; Provides c, d
  ; All four are now exported from aggregator
  )

; Import with aliases for internal use
(module m (process)
  (import (rename other-module
            (long-name short)))
  (define (process x)
    (short x)))             ; Use short name internally

; Shadowing imports
(module m (my-map)
  (import (except (rnrs) map))  ; Don't import map
  (define (my-map f lst)        ; Define our own
    ...))

Built-in Modules

Scheme module:

; The scheme module contains core bindings
(import scheme)

; Equivalent to importing base language features
; Includes:
; - Core syntax: lambda, if, define, let, etc.
; - Basic procedures: car, cdr, cons, list, etc.
; - Numeric operations: +, -, *, /, etc.
; - I/O: read, write, display, etc.

; Typically you'd use libraries instead:
(import (rnrs))             ; R6RS standard
(import (chezscheme))       ; Full Chez Scheme

Chez Scheme built-in module:

; $system module contains internal procedures
; Use with caution - implementation details

; Access to internal representations
#%$procedure-name           ; Get procedure name
#%$code-source              ; Get code source info
#%$continuation?            ; Check for continuation

; Example (implementation-specific):
(define (procedure-info proc)
  (and (procedure? proc)
       (#%$procedure-name proc)))

; These are not part of the public API and
; may change between Chez Scheme versions

ieee and r5rs modules:

; ieee module for IEEE Scheme compatibility
(import ieee)

; r5rs module for R5RS compatibility
(import (rnrs r5rs))

; Contains R5RS-specific forms:
; - null-environment
; - scheme-report-environment
; - delay, force
; - load
; - etc.

; Use for compatibility with older code
(let ([env (scheme-report-environment 5)])
  (eval '(+ 1 2) env))      ; Evaluate in R5RS environment

Interaction between modules and libraries:

; Libraries and modules can interact

; Library using internal module
(library (my-lib)
  (export public-api)
  (import (chezscheme))

  ; Internal module for organization
  (module helpers (h1 h2)
    (define (h1 x) ...)
    (define (h2 x) ...))

  (import helpers)

  (define (public-api x)
    (h1 (h2 x))))

; Module importing from library
(module my-module (combined)
  (import (rnrs))
  (import (my-lib))
  (define (combined x)
    (public-api x)))

Meta Definitions

meta form for expand-time code:

; meta runs code at expand time
(meta define helper-list '(a b c))

(define-syntax use-helper
  (lambda (stx)
    (syntax-case stx ()
      [(_)
       (datum->syntax #'use-helper helper-list)])))

(use-helper)                ; (a b c)

; Meta definitions are available during expansion
(meta define (compute-table n)
  (let loop ([i 0] [acc '()])
    (if (= i n)
        (reverse acc)
        (loop (+ i 1) (cons (* i i) acc)))))

(define-syntax get-squares
  (lambda (stx)
    (syntax-case stx ()
      [(_ n)
       (let ([squares (compute-table (syntax->datum #'n))])
         (datum->syntax #'n squares))])))

meta-cond for conditional compilation:

; meta-cond chooses code at expand time
(meta-cond
  [(= (optimize-level) 3)
   (define-syntax debug-print
     (syntax-rules ()
       [(_ . args) (void)]))]
  [else
   (define-syntax debug-print
     (syntax-rules ()
       [(_ . args) (printf . args)]))])

; Feature detection
(meta-cond
  [(memq 'threads (machine-features))
   (import (chezscheme threads))]
  [else
   (define make-thread (lambda (thunk) (thunk)))
   (define thread-start! (lambda (t) t))])

; Platform-specific code
(meta-cond
  [(eq? (machine-type) 'i3le)
   (define word-size 32)]
  [(eq? (machine-type) 'a6le)
   (define word-size 64)]
  [else
   (define word-size 64)])

Meta modules:

; Define module for expand-time use
(meta module syntax-helpers (make-id with-ids)
  (define (make-id template sym)
    (datum->syntax template sym))

  (define (with-ids template syms proc)
    (apply proc (map (lambda (s) (make-id template s)) syms))))

; Use in macro
(meta import syntax-helpers)

(define-syntax define-accessors
  (lambda (stx)
    (syntax-case stx ()
      [(_ name field ...)
       (with-ids #'name
         '(getter setter)
         (lambda (get set)
           #`(begin
               (define (#,get obj) ...)
               (define (#,set obj val) ...))))])))

Phases and meta levels:

; Meta levels:
; Level 0: run time
; Level 1: expand time (macro execution)
; Level 2: meta-expand time (macros defining macros)

; Regular definition (level 0)
(define run-time-value 42)

; Meta definition (level 1)
(meta define expand-time-value 100)

; Use expand-time value in macro
(define-syntax use-expand-time
  (lambda (stx)
    #`'#,expand-time-value))

(use-expand-time)           ; 100

; Nested meta for level 2
(meta meta define level-2-value 'deep)

; For library imports at different phases:
(import (for (helper-lib) expand))  ; Import for expand time

Conditional Expansion

cond-expand form:

; cond-expand chooses based on features
(cond-expand
  [chez-scheme
   (define implementation 'chez)]
  [guile
   (define implementation 'guile)]
  [else
   (define implementation 'unknown)])

; Feature requirements
(cond-expand
  [(and srfi-1 srfi-13)
   ; Both available
   (import (srfi :1) (srfi :13))]
  [(or srfi-1 rnrs-lists)
   ; At least one list library
   (import (rnrs lists))]
  [else
   (error 'init "need list library")])

; Check for library existence
(cond-expand
  [(library (my optional-lib))
   (import (my optional-lib))]
  [else
   (define optional-feature #f)])

when-feature and unless-feature:

; Chez-specific conditional expansion
(when-feature pthreads
  (import (chezscheme threads))
  (define use-threads? #t))

(unless-feature windows
  (define use-signals? #t))

; Feature detection helpers
(define-syntax if-feature
  (syntax-rules ()
    [(_ feature then else)
     (meta-cond
       [(memq 'feature (machine-features))
        then]
       [else
        else])]))

(if-feature pthreads
  (define parallel-map threaded-map)
  (define parallel-map map))

Machine type conditionals:

; Check machine type at expand time
(meta-cond
  [(eq? (machine-type) 'a6osx)
   (define os 'macos)
   (define arch 'x86-64)]
  [(eq? (machine-type) 'arm64osx)
   (define os 'macos)
   (define arch 'arm64)]
  [(memq (machine-type) '(a6le ta6le))
   (define os 'linux)
   (define arch 'x86-64)]
  [(memq (machine-type) '(arm64le tarm64le))
   (define os 'linux)
   (define arch 'arm64)]
  [else
   (define os 'unknown)
   (define arch 'unknown)])

; Threaded vs non-threaded
(meta-cond
  [(threaded?)
   (define-syntax with-mutex
     (syntax-rules ()
       [(_ m body ...)
        (with-mutex m (lambda () body ...))]))]
  [else
   (define-syntax with-mutex
     (syntax-rules ()
       [(_ m body ...)
        (begin body ...)]))])

Compile-time parameters:

; Conditionalize on optimization level
(meta-cond
  [(>= (optimize-level) 2)
   (define-syntax assert
     (syntax-rules ()
       [(_ expr) (void)]))]  ; Assertions removed
  [else
   (define-syntax assert
     (syntax-rules ()
       [(_ expr)
        (unless expr
          (error 'assert "assertion failed" 'expr))]))])

; Debug level conditionals
(meta define debug-level 2)

(meta-cond
  [(>= debug-level 1)
   (define-syntax trace
     (syntax-rules ()
       [(_ msg) (printf "TRACE: ~a~n" msg)]))]
  [else
   (define-syntax trace
     (syntax-rules ()
       [(_ msg) (void)]))])

(meta-cond
  [(>= debug-level 2)
   (define-syntax debug
     (syntax-rules ()
       [(_ msg args ...)
        (printf "DEBUG: ~a~n" (format msg args ...))]))]
  [else
   (define-syntax debug
     (syntax-rules ()
       [(_ msg args ...) (void)]))])

Aliases

alias form:

; alias creates alternative name for binding
(alias new-name old-name)

; Example
(alias λ lambda)
(λ (x) (* x x))             ; Same as (lambda (x) (* x x))

; Alias for imported binding
(import (rnrs))
(alias fn lambda)
(alias def define)

(def (square x)
  (* x x))

; Multiple aliases
(alias + plus)
(alias - minus)
(alias * times)
(alias / divide)

(plus 1 2)                  ; 3
(times 3 4)                 ; 12

Alias vs define:

; alias shares binding, define copies
(define original 42)

(alias aliased original)
(define copied original)

(set! original 100)

aliased                     ; 100 (shares binding)
copied                      ; 42 (separate copy)

; Alias for procedures
(define (greet name)
  (printf "Hello, ~a!~n" name))

(alias say-hello greet)

(set! greet (lambda (name)
              (printf "Hi, ~a!~n" name)))

(say-hello "World")         ; Hi, World! (alias follows change)

; Alias maintains all properties
(alias car* car)
; car* has same integrable property as car

Syntax aliases:

; Alias for syntax keywords
(alias when* when)
(alias unless* unless)

(when* #t (display "yes"))

; Alias for macros
(define-syntax my-let
  (syntax-rules ()
    [(_ ([var val] ...) body ...)
     (let ([var val] ...) body ...)]))

(alias bind my-let)

(bind ([x 1] [y 2])
  (+ x y))                  ; 3

; Alias in modules
(module m (external-name)
  (define (internal-impl x) ...)
  (alias external-name internal-impl))

Aliases for compatibility:

; Create R5RS-compatible names
(alias null? nil?)
(alias pair? cons?)
(alias procedure? function?)

; Platform-specific aliases
(meta-cond
  [(eq? (machine-type) 'windows)
   (alias path-separator #\\)]
  [else
   (alias path-separator #\/)])

; Version-specific aliases
(define (new-api-function x y)
  ...)

; Keep old name for compatibility
(alias old-api-function new-api-function)

; Documentation comment
; old-api-function is deprecated, use new-api-function

Annotations

Source annotations:

; Annotations attach source information to syntax
; Used for error messages and debugging

; Read with annotations
(define (read-annotated port)
  (get-datum/annotations port
    (make-source-file-descriptor (port-name port) port)))

; Annotation accessors
(define (show-annotation stx)
  (let ([anno (syntax->annotation stx)])
    (when anno
      (printf "Source: ~a~n" (annotation-source anno))
      (printf "Expression: ~a~n" (annotation-expression anno))
      (printf "Stripped: ~a~n" (annotation-stripped anno)))))

; Create annotation manually
(make-annotation 'expression source-object 'stripped-expression)

; annotation-source returns source-object with:
; - file information
; - position information
; - line/column (if available)

Working with source objects:

; Source objects contain location information
(define (get-source-location stx)
  (let ([anno (syntax->annotation stx)])
    (and anno
         (let ([src (annotation-source anno)])
           (and (source-object? src)
                (list (source-object-sfd src)
                      (source-object-bfp src)
                      (source-object-efp src)))))))

; source-object fields:
; - sfd: source-file descriptor
; - bfp: beginning file position
; - efp: ending file position

; Create source object
(make-source-object sfd bfp efp)

; Source file descriptor
(make-source-file-descriptor filename port)
(source-file-descriptor-checksum sfd)
(source-file-descriptor-path sfd)

Annotations in macros:

; Preserve source info in macro expansion
(define-syntax my-define
  (lambda (stx)
    (syntax-case stx ()
      [(_ name expr)
       ; Copy annotation from original to expansion
       (let ([anno (syntax->annotation #'expr)])
         (if anno
             ; Preserve source location
             #`(define name #,(syntax-with-annotation
                                #'expr anno))
             #'(define name expr)))])))

; Helpful for error messages
(define-syntax check-positive
  (lambda (stx)
    (syntax-case stx ()
      [(_ expr)
       #`(let ([v expr])
           (unless (positive? v)
             (error 'check-positive
               (format "~a: expected positive, got ~a"
                 '#,(syntax->source-info #'expr) v)))
           v)])))

; syntax->source-info extracts location string

Annotation options:

; Control annotation generation
(generate-inspector-information)     ; Get current
(generate-inspector-information #t)  ; Enable

(generate-procedure-source-information)
(generate-procedure-source-information #t)

; When enabled, compiled code contains source info
; for better error messages and debugging

; Strip annotations for production
(strip-fasl-file "debug.so" "release.so")

; Check if datum has annotation
(annotation? obj)

; Get annotation from various forms
(syntax->annotation stx)    ; From syntax object
(record-type-descriptor-uid-source-info rtd)  ; From RTD

Source Tables

Source table basics:

; Source tables map positions to source info
; Used by debugger and profiler

; Make source table during compilation
(parameterize ([generate-inspector-information #t])
  (compile-file "source.ss"))

; Source tables are embedded in compiled files
; and used for:
; - Stack traces
; - Debugging
; - Profiling
; - Code coverage

; Get source from procedure
(define (procedure-source-info proc)
  (#%$code-source (#%$closure-code proc)))

; Returns source position if available

Profile source information:

; Profiling uses source tables
(profile-clear)
(profile source.ss)         ; Enable profiling for file

; After running code:
(profile-dump-html "profile.html")
(profile-dump-list)

; Profile data includes:
; - Line numbers (from source table)
; - Call counts
; - Execution time

; Source table for coverage
(define coverage-data (make-eq-hashtable))

; Code coverage collection
(visit-source-table
  (lambda (file-name line-number count)
    (hashtable-update! coverage-data
      file-name
      (lambda (lines) (cons line-number lines))
      '())))

Inspector source information:

; Inspector uses source tables for display
; Enabled with generate-inspector-information

(debug-on-exception #t)

; When error occurs, inspector shows:
; - Source file
; - Line and column
; - Expression

; Manual inspection
(inspect object)

; Shows source if available
; Type 'e' to see expression
; Type 's' to see source location

; Continuation inspector
(call/cc
  (lambda (k)
    (inspect-continuation k)))

; Shows call stack with source info

Building and using source tables:

; Compile with source information
(parameterize ([generate-inspector-information #t]
               [generate-procedure-source-information #t])
  (compile-file "mycode.ss"))

; Source information increases .so size
; but enables better debugging

; Verify source info present
(define (has-source-info? proc)
  (and (procedure? proc)
       (#%$code-source (#%$closure-code proc))))

; Extract source for display
(define (show-procedure-source proc)
  (let ([src (has-source-info? proc)])
    (if src
        (printf "Source: ~a~n" src)
        (printf "No source information~n"))))

; Source tables for read syntax
(define (read-with-source-table filename)
  (call-with-input-file filename
    (lambda (port)
      (let ([sfd (make-source-file-descriptor filename port)])
        (let loop ([datums '()])
          (let ([d (get-datum/annotations port sfd)])
            (if (eof-object? d)
                (reverse datums)
                (loop (cons d datums)))))))))

Source table utilities:

; Walk through source table entries
(define (enumerate-sources compiled-code)
  ; Implementation-specific access to source table
  ; Typically used internally by profiler/debugger
  ...)

; Convert position to line/column
(define (position->line-col filename pos)
  (call-with-input-file filename
    (lambda (port)
      (let loop ([line 1] [col 0] [p 0])
        (if (= p pos)
            (values line col)
            (let ([c (read-char port)])
              (if (eof-object? c)
                  (values line col)
                  (if (char=? c #\newline)
                      (loop (+ line 1) 0 (+ p 1))
                      (loop line (+ col 1) (+ p 1))))))))))

; Format source location for display
(define (format-source-location sfd bfp)
  (let ([filename (source-file-descriptor-path sfd)])
    (let-values ([(line col) (position->line-col filename bfp)])
      (format "~a:~a:~a" filename line col))))

Complete Macro System Example

Pattern matching macro:

; Comprehensive match macro using syntax-case
(define-syntax match
  (lambda (stx)
    (syntax-case stx ()
      [(_ expr clause ...)
       #'(let ([v expr])
           (match-clauses v clause ...))])))

(define-syntax match-clauses
  (lambda (stx)
    (syntax-case stx (else)
      [(_ v)
       #'(error 'match "no matching clause")]
      [(_ v (else body ...))
       #'(begin body ...)]
      [(_ v (pattern body ...) rest ...)
       #'(let ([fail (lambda () (match-clauses v rest ...))])
           (match-pattern v pattern (begin body ...) (fail)))])))

(define-syntax match-pattern
  (lambda (stx)
    (syntax-case stx (quote ?)
      ; Wildcard
      [(_ v _ success fail)
       #'success]

      ; Variable binding
      [(_ v name success fail)
       (identifier? #'name)
       #'(let ([name v]) success)]

      ; Literal quote
      [(_ v 'datum success fail)
       #'(if (equal? v 'datum) success fail)]

      ; Predicate check
      [(_ v (? pred) success fail)
       #'(if (pred v) success fail)]

      ; Predicate with binding
      [(_ v (? pred name) success fail)
       (identifier? #'name)
       #'(if (pred v)
             (let ([name v]) success)
             fail)]

      ; Pair pattern
      [(_ v (pat1 . pat2) success fail)
       #'(if (pair? v)
             (match-pattern (car v) pat1
               (match-pattern (cdr v) pat2 success fail)
               fail)
             fail)]

      ; Vector pattern
      [(_ v #(pat ...) success fail)
       #'(if (and (vector? v) (= (vector-length v) (length '(pat ...))))
             (match-vector v 0 (pat ...) success fail)
             fail)]

      ; Literal
      [(_ v literal success fail)
       #'(if (equal? v 'literal) success fail)])))

(define-syntax match-vector
  (syntax-rules ()
    [(_ v i () success fail) success]
    [(_ v i (pat rest ...) success fail)
     (match-pattern (vector-ref v i) pat
       (match-vector v (+ i 1) (rest ...) success fail)
       fail)]))

; Usage examples
(define (eval-expr expr env)
  (match expr
    [(? number?) expr]
    [(? symbol? name) (lookup name env)]
    [('quote datum) datum]
    [('if test then else)
     (if (eval-expr test env)
         (eval-expr then env)
         (eval-expr else env))]
    [('lambda (params ...) body)
     (lambda args
       (eval-expr body (extend-env params args env)))]
    [(proc args ...)
     (apply (eval-expr proc env)
            (map (lambda (a) (eval-expr a env)) args))]
    [else (error 'eval "unknown expression" expr)]))

Object system macro:

; Simple object system with define-class
(define-syntax define-class
  (lambda (stx)
    (syntax-case stx ()
      [(_ name (field ...) method ...)
       (with-syntax
         ([constructor (datum->syntax #'name
                         (string->symbol
                           (string-append "make-"
                             (symbol->string (syntax->datum #'name)))))]
          [predicate (datum->syntax #'name
                       (string->symbol
                         (string-append
                           (symbol->string (syntax->datum #'name))
                           "?")))]
          [(getter ...) (map (lambda (f)
                               (datum->syntax f
                                 (string->symbol
                                   (string-append
                                     (symbol->string (syntax->datum #'name))
                                     "-"
                                     (symbol->string (syntax->datum f))))))
                             (syntax->list #'(field ...)))]
          [(index ...) (datum->syntax #'name
                         (iota (length (syntax->list #'(field ...)))))])
         #'(begin
             (define (constructor field ...)
               (let ([self (vector 'name field ...)])
                 (define-methods self method ...)
                 self))
             (define (predicate obj)
               (and (vector? obj)
                    (eq? (vector-ref obj 0) 'name)))
             (define (getter obj)
               (vector-ref obj (+ 1 index)))
             ...))])))

(define-syntax define-methods
  (syntax-rules ()
    [(_ self) (void)]
    [(_ self ((name args ...) body ...) rest ...)
     (begin
       (vector-set! self 'name-idx
         (lambda (args ...) body ...))
       (define-methods self rest ...))]))

; Usage
(define-class point (x y)
  ((move dx dy)
   (make-point (+ (point-x self) dx)
               (+ (point-y self) dy)))
  ((distance other)
   (sqrt (+ (square (- (point-x other) (point-x self)))
            (square (- (point-y other) (point-y self)))))))

Module with macros example:

; Complete module demonstrating macro techniques
(module parser-combinators
  (parse-result parse-success parse-failure
   succeed fail item satisfy
   seq alt many many1
   parse-char parse-string parse-number)

  ; Parse result type
  (define-syntax parse-result
    (syntax-rules ()
      [(_ success-case failure-case input result rest)
       (if result
           (success-case result rest)
           (failure-case input))]))

  (define (parse-success result rest) (cons result rest))
  (define (parse-failure input) #f)

  ; Basic parsers
  (define (succeed v)
    (lambda (input) (cons v input)))

  (define (fail)
    (lambda (input) #f))

  (define (item)
    (lambda (input)
      (if (null? input)
          #f
          (cons (car input) (cdr input)))))

  (define (satisfy pred)
    (lambda (input)
      (if (and (pair? input) (pred (car input)))
          (cons (car input) (cdr input))
          #f)))

  ; Combinators as macros for efficiency
  (define-syntax seq
    (syntax-rules (->)
      [(_ p) p]
      [(_ p1 -> name rest ...)
       (lambda (input)
         (let ([r1 (p1 input)])
           (and r1
                (let ([name (car r1)])
                  ((seq rest ...) (cdr r1))))))]
      [(_ p1 rest ...)
       (lambda (input)
         (let ([r1 (p1 input)])
           (and r1 ((seq rest ...) (cdr r1)))))]))

  (define-syntax alt
    (syntax-rules ()
      [(_ p) p]
      [(_ p1 p2 ...)
       (lambda (input)
         (or (p1 input)
             ((alt p2 ...) input)))]))

  ; Repetition
  (define (many p)
    (alt (many1 p) (succeed '())))

  (define (many1 p)
    (seq p -> x
         (many p) -> xs
         (succeed (cons x xs))))

  ; Derived parsers
  (define (parse-char c)
    (satisfy (lambda (x) (char=? x c))))

  (define (parse-string s)
    (if (string=? s "")
        (succeed '())
        (seq (parse-char (string-ref s 0))
             (parse-string (substring s 1 (string-length s)))
             (succeed s))))

  (define parse-digit
    (satisfy char-numeric?))

  (define parse-number
    (seq (many1 parse-digit) -> digits
         (succeed (string->number (list->string digits))))))

System Operations in Chez Scheme

Exceptions

Raising exceptions:

; raise signals an exception
(raise 'error-symbol)       ; Raise any value
(raise (make-error))        ; Raise condition

; raise-continuable allows handler to return
(raise-continuable 'warning)

; error convenience procedure
(error 'who "message" irritant ...)
(error 'divide "division by zero" 0)

; assertion-violation for contract violations
(assertion-violation 'proc "expected positive" -1)

; syntax-violation for macro errors
(syntax-violation 'my-macro "invalid syntax" form subform)

; Chez-specific error procedures
(errorf 'who "format ~a" arg)      ; With format string
(warningf 'who "warning: ~a" arg)  ; Warning message
(assertion-violationf 'who "bad: ~a" arg)

Handling exceptions with guard:

; guard provides structured exception handling
(guard (condition
        [(error? condition)
         (display "Error occurred\n")
         'error-result]
        [(warning? condition)
         (display "Warning\n")
         'warning-result]
        [else
         (display "Unknown exception\n")
         (raise condition)])  ; Re-raise
  ; Protected body
  (risky-operation))

; Multiple condition checks
(guard (c
        [(and (who-condition? c) (message-condition? c))
         (printf "~a: ~a~n"
                 (condition-who c)
                 (condition-message c))]
        [(message-condition? c)
         (display (condition-message c))]
        [else (raise c)])
  (error 'my-proc "something went wrong"))

; Nested guards
(guard (outer [(error? outer) 'outer-error])
  (guard (inner [(warning? inner) 'inner-warning])
    (error 'test "error")))

Exception handlers:

; with-exception-handler for low-level handling
(with-exception-handler
  (lambda (condition)
    (display "Exception caught\n")
    (display condition)
    (newline))
  (lambda ()
    (raise 'my-exception)))

; Handler must handle or re-raise
(with-exception-handler
  (lambda (c)
    (if (warning? c)
        (begin
          (display "Ignoring warning\n")
          42)                ; Return value for continuable
        (raise c)))          ; Re-raise others
  (lambda ()
    (raise-continuable (make-warning))))

; Nested handlers
(with-exception-handler
  (lambda (c) (printf "Outer: ~a~n" c))
  (lambda ()
    (with-exception-handler
      (lambda (c)
        (printf "Inner: ~a~n" c)
        (raise c))           ; Pass to outer
      (lambda ()
        (raise 'test)))))

Condition types:

; R6RS standard conditions
(make-error)                ; General error
(make-assertion-violation)  ; Assertion failure
(make-violation)            ; Contract violation
(make-warning)              ; Warning
(make-serious-condition)    ; Serious condition
(make-irritants-condition '(1 2 3))
(make-who-condition 'my-proc)
(make-message-condition "error message")

; Compound conditions
(condition
  (make-error)
  (make-who-condition 'divide)
  (make-message-condition "division by zero")
  (make-irritants-condition '(0)))

; Condition predicates
(error? c)
(warning? c)
(serious-condition? c)
(violation? c)
(assertion-violation? c)
(irritants-condition? c)
(who-condition? c)
(message-condition? c)

; Condition accessors
(condition-who c)           ; Get who
(condition-message c)       ; Get message
(condition-irritants c)     ; Get irritants

Defining custom conditions:

; Define new condition type
(define-condition-type &my-error
  &error                    ; Parent type
  make-my-error             ; Constructor
  my-error?                 ; Predicate
  (code my-error-code)      ; Field
  (data my-error-data))

; Use custom condition
(define (signal-my-error code data)
  (raise (condition
           (make-my-error code data)
           (make-who-condition 'my-proc)
           (make-message-condition "custom error"))))

; Handle custom condition
(guard (c
        [(my-error? c)
         (printf "Code: ~a, Data: ~a~n"
                 (my-error-code c)
                 (my-error-data c))])
  (signal-my-error 404 "not found"))

; Chez-specific: display-condition
(guard (c [else (display-condition c)])
  (error 'test "message" 'irritant))

Debug on exception:

; Enter debugger on unhandled exceptions
(debug-on-exception #t)

; When enabled, unhandled exceptions enter inspector
; Type ? for help in inspector

; Reset handler (Chez extension)
(reset-handler)             ; Get current
(reset-handler (lambda () (exit 1)))  ; Set

; Abort handler
(abort-handler)             ; Get current
(abort-handler (lambda () (reset)))

; Base exception handler
(base-exception-handler)
(base-exception-handler
  (lambda (c)
    (display-condition c)
    (reset)))

; Exit on exception (useful for scripts)
(parameterize ([reset-handler exit]
               [abort-handler exit])
  (run-main-program))

Interrupts

Keyboard interrupts:

; keyboard-interrupt-handler handles Ctrl+C
(keyboard-interrupt-handler)  ; Get current handler

; Set custom handler
(keyboard-interrupt-handler
  (lambda ()
    (display "\nInterrupted!\n")
    (reset)))                 ; Return to REPL

; Disable interrupts temporarily
(let ([old-handler (keyboard-interrupt-handler)])
  (keyboard-interrupt-handler void)
  (critical-operation)
  (keyboard-interrupt-handler old-handler))

; Default behavior enters break handler
; Type ? for options:
; - e: exit
; - r: reset
; - a: abort
; - n: new cafe
; - i: inspect
; - s: statistics

Timer interrupts:

; set-timer sets timer interrupt
(set-timer ticks)           ; Returns previous value

; Timer interrupt handler
(timer-interrupt-handler)   ; Get current
(timer-interrupt-handler
  (lambda ()
    (display "Tick!\n")
    (set-timer 1000000)))   ; Reset timer

; Disable timer
(set-timer 0)               ; Disable timer

; Example: timeout mechanism
(define (with-timeout seconds thunk)
  (let ([done #f]
        [result #f])
    (let ([old-handler (timer-interrupt-handler)])
      (timer-interrupt-handler
        (lambda ()
          (unless done
            (error 'timeout "operation timed out"))))
      (set-timer (* seconds 1000000))
      (set! result (thunk))
      (set! done #t)
      (set-timer 0)
      (timer-interrupt-handler old-handler)
      result)))

(with-timeout 5
  (lambda ()
    (expensive-computation)))

Signal handling (Unix):

; register-signal-handler for Unix signals
(register-signal-handler signal-number handler)

; Common signals
(define SIGINT 2)
(define SIGTERM 15)
(define SIGUSR1 10)
(define SIGUSR2 12)
(define SIGALRM 14)

; Handle SIGTERM for graceful shutdown
(register-signal-handler SIGTERM
  (lambda (sig)
    (display "Received SIGTERM, shutting down...\n")
    (cleanup)
    (exit 0)))

; Handle SIGUSR1 for status
(register-signal-handler SIGUSR1
  (lambda (sig)
    (display-status)))

; Default signal behavior
(register-signal-handler SIGINT #f)  ; Default handling

; Get current handler
(define old-handler (register-signal-handler SIGINT #f))
(register-signal-handler SIGINT old-handler)

Disabling and enabling interrupts:

; critical-section disables interrupts
(critical-section
  ; Code here won't be interrupted
  (sensitive-operation))

; disable-interrupts / enable-interrupts (low-level)
(disable-interrupts)
(try
  (critical-code)
  (finally (enable-interrupts)))

; with-interrupts-disabled (Chez extension)
(define-syntax with-interrupts-disabled
  (syntax-rules ()
    [(_ body ...)
     (begin
       (disable-interrupts)
       (let ([result (begin body ...)])
         (enable-interrupts)
         result))]))

; Interrupt status
(interrupts-disabled?)      ; Check current state

; Deferred interrupts
; Interrupts are deferred, not lost, during critical sections

Environments

Environment basics:

; Environments are first-class in Chez Scheme
(interaction-environment)   ; REPL environment
(scheme-report-environment 5)  ; R5RS environment
(null-environment 5)        ; Syntax only, no procedures

; Create copy of environment
(copy-environment (interaction-environment))

; Check if environment
(environment? (interaction-environment))  ; #t

; Standard R6RS environment
(environment '(rnrs))       ; R6RS bindings
(environment '(rnrs) '(rnrs lists))  ; Multiple libs

; Chez scheme environment
(environment '(chezscheme))

Evaluating in environments:

; eval with environment
(eval '(+ 1 2) (interaction-environment))  ; 3

(eval '(define x 42) (interaction-environment))
(eval 'x (interaction-environment))  ; 42

; Create isolated environment
(let ([env (copy-environment (scheme-report-environment 5))])
  (eval '(define my-var 100) env)
  (eval 'my-var env))       ; 100
; my-var not defined here

; Evaluate in fresh environment
(let ([env (environment '(rnrs))])
  (eval '(fold-left + 0 '(1 2 3 4 5)) env))  ; 15

; environment-symbols: list defined symbols
(environment-symbols (interaction-environment))

Top-level bindings:

; Access top-level value
(top-level-value 'cons)     ; #<procedure cons>

; Check if bound
(top-level-bound? 'cons)    ; #t
(top-level-bound? 'undefined-var)  ; #f

; Set top-level value
(set-top-level-value! 'my-global 42)
(top-level-value 'my-global)  ; 42

; Define top-level value (creates if not exists)
(define-top-level-value 'new-var 100)

; In specific environment
(top-level-value 'x env)
(set-top-level-value! 'x 10 env)
(top-level-bound? 'x env)

; Top-level syntax
(top-level-syntax? 'lambda) ; #t
(top-level-syntax? 'cons)   ; #f

; Get syntax transformer
(top-level-syntax 'when)    ; Returns transformer

Environment manipulation:

; environment-mutable? checks if can modify
(environment-mutable? (interaction-environment))  ; #t
(environment-mutable? (scheme-report-environment 5))  ; #f

; Make sandbox environment
(define (make-sandbox)
  (let ([env (copy-environment (environment '(rnrs)))])
    ; Remove dangerous procedures
    (set-top-level-value! 'delete-file
      (lambda (f) (error 'sandbox "not allowed")) env)
    (set-top-level-value! 'system
      (lambda (cmd) (error 'sandbox "not allowed")) env)
    env))

; Evaluate user code in sandbox
(define (safe-eval expr)
  (eval expr (make-sandbox)))

; Import into environment
(environment-symbols (environment '(rnrs lists)))
; (find for-all exists ...)

Compilation, Evaluation, and Loading

Basic evaluation:

; eval evaluates expression
(eval '(+ 1 2))             ; 3
(eval '(+ 1 2) (interaction-environment))

; Compile expression
(compile '(lambda (x) (* x x)))  ; Returns compiled procedure

; Interpret expression (no compilation)
(interpret '(lambda (x) (* x x)))

; interpret is slower but uses less memory

; expand macro
(expand '(when #t (display "yes")))
; (if #t (begin (display "yes")))

; sc-expand for syntax-case expansion
(sc-expand '(let ([x 1]) x))

Loading files:

; load evaluates file contents
(load "myfile.ss")
(load "myfile.so")          ; Load compiled

; load-library loads library definition
(load-library "mylib.ss")

; load-program loads top-level program
(load-program "program.ss")

; Load with specific environment
(load "file.ss" (interaction-environment))

; Portable load (searches source-directories)
(load "relative/path.ss")

; Load compiled object file
(load-shared-object "mylib.so")

; visit loads syntax only (for macros)
(visit "macros.so")

; revisit reloads
(revisit "macros.so")

Compiling files:

; compile-file compiles source to object
(compile-file "source.ss")        ; Creates source.so
(compile-file "source.ss" "out.so")  ; Custom output

; compile-library for libraries
(compile-library "mylib.ss")
(compile-library "mylib.ss" "mylib.so")

; compile-program for programs
(compile-program "main.ss")

; compile-script for scripts
(compile-script "script.ss")

; compile-whole-program for optimization
(compile-whole-program "input.wpo" "output.so")

; compile-whole-library
(compile-whole-library "lib.wpo" "lib.so")

; Compile with import
(parameterize ([compile-imported-libraries #t])
  (compile-program "main.ss"))

; maybe-compile: compile if source newer
(maybe-compile-library "mylib.ss")
(maybe-compile-file "source.ss")

Compilation options:

; compile-compressed: compress output
(parameterize ([compile-compressed #t])
  (compile-file "large-file.ss"))

; generate-wpo-files: for whole-program optimization
(parameterize ([generate-wpo-files #t])
  (compile-library "mylib.ss"))

; compile-profile: enable profiling
(parameterize ([compile-profile #t])
  (compile-file "profile-me.ss"))

; generate-inspector-information
(parameterize ([generate-inspector-information #t])
  (compile-file "debug.ss"))

; generate-procedure-source-information
(parameterize ([generate-procedure-source-information #t])
  (compile-file "source.ss"))

; generate-allocation-counts
(parameterize ([generate-allocation-counts #t])
  (compile-file "analyze.ss"))

Source Directories and Files

Source directories:

; source-directories controls where to find source
(source-directories)        ; Get current list
; (".")

; Add directories
(source-directories
  (append '("./src" "./lib" "/usr/local/scheme/lib")
          (source-directories)))

; Source search order
; 1. Current directory (if relative path)
; 2. Each directory in source-directories

; Absolute paths bypass search
(load "/absolute/path/to/file.ss")

; For libraries
(library-directories)       ; List of (source . object) pairs
(library-directories
  '(("src" . "build")
    ("." . ".")))

Library file locations:

; library-extensions: file extensions to try
(library-extensions)
; ((".chezscheme.sls" . ".chezscheme.so")
;  (".ss" . ".so")
;  (".sls" . ".so")
;  (".scm" . ".so"))

; Add extension
(library-extensions
  (cons '(".scheme" . ".so")
        (library-extensions)))

; Library search process for (my lib):
; 1. Try each (src . obj) in library-directories
; 2. For each, try extensions: my/lib.ss, my/lib.sls, etc.
; 3. Check if object file exists and is newer
; 4. Load object or compile source

; library-object-filename: find compiled library
(library-object-filename '(rnrs))

; library-search-handler: customize search
(library-search-handler
  (lambda (who path dir*)
    (default-library-search-handler who path dir*)))

File operations during load:

; source-file-descriptor during read
(make-source-file-descriptor filename port)

; Get source info
(current-source-file)       ; During load

; locate-source-file: find file in source-directories
(define (locate-source-file filename)
  (let loop ([dirs (source-directories)])
    (if (null? dirs)
        #f
        (let ([path (string-append (car dirs) "/" filename)])
          (if (file-exists? path)
              path
              (loop (cdr dirs)))))))

; compile-imported-libraries: auto-compile
(compile-imported-libraries #t)

; import-notify: print imports
(import-notify #t)
; > (import (my-library))
; compiling my-library.ss with output to my-library.so

Compiler Controls

Optimization levels:

; optimize-level controls optimization aggressiveness
(optimize-level)            ; Get current (0-3)
(optimize-level 2)          ; Set level

; Level 0: No optimization (fastest compile, debugging)
; Level 1: Light optimization
; Level 2: Standard optimization (default)
; Level 3: Aggressive optimization (may change semantics)

; Level 3 enables unsafe operations
(parameterize ([optimize-level 3])
  (compile-file "performance-critical.ss"))

; debug-level: inverse of optimize
(debug-level)               ; Get current
(debug-level 3)             ; Maximum debugging

; Compile for debugging
(parameterize ([debug-level 3]
               [optimize-level 0]
               [generate-inspector-information #t])
  (compile-file "debug-me.ss"))

Inlining and integration:

; cp0-effort-limit: expansion limit
(cp0-effort-limit)          ; Default 200
(cp0-effort-limit 1000)     ; Allow more expansion

; cp0-score-limit: code growth limit
(cp0-score-limit)           ; Default 20
(cp0-score-limit 50)        ; Allow more growth

; cp0-outer-unroll-limit: loop unrolling
(cp0-outer-unroll-limit)    ; Default 1

; run-cp0: enable/disable optimizer
(run-cp0)                   ; #t by default

; Enable integration of safe primitives at level 3
; car, cdr, etc. become unsafe (no checks)

; Prevent integration of specific procedures
(define-syntax my-car
  (identifier-syntax car))  ; Wrapper prevents integration

Code generation options:

; generate-interrupt-trap: overflow checks
(generate-interrupt-trap)   ; #t by default
(generate-interrupt-trap #f)  ; Disable for speed (risky)

; generate-allocation-counts
(generate-allocation-counts)
(generate-allocation-counts #t)  ; Enable counting

; enable-cross-library-optimization
(enable-cross-library-optimization)
(enable-cross-library-optimization #t)

; fasl-compressed: compress fasl output
(fasl-compressed)           ; Get
(fasl-compressed #t)        ; Enable

; compile-interpret-simple: interpret simple expressions
(compile-interpret-simple)  ; #t by default

; internal-defines-as-letrec*
(internal-defines-as-letrec*)  ; #t (R6RS compliant)

Compile-time features:

; enable-type-recovery: infer types
(enable-type-recovery)      ; #t default
(enable-type-recovery #t)

; enable-error-source-expression
(enable-error-source-expression)
(enable-error-source-expression #t)

; compile-time-value-paths: for cached data
(expand/optimize expr env)  ; Expand and optimize

; Check compiler version
(scheme-version)            ; "9.5.8"
(scheme-version-number)     ; #(9 5 8)

; Machine-specific compilation
(machine-type)              ; 'a6osx, 'ta6le, etc.
(native-code)               ; #t for native code generation

; Whole-program optimization workflow
(parameterize ([generate-wpo-files #t])
  (compile-library "lib1.ss")
  (compile-library "lib2.ss")
  (compile-program "main.ss"))
(compile-whole-program "main.wpo" "app.so")

Profiling

Basic profiling:

; Enable profiling for source file
(profile-clear)             ; Clear existing data
(profile "myfile.ss")       ; Enable profiling

; Compile with profiling enabled
(parameterize ([compile-profile #t])
  (compile-file "myfile.ss"))

; Run profiled code
(load "myfile.so")
(run-my-functions)

; View profile results
(profile-dump)              ; Print to stdout
(profile-dump-list)         ; Return as list
(profile-dump-html "profile.html")  ; HTML report
(profile-dump-html "profile.html" separate-files: #t)

; Profile data includes:
; - Call counts
; - Execution time
; - Source locations

Profile control:

; profile-release-counters: free memory
(profile-release-counters)

; Check if profiling active
; No direct predicate, use profile-dump-list

; Selective profiling
(profile "critical-module.ss")  ; Only this file

; Multiple files
(profile "module1.ss")
(profile "module2.ss")

; Profile all loaded code
(compile-profile #t)        ; Global enable

; Disable profiling
(compile-profile #f)

; Profile parameters
(profile-line-tracking)     ; Track line numbers
(profile-line-tracking #t)

Analyzing profile data:

; profile-dump-list returns structured data
(define profile-data (profile-dump-list))

; Each entry: (source-info count time)
(for-each
  (lambda (entry)
    (let ([source (car entry)]
          [count (cadr entry)]
          [time (caddr entry)])
      (when (> count 1000)
        (printf "Hot spot: ~a (~a calls)~n" source count))))
  profile-data)

; Find hottest functions
(define (top-n-by-count data n)
  (take (sort (lambda (a b) (> (cadr a) (cadr b))) data) n))

(define (top-n-by-time data n)
  (take (sort (lambda (a b) (> (caddr a) (caddr b))) data) n))

; Display summary
(printf "Top 10 by call count:~n")
(for-each
  (lambda (e)
    (printf "  ~a: ~a calls~n" (car e) (cadr e)))
  (top-n-by-count profile-data 10))

HTML profile report:

; Generate HTML profile
(profile-dump-html "profile.html")

; Options
(profile-dump-html "profile.html"
  separate-files: #t         ; Separate file per source
  dump-counts: #t           ; Include call counts
  dump-times: #t)           ; Include timing

; HTML report shows:
; - Source code with annotations
; - Call counts per line
; - Time spent per line
; - Heat map coloring

; Custom HTML generation
(define (profile->custom-report data filename)
  (call-with-output-file filename
    (lambda (port)
      (fprintf port "<html><body><table>~n")
      (for-each
        (lambda (e)
          (fprintf port "<tr><td>~a</td><td>~a</td><td>~a</td></tr>~n"
                   (car e) (cadr e) (caddr e)))
        data)
      (fprintf port "</table></body></html>~n"))
    '(replace)))

Waiter Customization

Waiter basics:

; The waiter is the REPL read-eval-print loop
; new-cafe starts new waiter level
(new-cafe)                  ; New REPL level
(new-cafe eval)             ; With custom evaluator

; Exit current level
(exit)                      ; Exit cafe
(reset)                     ; Reset to base level

; Cafe depth
(cafe-level)                ; Current nesting depth

; Custom REPL
(new-cafe
  (lambda (x)
    (printf "Evaluating: ~a~n" x)
    (eval x)))

Waiter prompts:

; waiter-prompt-string controls prompt
(waiter-prompt-string)      ; Get current
(waiter-prompt-string "λ> ")  ; Custom prompt

; waiter-prompt-and-read: full control
(waiter-prompt-and-read)    ; Get current
(waiter-prompt-and-read
  (lambda (level)
    (printf "[~a]> " level)
    (flush-output-port)
    (read)))

; Multi-line prompt
(waiter-prompt-and-read
  (lambda (level)
    (if (= level 0)
        (display "scheme> ")
        (printf "~a> " level))
    (flush-output-port)
    (read)))

; With line editing
; Chez uses GNU readline if available

REPL hooks:

; waiter-write: control output format
(waiter-write)              ; Get current
(waiter-write
  (lambda (x)
    (unless (eq? x (void))
      (pretty-print x))))

; Custom output formatting
(waiter-write
  (lambda (x)
    (cond
      [(eq? x (void)) (void)]
      [(procedure? x)
       (printf "#~n")]
      [else
       (write x)
       (newline)])))

; waiter-evaluator: control evaluation
(waiter-evaluator)          ; Get current
(waiter-evaluator
  (lambda (x)
    (let ([start (current-time)])
      (let ([result (eval x)])
        (printf "; ~a ms~n"
          (time-difference (current-time) start))
        result))))

REPL utilities:

; abort returns to top level
(abort)

; break enters break handler
(break)

; inspect starts inspector
(inspect value)

; trace procedures
(trace procedure-name)
(trace factorial)

(factorial 5)
; |(factorial 5)
; | (factorial 4)
; | |(factorial 3)
; ...

(untrace factorial)

; trace-define
(trace-define (my-proc x)
  (* x 2))

; Debug with continuation inspector
(debug-on-exception #t)

Transcript Files

Basic transcript:

; transcript-on starts recording
(transcript-on "session.log")

; All input and output recorded
(+ 1 2)                     ; Recorded
(display "hello")           ; Recorded

; transcript-off stops recording
(transcript-off)

; Transcript includes:
; - All expressions typed
; - All results
; - All printed output

; Append to existing transcript
(transcript-on "session.log")  ; Appends if exists

Transcript file format:

; Example transcript content:
; > (define (square x) (* x x))
; > (square 5)
; 25
; > (map square '(1 2 3 4 5))
; (1 4 9 16 25)
; > (display "Hello\n")
; Hello

; Transcripts are human-readable
; Can be loaded as source (with care)

; Transcript for debugging
(transcript-on "debug-session.log")
(load "problem-code.ss")
(test-function)
(transcript-off)
; Review debug-session.log to see what happened

Programmatic transcript control:

; transcript-cafe: record single cafe session
(transcript-cafe "session.log")

; Run code with transcript
(define (with-transcript filename thunk)
  (transcript-on filename)
  (guard (c [else
             (transcript-off)
             (raise c)])
    (let ([result (thunk)])
      (transcript-off)
      result)))

; Timestamped transcript
(define (transcript-on/timestamp prefix)
  (let ([filename (format "~a-~a.log"
                          prefix
                          (date-and-time))])
    (transcript-on filename)
    filename))

; Auto-transcript on startup (in .schemerc)
(unless (top-level-bound? 'no-transcript)
  (transcript-on
    (format "~a/scheme-~a.log"
            (getenv "HOME")
            (date-and-time))))

Times and Dates

Time objects:

; current-time returns time object
(current-time)              ; Time since epoch
(current-time 'time-utc)    ; UTC time
(current-time 'time-monotonic)  ; Monotonic (for measuring)
(current-time 'time-process)    ; Process time
(current-time 'time-thread)     ; Thread time

; Time predicates
(time? (current-time))      ; #t
(time=? t1 t2)
(time<? t1 t2)
(time<=? t1 t2)
(time>? t1 t2)
(time>=? t1 t2)

; Time arithmetic
(time-difference t1 t2)     ; Returns time duration
(add-duration t duration)

; Time components
(time-second t)             ; Seconds part
(time-nanosecond t)         ; Nanoseconds part
(time-type t)               ; 'time-utc, etc.

Date operations:

; date-and-time returns formatted string
(date-and-time)             ; "Wed Dec 4 10:30:45 2024"

; current-date returns date object
(current-date)              ; Date object
(current-date 0)            ; UTC date

; Date components
(date-year d)               ; e.g., 2024
(date-month d)              ; 1-12
(date-day d)                ; 1-31
(date-hour d)               ; 0-23
(date-minute d)             ; 0-59
(date-second d)             ; 0-60 (leap second)
(date-nanosecond d)         ; 0-999999999
(date-zone-offset d)        ; Seconds from UTC
(date-week-day d)           ; 0-6 (Sunday = 0)
(date-year-day d)           ; 1-366

; Create date
(make-date nsec sec min hour day month year zone-offset)

Time/date conversions:

; Time to date
(time-utc->date (current-time))
(time-utc->date (current-time) 0)  ; With zone offset

; Date to time
(date->time-utc date)
(date->time-monotonic date)

; String formatting
(date->string date)         ; Default format
(date->string date "~Y-~m-~d ~H:~M:~S")

; Format codes:
; ~Y - 4-digit year
; ~m - month (01-12)
; ~d - day (01-31)
; ~H - hour (00-23)
; ~M - minute (00-59)
; ~S - second (00-60)
; ~N - nanosecond
; ~z - timezone offset

; Parse string to date
(string->date "2024-12-04" "~Y-~m-~d")

; Julian day conversions
(date->julian-day date)
(julian-day->date jd)
(julian-day->time-utc jd)

Practical time utilities:

; Measure elapsed time
(define (time-it thunk)
  (let* ([start (current-time 'time-monotonic)]
         [result (thunk)]
         [end (current-time 'time-monotonic)])
    (values result (time-difference end start))))

(let-values ([(result duration) (time-it expensive-computation)])
  (printf "Took ~a seconds~n"
          (+ (time-second duration)
             (/ (time-nanosecond duration) 1e9))))

; Format duration
(define (format-duration t)
  (let ([secs (time-second t)]
        [nsecs (time-nanosecond t)])
    (cond
      [(< secs 1) (format "~,3fms" (/ nsecs 1e6))]
      [(< secs 60) (format "~,2fs" (+ secs (/ nsecs 1e9)))]
      [else (format "~am ~as" (quotient secs 60) (modulo secs 60))])))

; Timestamp string
(define (timestamp)
  (date->string (current-date) "~Y~m~d-~H~M~S"))

; ISO 8601 format
(define (iso-timestamp)
  (date->string (current-date) "~Y-~m-~dT~H:~M:~S~z"))

Timing and Statistics

The time form:

; time measures expression evaluation
(time (factorial 10000))
; (time (factorial 10000))
;     2 collections
;     32 ms elapsed cpu time, including 5 ms collecting
;     35 ms elapsed real time
;     5,234,567 bytes allocated

; Returns the expression result
(define result (time (heavy-computation)))

; time reports:
; - Number of GC collections
; - CPU time (including GC)
; - Real (wall clock) time
; - Bytes allocated

Statistics procedures:

; statistics returns detailed info
(statistics)
; Returns:
; ((time type . value) ...)

; Specific statistics
(cpu-time)                  ; CPU time in nanoseconds
(real-time)                 ; Real time in nanoseconds
(bytes-allocated)           ; Total bytes allocated
(current-memory-bytes)      ; Current memory usage

; Collections
(collections)               ; Number of GC collections
(collect-trip-bytes)        ; Bytes between collections

; More detailed
(sstats-cpu sstats)         ; CPU time from sstats
(sstats-real sstats)        ; Real time
(sstats-bytes sstats)       ; Bytes allocated
(sstats-gc-count sstats)    ; GC count
(sstats-gc-cpu sstats)      ; GC CPU time
(sstats-gc-real sstats)     ; GC real time
(sstats-gc-bytes sstats)    ; Bytes reclaimed

Statistics difference:

; sstats-difference for measuring
(define (measure thunk)
  (let ([before (statistics)])
    (let ([result (thunk)])
      (let ([after (statistics)])
        (values result (sstats-difference after before))))))

(let-values ([(result stats) (measure heavy-computation)])
  (printf "CPU: ~a ms~n" (/ (sstats-cpu stats) 1e6))
  (printf "Real: ~a ms~n" (/ (sstats-real stats) 1e6))
  (printf "Allocated: ~a bytes~n" (sstats-bytes stats))
  result)

; Print statistics
(sstats-print stats)
(sstats-print stats (current-output-port))

GC statistics:

; collect performs garbage collection
(collect)                   ; Full collection
(collect 0)                 ; Generation 0 only
(collect 1)                 ; Generations 0-1
(collect (collect-maximum-generation))  ; Full

; GC parameters
(collect-maximum-generation)  ; Highest generation
(collect-generation-radix)    ; Ratio between generations
(collect-trip-bytes)          ; Bytes before next GC
(collect-trip-bytes 10000000) ; Set to 10MB

; Heap statistics
(bytes-allocated)           ; Total ever allocated
(current-memory-bytes)      ; Current heap size

; GC notification
(collect-notify #t)         ; Print on GC
; gc: 0:1234567 (0:0) 2345ms @ 123456789

; collect-request-handler
(collect-request-handler)
(collect-request-handler
  (lambda ()
    (display "GC requested\n")
    (collect)))

Cost Centers

Cost center basics:

; Cost centers track resource usage
(define cc (make-cost-center))

; with-cost-center runs code in cost center
(with-cost-center cc
  (lambda ()
    (heavy-computation)))

; Get accumulated costs
(cost-center-instruction-count cc)
(cost-center-allocation-count cc)
(cost-center-time cc)

; Reset cost center
(reset-cost-center! cc)

; Example
(define cc (make-cost-center))
(with-cost-center cc
  (lambda ()
    (let loop ([n 1000000] [sum 0])
      (if (zero? n)
          sum
          (loop (- n 1) (+ sum n))))))

(printf "Instructions: ~a~n" (cost-center-instruction-count cc))
(printf "Allocations: ~a~n" (cost-center-allocation-count cc))

Multiple cost centers:

; Track different parts of program
(define cc-parse (make-cost-center))
(define cc-eval (make-cost-center))
(define cc-print (make-cost-center))

(define (repl)
  (let ([expr (with-cost-center cc-parse read)])
    (let ([result (with-cost-center cc-eval
                    (lambda () (eval expr)))])
      (with-cost-center cc-print
        (lambda () (write result) (newline))))))

; Compare costs
(printf "Parse: ~a~n" (cost-center-time cc-parse))
(printf "Eval: ~a~n" (cost-center-time cc-eval))
(printf "Print: ~a~n" (cost-center-time cc-print))

Cost center for profiling:

; Create cost centers for each function
(define-syntax define/profiled
  (syntax-rules ()
    [(_ (name args ...) body ...)
     (begin
       (define cc (make-cost-center))
       (define (name args ...)
         (with-cost-center cc
           (lambda () body ...)))
       (set! profile-data
             (cons (cons 'name cc) profile-data)))]))

(define profile-data '())

; Usage
(define/profiled (factorial n)
  (if (zero? n) 1 (* n (factorial (- n 1)))))

; Report
(define (print-profile)
  (for-each
    (lambda (entry)
      (let ([name (car entry)]
            [cc (cdr entry)])
        (printf "~a: ~a instructions, ~a allocs~n"
                name
                (cost-center-instruction-count cc)
                (cost-center-allocation-count cc))))
    profile-data))

Parameters

Parameter basics:

; make-parameter creates dynamic parameter
(define current-user (make-parameter "anonymous"))

; Get value
(current-user)              ; "anonymous"

; Set value globally
(current-user "alice")
(current-user)              ; "alice"

; parameterize for dynamic binding
(parameterize ([current-user "bob"])
  (current-user))           ; "bob"
(current-user)              ; "alice" (restored)

; Nested parameterize
(parameterize ([current-user "bob"])
  (parameterize ([current-user "charlie"])
    (current-user)))        ; "charlie"

Parameters with guards:

; Guard function validates/transforms values
(define current-count
  (make-parameter 0
    (lambda (v)
      (unless (and (integer? v) (>= v 0))
        (error 'current-count "expected non-negative integer" v))
      v)))

(current-count 10)          ; OK
; (current-count -1)        ; Error

; Transform value
(define current-directory-param
  (make-parameter "."
    (lambda (v)
      (if (absolute-path? v)
          v
          (string-append (current-directory) "/" v)))))

; Multiple validation
(define valid-port
  (make-parameter 8080
    (lambda (v)
      (unless (and (integer? v) (<= 1 v 65535))
        (error 'valid-port "invalid port number" v))
      v)))

Built-in parameters:

; I/O parameters
(current-input-port)
(current-output-port)
(current-error-port)

; Compilation parameters
(optimize-level)
(debug-level)
(compile-imported-libraries)
(compile-profile)
(generate-inspector-information)

; Print parameters
(print-level)               ; Depth limit
(print-length)              ; Length limit
(print-graph)               ; Show sharing
(print-gensym)              ; Show gensyms
(print-brackets)            ; Use [ ] syntax

; Read parameters
(case-sensitive)            ; Case sensitivity

; Library parameters
(library-directories)
(library-extensions)
(source-directories)

; Evaluator parameters
(eval-syntax-expanders-when)
(interaction-environment)

Parameter interaction with threads:

; Parameters are thread-local
(define my-param (make-parameter 0))

(my-param 1)                ; Set in main thread

(fork-thread
  (lambda ()
    (my-param)              ; 1 (inherited)
    (my-param 2)            ; Set in child
    (my-param)))            ; 2

(my-param)                  ; Still 1 in main thread

; parameterize in thread
(fork-thread
  (lambda ()
    (parameterize ([my-param 100])
      ; my-param is 100 in this thread
      (work))))

; Initial values for new threads
(define (fork-thread/params thunk . param-vals)
  (fork-thread
    (lambda ()
      (apply parameterize param-vals
        thunk))))

Virtual Registers

Virtual register basics:

; Virtual registers are fast thread-local storage
; Faster than parameters, no guard support

; Number of available registers
(virtual-register-count)    ; Implementation-dependent

; Access virtual register
(virtual-register 0)        ; Get register 0
(set-virtual-register! 0 'value)  ; Set register 0

; Example usage
(set-virtual-register! 0 0)       ; Counter
(set-virtual-register! 1 '())     ; Accumulator

(define (fast-count!)
  (set-virtual-register! 0 (+ (virtual-register 0) 1)))

(define (fast-push! v)
  (set-virtual-register! 1 (cons v (virtual-register 1))))

Virtual registers vs parameters:

; Parameters: safer, guard support, slightly slower
(define my-param (make-parameter 0))
(my-param)                  ; Read
(my-param 1)                ; Write

; Virtual registers: faster, no guards, raw access
(virtual-register 0)        ; Read
(set-virtual-register! 0 1) ; Write

; Use virtual registers for:
; - Performance-critical inner loops
; - Simple values (no validation needed)
; - Temporary storage

; Use parameters for:
; - Configuration settings
; - Validated/transformed values
; - External interfaces

; Benchmark comparison
(time
  (do ([i 0 (+ i 1)])
      ((= i 1000000))
    (my-param (+ (my-param) 1))))

(time
  (do ([i 0 (+ i 1)])
      ((= i 1000000))
    (set-virtual-register! 0
      (+ (virtual-register 0) 1))))

Thread safety:

; Virtual registers are thread-local
(set-virtual-register! 0 'main)

(fork-thread
  (lambda ()
    (set-virtual-register! 0 'child)
    (virtual-register 0)))  ; 'child

(virtual-register 0)        ; 'main (unchanged)

; Each thread has own set of virtual registers
; No synchronization needed

; But be careful: values are not automatically copied
; to new threads - they start uninitialized

(define (init-thread-registers!)
  (set-virtual-register! 0 0)
  (set-virtual-register! 1 '())
  (set-virtual-register! 2 (make-eq-hashtable)))

Environmental Queries and Settings

System information:

; Scheme version
(scheme-version)            ; "9.5.8"
(scheme-version-number)     ; #(9 5 8)
(petite?)                   ; #t if Petite Chez Scheme

; Machine information
(machine-type)              ; 'a6osx, 'ta6le, 'arm64le, etc.
(threaded?)                 ; #t if threaded build
(native-code)               ; #t if native code generation

; Endianness
(native-endianness)         ; 'little or 'big

; Chez Scheme directory
(scheme-directory)          ; Installation directory

; Features
(machine-features)          ; List of features
; (pthreads ieee-floating-point ...)

Environment variables:

; Get environment variable
(getenv "HOME")             ; "/home/user"
(getenv "UNDEFINED")        ; #f if not set

; Set environment variable (Chez extension)
(putenv "MY_VAR" "value")
(getenv "MY_VAR")           ; "value"

; Unset
(putenv "MY_VAR" #f)        ; Remove variable

; Common environment variables
(getenv "PATH")
(getenv "USER")
(getenv "SHELL")
(getenv "TERM")
(getenv "SCHEMEHEAPDIRS")   ; Chez Scheme heap location

; Get all environment variables
; Not directly available, but can parse from (system "env")

Command line and process:

; Command line arguments
(command-line)              ; All args including program name
(command-line-arguments)    ; Just arguments

; Process ID
(getpid)                    ; Current process ID

; Exit program
(exit)                      ; Exit with status 0
(exit 1)                    ; Exit with status 1

; Scheme program/script name
(car (command-line))        ; Program name

; Working directory
(current-directory)         ; Get
(current-directory "/tmp")  ; Set
(cd "/tmp")                 ; Alias

; Host name
(system "hostname")         ; Via shell
; or use foreign function interface

Memory and heap:

; Heap information
(bytes-allocated)           ; Total allocated
(current-memory-bytes)      ; Current heap size

; Heap directories (for boot files)
(scheme-heap-path)          ; Where to find heaps

; Memory limit (if supported)
; Set via --heap-limit command line

; Object counts (when enabled)
(object-counts)             ; Association list of types and counts

; Enable allocation counting
(generate-allocation-counts #t)

; Weak references and ephemerons
; Interact with GC - see earlier chapters

; Finalization
(collect-rendezvous)        ; Wait for finalizers

Subset Modes

Subset mode basics:

; subset-mode controls language dialect
(subset-mode)               ; Get current mode

; Available modes:
; 'system - Full Chez Scheme (default)
; 'r6rs - Strict R6RS compliance

; Set mode
(subset-mode 'r6rs)

; In r6rs mode:
; - Only R6RS syntax/procedures available
; - Chez extensions disabled
; - Stricter error checking

; Reset to full mode
(subset-mode 'system)

; Check mode
(eq? (subset-mode) 'r6rs)   ; #t if in R6RS mode

R6RS compliance:

; R6RS mode disables:
; - printf, format extensions
; - trace, inspect
; - Chez-specific syntax
; - Extended reader syntax

; Example differences
(subset-mode 'system)
(printf "~a~n" 42)          ; Works

(subset-mode 'r6rs)
; (printf "~a~n" 42)        ; Error: printf not bound

; Library differences
; R6RS mode only allows R6RS libraries
(import (rnrs))             ; OK in both modes
; (import (chezscheme))     ; Error in R6RS mode

; Use for testing portability
(define (test-r6rs-compatible)
  (parameterize ([subset-mode 'r6rs])
    (load "my-library.ss")))

IEEE mode:

; ieee-mode for IEEE Scheme compliance
(ieee-mode)                 ; Get current

; Differences in IEEE mode:
; - Implicit forcing of promises
; - Different treatment of '() and #f
; - Stricter type checking

; Historical compatibility
; Most code doesn't need this

; Combining modes
(subset-mode 'system)       ; Full Chez
(ieee-mode #f)              ; No IEEE restrictions

Mode-specific code:

; Conditional on mode
(define (portable-print x)
  (if (eq? (subset-mode) 'r6rs)
      (begin (display x) (newline))
      (printf "~a~n" x)))

; Provide fallbacks
(define my-printf
  (if (top-level-bound? 'printf)
      printf
      (lambda (fmt . args)
        (display (apply format fmt args))
        (newline))))

; Library that works in both modes
(library (my portable-lib)
  (export my-proc)
  (import (rnrs))           ; Only R6RS imports

  ; Only R6RS forms in body
  (define (my-proc x)
    (let ([y (* x 2)])
      y)))

; Test in both modes
(define (test-both-modes thunk)
  (let ([system-result
         (parameterize ([subset-mode 'system])
           (thunk))]
        [r6rs-result
         (parameterize ([subset-mode 'r6rs])
           (thunk))])
    (list system-result r6rs-result)))

Complete System Example

Application framework:

; Complete application with system features
(library (app framework)
  (export
    define-application
    run-application
    app-log
    app-config
    with-app-context)
  (import (chezscheme))

  ; Configuration parameter
  (define app-config
    (make-parameter
      '((log-level . info)
        (log-file . #f)
        (debug . #f))))

  ; Logging with timestamps
  (define (app-log level msg . args)
    (let ([config (app-config)])
      (when (should-log? level (cdr (assq 'log-level config)))
        (let ([formatted (apply format msg args)]
              [timestamp (date->string (current-date)
                          "~Y-~m-~d ~H:~M:~S")])
          (let ([line (format "[~a] [~a] ~a~n"
                              timestamp level formatted)])
            (display line (current-error-port))
            (let ([log-file (cdr (assq 'log-file config))])
              (when log-file
                (call-with-output-file log-file
                  (lambda (p) (display line p))
                  '(append)))))))))

  (define (should-log? level min-level)
    (let ([levels '((debug . 0) (info . 1)
                    (warn . 2) (error . 3))])
      (>= (cdr (assq level levels))
          (cdr (assq min-level levels)))))

  ; Exception-safe context
  (define (with-app-context thunk)
    (guard (c
            [(serious-condition? c)
             (app-log 'error "Fatal error: ~a"
                      (condition-message c))
             (when (cdr (assq 'debug (app-config)))
               (debug-on-exception #t)
               (raise c))
             (exit 1)]
            [else
             (app-log 'warn "Warning: ~a" c)])
      (thunk)))

  ; Application definition macro
  (define-syntax define-application
    (syntax-rules ()
      [(_ name
          (option opt-name opt-default) ...
          body ...)
       (define (name args)
         (let ([config (parse-options args
                         '((opt-name . opt-default) ...))])
           (parameterize ([app-config config])
             (with-app-context
               (lambda () body ...)))))]))

  (define (parse-options args defaults)
    (let loop ([args args] [config defaults])
      (cond
        [(null? args) config]
        [(string=? (car args) "--debug")
         (loop (cdr args)
               (cons '(debug . #t) config))]
        [(and (pair? (cdr args))
              (string-prefix? "--" (car args)))
         (let ([key (string->symbol
                      (substring (car args) 2
                                (string-length (car args))))]
               [val (cadr args)])
           (loop (cddr args)
                 (cons (cons key val) config)))]
        [else (loop (cdr args) config)])))

  ; Run application
  (define (run-application app-proc)
    (let ([args (command-line-arguments)])
      (app-proc args))))

Using the framework:

(import (chezscheme) (app framework))

(define-application my-app
  (option log-level info)
  (option log-file "app.log")
  (option debug #f)

  (app-log 'info "Application starting")
  (app-log 'info "Config: ~a" (app-config))

  ; Main logic
  (let ([start (current-time 'time-monotonic)])
    (do-work)
    (let ([elapsed (time-difference
                     (current-time 'time-monotonic) start)])
      (app-log 'info "Completed in ~a ms"
               (/ (time-nanosecond elapsed) 1e6))))

  (app-log 'info "Application finished")
  0)  ; Exit code

; Run from command line
(run-application my-app)

; Or with options
; scheme --script myapp.ss --log-level debug --debug

System monitoring utility:

; Monitor system resources
(define (system-monitor interval iterations)
  (let ([start-stats (statistics)])
    (let loop ([i 0])
      (when (< i iterations)
        (collect 0)  ; Minor GC to update stats
        (let ([stats (statistics)])
          (printf "~n=== Iteration ~a ===~n" i)
          (printf "Memory: ~a MB~n"
                  (/ (current-memory-bytes) 1e6))
          (printf "Allocated: ~a MB~n"
                  (/ (bytes-allocated) 1e6))
          (printf "Collections: ~a~n" (collections))
          (printf "CPU time: ~a ms~n" (/ (cpu-time) 1e6))
          (printf "Real time: ~a ms~n" (/ (real-time) 1e6)))
        (sleep (make-time 'time-duration 0 interval))
        (loop (+ i 1))))))

; Profile wrapper
(define (profile-execution thunk)
  (profile-clear)
  (let ([result #f]
        [stats #f])
    (let ([before (statistics)])
      (set! result (thunk))
      (set! stats (sstats-difference (statistics) before)))
    (printf "~nExecution Statistics:~n")
    (sstats-print stats)
    (printf "~nProfile Data:~n")
    (for-each
      (lambda (e)
        (when (> (cadr e) 100)  ; Only hot spots
          (printf "  ~a: ~a calls~n" (car e) (cadr e))))
      (profile-dump-list))
    result))

; Exception reporter
(define (with-exception-report thunk)
  (guard (c
          [else
           (printf "Exception occurred:~n")
           (display-condition c)
           (printf "~nStack trace:~n")
           (parameterize ([print-level 5]
                          [print-length 10])
             (for-each
               (lambda (frame)
                 (printf "  ~a~n" frame))
               (continuation->list (current-continuation))))
           #f])
    (thunk)))

Storage Management in Chez Scheme

Garbage Collection

Generational garbage collection overview:

; Chez Scheme uses generational garbage collection
; Objects are allocated in generation 0 (youngest)
; Surviving objects are promoted to older generations

; Generation hierarchy:
; - Generation 0: New objects (collected frequently)
; - Generation 1: Survived one collection
; - ...
; - Generation N: Oldest (collected rarely)

; Check maximum generation
(collect-maximum-generation)  ; Returns highest generation number

; Typical values: 4 or 5 generations
; Generation 0 = nursery (very fast allocation)

Generational collection visualization:

Manual garbage collection:

; collect triggers garbage collection
(collect)                   ; Full collection (all generations)
(collect 0)                 ; Collect generation 0 only
(collect 1)                 ; Collect generations 0 and 1
(collect 2)                 ; Collect generations 0, 1, and 2

; Collect specific generation
(collect (collect-maximum-generation))  ; Full collection

; Example: force cleanup before measurement
(collect)
(collect)                   ; Run twice to ensure finalization
(let ([mem-before (current-memory-bytes)])
  (create-large-structure)
  (collect)
  (let ([mem-after (current-memory-bytes)])
    (printf "Memory used: ~a bytes~n"
            (- mem-after mem-before))))

GC parameters:

; collect-trip-bytes: bytes allocated before auto-collect
(collect-trip-bytes)            ; Get current value
(collect-trip-bytes 1000000)    ; Set to 1MB

; Larger value = less frequent GC, more memory use
; Smaller value = more frequent GC, less memory use

; collect-generation-radix: size ratio between generations
(collect-generation-radix)      ; Typically 4
; Each generation is ~4x larger than previous

; collect-maximum-generation: highest generation number
(collect-maximum-generation)    ; Typically 4 or 5

; release-minimum-generation: when to release memory to OS
(release-minimum-generation)
(release-minimum-generation 2)  ; Release after gen 2+ collection

; heap-reserve-ratio: extra heap space to reserve
(heap-reserve-ratio)            ; Default 1.0 (100% extra)

GC statistics and monitoring:

; Memory statistics
(bytes-allocated)           ; Total bytes ever allocated
(current-memory-bytes)      ; Current heap size
(maximum-memory-bytes)      ; Peak memory usage

; Collection count
(collections)               ; Total collections performed

; Statistics breakdown
(statistics)                ; Detailed statistics

; GC notification
(collect-notify #t)         ; Enable GC notifications
; Prints: gc: gen:bytes @ time

; Example output:
; gc: 0:123456 @ 1234567890
; gc: 1:234567 (0:12345) @ 1234567900

; Custom notification handler
(collect-notify
  (lambda (gen pre-bytes pre-time post-bytes post-time)
    (printf "GC gen ~a: ~a -> ~a bytes~n"
            gen pre-bytes post-bytes)))

; collect-request-handler: intercept GC requests
(collect-request-handler
  (lambda ()
    (printf "GC requested~n")
    (collect)))

GC tuning strategies:

; For throughput (batch processing)
(collect-trip-bytes (* 64 1024 1024))  ; 64MB between collections
(heap-reserve-ratio 2.0)               ; More headroom

; For latency (interactive applications)
(collect-trip-bytes (* 1 1024 1024))   ; 1MB - more frequent, shorter
(release-minimum-generation 1)         ; Release memory sooner

; For memory-constrained environments
(collect-trip-bytes (* 256 1024))      ; 256KB
(heap-reserve-ratio 0.5)               ; Less reserve

; Disable automatic collection (use with care!)
(let ([old-trip (collect-trip-bytes)])
  (collect-trip-bytes (most-positive-fixnum))
  ; ... critical section with no GC ...
  (collect-trip-bytes old-trip)
  (collect))                           ; Catch up

; Measure GC impact
(define (measure-gc-overhead thunk)
  (let ([gc-before (collections)]
        [time-before (cpu-time)])
    (let ([result (thunk)])
      (let ([gc-after (collections)]
            [time-after (cpu-time)])
        (printf "Collections: ~a~n" (- gc-after gc-before))
        (printf "Time: ~a ms~n" (/ (- time-after time-before) 1e6))
        result))))

Weak Pairs, Ephemeron Pairs, and Guardians

Weak pairs:

; Weak pairs hold car weakly - GC can collect it
(define wp (weak-cons 'key 'value))

; Access like normal pair
(car wp)                    ; 'key
(cdr wp)                    ; 'value

; If car is only referenced through weak pairs,
; it can be collected and replaced with #!bwp

; Check for broken weak pointer
(bwp-object? (car wp))      ; #f while key exists

; After key is collected:
(bwp-object? (car wp))      ; #t

; Example: weak cache
(define cache '())

(define (cache-put! key value)
  (set! cache (cons (weak-cons key value) cache)))

(define (cache-get key)
  (let loop ([pairs cache])
    (cond
      [(null? pairs) #f]
      [(bwp-object? (caar pairs))
       ; Clean up broken entries
       (loop (cdr pairs))]
      [(eq? (caar pairs) key)
       (cdar pairs)]
      [else (loop (cdr pairs))])))

; Clean broken weak pairs periodically
(define (cache-clean!)
  (set! cache
    (filter (lambda (wp)
              (not (bwp-object? (car wp))))
            cache)))

Weak pair visualization:

Ephemeron pairs:

; Ephemerons: car is key, cdr kept alive only if car is alive
(define ep (ephemeron-cons 'key 'value))

; Similar to weak-cons but with important difference:
; - weak-cons: cdr always kept alive
; - ephemeron-cons: cdr collected when car is collected

; This prevents memory leaks in certain scenarios
(car ep)                    ; 'key
(cdr ep)                    ; 'value

; Check if broken
(bwp-object? (car ep))      ; #f while key exists

; Use case: associating data with objects without preventing GC
(define object-metadata (make-eq-hashtable))

; Problem with weak-cons in hashtable:
; Key can be collected but value stays (memory leak)

; Solution: use ephemeron hashtable
(define object-metadata (make-ephemeron-eq-hashtable))

; When key is collected, value is also eligible for collection

Ephemeron vs weak pair comparison:

Guardians:

; Guardians track when objects become unreachable
(define g (make-guardian))

; Register object with guardian
(let ([obj (list 1 2 3)])
  (g obj)                   ; Register
  ; obj is now guarded
  )

; After GC, check for collected objects
(collect)
(g)                         ; Returns collected object or #f

; Multiple registrations
(define g (make-guardian))
(g (cons 'a 'b))
(g (vector 1 2 3))
(g "temporary string")

(collect)

; Retrieve all collected objects
(let loop ()
  (let ([obj (g)])
    (when obj
      (printf "Collected: ~a~n" obj)
      (loop))))

; Use case: cleanup resources
(define resource-guardian (make-guardian))

(define (make-managed-resource)
  (let ([resource (allocate-external-resource)])
    (resource-guardian resource)
    resource))

; Periodic cleanup
(define (cleanup-resources!)
  (let loop ()
    (let ([r (resource-guardian)])
      (when r
        (release-external-resource r)
        (loop)))))

Guardian-based finalization:

; Implement finalizers using guardians
(define finalizer-guardian (make-guardian))
(define finalizer-table (make-eq-hashtable))

(define (add-destructor! obj destructor)
  (finalizer-guardian obj)
  (hashtable-set! finalizer-table obj destructor))

(define (run-finalizers!)
  (let loop ()
    (let ([obj (finalizer-guardian)])
      (when obj
        (let ([destructor (hashtable-ref finalizer-table obj #f)])
          (when destructor
            (guard (c [else (void)])  ; Ignore errors in finalizers
              (destructor obj))
            (hashtable-delete! finalizer-table obj)))
        (loop)))))

; Example: file handle with automatic close
(define (open-managed-file filename)
  (let ([port (open-input-file filename)])
    (add-destructor! port
      (lambda (p)
        (printf "Auto-closing ~a~n" filename)
        (close-port p)))
    port))

; Run finalizers after GC
(collect-request-handler
  (lambda ()
    (collect)
    (run-finalizers!)))

Weak and ephemeron hashtables:

; Weak hashtables: keys held weakly
(define wht (make-weak-eq-hashtable))
(define wht (make-weak-eqv-hashtable))

; Ephemeron hashtables: both key and value can be collected
(define eht (make-ephemeron-eq-hashtable))
(define eht (make-ephemeron-eqv-hashtable))

; Usage
(let ([key (cons 'a 'b)])
  (hashtable-set! wht key "value")
  (hashtable-ref wht key #f))  ; "value"

; After key becomes unreachable and GC runs:
(collect)
; Entry may be removed from weak hashtable

; Practical example: memoization with weak keys
(define (make-weak-memoize proc)
  (let ([cache (make-weak-eq-hashtable)])
    (lambda (arg)
      (let ([cached (hashtable-ref cache arg 'not-found)])
        (if (eq? cached 'not-found)
            (let ([result (proc arg)])
              (hashtable-set! cache arg result)
              result)
            cached)))))

; Memoize without preventing GC of keys
(define weak-memo-process
  (make-weak-memoize expensive-process))

Locking Objects

Object locking basics:

; lock-object prevents GC from moving object
(define obj (list 1 2 3))
(lock-object obj)           ; Lock the object

; Object is now:
; 1. Protected from collection
; 2. Fixed in memory (won't move)

; Unlock when done
(unlock-object obj)         ; Allow GC to manage again

; Check if locked
(locked-object? obj)        ; #t if locked

; Use case: passing pointer to foreign code
(define data (make-bytevector 1024))
(lock-object data)
; ... pass (bytevector-data data) to C function ...
(unlock-object data)

Why locking is necessary:

Locking for foreign interface:

; When calling C functions that keep references
(define (call-foreign-with-buffer proc size)
  (let ([buffer (make-bytevector size)])
    (lock-object buffer)
    (guard (c [else
               (unlock-object buffer)
               (raise c)])
      (let ([result (proc buffer)])
        (unlock-object buffer)
        result))))

; Example: C function fills buffer asynchronously
(define async-read
  (foreign-procedure "async_read" (void* size_t) int))

(define (safe-async-read size)
  (let ([buffer (make-bytevector size)])
    (lock-object buffer)
    ; Pass raw pointer to C
    (async-read (#%$bytevector-data buffer) size)
    ; Keep locked until callback signals completion
    ; ... later in callback:
    ; (unlock-object buffer)
    buffer))

; Locking multiple objects
(define (with-locked-objects objs thunk)
  (for-each lock-object objs)
  (guard (c [else
             (for-each unlock-object objs)
             (raise c)])
    (let ([result (thunk)])
      (for-each unlock-object objs)
      result)))

Locking implications:

; Locked objects affect GC efficiency
; - Cannot be compacted (memory fragmentation)
; - Pinned in place until unlocked

; Best practices:
; 1. Lock for minimum necessary duration
; 2. Unlock in finally/guard clauses
; 3. Don't lock long-lived objects unnecessarily

; Check lock status
(define (object-info obj)
  (printf "Object: ~a~n" obj)
  (printf "Locked: ~a~n" (locked-object? obj)))

; Reference counting pattern for shared locking
(define lock-counts (make-eq-hashtable))

(define (acquire-lock! obj)
  (let ([count (hashtable-ref lock-counts obj 0)])
    (when (zero? count)
      (lock-object obj))
    (hashtable-set! lock-counts obj (+ count 1))))

(define (release-lock! obj)
  (let ([count (hashtable-ref lock-counts obj 0)])
    (when (> count 0)
      (let ([new-count (- count 1)])
        (hashtable-set! lock-counts obj new-count)
        (when (zero? new-count)
          (unlock-object obj))))))

Lock and foreign callable:

; Foreign callables need special consideration
(define callback
  (foreign-callable
    (lambda (x) (* x 2))
    (int)
    int))

; Lock the callable code
(lock-object callback)

; Get entry point (safe because locked)
(define callback-ptr (foreign-callable-entry-point callback))

; Pass to C code
(register-callback callback-ptr)

; Keep locked as long as C might call it
; ...
; When done:
(unlock-object callback)

; Helper for managed callbacks
(define active-callbacks '())

(define (make-persistent-callback proc arg-types ret-type)
  (let ([cb (foreign-callable proc arg-types ret-type)])
    (lock-object cb)
    (set! active-callbacks (cons cb active-callbacks))
    (foreign-callable-entry-point cb)))

(define (release-all-callbacks!)
  (for-each unlock-object active-callbacks)
  (set! active-callbacks '()))

Immobile Objects

Understanding immobile objects:

; Some Chez Scheme objects are naturally immobile
; They are allocated in non-moving memory regions

; Immobile by design:
; - Code objects (procedures)
; - Large objects (above certain threshold)
; - Objects in static generation

; Check if object might move
; (No direct predicate, but can infer from type)

; Large object threshold
; Objects above this size go to large object space
; Typically 1KB-4KB depending on configuration

; Large objects don't move but can be collected
(define large-vector (make-vector 10000))
; Allocated in large object space - won't move

; vs small objects that might move
(define small-vector (make-vector 10))
; Allocated in nursery - may move during GC

Memory regions visualization:

Static generation:

; Objects can be made permanent (static generation)
; collect-maximum-generation + 1 = static

(define important-data (list 1 2 3 4 5))

; Promote to oldest generation through collections
(do ([i 0 (+ i 1)])
    ((= i (+ (collect-maximum-generation) 2)))
  (collect i))

; Now object is in oldest generation
; Less likely to be scanned/moved

; Note: There's no direct API to force static allocation
; Objects naturally move to older generations by surviving GC

; For truly permanent data, consider:
; 1. Define at top level (lives in static space)
; 2. Lock the object
; 3. Use foreign allocation

Code objects and immobility:

; Compiled procedures are code objects
(define (my-procedure x) (* x 2))

; Code objects are inherently immobile
; Their addresses are stable

; This is why foreign-callable works
(define my-callback
  (foreign-callable
    (lambda () (display "Hello\n"))
    ()
    void))

; Code is immobile, but the closure might not be!
; For closures with free variables:
(define (make-adder n)
  (lambda (x) (+ x n)))

(define add-5 (make-adder 5))
; The closure object (containing n=5) CAN move
; But the code itself is immobile

; When passing to FFI, lock the closure
(lock-object add-5)
; Now both code and closure environment are stable

Working with immobile data:

; Allocate data that won't move
; Option 1: Use large enough allocation
(define immobile-buffer
  (make-bytevector (* 64 1024)))  ; 64KB - definitely in LOS

; Option 2: Foreign allocation
(define foreign-buffer
  (foreign-alloc 1024))           ; Not managed by GC at all

; Option 3: Lock small objects
(define small-data (make-bytevector 100))
(lock-object small-data)

; Getting stable pointer for FFI
(define (get-stable-pointer obj)
  (cond
    ; Bytevector data pointer
    [(bytevector? obj)
     (lock-object obj)
     (#%$bytevector-data obj)]
    ; String data pointer
    [(string? obj)
     (lock-object obj)
     (#%$string-data obj)]
    [else
     (error 'get-stable-pointer "unsupported type")]))

; Remember to unlock when done!
(define (release-stable-pointer obj)
  (unlock-object obj))

Phantom Bytevectors

Phantom bytevector basics:

; Phantom bytevectors track external memory for GC accounting
; They don't actually contain data - just report size to GC

; Create phantom bytevector
(define phantom (make-phantom-bytevector 1000000))

; This tells GC: "I have 1MB of external memory"
; GC includes this in its memory pressure calculations

; Use case: foreign-allocated memory
(define external-buffer (foreign-alloc (* 1024 1024)))  ; 1MB
(define phantom (make-phantom-bytevector (* 1024 1024)))

; GC now knows about the external memory
; Will collect more aggressively if memory pressure high

; When freeing external memory, release phantom too
(foreign-free external-buffer)
(set! phantom #f)  ; Allow phantom to be collected

Phantom bytevector purpose:

Using phantom bytevectors with foreign memory:

; Wrapper for foreign-allocated memory with GC awareness
(define-record-type external-buffer
  (fields pointer size phantom)
  (protocol
    (lambda (new)
      (lambda (size)
        (let ([ptr (foreign-alloc size)]
              [phantom (make-phantom-bytevector size)])
          (new ptr size phantom))))))

; Destructor using guardian
(define buffer-guardian (make-guardian))

(define (make-managed-external-buffer size)
  (let ([buf (make-external-buffer size)])
    (buffer-guardian buf)
    buf))

(define (cleanup-external-buffers!)
  (let loop ()
    (let ([buf (buffer-guardian)])
      (when buf
        (foreign-free (external-buffer-pointer buf))
        ; Phantom will be collected automatically
        (loop)))))

; Example: image processing with external memory
(define (load-large-image filename)
  (let* ([size (get-image-size filename)]  ; External function
         [buffer (make-managed-external-buffer size)])
    (load-image-data filename (external-buffer-pointer buffer))
    buffer))

Phantom bytevector patterns:

; Pattern 1: Direct association
(define (allocate-external size)
  (let ([ptr (foreign-alloc size)]
        [phantom (make-phantom-bytevector size)])
    ; Keep phantom alive as long as ptr is valid
    (values ptr phantom)))

; Pattern 2: Weak association with guardian
(define (make-tracked-allocation size)
  (let ([ptr (foreign-alloc size)]
        [phantom (make-phantom-bytevector size)]
        [guardian (make-guardian)])
    (guardian phantom)
    ; When phantom is collected, free the pointer
    (values
      ptr
      (lambda ()  ; Check function
        (let ([p (guardian)])
          (when p
            (foreign-free ptr)
            #t))))))

; Pattern 3: Resource pool with phantoms
(define (make-resource-pool allocator deallocator)
  (let ([resources '()]
        [phantoms '()])
    (lambda (msg . args)
      (case msg
        [(allocate)
         (let* ([size (car args)]
                [res (allocator size)]
                [phantom (make-phantom-bytevector size)])
           (set! resources (cons res resources))
           (set! phantoms (cons phantom phantoms))
           res)]
        [(free)
         (let ([res (car args)])
           (deallocator res)
           (set! resources (remq res resources))
           ; Phantoms will be collected when pool is
           )]
        [(memory)
         (apply + (map bytevector-length phantoms))]))))

Memory pressure and collection:

; Phantom bytevectors affect GC collection decisions
; Large phantom = GC thinks memory is tight

; Example: force collection by creating pressure
(define (force-gc-via-phantom)
  (let ([phantom (make-phantom-bytevector (* 100 1024 1024))])
    ; GC sees 100MB pressure
    (collect)
    ; Release phantom
    (set! phantom #f)
    (collect)))

; Monitor memory with phantoms
(define (memory-report)
  (printf "Heap: ~a MB~n"
          (/ (current-memory-bytes) (* 1024 1024)))
  (printf "Allocated: ~a MB~n"
          (/ (bytes-allocated) (* 1024 1024))))

; Create phantom, see effect
(memory-report)
(define p (make-phantom-bytevector (* 50 1024 1024)))
(memory-report)  ; bytes-allocated includes phantom
(set! p #f)
(collect)
(memory-report)  ; Phantom freed

; Phantom bytevector predicates
(phantom-bytevector? (make-phantom-bytevector 100))  ; #t
(phantom-bytevector? (make-bytevector 100))          ; #f

; Get reported size
(phantom-bytevector-length (make-phantom-bytevector 1000))  ; 1000

Complete external resource manager:

; Comprehensive external memory management
(library (external-memory)
  (export
    make-external-memory
    external-memory?
    external-memory-pointer
    external-memory-size
    free-external-memory!
    with-external-memory
    external-memory-stats)
  (import (chezscheme))

  ; Track all allocations
  (define allocations (make-eq-hashtable))
  (define total-allocated 0)
  (define allocation-count 0)

  ; Record type with phantom
  (define-record-type external-memory
    (fields pointer size phantom (mutable freed?))
    (protocol
      (lambda (new)
        (lambda (size)
          (let ([ptr (foreign-alloc size)]
                [phantom (make-phantom-bytevector size)])
            (let ([mem (new ptr size phantom #f)])
              (hashtable-set! allocations ptr mem)
              (set! total-allocated (+ total-allocated size))
              (set! allocation-count (+ allocation-count 1))
              mem))))))

  ; Guardian for automatic cleanup
  (define memory-guardian (make-guardian))

  ; Free external memory
  (define (free-external-memory! mem)
    (unless (external-memory-freed? mem)
      (foreign-free (external-memory-pointer mem))
      (hashtable-delete! allocations (external-memory-pointer mem))
      (set! total-allocated (- total-allocated (external-memory-size mem)))
      (external-memory-freed?-set! mem #t)))

  ; Safe scope-based allocation
  (define (with-external-memory size proc)
    (let ([mem (make-external-memory size)])
      (guard (c [else
                 (free-external-memory! mem)
                 (raise c)])
        (let ([result (proc mem)])
          (free-external-memory! mem)
          result))))

  ; Cleanup guardian-tracked allocations
  (define (cleanup-abandoned!)
    (let loop ([count 0])
      (let ([mem (memory-guardian)])
        (if mem
            (begin
              (free-external-memory! mem)
              (loop (+ count 1)))
            count))))

  ; Statistics
  (define (external-memory-stats)
    `((total-allocated . ,total-allocated)
      (allocation-count . ,allocation-count)
      (active-allocations . ,(hashtable-size allocations))))

  ; Register with collect-request-handler
  (let ([old-handler (collect-request-handler)])
    (collect-request-handler
      (lambda ()
        (old-handler)
        (cleanup-abandoned!)))))

Complete Storage Management Example

Cache implementation using weak references:

; LRU cache with weak values - allows GC to reclaim unused entries
(library (storage weak-cache)
  (export
    make-weak-cache
    cache-get
    cache-put!
    cache-remove!
    cache-clear!
    cache-stats)
  (import (chezscheme))

  (define-record-type cache-entry
    (fields key (mutable value-cell) (mutable timestamp)))

  (define-record-type weak-cache
    (fields
      (mutable table)           ; eq-hashtable of cache-entry
      (mutable access-order)    ; List for LRU
      capacity
      guardian))

  (define (make-weak-cache capacity)
    (let ([cache (make-weak-cache
                   (make-eq-hashtable)
                   '()
                   capacity
                   (make-guardian))])
      cache))

  ; Store value in ephemeron (key keeps value alive)
  (define (cache-put! cache key value)
    (let ([table (weak-cache-table cache)]
          [cell (ephemeron-cons key value)]
          [timestamp (current-time 'time-monotonic)])
      ; Create entry
      (let ([entry (make-cache-entry key cell timestamp)])
        ; Evict if at capacity
        (when (>= (hashtable-size table) (weak-cache-capacity cache))
          (evict-lru! cache))
        ; Add entry
        (hashtable-set! table key entry)
        ; Update access order
        (weak-cache-access-order-set! cache
          (cons key (remq key (weak-cache-access-order cache))))
        ; Track with guardian for cleanup
        ((weak-cache-guardian cache) cell)
        value)))

  (define (cache-get cache key)
    (let ([table (weak-cache-table cache)])
      (let ([entry (hashtable-ref table key #f)])
        (if entry
            (let ([cell (cache-entry-value-cell entry)])
              (if (bwp-object? (car cell))
                  (begin
                    ; Value was collected
                    (hashtable-delete! table key)
                    #f)
                  (begin
                    ; Update access time and order
                    (cache-entry-timestamp-set! entry
                      (current-time 'time-monotonic))
                    (weak-cache-access-order-set! cache
                      (cons key (remq key (weak-cache-access-order cache))))
                    (cdr cell))))  ; Return value
            #f))))

  (define (cache-remove! cache key)
    (hashtable-delete! (weak-cache-table cache) key)
    (weak-cache-access-order-set! cache
      (remq key (weak-cache-access-order cache))))

  (define (cache-clear! cache)
    (hashtable-clear! (weak-cache-table cache))
    (weak-cache-access-order-set! cache '()))

  (define (evict-lru! cache)
    (let ([order (weak-cache-access-order cache)])
      (when (pair? order)
        (let ([lru-key (last order)])
          (cache-remove! cache lru-key)))))

  (define (last lst)
    (if (null? (cdr lst))
        (car lst)
        (last (cdr lst))))

  (define (cache-stats cache)
    (clean-collected-entries! cache)
    `((size . ,(hashtable-size (weak-cache-table cache)))
      (capacity . ,(weak-cache-capacity cache))))

  (define (clean-collected-entries! cache)
    (let ([table (weak-cache-table cache)]
          [guardian (weak-cache-guardian cache)])
      (let loop ()
        (let ([cell (guardian)])
          (when cell
            ; Find and remove entry with this cell
            (let-values ([(keys vals) (hashtable-entries table)])
              (vector-for-each
                (lambda (k v)
                  (when (eq? (cache-entry-value-cell v) cell)
                    (hashtable-delete! table k)))
                keys vals))
            (loop)))))))

Object pool with automatic management:

; Object pool that recycles objects, with GC integration
(library (storage object-pool)
  (export
    make-object-pool
    pool-acquire
    pool-release
    pool-stats
    with-pooled-object)
  (import (chezscheme))

  (define-record-type object-pool
    (fields
      name
      allocator              ; () -> object
      resetter               ; (object) -> void
      (mutable available)    ; List of free objects
      (mutable in-use)       ; Eq-hashtable of in-use objects
      max-size
      guardian))

  (define (make-object-pool name allocator resetter max-size)
    (make-object-pool
      name
      allocator
      resetter
      '()
      (make-eq-hashtable)
      max-size
      (make-guardian)))

  (define (pool-acquire pool)
    ; First, reclaim any abandoned objects
    (reclaim-abandoned! pool)

    (let ([available (object-pool-available pool)])
      (if (pair? available)
          ; Reuse existing object
          (let ([obj (car available)])
            (object-pool-available-set! pool (cdr available))
            (hashtable-set! (object-pool-in-use pool) obj #t)
            ((object-pool-guardian pool) obj)  ; Track for abandonment
            obj)
          ; Allocate new object if under limit
          (if (< (hashtable-size (object-pool-in-use pool))
                 (object-pool-max-size pool))
              (let ([obj ((object-pool-allocator pool))])
                (hashtable-set! (object-pool-in-use pool) obj #t)
                ((object-pool-guardian pool) obj)
                obj)
              ; Pool exhausted
              (error 'pool-acquire
                     "pool exhausted"
                     (object-pool-name pool))))))

  (define (pool-release pool obj)
    (when (hashtable-contains? (object-pool-in-use pool) obj)
      (hashtable-delete! (object-pool-in-use pool) obj)
      ; Reset object for reuse
      ((object-pool-resetter pool) obj)
      ; Return to available pool
      (object-pool-available-set! pool
        (cons obj (object-pool-available pool)))))

  (define (reclaim-abandoned! pool)
    ; Check guardian for objects that were abandoned without release
    (let loop ()
      (let ([obj ((object-pool-guardian pool))])
        (when obj
          (when (hashtable-contains? (object-pool-in-use pool) obj)
            ; Object was abandoned - reclaim it
            (hashtable-delete! (object-pool-in-use pool) obj)
            ((object-pool-resetter pool) obj)
            (object-pool-available-set! pool
              (cons obj (object-pool-available pool))))
          (loop)))))

  (define (pool-stats pool)
    (reclaim-abandoned! pool)
    `((name . ,(object-pool-name pool))
      (available . ,(length (object-pool-available pool)))
      (in-use . ,(hashtable-size (object-pool-in-use pool)))
      (max-size . ,(object-pool-max-size pool))))

  ; Safe scoped access
  (define (with-pooled-object pool proc)
    (let ([obj (pool-acquire pool)])
      (guard (c [else
                 (pool-release pool obj)
                 (raise c)])
        (let ([result (proc obj)])
          (pool-release pool obj)
          result)))))

Memory-mapped file with locking:

; Memory-mapped file access with proper locking
(library (storage mmap)
  (export
    mmap-open
    mmap-close
    mmap-read
    mmap-write
    mmap-sync)
  (import (chezscheme))

  ; Foreign functions (simplified - actual signatures vary by OS)
  (define libc (load-shared-object "libc.so.6"))

  (define c-mmap
    (foreign-procedure "mmap"
      (void* size_t int int int ssize_t)
      void*))

  (define c-munmap
    (foreign-procedure "munmap"
      (void* size_t)
      int))

  (define c-msync
    (foreign-procedure "msync"
      (void* size_t int)
      int))

  ; Constants
  (define PROT_READ 1)
  (define PROT_WRITE 2)
  (define MAP_SHARED 1)
  (define MS_SYNC 4)

  (define-record-type mmap-region
    (fields
      pointer
      size
      phantom           ; For GC accounting
      (mutable locked?)))

  (define (mmap-open filename size)
    (let* ([fd (open filename (file-options no-fail no-truncate))]
           [ptr (c-mmap 0 size
                        (fxlogor PROT_READ PROT_WRITE)
                        MAP_SHARED
                        (port-file-descriptor fd)
                        0)])
      (close-port fd)
      (when (= ptr -1)
        (error 'mmap-open "mmap failed" filename))
      (let ([region (make-mmap-region
                      ptr
                      size
                      (make-phantom-bytevector size)
                      #f)])
        region)))

  (define (mmap-close region)
    (when (mmap-region-locked? region)
      (error 'mmap-close "region is locked"))
    (c-munmap (mmap-region-pointer region)
              (mmap-region-size region)))

  (define (mmap-read region offset size)
    (unless (mmap-region-locked? region)
      (mmap-region-locked?-set! region #t))
    (let ([bv (make-bytevector size)])
      (let ([ptr (+ (mmap-region-pointer region) offset)])
        ; Copy from mapped memory to bytevector
        (do ([i 0 (+ i 1)])
            ((= i size))
          (bytevector-u8-set! bv i
            (foreign-ref 'unsigned-8 ptr i))))
      bv))

  (define (mmap-write region offset data)
    (unless (mmap-region-locked? region)
      (mmap-region-locked?-set! region #t))
    (let ([ptr (+ (mmap-region-pointer region) offset)]
          [size (bytevector-length data)])
      (do ([i 0 (+ i 1)])
          ((= i size))
        (foreign-set! 'unsigned-8 ptr i
          (bytevector-u8-ref data i)))))

  (define (mmap-sync region)
    (c-msync (mmap-region-pointer region)
             (mmap-region-size region)
             MS_SYNC)
    (mmap-region-locked?-set! region #f)))

GC-aware data structure:

; Trie with automatic memory management
(define-record-type trie-node
  (fields
    (mutable value)
    (mutable children)))    ; Weak hashtable for children

(define (make-trie)
  (make-trie-node #f (make-weak-eq-hashtable)))

(define (trie-insert! trie key value)
  (let loop ([node trie] [chars (string->list key)])
    (if (null? chars)
        (trie-node-value-set! node value)
        (let* ([children (trie-node-children node)]
               [char (car chars)]
               [child (hashtable-ref children char #f)])
          (unless child
            (set! child (make-trie-node #f (make-weak-eq-hashtable)))
            (hashtable-set! children char child))
          (loop child (cdr chars))))))

(define (trie-lookup trie key)
  (let loop ([node trie] [chars (string->list key)])
    (if (null? chars)
        (trie-node-value node)
        (let ([child (hashtable-ref (trie-node-children node)
                                     (car chars)
                                     #f)])
          (and child (loop child (cdr chars)))))))

; The weak hashtable for children allows unused branches
; to be garbage collected automatically

Expression Editor in Chez Scheme

Expression Editor Parameters

Enabling the expression editor:

; The expression editor provides line editing capabilities
; Similar to GNU Readline but integrated with Scheme

; Check if expression editor is enabled
(expression-editor)         ; #t if enabled

; Enable expression editor
(expression-editor #t)

; Disable expression editor
(expression-editor #f)

; The expression editor provides:
; - Line editing (insert, delete, cursor movement)
; - History navigation
; - Parenthesis matching
; - Tab completion
; - Multi-line editing
; - Emacs-style key bindings (default)

History parameters:

; ee-history-limit: maximum history entries
(ee-history-limit)          ; Get current limit
(ee-history-limit 500)      ; Set to 500 entries

; History file location
(ee-history-file)           ; Get current file path
(ee-history-file "~/.chez_history")  ; Set custom path

; Typical default: ~/.chez_history or platform equivalent

; History is automatically saved/loaded
; Each expression entered is added to history

; Disable history persistence
(ee-history-file #f)        ; Don't save history

; Clear current history
; (No direct command - restart or set new file)

Display and formatting parameters:

; ee-paren-flash-delay: parenthesis flash duration
(ee-paren-flash-delay)      ; Get current (milliseconds)
(ee-paren-flash-delay 100)  ; Set to 100ms

; When you type a closing paren, cursor briefly jumps
; to matching open paren, then returns

; Disable paren flashing
(ee-paren-flash-delay #f)

; ee-default-repeat: default repeat count
(ee-default-repeat)         ; Get current
(ee-default-repeat 4)       ; Set default repeat

; Used with universal argument (C-u)
; C-u C-f moves forward 4 characters by default

; ee-auto-indent: automatic indentation
(ee-auto-indent)            ; #t if enabled
(ee-auto-indent #t)         ; Enable auto-indent

; Automatically indents new lines based on
; Scheme syntax (parentheses depth)

Completion parameters:

; ee-common-identifiers: identifiers for completion
(ee-common-identifiers)     ; Get current list

; Add custom identifiers for completion
(ee-common-identifiers
  (append '(my-special-function my-custom-macro)
          (ee-common-identifiers)))

; Completion sources:
; 1. Bound identifiers in current environment
; 2. Common identifiers list
; 3. History entries

; Tab completion behavior:
; - Single match: complete immediately
; - Multiple matches: show options
; - No match: beep or do nothing

; ee-auto-paren-balance: auto-balance parentheses
(ee-auto-paren-balance)     ; #t if enabled
(ee-auto-paren-balance #t)  ; Enable

; Helps maintain balanced parentheses during editing

Terminal parameters:

; ee-noisy: beep on errors
(ee-noisy)                  ; #t if beeping enabled
(ee-noisy #f)               ; Disable beeping

; Terminal dimensions (usually auto-detected)
; Can affect line wrapping and display

; Console parameters
(console-input-port)        ; Input port for editor
(console-output-port)       ; Output port for editor

; The expression editor works with terminal capabilities
; TERM environment variable affects behavior

; For best experience:
; - Use terminal with ANSI support
; - Ensure TERM is set correctly
; - UTF-8 encoding recommended

; Check terminal type
(getenv "TERM")             ; e.g., "xterm-256color"

Expression editor parameter summary:

Parameter	Type	Description
`expression-editor`	boolean	Enable/disable expression editor
`ee-history-limit`	integer	Maximum history entries to keep
`ee-history-file`	string/#f	Path to history file
`ee-paren-flash-delay`	integer/#f	Paren matching flash delay (ms)
`ee-auto-indent`	boolean	Auto-indent new lines
`ee-default-repeat`	integer	Default repeat count for C-u
`ee-noisy`	boolean	Beep on errors
`ee-auto-paren-balance`	boolean	Auto-balance parentheses
`ee-common-identifiers`	list	Identifiers for tab completion

Key Binding

Understanding key representations:

; Keys are represented as strings with special notation

; Regular characters
"a"                         ; The letter 'a'
"A"                         ; The letter 'A' (shift-a)
"1"                         ; The digit '1'
" "                         ; Space

; Control characters (C- prefix)
"\\C-a"                     ; Control-a (^A)
"\\C-b"                     ; Control-b (^B)
"\\C-x"                     ; Control-x (^X)

; Meta/Alt characters (M- or \\e prefix)
"\\M-f"                     ; Meta-f (Alt-f or Esc f)
"\\ef"                      ; Same as above (escape followed by f)
"\\M-b"                     ; Meta-b

; Special keys
"\\C-m"                     ; Return/Enter (same as \\r)
"\\C-i"                     ; Tab (same as \\t)
"\\C-j"                     ; Newline
"\\C-["                     ; Escape

; Key sequences (multiple keys)
"\\C-x\\C-f"                ; Control-x followed by Control-f
"\\C-xb"                    ; Control-x followed by 'b'
"\\exf"                     ; Escape, then 'x', then 'f'

Key binding visualization:

Viewing current bindings:

; ee-binding-list: get all current bindings
(ee-binding-list)
; Returns association list of (key . command) pairs

; Example output:
; (("\\C-a" . ee-beginning-of-line)
;  ("\\C-e" . ee-end-of-line)
;  ("\\C-f" . ee-forward-char)
;  ("\\C-b" . ee-backward-char)
;  ...)

; Find binding for specific key
(define (find-binding key)
  (let ([bindings (ee-binding-list)])
    (cond
      [(assoc key bindings) => cdr]
      [else #f])))

(find-binding "\\C-a")      ; ee-beginning-of-line

; Find key for specific command
(define (find-key-for-command cmd)
  (let loop ([bindings (ee-binding-list)])
    (cond
      [(null? bindings) #f]
      [(eq? (cdar bindings) cmd) (caar bindings)]
      [else (loop (cdr bindings))])))

(find-key-for-command 'ee-beginning-of-line)  ; "\\C-a"

Setting key bindings:

; ee-bind-key: bind key to command
(ee-bind-key "\\C-t" 'ee-transpose-char)
(ee-bind-key "\\M-u" 'ee-upcase-word)
(ee-bind-key "\\M-l" 'ee-downcase-word)

; Bind key sequence
(ee-bind-key "\\C-x\\C-s" 'ee-save-history)
(ee-bind-key "\\C-xh" 'ee-select-all)

; Unbind a key (bind to #f)
(ee-bind-key "\\C-z" #f)    ; Disable Ctrl-Z

; Rebind existing key
(ee-bind-key "\\C-w" 'ee-backward-kill-word)  ; Change from default

; Multiple bindings for same command
(ee-bind-key "\\C-a" 'ee-beginning-of-line)
(ee-bind-key "\\eOH" 'ee-beginning-of-line)  ; Home key (some terminals)

; Bind to self-insert for special characters
(ee-bind-key "λ" 'ee-self-insert)

Default Emacs-style bindings:

Key	Command	Description
`C-a`	`ee-beginning-of-line`	Move to beginning of line
`C-e`	`ee-end-of-line`	Move to end of line
`C-f`	`ee-forward-char`	Move forward one character
`C-b`	`ee-backward-char`	Move backward one character
`M-f`	`ee-forward-word`	Move forward one word
`M-b`	`ee-backward-word`	Move backward one word
`C-p`	`ee-previous-history`	Previous history entry
`C-n`	`ee-next-history`	Next history entry
`C-d`	`ee-delete-char`	Delete character under cursor
`C-h / DEL`	`ee-backward-delete-char`	Delete character before cursor
`C-k`	`ee-kill-line`	Kill to end of line
`C-y`	`ee-yank`	Yank (paste) killed text
`C-_`	`ee-undo`	Undo last change
`C-r`	`ee-history-search-backward`	Search history backward
`C-s`	`ee-history-search-forward`	Search history forward
`TAB`	`ee-complete`	Complete identifier
`C-m / RET`	`ee-accept`	Accept input (if complete)
`C-j`	`ee-newline`	Insert newline
`C-g`	`ee-abort`	Abort current input
`C-l`	`ee-redisplay`	Redraw screen

Custom key binding configuration:

; Setup function for custom bindings
(define (setup-my-keybindings)
  ; Vi-like bindings (example)
  ; Note: This is partial - full vi mode would need more

  ; Navigation in "normal" style
  (ee-bind-key "\\C-h" 'ee-backward-char)     ; h = left
  (ee-bind-key "\\C-l" 'ee-forward-char)      ; l = right
  (ee-bind-key "\\ew" 'ee-forward-word)       ; w = word forward
  (ee-bind-key "\\eb" 'ee-backward-word)      ; b = word backward

  ; Additional useful bindings
  (ee-bind-key "\\C-x\\C-e" 'ee-edit-externally)
  (ee-bind-key "\\M-p" 'ee-previous-history)
  (ee-bind-key "\\M-n" 'ee-next-history)

  ; Function key bindings (terminal-dependent)
  (ee-bind-key "\\e[A" 'ee-previous-history)  ; Up arrow
  (ee-bind-key "\\e[B" 'ee-next-history)      ; Down arrow
  (ee-bind-key "\\e[C" 'ee-forward-char)      ; Right arrow
  (ee-bind-key "\\e[D" 'ee-backward-char)     ; Left arrow
  (ee-bind-key "\\e[H" 'ee-beginning-of-line) ; Home
  (ee-bind-key "\\e[F" 'ee-end-of-line)       ; End
  (ee-bind-key "\\e[3~" 'ee-delete-char))     ; Delete

; Call during startup (e.g., in .schemerc)
(when (expression-editor)
  (setup-my-keybindings))

Editing Commands

Cursor movement commands:

; Character movement
ee-forward-char             ; Move right one character (C-f)
ee-backward-char            ; Move left one character (C-b)

; Word movement
ee-forward-word             ; Move to end of word (M-f)
ee-backward-word            ; Move to beginning of word (M-b)

; Line movement
ee-beginning-of-line        ; Move to line start (C-a)
ee-end-of-line              ; Move to line end (C-e)
ee-previous-line            ; Move to previous line (C-p in multi-line)
ee-next-line                ; Move to next line (C-n in multi-line)

; Expression movement (Scheme-aware)
ee-forward-exp              ; Move forward one S-expression (C-M-f)
ee-backward-exp             ; Move backward one S-expression (C-M-b)

; Buffer movement
ee-beginning-of-entry       ; Move to start of entire input
ee-end-of-entry             ; Move to end of entire input

; Matching parenthesis
ee-flash-matching-paren     ; Flash matching paren
ee-goto-matching-paren      ; Move to matching paren

Deletion commands:

; Character deletion
ee-delete-char              ; Delete char at cursor (C-d)
ee-backward-delete-char     ; Delete char before cursor (Backspace)

; Word deletion
ee-delete-word              ; Delete word forward (M-d)
ee-backward-delete-word     ; Delete word backward (M-Backspace)

; Kill commands (save to kill ring)
ee-kill-line                ; Kill to end of line (C-k)
ee-backward-kill-line       ; Kill to beginning of line (C-u)
ee-kill-word                ; Kill word forward (M-d)
ee-backward-kill-word       ; Kill word backward (M-DEL)
ee-kill-exp                 ; Kill S-expression forward (C-M-k)
ee-backward-kill-exp        ; Kill S-expression backward

; Delete entire entry
ee-delete-entry             ; Delete entire input

; Note: Kill commands save text to kill ring for yanking
; Delete commands do not save to kill ring

Text insertion and manipulation:

; Self-insert
ee-self-insert              ; Insert the typed character

; Newline and indentation
ee-newline                  ; Insert newline (C-j)
ee-newline-and-indent       ; Newline with auto-indent (C-m in some configs)
ee-indent                   ; Indent current line
ee-indent-all               ; Indent entire entry

; Case conversion
ee-upcase-word              ; Convert word to uppercase (M-u)
ee-downcase-word            ; Convert word to lowercase (M-l)
ee-capitalize-word          ; Capitalize word (M-c)

; Transposition
ee-transpose-char           ; Swap chars around cursor (C-t)
ee-transpose-word           ; Swap words around cursor (M-t)
ee-transpose-exp            ; Swap S-expressions (C-M-t)

; Open line
ee-open-line                ; Insert newline after cursor (C-o)

Kill ring and yank:

; The kill ring stores killed text for later retrieval

; Yank (paste) most recent kill
ee-yank                     ; Paste last killed text (C-y)

; Yank previous kills
ee-yank-pop                 ; Cycle through kill ring (M-y after C-y)

; Kill ring operations:
; 1. C-k kills to end of line, saves to ring
; 2. C-y yanks most recent
; 3. M-y after C-y cycles through older kills

; Example workflow:
; Type: (define x 10)
; C-a C-k          ; Kill entire line
; Type: (define y 20)
; C-a C-k          ; Kill this line too
; C-y              ; Yank "(define y 20)"
; M-y              ; Replace with "(define x 10)"
; M-y              ; Cycle back to "(define y 20)"

History commands:

; History navigation
ee-previous-history         ; Previous entry (C-p or Up)
ee-next-history             ; Next entry (C-n or Down)
ee-history-beginning        ; First history entry (M-<)
ee-history-end              ; Last/current entry (M->)

; History search
ee-history-search-backward  ; Search backward (C-r)
ee-history-search-forward   ; Search forward (C-s)

; Search behavior:
; 1. Press C-r
; 2. Type search string
; 3. Press C-r again to find next match
; 4. Press Enter to accept
; 5. Press C-g to cancel

; History by prefix
ee-history-bwd-prefix       ; Find previous with same prefix
ee-history-fwd-prefix       ; Find next with same prefix

; Example: type "(def" then use prefix search
; to find all entries starting with "(def"

Completion commands:

; Tab completion
ee-complete                 ; Complete identifier (Tab)
ee-complete-list            ; Show all completions

; Completion behavior:
; - Completes based on current prefix
; - Sources: bound identifiers, common-identifiers, history

; Example:
; Type: str      (then Tab)
; Shows: string->list, string->number, string-append, ...

; Type: string-a (then Tab)
; Completes to: string-append (if unique match)

; Completion is context-aware:
; - At start of expression: all identifiers
; - After open paren: procedure names
; - After quote: symbols

Parenthesis handling:

; Parenthesis matching and manipulation
ee-flash-matching-paren     ; Briefly show matching paren
ee-goto-matching-paren      ; Move to matching paren

; Insert with matching
ee-insert-paren             ; Insert ( and potentially )
ee-insert-bracket           ; Insert [ and potentially ]

; Balance checking
ee-paren-balance            ; Check if parens are balanced

; The expression editor understands Scheme syntax:
; - () round parentheses
; - [] square brackets
; - {} curly braces (for some syntaxes)
; - "" string delimiters
; - ; comments
; - #| |# block comments

; Accept behavior depends on balance:
; - Balanced: Enter accepts and evaluates
; - Unbalanced: Enter adds newline for continuation

Control and miscellaneous commands:

; Accept and evaluate
ee-accept                   ; Accept input if complete (Enter/C-m)
ee-newline                  ; Always insert newline (C-j)

; Abort and reset
ee-abort                    ; Abort current input (C-g)
ee-reset                    ; Reset editor state

; Undo
ee-undo                     ; Undo last edit (C-_ or C-/)
ee-redo                     ; Redo undone edit

; Display
ee-redisplay                ; Redraw display (C-l)
ee-clear-screen             ; Clear screen and redraw

; Information
ee-command-repeat           ; Repeat last command
ee-set-mark                 ; Set mark at point (C-Space)
ee-exchange-point-and-mark  ; Swap cursor and mark (C-x C-x)
ee-kill-region              ; Kill between mark and point (C-w)
ee-copy-region              ; Copy between mark and point (M-w)

; Help
ee-help                     ; Show help (if bound)
ee-describe-key             ; Describe what key does

Complete command reference:

Category	Command	Description
Movement	`ee-forward-char`	Move right one character
	`ee-backward-char`	Move left one character
	`ee-forward-word`	Move forward one word
	`ee-backward-word`	Move backward one word
	`ee-forward-exp`	Move forward one S-expression
	`ee-backward-exp`	Move backward one S-expression
	`ee-beginning-of-line`	Move to line start
	`ee-end-of-line`	Move to line end
Deletion	`ee-delete-char`	Delete char at cursor
	`ee-backward-delete-char`	Delete char before cursor
	`ee-kill-line`	Kill to end of line
	`ee-kill-word`	Kill word forward
	`ee-backward-kill-word`	Kill word backward
	`ee-kill-exp`	Kill S-expression forward
History	`ee-previous-history`	Previous history entry
	`ee-next-history`	Next history entry
	`ee-history-search-backward`	Search history backward
	`ee-history-search-forward`	Search history forward
Editing	`ee-yank`	Paste killed text
	`ee-transpose-char`	Swap characters
	`ee-upcase-word`	Uppercase word
	`ee-undo`	Undo last change
Control	`ee-accept`	Accept and evaluate
	`ee-abort`	Abort input
	`ee-complete`	Tab completion

Creating New Editing Commands

Understanding the editor state:

; The expression editor maintains state including:
; - Current entry text (string or list of strings for multi-line)
; - Cursor position (line and column)
; - Mark position (for region operations)
; - Kill ring (list of killed text)
; - History (list of previous entries)
; - Undo history

; Commands are procedures that:
; 1. Receive editor state
; 2. Modify state as needed
; 3. Return updated state

; Basic structure of a custom command:
(define (my-command)
  (lambda (ee entry)
    ; ee = editor state object
    ; entry = current text entry
    ; Return: (values new-entry update-needed?)
    ...))

; Editor state accessors (implementation-specific):
; These may vary by Chez Scheme version

Simple custom commands:

; Example: Insert current date
(define (ee-insert-date)
  ; This is a simplified conceptual example
  ; Actual implementation depends on editor internals
  (let ([date-string (date->string (current-date) "~Y-~m-~d")])
    (ee-insert-string date-string)))

; Bind to key
(ee-bind-key "\\C-xd" ee-insert-date)

; Example: Insert lambda character
(define ee-insert-lambda
  (lambda ()
    (ee-insert-string "λ")))

(ee-bind-key "\\C-xl" ee-insert-lambda)

; Example: Clear line and insert template
(define (ee-insert-define-template)
  (ee-delete-entry)
  (ee-insert-string "(define (name args)\n  body)"))

(ee-bind-key "\\C-xD" ee-insert-define-template)

Commands using ee-string-macro:

; ee-string-macro: create command from key string
; Simulates typing a sequence of characters

; Insert template text
(define ee-insert-let-template
  (ee-string-macro "(let ([])\\C-b\\C-b"))

(ee-bind-key "\\C-xL" ee-insert-let-template)
; Inserts "(let ([])" with cursor inside brackets

; Insert and position
(define ee-insert-if-template
  (ee-string-macro "(if \\C-j    \\C-j    )\\C-p\\C-p\\C-e"))

(ee-bind-key "\\C-xI" ee-insert-if-template)

; Multi-line lambda template
(define ee-insert-lambda-template
  (ee-string-macro "(lambda ()\\C-j  )\\C-p\\C-e\\C-b"))

(ee-bind-key "\\C-x\\\\" ee-insert-lambda-template)

; Insert common patterns
(define ee-insert-define-syntax
  (ee-string-macro "(define-syntax \\C-j  (syntax-rules ()\\C-j    [(_ )]))\\C-p\\C-p\\C-e"))

(ee-bind-key "\\C-xS" ee-insert-define-syntax)

Composing existing commands:

; ee-compose: combine multiple commands
; Executes commands in sequence

; Kill line and yank at different position
(define ee-duplicate-line
  (ee-compose
    ee-beginning-of-line
    ee-set-mark
    ee-end-of-line
    ee-copy-region
    ee-end-of-line
    ee-newline
    ee-yank))

(ee-bind-key "\\C-xc" ee-duplicate-line)

; Select entire entry
(define ee-select-all
  (ee-compose
    ee-beginning-of-entry
    ee-set-mark
    ee-end-of-entry))

(ee-bind-key "\\C-xa" ee-select-all)

; Kill entire entry
(define ee-kill-entire-entry
  (ee-compose
    ee-beginning-of-entry
    ee-set-mark
    ee-end-of-entry
    ee-kill-region))

(ee-bind-key "\\C-xk" ee-kill-entire-entry)

; Uppercase entire word under cursor
(define ee-upcase-current-word
  (ee-compose
    ee-backward-word
    ee-upcase-word))

(ee-bind-key "\\M-U" ee-upcase-current-word)

Commands with repeat count:

; Commands can respect repeat count (C-u prefix)
; C-u sets repeat count, default is 4
; C-u C-u is 16, C-u C-u C-u is 64, etc.
; C-u followed by digits sets explicit count

; Example: C-u 10 C-f moves forward 10 characters
; Most movement and deletion commands respect repeat count

; Custom command respecting repeat count
(define (ee-insert-multiple-chars char)
  (lambda ()
    ; The editor provides repeat count to command
    ; Simplified example:
    (let ([count (ee-get-repeat-count)])
      (do ([i 0 (+ i 1)])
          ((= i count))
        (ee-insert-string (string char))))))

; Insert multiple spaces
(define ee-insert-spaces
  (ee-insert-multiple-chars #\space))

(ee-bind-key "\\M-SPC" ee-insert-spaces)
; M-SPC inserts 1 space, C-u M-SPC inserts 4 spaces

; Insert separator line
(define (ee-insert-separator)
  (let ([count (or (ee-get-repeat-count) 40)])
    (ee-insert-string (make-string count #\-))))

(ee-bind-key "\\C-x-" ee-insert-separator)

Context-sensitive commands:

; Commands that behave differently based on context

; Smart semicolon - add comment or toggle comment
(define (ee-smart-semicolon)
  (let ([line (ee-current-line)])
    (cond
      ; Already has comment - remove it
      [(string-prefix? ";" (string-trim line))
       (ee-beginning-of-line)
       (ee-delete-char)]
      ; Add comment
      [else
       (ee-beginning-of-line)
       (ee-insert-string "; ")])))

(ee-bind-key "\\C-x;" ee-smart-semicolon)

; Smart parenthesis - wrap selection or insert pair
(define (ee-smart-paren)
  (if (ee-region-active?)
      ; Wrap region in parentheses
      (begin
        (ee-goto-mark)
        (ee-insert-string "(")
        (ee-exchange-point-and-mark)
        (ee-insert-string ")"))
      ; Just insert pair and position
      (begin
        (ee-insert-string "()")
        (ee-backward-char))))

(ee-bind-key "(" ee-smart-paren)

; Electric return - newline with smart indent
(define (ee-electric-return)
  (ee-newline)
  (ee-indent))

Commands with user input:

; Commands can prompt for input

; Go to specific line number
(define (ee-goto-line)
  (let ([input (ee-prompt "Go to line: ")])
    (when input
      (let ([line-num (string->number input)])
        (when (and line-num (positive? line-num))
          (ee-goto-line-number line-num))))))

(ee-bind-key "\\M-g" ee-goto-line)

; Search and replace
(define (ee-search-replace)
  (let ([search (ee-prompt "Search: ")])
    (when search
      (let ([replace (ee-prompt "Replace with: ")])
        (when replace
          (ee-replace-all search replace))))))

(ee-bind-key "\\M-%" ee-search-replace)

; Insert from history by pattern
(define (ee-insert-from-history)
  (let ([pattern (ee-prompt "History pattern: ")])
    (when pattern
      (let ([match (find-history-match pattern)])
        (when match
          (ee-insert-string match))))))

(ee-bind-key "\\M-h" ee-insert-from-history)

Scheme-aware commands:

; Commands that understand Scheme syntax

; Evaluate S-expression before cursor
(define (ee-eval-last-exp)
  (let ([exp-text (ee-get-last-exp)])
    (when exp-text
      (let ([result (eval (read (open-input-string exp-text)))])
        (ee-message (format "~s" result))))))

(ee-bind-key "\\C-x\\C-e" ee-eval-last-exp)

; Expand macro at cursor
(define (ee-expand-macro)
  (let ([exp-text (ee-get-current-exp)])
    (when exp-text
      (let* ([exp (read (open-input-string exp-text))]
             [expanded (expand exp)])
        (ee-delete-exp)
        (ee-insert-string (format "~s" expanded))))))

(ee-bind-key "\\C-xm" ee-expand-macro)

; Format/indent current expression
(define (ee-format-exp)
  (let ([exp-text (ee-get-current-exp)])
    (when exp-text
      (let ([exp (read (open-input-string exp-text))])
        (ee-delete-exp)
        (ee-insert-string
          (with-output-to-string
            (lambda () (pretty-print exp))))))))

(ee-bind-key "\\C-x\\C-q" ee-format-exp)

; Wrap expression in form
(define (ee-wrap-in-let)
  (let ([exp (ee-get-current-exp)])
    (when exp
      (ee-delete-exp)
      (ee-insert-string
        (format "(let ([x ~a])~n  x)" exp))
      ; Position cursor at 'x' binding name
      (ee-beginning-of-entry)
      (ee-forward-char 7))))

(ee-bind-key "\\C-xl" ee-wrap-in-let)

Complete custom configuration example:

; Complete expression editor customization
; Put in ~/.schemerc or load at startup

(define (setup-expression-editor)
  (when (expression-editor)

    ; Basic settings
    (ee-history-limit 1000)
    (ee-paren-flash-delay 100)
    (ee-auto-indent #t)
    (ee-noisy #f)

    ; Add custom identifiers for completion
    (ee-common-identifiers
      (append
        '(define-syntax syntax-rules syntax-case
          with-syntax datum->syntax syntax->datum
          guard condition raise
          parameterize make-parameter
          call-with-values let-values define-values
          case-lambda rec trace untrace
          pretty-print format printf fprintf)
        (ee-common-identifiers)))

    ; Template insertions
    (ee-bind-key "\\C-xd"
      (ee-string-macro "(define ()\\C-b"))

    (ee-bind-key "\\C-xD"
      (ee-string-macro "(define-syntax \\C-j  (syntax-rules ()\\C-j    ))"))

    (ee-bind-key "\\C-xl"
      (ee-string-macro "(lambda ()\\C-b"))

    (ee-bind-key "\\C-xL"
      (ee-string-macro "(let ([])\\C-b\\C-b\\C-b"))

    (ee-bind-key "\\C-xi"
      (ee-string-macro "(if \\C-j    \\C-j    )"))

    (ee-bind-key "\\C-xc"
      (ee-string-macro "(cond\\C-j  [])"))

    (ee-bind-key "\\C-xg"
      (ee-string-macro "(guard (c\\C-j        [else ])\\C-j  )"))

    ; Navigation enhancements
    (ee-bind-key "\\e[1;5C" ee-forward-word)   ; Ctrl-Right
    (ee-bind-key "\\e[1;5D" ee-backward-word)  ; Ctrl-Left
    (ee-bind-key "\\e[1;5A" ee-backward-exp)   ; Ctrl-Up (expression)
    (ee-bind-key "\\e[1;5B" ee-forward-exp)    ; Ctrl-Down (expression)

    ; Duplicate line
    (ee-bind-key "\\C-xc"
      (ee-compose
        ee-beginning-of-line
        ee-set-mark
        ee-end-of-line
        ee-copy-region
        ee-end-of-line
        ee-newline
        ee-yank))

    ; Comment/uncomment line
    (ee-bind-key "\\C-x;"
      (ee-compose
        ee-beginning-of-line
        (ee-string-macro "; ")))

    ; Quick evaluation message
    (ee-bind-key "\\C-xp"
      (ee-string-macro "(printf \"~a~n\" )\\C-b"))

    (printf "Expression editor configured.~n")))

; Run setup
(setup-expression-editor)

Editor state diagram:

Advanced Expression Editor Topics

Multi-line editing:

; The expression editor handles multi-line input automatically
; When parentheses are unbalanced, Enter adds newline

; Example multi-line input:
; > (define (factorial n)
;     (if (zero? n)
;         1
;         (* n (factorial (- n 1)))))

; Navigation in multi-line mode:
; C-p / Up    - Previous line (or previous history if at top)
; C-n / Down  - Next line (or next history if at bottom)
; C-a         - Beginning of current line
; C-e         - End of current line
; M-<         - Beginning of entire entry
; M->         - End of entire entry

; Multi-line history:
; Entire multi-line expressions stored as single history entry
; Navigate with C-p/C-n at entry boundaries

; Indentation in multi-line:
; Auto-indent based on paren depth
; Tab to manually indent
; ee-indent-all to reindent entire entry

Terminal compatibility:

; Expression editor adapts to terminal capabilities

; Check terminal type
(getenv "TERM")             ; Should be set correctly

; Common terminal types:
; - xterm, xterm-256color
; - screen, screen-256color
; - vt100, vt220
; - linux (console)
; - dumb (no capabilities)

; If keys don't work, check terminal settings:
; 1. Verify TERM is set correctly
; 2. Check key sequences with: cat -v (then press keys)
; 3. Bind actual sequences your terminal sends

; Example: finding actual escape sequence
; $ cat -v
; (press Ctrl-Right)
; ^[[1;5C
;
; In Scheme: "\\e[1;5C"

; Some terminals need special configuration:
(ee-bind-key "\\e[1~" ee-beginning-of-line)  ; Home (some terms)
(ee-bind-key "\\e[4~" ee-end-of-line)        ; End (some terms)
(ee-bind-key "\\e[5~" ee-history-beginning)  ; PgUp
(ee-bind-key "\\e[6~" ee-history-end)        ; PgDn

; For dumb terminals, expression editor may be disabled
; Use rlwrap or similar as alternative

History file management:

; History persistence across sessions
(ee-history-file)           ; Default location

; Custom history location
(ee-history-file
  (string-append (getenv "HOME") "/.scheme_history"))

; Separate history per project
(define (set-project-history! project-name)
  (ee-history-file
    (format "~a/.scheme_history_~a"
            (getenv "HOME")
            project-name)))

; History is saved automatically:
; - On normal exit
; - Periodically during session (implementation-dependent)

; History format is typically plain text
; One entry per line (multi-line entries escaped)

; Clear history
(define (clear-history!)
  (let ([file (ee-history-file)])
    (when file
      (when (file-exists? file)
        (delete-file file)))))

; Export history
(define (export-history filename)
  (let ([history (ee-history-list)])
    (call-with-output-file filename
      (lambda (port)
        (for-each
          (lambda (entry)
            (fprintf port "~a~n~n" entry))
          history))
      '(replace))))

Integrating with external editors:

; Edit current expression in external editor
(define (ee-edit-external)
  (let ([text (ee-get-entry)]
        [editor (or (getenv "VISUAL")
                    (getenv "EDITOR")
                    "vi")])
    ; Write to temp file
    (let ([temp-file (format "/tmp/scheme-edit-~a" (getpid))])
      (call-with-output-file temp-file
        (lambda (port)
          (display text port))
        '(replace))
      ; Run editor
      (system (format "~a ~a" editor temp-file))
      ; Read back
      (let ([new-text (call-with-input-file temp-file
                        get-string-all)])
        (delete-file temp-file)
        ; Replace entry
        (ee-delete-entry)
        (ee-insert-string new-text)))))

(ee-bind-key "\\C-x\\C-e" ee-edit-external)

; Edit with specific editor
(define (ee-edit-with-emacs)
  (parameterize ([current-environment-variable "VISUAL" "emacsclient"])
    (ee-edit-external)))

(define (ee-edit-with-vim)
  (parameterize ([current-environment-variable "VISUAL" "vim"])
    (ee-edit-external)))

Completion customization:

; Customize tab completion behavior

; Add module-specific completions
(define (add-module-completions! module-name)
  (let ([exports (library-exports module-name)])
    (ee-common-identifiers
      (append exports (ee-common-identifiers)))))

; Add completions from current file
(define (add-file-completions! filename)
  (let ([identifiers (extract-definitions filename)])
    (ee-common-identifiers
      (append identifiers (ee-common-identifiers)))))

(define (extract-definitions filename)
  (call-with-input-file filename
    (lambda (port)
      (let loop ([defs '()])
        (let ([form (read port)])
          (if (eof-object? form)
              defs
              (loop
                (if (and (pair? form)
                         (memq (car form) '(define define-syntax)))
                    (cons (if (pair? (cadr form))
                              (caadr form)
                              (cadr form))
                          defs)
                    defs))))))))

; Context-aware completion (conceptual)
(define (smart-complete)
  (let ([context (ee-get-context)])
    (case context
      [(after-open-paren)
       ; Complete with procedures only
       (ee-complete-procedures)]
      [(after-quote)
       ; Complete with symbols
       (ee-complete-symbols)]
      [(in-string)
       ; Complete file paths
       (ee-complete-files)]
      [else
       (ee-complete)])))  ; Default

Expression editor initialization file:

; Complete .schemerc example for expression editor

; ~/.schemerc or ~/.chezschemerc

;; Expression Editor Configuration

(when (expression-editor)

  ;; ========== Basic Settings ==========
  (ee-history-limit 2000)
  (ee-history-file (format "~a/.chez_history" (getenv "HOME")))
  (ee-paren-flash-delay 100)
  (ee-auto-indent #t)
  (ee-noisy #f)
  (ee-default-repeat 4)

  ;; ========== Common Identifiers ==========
  (ee-common-identifiers
    (append
      '(; Syntax
        define-syntax syntax-rules syntax-case
        with-syntax quasisyntax unsyntax
        datum->syntax syntax->datum
        identifier? free-identifier=? bound-identifier=?
        generate-temporaries

        ; Control
        guard raise raise-continuable
        call/cc call/1cc call-with-values
        dynamic-wind parameterize

        ; I/O
        call-with-input-file call-with-output-file
        with-input-from-file with-output-to-file
        open-input-string open-output-string
        get-string-all get-line

        ; Common utilities
        printf fprintf format
        pretty-print trace untrace
        time collect

        ; Records
        define-record-type

        ; Foreign
        foreign-procedure load-shared-object
        foreign-callable foreign-alloc foreign-free)
      (ee-common-identifiers)))

  ;; ========== Key Bindings ==========

  ; Arrow keys (adjust for your terminal)
  (ee-bind-key "\\e[A" ee-previous-history)    ; Up
  (ee-bind-key "\\e[B" ee-next-history)        ; Down
  (ee-bind-key "\\e[C" ee-forward-char)        ; Right
  (ee-bind-key "\\e[D" ee-backward-char)       ; Left
  (ee-bind-key "\\e[H" ee-beginning-of-line)   ; Home
  (ee-bind-key "\\e[F" ee-end-of-line)         ; End
  (ee-bind-key "\\e[3~" ee-delete-char)        ; Delete

  ; Ctrl+Arrow
  (ee-bind-key "\\e[1;5C" ee-forward-word)     ; Ctrl+Right
  (ee-bind-key "\\e[1;5D" ee-backward-word)    ; Ctrl+Left

  ;; ========== Templates ==========

  ; Basic forms
  (ee-bind-key "\\C-xd"
    (ee-string-macro "(define )\\C-b"))

  (ee-bind-key "\\C-xf"
    (ee-string-macro "(define ()\\C-j  )\\C-p\\C-e\\C-b\\C-b"))

  (ee-bind-key "\\C-xl"
    (ee-string-macro "(lambda ()\\C-j  )\\C-p\\C-e\\C-b"))

  (ee-bind-key "\\C-xL"
    (ee-string-macro "(let ([])\\C-j  )\\C-p\\C-e\\C-b\\C-b\\C-b"))

  (ee-bind-key "\\C-xL"
    (ee-string-macro "(let* ([])\\C-j  )\\C-p\\C-e\\C-b\\C-b\\C-b"))

  (ee-bind-key "\\C-xi"
    (ee-string-macro "(if \\C-j    \\C-j    )\\C-p\\C-p\\C-e"))

  (ee-bind-key "\\C-xc"
    (ee-string-macro "(cond\\C-j  [else ])\\C-b"))

  (ee-bind-key "\\C-xw"
    (ee-string-macro "(when \\C-j  )\\C-p\\C-e"))

  ; Macro templates
  (ee-bind-key "\\C-xS"
    (ee-string-macro "(define-syntax \\C-j  (syntax-rules ()\\C-j    [(_ ) ]))\\C-p\\C-p\\C-e"))

  ; Test/debug
  (ee-bind-key "\\C-xp"
    (ee-string-macro "(printf \"~a~n\" )\\C-b"))

  (ee-bind-key "\\C-xt"
    (ee-string-macro "(time )\\C-b"))

  (ee-bind-key "\\C-xT"
    (ee-string-macro "(trace )\\C-b"))

  ;; ========== Utility Bindings ==========

  ; Duplicate line (simplified)
  (ee-bind-key "\\C-xc"
    (ee-compose
      ee-beginning-of-line
      ee-set-mark
      ee-end-of-line
      ee-copy-region
      ee-end-of-line
      ee-newline
      ee-yank))

  ;; ========== Report ==========
  (printf "; Expression editor configured~n")
  (printf "; History file: ~a~n" (ee-history-file))
  (printf "; History limit: ~a~n" (ee-history-limit))
)

Thread System in Chez Scheme

Thread Creation

Checking for threaded Chez Scheme:

; Thread support requires threaded build of Chez Scheme
(threaded?)                 ; #t if threaded build

; Machine types with 't' prefix are threaded:
; ta6le  - threaded, 64-bit Linux
; ta6osx - threaded, 64-bit macOS
; ta6nt  - threaded, 64-bit Windows
; tarm64le - threaded, ARM64 Linux

(machine-type)              ; Check current machine type

; If not threaded, thread procedures are not available
; Use threaded version: scheme (not petite)

Creating and starting threads:

; fork-thread creates and starts a new thread
(define t (fork-thread
            (lambda ()
              (display "Hello from thread!\n")
              42)))

; Thread runs concurrently with main thread
; Returns thread object

; Wait for thread to complete
(define result (thread-join t))
; result = 42 (the return value)

; Thread with arguments (use closure)
(define (make-worker id)
  (fork-thread
    (lambda ()
      (printf "Worker ~a starting~n" id)
      (do-work id)
      (printf "Worker ~a done~n" id))))

(define workers
  (map make-worker '(1 2 3 4)))

; Wait for all workers
(for-each thread-join workers)

Thread object operations:

; Check if value is a thread
(thread? t)                 ; #t if t is a thread object

; Get current thread
(get-thread-id)             ; Returns unique thread identifier

; Thread join waits for completion and returns value
(thread-join t)             ; Block until t finishes

; Thread join with timeout (if supported)
; May not be directly available - use condition variables

; Check thread status (implementation-specific)
; Threads are either: running, finished, or errored

; Thread that signals error
(define t (fork-thread
            (lambda ()
              (error 'worker "something went wrong"))))

; thread-join re-raises the error
(guard (c [else (display-condition c)])
  (thread-join t))

Thread lifecycle visualization:

Thread management patterns:

; Thread pool pattern
(define (make-thread-pool size)
  (let ([threads '()]
        [task-queue (make-queue)]
        [running #t])

    ; Worker function
    (define (worker)
      (let loop ()
        (when running
          (let ([task (queue-dequeue! task-queue)])
            (when task
              (guard (c [else (printf "Task error: ~a~n" c)])
                (task))))
          (loop))))

    ; Start workers
    (set! threads
      (map (lambda (_) (fork-thread worker))
           (iota size)))

    ; Return pool interface
    (lambda (msg . args)
      (case msg
        [(submit)
         (queue-enqueue! task-queue (car args))]
        [(shutdown)
         (set! running #f)
         (for-each thread-join threads)]))))

; Usage
(define pool (make-thread-pool 4))
(pool 'submit (lambda () (printf "Task 1~n")))
(pool 'submit (lambda () (printf "Task 2~n")))
(pool 'shutdown)

Thread-safe initialization:

; Ensure code runs only once across threads
(define make-once
  (lambda (thunk)
    (let ([done #f]
          [result #f]
          [mutex (make-mutex)])
      (lambda ()
        (with-mutex mutex
          (unless done
            (set! result (thunk))
            (set! done #t)))
        result))))

; Usage
(define get-config
  (make-once
    (lambda ()
      (printf "Loading config (only once)~n")
      (load-config-file))))

; Multiple threads can call (get-config)
; Config loaded exactly once

Mutexes

Mutex basics:

; Mutexes provide mutual exclusion
(define m (make-mutex))

; Acquire mutex (blocks if held by another thread)
(mutex-acquire m)

; Release mutex
(mutex-release m)

; Check mutex name (optional, for debugging)
(define named-mutex (make-mutex 'my-mutex))
(mutex-name named-mutex)    ; my-mutex

; Critical section pattern
(mutex-acquire m)
(guard (c [else (mutex-release m) (raise c)])
  (critical-operation)
  (mutex-release m))

with-mutex convenience form:

; with-mutex handles acquire/release automatically
(with-mutex m
  (critical-operation))

; Equivalent to:
; (dynamic-wind
;   (lambda () (mutex-acquire m))
;   (lambda () (critical-operation))
;   (lambda () (mutex-release m)))

; Safe even with exceptions
(with-mutex m
  (error 'test "oops"))     ; Mutex released despite error

; with-mutex returns body's value
(define result
  (with-mutex m
    (compute-something)))

; Nested with-mutex (different mutexes)
(with-mutex m1
  (with-mutex m2
    (operation-needing-both)))

Mutex operations:

; mutex-acquire with blocking control
(mutex-acquire m)           ; Block until acquired
(mutex-acquire m #f)        ; Non-blocking, returns #f if unavailable

; Try to acquire without blocking
(if (mutex-acquire m #f)
    (begin
      (critical-section)
      (mutex-release m))
    (handle-busy))

; Check if mutex is acquired
; No direct predicate - use try-acquire pattern

; Mutex fairness
; Chez Scheme mutexes are not guaranteed fair
; Long waits possible under contention

; Deadlock prevention
; Always acquire mutexes in consistent order
(define mutex-a (make-mutex 'a))
(define mutex-b (make-mutex 'b))

; Good: consistent order
(with-mutex mutex-a
  (with-mutex mutex-b
    (operation)))

; Bad: different order in different threads can deadlock
; Thread 1: lock a, lock b
; Thread 2: lock b, lock a

Protecting shared state:

; Thread-safe counter
(define (make-counter)
  (let ([count 0]
        [mutex (make-mutex)])
    (lambda (msg)
      (case msg
        [(get)
         (with-mutex mutex count)]
        [(inc!)
         (with-mutex mutex
           (set! count (+ count 1))
           count)]
        [(dec!)
         (with-mutex mutex
           (set! count (- count 1))
           count)]
        [(add!)
         (lambda (n)
           (with-mutex mutex
             (set! count (+ count n))
             count))]))))

(define counter (make-counter))
(counter 'inc!)             ; 1
((counter 'add!) 10)        ; 11
(counter 'get)              ; 11

; Thread-safe hash table wrapper
(define (make-synchronized-hashtable)
  (let ([ht (make-eq-hashtable)]
        [mutex (make-mutex)])
    (lambda (msg key . args)
      (with-mutex mutex
        (case msg
          [(get) (hashtable-ref ht key (if (null? args) #f (car args)))]
          [(set!) (hashtable-set! ht key (car args))]
          [(delete!) (hashtable-delete! ht key)]
          [(contains?) (hashtable-contains? ht key)])))))

Mutex visualization:

Conditions

Condition variable basics:

; Condition variables allow threads to wait for events
(define cv (make-condition))

; Condition with name (for debugging)
(define named-cv (make-condition 'my-condition))
(condition-name named-cv)   ; my-condition

; Conditions are always used with a mutex
(define m (make-mutex))

; Wait on condition (must hold mutex)
(with-mutex m
  (condition-wait cv m))    ; Releases mutex while waiting

; Signal one waiting thread
(condition-signal cv)

; Broadcast to all waiting threads
(condition-broadcast cv)

Wait and signal pattern:

; Producer-consumer with condition variable
(define queue '())
(define mutex (make-mutex))
(define not-empty (make-condition))
(define not-full (make-condition))
(define max-size 10)

; Producer
(define (produce item)
  (with-mutex mutex
    ; Wait while queue is full
    (let loop ()
      (when (>= (length queue) max-size)
        (condition-wait not-full mutex)
        (loop)))
    ; Add item
    (set! queue (append queue (list item)))
    ; Signal consumer
    (condition-signal not-empty)))

; Consumer
(define (consume)
  (with-mutex mutex
    ; Wait while queue is empty
    (let loop ()
      (when (null? queue)
        (condition-wait not-empty mutex)
        (loop)))
    ; Remove item
    (let ([item (car queue)])
      (set! queue (cdr queue))
      ; Signal producer
      (condition-signal not-full)
      item)))

Condition wait with timeout:

; condition-wait with timeout
(with-mutex m
  (let ([result (condition-wait cv m
                  (make-time 'time-duration 0 5))])  ; 5 second timeout
    (if result
        (handle-signaled)
        (handle-timeout))))

; Timeout returns #f, signal returns #t

; Implementing timeout pattern
(define (wait-with-timeout cv m seconds)
  (let ([deadline (add-duration
                    (current-time 'time-utc)
                    (make-time 'time-duration 0 seconds))])
    (condition-wait cv m deadline)))

; Timed wait loop
(define (wait-for-condition pred cv m timeout)
  (let ([deadline (add-duration
                    (current-time 'time-utc)
                    (make-time 'time-duration 0 timeout))])
    (with-mutex m
      (let loop ()
        (cond
          [(pred) #t]                    ; Condition met
          [(time>=? (current-time 'time-utc) deadline) #f]  ; Timeout
          [else
           (condition-wait cv m deadline)
           (loop)])))))

Spurious wakeups:

; condition-wait may return spuriously (without signal)
; Always recheck condition in a loop!

; WRONG - may proceed without condition being true
(with-mutex m
  (condition-wait cv m)
  (process-data))           ; Might not be ready!

; CORRECT - loop until condition is actually true
(with-mutex m
  (let loop ()
    (unless (data-ready?)
      (condition-wait cv m)
      (loop)))
  (process-data))           ; Guaranteed ready

; Or using when
(with-mutex m
  (while (not (data-ready?))
    (condition-wait cv m))
  (process-data))

; Helper macro
(define-syntax wait-until
  (syntax-rules ()
    [(_ cv m pred)
     (let loop ()
       (unless pred
         (condition-wait cv m)
         (loop)))]))

Condition variable visualization:

Locks

Recursive locks:

; Recursive locks (reentrant) can be acquired multiple times by same thread
; Standard mutexes are not recursive in Chez Scheme

; Implement recursive lock
(define (make-recursive-lock)
  (let ([mutex (make-mutex)]
        [owner #f]
        [count 0]
        [owner-mutex (make-mutex)])  ; Protects owner/count

    (define (acquire)
      (let ([self (get-thread-id)])
        (with-mutex owner-mutex
          (if (eq? owner self)
              ; Already own it, increment count
              (set! count (+ count 1))
              ; Don't own it, need to acquire
              (begin
                (mutex-release owner-mutex)  ; Release before blocking
                (mutex-acquire mutex)
                (mutex-acquire owner-mutex)
                (set! owner self)
                (set! count 1))))))

    (define (release)
      (with-mutex owner-mutex
        (unless (eq? owner (get-thread-id))
          (error 'recursive-lock "not owner"))
        (set! count (- count 1))
        (when (zero? count)
          (set! owner #f)
          (mutex-release mutex))))

    (lambda (msg)
      (case msg
        [(acquire) (acquire)]
        [(release) (release)]))))

; Usage
(define rlock (make-recursive-lock))
(rlock 'acquire)            ; First acquisition
(rlock 'acquire)            ; Second (same thread OK)
(rlock 'release)            ; Count = 1
(rlock 'release)            ; Count = 0, actually released

Read-write locks:

; Read-write locks allow multiple readers OR single writer
(define (make-rwlock)
  (let ([mutex (make-mutex)]
        [read-cv (make-condition)]
        [write-cv (make-condition)]
        [readers 0]
        [writers 0]
        [write-waiters 0])

    (define (read-lock)
      (with-mutex mutex
        ; Wait while there are writers or waiting writers
        (let loop ()
          (when (or (> writers 0) (> write-waiters 0))
            (condition-wait read-cv mutex)
            (loop)))
        (set! readers (+ readers 1))))

    (define (read-unlock)
      (with-mutex mutex
        (set! readers (- readers 1))
        (when (zero? readers)
          (condition-signal write-cv))))

    (define (write-lock)
      (with-mutex mutex
        (set! write-waiters (+ write-waiters 1))
        (let loop ()
          (when (or (> readers 0) (> writers 0))
            (condition-wait write-cv mutex)
            (loop)))
        (set! write-waiters (- write-waiters 1))
        (set! writers 1)))

    (define (write-unlock)
      (with-mutex mutex
        (set! writers 0)
        ; Prefer waiting writers
        (if (> write-waiters 0)
            (condition-signal write-cv)
            (condition-broadcast read-cv))))

    (lambda (msg)
      (case msg
        [(read-lock) (read-lock)]
        [(read-unlock) (read-unlock)]
        [(write-lock) (write-lock)]
        [(write-unlock) (write-unlock)]))))

; Usage
(define rwlock (make-rwlock))

; Reader threads (can be concurrent)
(fork-thread
  (lambda ()
    (rwlock 'read-lock)
    (read-data)
    (rwlock 'read-unlock)))

; Writer thread (exclusive)
(fork-thread
  (lambda ()
    (rwlock 'write-lock)
    (write-data)
    (rwlock 'write-unlock)))

Spin locks (for very short critical sections):

; Spin lock - busy waits (use only for very short operations)
; Generally prefer mutexes

(define (make-spinlock)
  (let ([locked (box #f)])
    (define (acquire)
      (let loop ()
        ; Try to atomically set locked to #t
        (unless (box-cas! locked #f #t)
          (loop))))  ; Spin until successful

    (define (release)
      (set-box! locked #f))

    (lambda (msg)
      (case msg
        [(acquire) (acquire)]
        [(release) (release)]
        [(try-acquire) (box-cas! locked #f #t)]))))

; box-cas! is atomic compare-and-swap
; Returns #t if swap succeeded, #f otherwise

; When to use spinlocks:
; - Very short critical sections (few instructions)
; - Low contention expected
; - Cannot afford mutex overhead

; When NOT to use:
; - Long operations (wastes CPU)
; - High contention (threads spin-waiting)
; - When thread might block in critical section

Lock comparison table:

Lock Type	Multiple Acquires	Concurrent Readers	Blocking	Use Case
Mutex	No	No	Yes	General purpose mutual exclusion
Recursive Lock	Yes (same thread)	No	Yes	Reentrant algorithms
Read-Write Lock	Readers yes	Yes	Yes	Read-heavy workloads
Spinlock	No	No	No (busy wait)	Very short critical sections

Locked Increment and Decrement

Atomic operations:

; Chez Scheme provides atomic box operations
(define counter (box 0))

; box-cas! - Compare And Swap
; (box-cas! box expected new)
; If box contains expected, set to new and return #t
; Otherwise return #f

(box-cas! counter 0 1)      ; #t if was 0, now 1
(box-cas! counter 0 1)      ; #f - not 0 anymore

; Atomic increment using CAS loop
(define (atomic-increment! box)
  (let loop ()
    (let ([old (unbox box)])
      (unless (box-cas! box old (+ old 1))
        (loop)))))

; Atomic decrement
(define (atomic-decrement! box)
  (let loop ()
    (let ([old (unbox box)])
      (unless (box-cas! box old (- old 1))
        (loop)))))

; Atomic add
(define (atomic-add! box n)
  (let loop ()
    (let ([old (unbox box)])
      (unless (box-cas! box old (+ old n))
        (loop)))))

fxbox operations (fixnum-specific):

; Faster operations for fixnum boxes
(define fx-counter (box 0))

; These may be more efficient for fixnums
(define (fx-atomic-increment! box)
  (let loop ()
    (let ([old (unbox box)])
      (unless (box-cas! box old (fx+ old 1))
        (loop))
      old)))  ; Return old value

(define (fx-atomic-decrement! box)
  (let loop ()
    (let ([old (unbox box)])
      (unless (box-cas! box old (fx- old 1))
        (loop))
      old)))

; Atomic fetch-and-add
(define (fetch-and-add! box n)
  (let loop ()
    (let ([old (unbox box)])
      (if (box-cas! box old (fx+ old n))
          old
          (loop)))))

; Test counter from multiple threads
(define counter (box 0))

(define threads
  (map (lambda (_)
         (fork-thread
           (lambda ()
             (do ([i 0 (+ i 1)])
                 ((= i 10000))
               (atomic-increment! counter)))))
       (iota 10)))

(for-each thread-join threads)
(unbox counter)             ; Should be exactly 100000

Atomic update patterns:

; Generic atomic update
(define (atomic-update! box proc)
  (let loop ()
    (let* ([old (unbox box)]
           [new (proc old)])
      (if (box-cas! box old new)
          new
          (loop)))))

; Usage
(define stats (box '((count . 0) (sum . 0))))

(atomic-update! stats
  (lambda (s)
    `((count . ,(+ (cdr (assq 'count s)) 1))
      (sum . ,(+ (cdr (assq 'sum s)) value)))))

; Atomic max
(define (atomic-max! box value)
  (atomic-update! box
    (lambda (old)
      (max old value))))

; Atomic push (for list in box)
(define (atomic-push! box value)
  (atomic-update! box
    (lambda (lst)
      (cons value lst))))

; Atomic pop (returns popped value)
(define (atomic-pop! box)
  (let loop ()
    (let ([old (unbox box)])
      (if (null? old)
          #f
          (if (box-cas! box old (cdr old))
              (car old)
              (loop))))))

Lock-free data structures:

; Lock-free stack
(define (make-lock-free-stack)
  (let ([top (box '())])
    (define (push! value)
      (let loop ()
        (let ([old-top (unbox top)])
          (unless (box-cas! top old-top (cons value old-top))
            (loop)))))

    (define (pop!)
      (let loop ()
        (let ([old-top (unbox top)])
          (cond
            [(null? old-top) #f]
            [(box-cas! top old-top (cdr old-top))
             (car old-top)]
            [else (loop)]))))

    (define (peek)
      (let ([t (unbox top)])
        (if (null? t) #f (car t))))

    (lambda (msg . args)
      (case msg
        [(push!) (push! (car args))]
        [(pop!) (pop!)]
        [(peek) (peek)]
        [(empty?) (null? (unbox top))]))))

; Usage
(define stack (make-lock-free-stack))
(stack 'push! 1)
(stack 'push! 2)
(stack 'push! 3)
(stack 'pop!)               ; 3
(stack 'pop!)               ; 2

CAS operation visualization:

Reference Counting with Ftype Guardians

Reference counting basics:

; Reference counting for manual resource management
; Useful for foreign resources

(define-record-type ref-counted
  (fields
    resource                ; The actual resource
    (mutable count)         ; Reference count (in box for atomicity)
    destructor              ; Cleanup procedure
    mutex))                 ; Protects count

(define (make-ref-counted resource destructor)
  (make-ref-counted
    resource
    (box 1)                 ; Initial count = 1
    destructor
    (make-mutex)))

(define (ref-retain! rc)
  (atomic-increment! (ref-counted-count rc)))

(define (ref-release! rc)
  (let ([new-count (fx- (fetch-and-add! (ref-counted-count rc) -1) 1)])
    (when (zero? new-count)
      ; Last reference - destroy
      ((ref-counted-destructor rc) (ref-counted-resource rc)))))

(define (ref-get rc)
  (ref-counted-resource rc))

Ftype guardian integration:

; Using guardians with foreign types
(define-ftype foreign-buffer
  (struct
    [data void*]
    [size size_t]))

; Guardian for foreign buffer cleanup
(define buffer-guardian (make-guardian))

(define (allocate-foreign-buffer size)
  (let* ([ptr (foreign-alloc (ftype-sizeof foreign-buffer))]
         [buf (make-ftype-pointer foreign-buffer ptr)])
    ; Allocate data
    (ftype-set! foreign-buffer (data) buf (foreign-alloc size))
    (ftype-set! foreign-buffer (size) buf size)
    ; Register with guardian
    (buffer-guardian buf)
    buf))

(define (free-foreign-buffer buf)
  (let ([data (ftype-ref foreign-buffer (data) buf)])
    (foreign-free data)
    (foreign-free (ftype-pointer-address buf))))

; Cleanup thread
(define (start-cleanup-thread!)
  (fork-thread
    (lambda ()
      (let loop ()
        (let ([buf (buffer-guardian)])
          (when buf
            (printf "Cleaning up buffer ~a~n" buf)
            (free-foreign-buffer buf)))
        (sleep (make-time 'time-duration 0 1))  ; Check every second
        (loop)))))

Thread-safe reference counting:

; Full thread-safe reference counted wrapper
(define (make-rc-manager)
  (let ([guardian (make-guardian)]
        [ref-counts (make-eq-hashtable)]
        [mutex (make-mutex)])

    (define (wrap resource destructor)
      (with-mutex mutex
        (hashtable-set! ref-counts resource (box 1)))
      (guardian (cons resource destructor))
      resource)

    (define (retain resource)
      (with-mutex mutex
        (let ([count-box (hashtable-ref ref-counts resource #f)])
          (when count-box
            (atomic-increment! count-box)))))

    (define (release resource)
      (let ([should-destroy #f]
            [destructor #f])
        (with-mutex mutex
          (let ([count-box (hashtable-ref ref-counts resource #f)])
            (when count-box
              (atomic-decrement! count-box)
              (when (zero? (unbox count-box))
                (set! should-destroy #t)
                (hashtable-delete! ref-counts resource)))))
        (when should-destroy
          ; Find and call destructor via guardian
          (let loop ()
            (let ([pair (guardian)])
              (when pair
                (when (eq? (car pair) resource)
                  ((cdr pair) resource))
                (loop)))))))

    (define (cleanup-abandoned!)
      (let loop ()
        (let ([pair (guardian)])
          (when pair
            (let ([resource (car pair)]
                  [destructor (cdr pair)])
              (with-mutex mutex
                (let ([count-box (hashtable-ref ref-counts resource #f)])
                  (when (and count-box (zero? (unbox count-box)))
                    (destructor resource)
                    (hashtable-delete! ref-counts resource)))))
            (loop)))))

    (lambda (msg . args)
      (case msg
        [(wrap) (apply wrap args)]
        [(retain) (retain (car args))]
        [(release) (release (car args))]
        [(cleanup) (cleanup-abandoned!)]))))

Weak reference pattern with threads:

; Weak references for caching without preventing GC
(define (make-weak-ref-cache)
  (let ([cache (make-weak-eq-hashtable)]
        [mutex (make-mutex)])

    (define (get key)
      (with-mutex mutex
        (let ([value (hashtable-ref cache key #f)])
          (if (and value (not (bwp-object? value)))
              value
              (begin
                (when value
                  ; Clean up broken weak pointer
                  (hashtable-delete! cache key))
                #f)))))

    (define (put! key value)
      (with-mutex mutex
        (hashtable-set! cache key value)))

    (define (cleanup!)
      (with-mutex mutex
        (let-values ([(keys vals) (hashtable-entries cache)])
          (vector-for-each
            (lambda (k v)
              (when (bwp-object? v)
                (hashtable-delete! cache k)))
            keys vals))))

    (lambda (msg . args)
      (case msg
        [(get) (get (car args))]
        [(put!) (put! (car args) (cadr args))]
        [(cleanup!) (cleanup!)]))))

; Use in multi-threaded context
(define cache (make-weak-ref-cache))

; Multiple threads can access
(fork-thread
  (lambda ()
    (cache 'put! 'key1 (compute-expensive-value))))

Memory Consistency

Understanding memory ordering:

; Modern CPUs may reorder memory operations
; Threads may see writes in different orders

; Example of problematic code:
(define data #f)
(define ready #f)

; Thread 1 (producer)
(set! data (compute-value))
(set! ready #t)

; Thread 2 (consumer)
(when ready
  (use data))  ; Might see ready=#t but old data!

; Problem: CPU/compiler might reorder writes
; Thread 2 might see ready=#t before data is updated

; Solution: Use proper synchronization
(define mutex (make-mutex))
(define cv (make-condition))

; Thread 1 (producer)
(with-mutex mutex
  (set! data (compute-value))
  (set! ready #t)
  (condition-signal cv))

; Thread 2 (consumer)
(with-mutex mutex
  (unless ready
    (condition-wait cv mutex))
  (use data))  ; Now guaranteed to see updated data

Memory barriers with mutex:

; Mutexes provide memory barriers (fences)
; Acquiring mutex: acquire barrier (reads can't move before)
; Releasing mutex: release barrier (writes can't move after)

; This ensures:
; 1. All writes before release are visible after acquire
; 2. Critical section operations don't leak out

; Visualization of memory barrier:
;
; Thread 1             Thread 2
; ---------            ---------
; x = 1
; y = 2
; mutex-release -----> mutex-acquire
;                      read x (sees 1)
;                      read y (sees 2)

; Without mutex, reads might see old values

; Box operations provide some ordering
; box-cas! includes memory barriers
(define flag (box #f))

; Safe publication with CAS
(define published-data #f)

; Publisher
(set! published-data (create-data))
(box-cas! flag #f #t)       ; Release barrier

; Consumer
(let spin ()
  (unless (unbox flag)      ; Acquire barrier with CAS below
    (spin)))
; Now safe to read published-data

Safe publication patterns:

; Immutable data is always safe to share
; Once created, no synchronization needed

(define config (read-config-file))  ; Immutable after creation
; Any thread can read config safely

; For mutable data, use synchronization

; Pattern 1: Mutex-protected access
(define (make-safe-config)
  (let ([data #f]
        [mutex (make-mutex)])
    (lambda (msg . args)
      (with-mutex mutex
        (case msg
          [(get) data]
          [(set!) (set! data (car args))])))))

; Pattern 2: Atomic box for single value
(define config-box (box #f))

(define (update-config! new-config)
  (let loop ()
    (let ([old (unbox config-box)])
      (unless (box-cas! config-box old new-config)
        (loop)))))

; Pattern 3: Copy-on-write
(define config-cow (box '()))

(define (add-config-entry! key value)
  (let loop ()
    (let* ([old (unbox config-cow)]
           [new (cons (cons key value) old)])
      (unless (box-cas! config-cow old new)
        (loop)))))

; Readers never block - always see consistent snapshot
(define (get-config-entry key)
  (let ([cfg (unbox config-cow)])
    (cdr (assq key cfg))))

Memory consistency visualization:

Thread Parameters

Parameters are thread-local:

; Parameters have thread-local values
(define my-param (make-parameter 'default))

(my-param)                  ; 'default in main thread

; Each thread gets independent value
(fork-thread
  (lambda ()
    (my-param 'thread-value)
    (my-param)))            ; 'thread-value

(my-param)                  ; Still 'default in main thread

; parameterize is also thread-local
(fork-thread
  (lambda ()
    (parameterize ([my-param 'temporary])
      (my-param))))         ; 'temporary

; After thread exits, no effect on main thread

Parameter inheritance:

; New threads inherit parameter values from creating thread
(define config (make-parameter 'initial))

(config 'main-value)

(define t (fork-thread
            (lambda ()
              (config))))   ; Inherits 'main-value

(thread-join t)             ; Returns 'main-value

; Changes in child don't affect parent
(config 'main-value)

(define t2 (fork-thread
             (lambda ()
               (config 'child-value)
               (config))))  ; 'child-value

(thread-join t2)
(config)                    ; Still 'main-value

; Use for configuration
(parameterize ([config 'special])
  ; All threads forked here inherit 'special
  (fork-thread worker)
  (fork-thread worker))

Thread-specific storage pattern:

; Create thread-local storage explicitly
(define (make-thread-local init)
  (let ([storage (make-eq-hashtable)]
        [mutex (make-mutex)])
    (lambda msg
      (let ([tid (get-thread-id)])
        (case (and (pair? msg) (car msg))
          [(get)
           (with-mutex mutex
             (hashtable-ref storage tid init))]
          [(set!)
           (with-mutex mutex
             (hashtable-set! storage tid (cadr msg)))]
          [(delete!)
           (with-mutex mutex
             (hashtable-delete! storage tid))]
          [else
           ; No args = get
           (with-mutex mutex
             (hashtable-ref storage tid init))])))))

; Usage
(define thread-data (make-thread-local '()))

(fork-thread
  (lambda ()
    (thread-data 'set! '(a b c))
    (printf "Thread data: ~a~n" (thread-data))))

(thread-data)               ; '() in main thread

Common thread-affected parameters:

; These parameters are thread-local:

; I/O ports
(current-input-port)
(current-output-port)
(current-error-port)

; Each thread can have different I/O
(fork-thread
  (lambda ()
    (parameterize ([current-output-port (open-output-file "thread.log")])
      (display "Thread output")
      (close-port (current-output-port)))))

; Exception handling
(parameterize ([reset-handler (lambda () (exit 1))])
  (fork-thread dangerous-operation))

; Print parameters
(parameterize ([print-level 3]
               [print-length 10])
  (fork-thread
    (lambda ()
      (pretty-print deeply-nested-data))))

; Environment
(interaction-environment)   ; Thread-local

; Compilation parameters
(optimize-level)
(debug-level)

Thread parameter table:

Parameter	Thread Behavior	Notes
`current-input-port`	Thread-local	Each thread can have own input
`current-output-port`	Thread-local	Each thread can have own output
`current-error-port`	Thread-local	Each thread can have own error output
`reset-handler`	Thread-local	Thread-specific reset behavior
`print-level`	Thread-local	Affects thread's print output
`optimize-level`	Shared (compilation)	Affects all compilations
Custom parameters	Thread-local	All user parameters are thread-local

Buffered I/O

I/O and thread safety:

; Port operations are generally NOT thread-safe
; Concurrent writes to same port can interleave

; Problem: interleaved output
(define (worker id)
  (do ([i 0 (+ i 1)])
      ((= i 100))
    (printf "Worker ~a: iteration ~a~n" id i)))

; Running multiple workers - output will interleave badly
(for-each thread-join
  (map (lambda (id) (fork-thread (lambda () (worker id))))
       '(1 2 3 4)))

; Solution 1: Mutex around I/O
(define output-mutex (make-mutex))

(define (safe-printf fmt . args)
  (with-mutex output-mutex
    (apply printf fmt args)
    (flush-output-port (current-output-port))))

; Solution 2: Thread-local output buffers
(define (make-buffered-output)
  (let ([buffer (open-output-string)]
        [mutex (make-mutex)])
    (values
      ; Write to buffer
      (lambda (fmt . args)
        (apply fprintf buffer fmt args))
      ; Flush buffer to actual output
      (lambda ()
        (with-mutex output-mutex
          (display (get-output-string buffer))
          (flush-output-port (current-output-port)))))))

Buffering strategies:

; Per-thread buffering
(define (make-thread-buffer-manager)
  (let ([buffers (make-eq-hashtable)]
        [mutex (make-mutex)]
        [output-lock (make-mutex)])

    (define (get-buffer)
      (let ([tid (get-thread-id)])
        (with-mutex mutex
          (or (hashtable-ref buffers tid #f)
              (let ([buf (open-output-string)])
                (hashtable-set! buffers tid buf)
                buf)))))

    (define (write-to-buffer fmt . args)
      (apply fprintf (get-buffer) fmt args))

    (define (flush-buffer!)
      (let ([tid (get-thread-id)])
        (with-mutex mutex
          (let ([buf (hashtable-ref buffers tid #f)])
            (when buf
              (with-mutex output-lock
                (display (get-output-string buf))
                (flush-output-port (current-output-port)))
              ; Reset buffer
              (hashtable-set! buffers tid (open-output-string)))))))

    (define (flush-all!)
      (with-mutex mutex
        (with-mutex output-lock
          (vector-for-each
            (lambda (buf)
              (display (get-output-string buf)))
            (hashtable-values buffers))
          (flush-output-port (current-output-port)))))

    (values write-to-buffer flush-buffer! flush-all!)))

(define-values (tprintf tflush tflush-all)
  (make-thread-buffer-manager))

Log queue pattern:

; Dedicated logging thread with queue
(define (make-async-logger filename)
  (let ([queue (make-bounded-queue 1000)]
        [running (box #t)]
        [port #f])

    ; Logger thread
    (define logger-thread
      (fork-thread
        (lambda ()
          (set! port (open-output-file filename '(append)))
          (let loop ()
            (when (unbox running)
              (let ([msg (queue-dequeue-wait! queue
                           (make-time 'time-duration 0 1))])
                (when msg
                  (display msg port)
                  (newline port)))
              (loop)))
          (close-port port))))

    ; Log function (called from any thread)
    (define (log level msg . args)
      (let ([formatted (format "[~a] [~a] ~a"
                               (date->string (current-date) "~Y-~m-~d ~H:~M:~S")
                               level
                               (apply format msg args))])
        (queue-enqueue! queue formatted)))

    ; Shutdown
    (define (shutdown!)
      (set-box! running #f)
      (thread-join logger-thread))

    (values log shutdown!)))

(define-values (log shutdown-logger!)
  (make-async-logger "app.log"))

; Use from any thread
(log 'INFO "Application started")
(log 'DEBUG "Processing item ~a" item-id)
(log 'ERROR "Failed: ~a" error-message)

Flush and synchronization:

; Ensure output is visible
(define (synchronized-output port thunk)
  (with-mutex output-mutex
    (thunk)
    (flush-output-port port)))

; Write complete lines atomically
(define (write-line port line)
  (with-mutex output-mutex
    (display line port)
    (newline port)
    (flush-output-port port)))

; Batch output for efficiency
(define (write-batch port items)
  (with-mutex output-mutex
    (for-each
      (lambda (item)
        (write item port)
        (newline port))
      items)
    (flush-output-port port)))

; File I/O with locking
(define (safe-append-to-file filename data)
  (with-mutex file-mutex
    (call-with-output-file filename
      (lambda (port)
        (display data port)
        (newline port))
      '(append))))

Example: Bounded Queues

Basic bounded queue implementation:

; Thread-safe bounded queue with blocking operations
(define (make-bounded-queue capacity)
  (let ([items (make-vector capacity)]
        [head 0]
        [tail 0]
        [count 0]
        [mutex (make-mutex)]
        [not-empty (make-condition)]
        [not-full (make-condition)])

    ; Enqueue (blocking if full)
    (define (enqueue! item)
      (with-mutex mutex
        ; Wait while full
        (let loop ()
          (when (= count capacity)
            (condition-wait not-full mutex)
            (loop)))
        ; Add item
        (vector-set! items tail item)
        (set! tail (modulo (+ tail 1) capacity))
        (set! count (+ count 1))
        ; Signal not empty
        (condition-signal not-empty)))

    ; Dequeue (blocking if empty)
    (define (dequeue!)
      (with-mutex mutex
        ; Wait while empty
        (let loop ()
          (when (zero? count)
            (condition-wait not-empty mutex)
            (loop)))
        ; Remove item
        (let ([item (vector-ref items head)])
          (set! head (modulo (+ head 1) capacity))
          (set! count (- count 1))
          ; Signal not full
          (condition-signal not-full)
          item)))

    ; Non-blocking operations
    (define (try-enqueue! item)
      (with-mutex mutex
        (if (= count capacity)
            #f
            (begin
              (vector-set! items tail item)
              (set! tail (modulo (+ tail 1) capacity))
              (set! count (+ count 1))
              (condition-signal not-empty)
              #t))))

    (define (try-dequeue!)
      (with-mutex mutex
        (if (zero? count)
            (values #f #f)
            (let ([item (vector-ref items head)])
              (set! head (modulo (+ head 1) capacity))
              (set! count (- count 1))
              (condition-signal not-full)
              (values item #t)))))

    ; Query operations
    (define (size)
      (with-mutex mutex count))

    (define (empty?)
      (with-mutex mutex (zero? count)))

    (define (full?)
      (with-mutex mutex (= count capacity)))

    (lambda (msg . args)
      (case msg
        [(enqueue!) (enqueue! (car args))]
        [(dequeue!) (dequeue!)]
        [(try-enqueue!) (try-enqueue! (car args))]
        [(try-dequeue!) (try-dequeue!)]
        [(size) (size)]
        [(empty?) (empty?)]
        [(full?) (full?)]))))

Bounded queue with timeout:

; Extended bounded queue with timeout support
(define (make-bounded-queue/timeout capacity)
  (let ([items (make-vector capacity)]
        [head 0]
        [tail 0]
        [count 0]
        [mutex (make-mutex)]
        [not-empty (make-condition)]
        [not-full (make-condition)])

    ; Enqueue with timeout
    (define (enqueue-wait! item timeout)
      (let ([deadline (and timeout
                           (add-duration
                             (current-time 'time-utc)
                             (make-time 'time-duration 0 timeout)))])
        (with-mutex mutex
          (let loop ()
            (cond
              [(< count capacity)
               ; Space available - add item
               (vector-set! items tail item)
               (set! tail (modulo (+ tail 1) capacity))
               (set! count (+ count 1))
               (condition-signal not-empty)
               #t]
              [(and deadline
                    (time>=? (current-time 'time-utc) deadline))
               ; Timeout expired
               #f]
              [else
               ; Wait for space
               (if deadline
                   (condition-wait not-full mutex deadline)
                   (condition-wait not-full mutex))
               (loop)])))))

    ; Dequeue with timeout
    (define (dequeue-wait! timeout)
      (let ([deadline (and timeout
                           (add-duration
                             (current-time 'time-utc)
                             (make-time 'time-duration 0 timeout)))])
        (with-mutex mutex
          (let loop ()
            (cond
              [(> count 0)
               ; Item available
               (let ([item (vector-ref items head)])
                 (set! head (modulo (+ head 1) capacity))
                 (set! count (- count 1))
                 (condition-signal not-full)
                 (values item #t))]
              [(and deadline
                    (time>=? (current-time 'time-utc) deadline))
               ; Timeout
               (values #f #f)]
              [else
               ; Wait for item
               (if deadline
                   (condition-wait not-empty mutex deadline)
                   (condition-wait not-empty mutex))
               (loop)])))))

    (lambda (msg . args)
      (case msg
        [(enqueue!) (enqueue-wait! (car args) #f)]
        [(enqueue-wait!) (enqueue-wait! (car args) (cadr args))]
        [(dequeue!) (dequeue-wait! #f)]
        [(dequeue-wait!) (dequeue-wait! (car args))]
        [(size) (with-mutex mutex count)]
        [(empty?) (with-mutex mutex (zero? count))]))))

Producer-consumer example:

; Complete producer-consumer example
(define (producer-consumer-demo)
  (let ([queue (make-bounded-queue 10)]
        [items-produced 0]
        [items-consumed 0]
        [done (box #f)])

    ; Producer
    (define (producer id num-items)
      (fork-thread
        (lambda ()
          (do ([i 0 (+ i 1)])
              ((= i num-items))
            (let ([item (cons id i)])
              (queue 'enqueue! item)
              (printf "Producer ~a: produced ~a~n" id item)
              (sleep (make-time 'time-duration
                       (* (random 100) 1000000) 0))))
          (printf "Producer ~a: done~n" id))))

    ; Consumer
    (define (consumer id)
      (fork-thread
        (lambda ()
          (let loop ()
            (let-values ([(item found?)
                          (queue 'try-dequeue!)])
              (cond
                [found?
                 (printf "Consumer ~a: consumed ~a~n" id item)
                 (sleep (make-time 'time-duration
                          (* (random 50) 1000000) 0))
                 (loop)]
                [(not (unbox done))
                 ; No item but producers still running
                 (sleep (make-time 'time-duration 10000000 0))
                 (loop)]
                [else
                 (printf "Consumer ~a: done~n" id)]))))))

    ; Start workers
    (let ([producers (map (lambda (id) (producer id 20))
                          '(1 2 3))]
          [consumers (map consumer '(A B))])
      ; Wait for producers
      (for-each thread-join producers)
      (set-box! done #t)
      ; Wait for consumers
      (for-each thread-join consumers)
      (printf "All done! Queue empty: ~a~n" (queue 'empty?)))))

(producer-consumer-demo)

Bounded queue visualization:

Priority queue variant:

; Bounded priority queue (highest priority dequeued first)
(define (make-bounded-priority-queue capacity)
  (let ([heap (make-vector capacity)]
        [size 0]
        [mutex (make-mutex)]
        [not-empty (make-condition)]
        [not-full (make-condition)])

    ; Heap operations
    (define (parent i) (quotient (- i 1) 2))
    (define (left i) (+ (* 2 i) 1))
    (define (right i) (+ (* 2 i) 2))

    (define (swap! i j)
      (let ([tmp (vector-ref heap i)])
        (vector-set! heap i (vector-ref heap j))
        (vector-set! heap j tmp)))

    (define (priority item) (car item))
    (define (value item) (cdr item))

    (define (bubble-up! i)
      (when (and (> i 0)
                 (> (priority (vector-ref heap i))
                    (priority (vector-ref heap (parent i)))))
        (swap! i (parent i))
        (bubble-up! (parent i))))

    (define (bubble-down! i)
      (let ([l (left i)]
            [r (right i)]
            [largest i])
        (when (and (< l size)
                   (> (priority (vector-ref heap l))
                      (priority (vector-ref heap largest))))
          (set! largest l))
        (when (and (< r size)
                   (> (priority (vector-ref heap r))
                      (priority (vector-ref heap largest))))
          (set! largest r))
        (when (not (= largest i))
          (swap! i largest)
          (bubble-down! largest))))

    ; Enqueue with priority
    (define (enqueue! priority value)
      (with-mutex mutex
        (let loop ()
          (when (= size capacity)
            (condition-wait not-full mutex)
            (loop)))
        (vector-set! heap size (cons priority value))
        (set! size (+ size 1))
        (bubble-up! (- size 1))
        (condition-signal not-empty)))

    ; Dequeue highest priority
    (define (dequeue!)
      (with-mutex mutex
        (let loop ()
          (when (zero? size)
            (condition-wait not-empty mutex)
            (loop)))
        (let ([item (vector-ref heap 0)])
          (set! size (- size 1))
          (when (> size 0)
            (vector-set! heap 0 (vector-ref heap size))
            (bubble-down! 0))
          (condition-signal not-full)
          (value item))))

    (lambda (msg . args)
      (case msg
        [(enqueue!) (enqueue! (car args) (cadr args))]
        [(dequeue!) (dequeue!)]
        [(size) (with-mutex mutex size)]
        [(empty?) (with-mutex mutex (zero? size))]))))

; Usage
(define pq (make-bounded-priority-queue 100))
(pq 'enqueue! 1 "low priority")
(pq 'enqueue! 10 "high priority")
(pq 'enqueue! 5 "medium priority")

(pq 'dequeue!)              ; "high priority"
(pq 'dequeue!)              ; "medium priority"
(pq 'dequeue!)              ; "low priority"

Thread System Best Practices

General guidelines:

; 1. Minimize shared mutable state
; Prefer message passing or immutable data

; Bad: Shared mutable state
(define shared-list '())
(define (add-item! x)
  (set! shared-list (cons x shared-list)))  ; Race condition!

; Good: Message passing with queue
(define work-queue (make-bounded-queue 100))
(work-queue 'enqueue! item)

; 2. Always use proper synchronization
; Never access shared data without mutex

; 3. Hold locks for minimum time
; Bad: Long critical section
(with-mutex m
  (let ([data (read-from-database)])  ; Slow!
    (process data)))

; Good: Minimize locked time
(let ([data (read-from-database)])    ; Outside lock
  (with-mutex m
    (quick-update! data)))

; 4. Consistent lock ordering to prevent deadlock
(define lock-a (make-mutex 'a))
(define lock-b (make-mutex 'b))

; Always acquire in same order: a before b
(with-mutex lock-a
  (with-mutex lock-b
    (operation)))

; 5. Use higher-level abstractions when possible
; Bounded queues, thread pools, etc.

Error handling in threads:

; Threads should handle their own errors
(define (safe-fork-thread thunk)
  (fork-thread
    (lambda ()
      (guard (c
              [(serious-condition? c)
               (printf "Thread error: ~a~n" (condition-message c))
               #f]
              [else
               (printf "Thread warning: ~a~n" c)
               #f])
        (thunk)))))

; Supervisor pattern
(define (make-supervisor worker-thunk)
  (let ([running (box #t)]
        [worker #f])

    (define (start-worker!)
      (set! worker
        (fork-thread
          (lambda ()
            (guard (c [else
                       (printf "Worker crashed, restarting...~n")
                       (when (unbox running)
                         (start-worker!))])
              (worker-thunk))))))

    (define (stop!)
      (set-box! running #f))

    (start-worker!)
    stop!))

; Usage
(define stop-supervisor!
  (make-supervisor
    (lambda ()
      (let loop ()
        (do-work)
        (loop)))))

; Later:
(stop-supervisor!)

Thread pool implementation:

; Production-quality thread pool
(define (make-thread-pool num-workers)
  (let ([task-queue (make-bounded-queue 1000)]
        [workers '()]
        [running (box #t)]
        [completed (box 0)]
        [mutex (make-mutex)])

    ; Worker function
    (define (worker-loop id)
      (let loop ()
        (when (unbox running)
          (let-values ([(task found?)
                        (task-queue 'dequeue-wait! 1)])
            (when found?
              (guard (c [else
                         (printf "Worker ~a task error: ~a~n"
                                 id (condition-message c))])
                (task))
              (atomic-increment! completed)))
          (loop))))

    ; Start workers
    (set! workers
      (map (lambda (id)
             (fork-thread (lambda () (worker-loop id))))
           (iota num-workers)))

    ; Submit task
    (define (submit task)
      (unless (unbox running)
        (error 'thread-pool "pool is shut down"))
      (task-queue 'enqueue! task))

    ; Submit and wait for result
    (define (submit-wait task)
      (let ([result-box (box #f)]
            [done (box #f)]
            [cv (make-condition)]
            [m (make-mutex)])
        (submit
          (lambda ()
            (let ([result (task)])
              (with-mutex m
                (set-box! result-box result)
                (set-box! done #t)
                (condition-signal cv)))))
        (with-mutex m
          (let loop ()
            (unless (unbox done)
              (condition-wait cv m)
              (loop))))
        (unbox result-box)))

    ; Shutdown
    (define (shutdown!)
      (set-box! running #f)
      (for-each thread-join workers))

    ; Stats
    (define (stats)
      `((workers . ,num-workers)
        (pending . ,(task-queue 'size))
        (completed . ,(unbox completed))))

    (lambda (msg . args)
      (case msg
        [(submit) (submit (car args))]
        [(submit-wait) (submit-wait (car args))]
        [(shutdown!) (shutdown!)]
        [(stats) (stats)]))))

; Usage
(define pool (make-thread-pool 4))

(pool 'submit (lambda () (printf "Task 1~n")))
(pool 'submit (lambda () (printf "Task 2~n")))

(let ([result (pool 'submit-wait
                (lambda ()
                  (heavy-computation)
                  'done))])
  (printf "Result: ~a~n" result))

(pool 'stats)               ; Check pool status
(pool 'shutdown!)

Compatibility Features in Chez Scheme

Hash Tables

Legacy hash table overview:

; Chez Scheme provides two hash table APIs:
; 1. R6RS hashtables (recommended): make-eq-hashtable, etc.
; 2. Legacy hash tables (compatibility): make-hash-table, etc.

; The legacy API predates R6RS and uses different naming
; It remains for backward compatibility with older code

; Key differences:
; - Different procedure names
; - Different iteration interface
; - Some different semantics

; Recommendation: Use R6RS hashtables for new code
; Use legacy hash tables only for maintaining old code

Legacy hash table comparison:

Operation	R6RS Hashtable	Legacy Hash Table
Create (eq)	`(make-eq-hashtable)`	`(make-hash-table)`
Create (eqv)	`(make-eqv-hashtable)`	`(make-hash-table eqv?)`
Create (equal)	`(make-hashtable equal-hash equal?)`	`(make-hash-table equal?)`
Lookup	`(hashtable-ref ht key default)`	`(hash-table-ref ht key default)`
Insert	`(hashtable-set! ht key value)`	`(hash-table-set! ht key value)`
Delete	`(hashtable-delete! ht key)`	`(hash-table-delete! ht key)`
Contains	`(hashtable-contains? ht key)`	`(hash-table-contains? ht key)`
Size	`(hashtable-size ht)`	`(hash-table-size ht)`
Iterate	`(hashtable-for-each proc ht)`	`(hash-table-for-each ht proc)`

Creating legacy hash tables:

; Basic creation - uses eq? by default
(define ht (make-hash-table))

; Specify comparison function
(define ht-eqv (make-hash-table eqv?))
(define ht-equal (make-hash-table equal?))

; With initial size hint
(define ht-sized (make-hash-table eq? 1000))

; Weak hash tables (keys held weakly)
(define wht (make-hash-table eq? #t))  ; Weak keys

; Check if hash table
(hash-table? ht)            ; #t
(hash-table? '())           ; #f

; Note: Argument order differs from R6RS
; Legacy: (make-hash-table equiv? size weak?)
; R6RS:   (make-eq-hashtable size)

Legacy hash table operations:

; Insert/update
(hash-table-set! ht 'key1 'value1)
(hash-table-set! ht 'key2 'value2)
(hash-table-set! ht "string-key" "string-value")

; Lookup with default
(hash-table-ref ht 'key1 #f)         ; 'value1
(hash-table-ref ht 'missing #f)      ; #f
(hash-table-ref ht 'missing 'default) ; 'default

; Check existence
(hash-table-contains? ht 'key1)      ; #t
(hash-table-contains? ht 'missing)   ; #f

; Delete
(hash-table-delete! ht 'key1)
(hash-table-contains? ht 'key1)      ; #f

; Size
(hash-table-size ht)                 ; Number of entries

; Clear all entries
(hash-table-clear! ht)
(hash-table-size ht)                 ; 0

Iteration over legacy hash tables:

; hash-table-for-each - note argument order!
; Legacy: (hash-table-for-each ht proc)
; R6RS:   (hashtable-for-each proc ht)

(define ht (make-hash-table))
(hash-table-set! ht 'a 1)
(hash-table-set! ht 'b 2)
(hash-table-set! ht 'c 3)

; Iterate over all entries
(hash-table-for-each ht
  (lambda (key value)
    (printf "~a -> ~a~n" key value)))

; Map over hash table
(hash-table-map ht
  (lambda (key value)
    (cons key (* value 2))))
; Returns list: ((a . 2) (b . 4) (c . 6))

; Get keys and values as lists
(hash-table-keys ht)                 ; (a b c)
(hash-table-values ht)               ; (1 2 3)

; Fold over hash table
(hash-table-fold ht
  (lambda (key value acc)
    (+ acc value))
  0)                                 ; 6 (sum of values)

Legacy to R6RS migration:

; Converting code from legacy to R6RS hashtables

; Legacy code:
(define ht (make-hash-table equal?))
(hash-table-set! ht "key" "value")
(hash-table-ref ht "key" #f)
(hash-table-for-each ht
  (lambda (k v) (printf "~a: ~a~n" k v)))

; Equivalent R6RS code:
(define ht (make-hashtable string-hash equal?))
(hashtable-set! ht "key" "value")
(hashtable-ref ht "key" #f)
(let-values ([(keys vals) (hashtable-entries ht)])
  (vector-for-each
    (lambda (k v) (printf "~a: ~a~n" k v))
    keys vals))

; Wrapper for gradual migration
(define (legacy->r6rs-hashtable ht)
  (let ([new-ht (make-eq-hashtable)])
    (hash-table-for-each ht
      (lambda (k v)
        (hashtable-set! new-ht k v)))
    new-ht))

; Compatibility shim (use legacy API with R6RS table)
(define (make-compat-hash-table . args)
  (case (length args)
    [(0) (make-eq-hashtable)]
    [(1) (let ([equiv? (car args)])
           (cond
             [(eq? equiv? eq?) (make-eq-hashtable)]
             [(eq? equiv? eqv?) (make-eqv-hashtable)]
             [(eq? equiv? equal?)
              (make-hashtable equal-hash equal?)]
             [else (error 'make-hash-table
                          "unsupported" equiv?)]))]
    [else (apply make-eq-hashtable (cdr args))]))

Extend-Syntax Macros

Extend-syntax overview:

; extend-syntax is a legacy macro system
; Predates syntax-rules and syntax-case
; Pattern-based but with different syntax

; Key characteristics:
; - Uses with clause for auxiliary patterns
; - Different pattern matching syntax
; - Explicit quasiquote in templates
; - No hygiene guarantees (like defmacro)

; Recommendation: Use syntax-rules or syntax-case for new code
; extend-syntax exists for compatibility with old code

; extend-syntax must be loaded from compatibility file
; (load "compat.ss") or enable in configuration

Basic extend-syntax form:

; Basic extend-syntax structure
(extend-syntax (macro-name)
  [(pattern) template]
  [(pattern) template]
  ...)

; Example: simple when macro
(extend-syntax (when)
  [(when test body ...)
   (if test (begin body ...))])

; Example: unless macro
(extend-syntax (unless)
  [(unless test body ...)
   (if (not test) (begin body ...))])

; Example: swap macro
(extend-syntax (swap!)
  [(swap! a b)
   (let ([temp a])
     (set! a b)
     (set! b temp))])

; Usage
(when (> x 0)
  (display "positive")
  (newline))

(let ([a 1] [b 2])
  (swap! a b)
  (list a b))                ; (2 1)

Pattern matching in extend-syntax:

; Patterns use similar notation to syntax-rules
; but with some differences

; Literal matching
(extend-syntax (my-cond else)
  [(my-cond) #f]
  [(my-cond (else e ...))
   (begin e ...)]
  [(my-cond (test e ...) clause ...)
   (if test
       (begin e ...)
       (my-cond clause ...))])

; The second argument lists literal identifiers
; (my-cond else) - 'else' is a literal keyword

; Ellipsis matching
(extend-syntax (my-list)
  [(my-list) '()]
  [(my-list x) (cons x '())]
  [(my-list x y ...) (cons x (my-list y ...))])

(my-list 1 2 3 4)            ; (1 2 3 4)

; Nested patterns
(extend-syntax (my-let)
  [(my-let ([var val] ...) body ...)
   ((lambda (var ...) body ...) val ...)])

(my-let ([x 1] [y 2])
  (+ x y))                   ; 3

The with clause:

; 'with' allows auxiliary pattern matching
; Useful for generating temporary names

(extend-syntax (my-or)
  [(my-or) #f]
  [(my-or e) e]
  [(my-or e1 e2 ...)
   (with ([temp (gensym)])
     (let ([temp e1])
       (if temp temp (my-or e2 ...))))])

; 'with' binds pattern variables to computed values
; (gensym) generates unique symbol for hygiene

; More complex with usage
(extend-syntax (define-accessor)
  [(define-accessor name index)
   (with ([getter (string->symbol
                    (string-append
                      (symbol->string 'name)
                      "-ref"))]
          [setter (string->symbol
                    (string-append
                      (symbol->string 'name)
                      "-set!"))])
     (begin
       (define (getter vec) (vector-ref vec index))
       (define (setter vec val) (vector-set! vec index val))))])

(define-accessor x-coord 0)
(define-accessor y-coord 1)

(define point (vector 10 20))
(x-coord-ref point)          ; 10
(y-coord-set! point 15)

Comparison with syntax-rules:

Converting extend-syntax to syntax-rules:

; Original extend-syntax
(extend-syntax (old-when)
  [(old-when test body ...)
   (if test (begin body ...))])

; Equivalent syntax-rules
(define-syntax new-when
  (syntax-rules ()
    [(new-when test body ...)
     (if test (begin body ...))]))

; extend-syntax with 'with' clause
(extend-syntax (old-or)
  [(old-or) #f]
  [(old-or e) e]
  [(old-or e1 e2 ...)
   (with ([temp (gensym)])
     (let ([temp e1])
       (if temp temp (old-or e2 ...))))])

; Equivalent syntax-rules (hygiene automatic)
(define-syntax new-or
  (syntax-rules ()
    [(new-or) #f]
    [(new-or e) e]
    [(new-or e1 e2 ...)
     (let ([temp e1])        ; 'temp' is automatically fresh
       (if temp temp (new-or e2 ...)))]))

; extend-syntax with literals
(extend-syntax (old-case else)
  [(old-case val (else e ...))
   (begin e ...)]
  [(old-case val ((k ...) e ...) clause ...)
   (if (memv val '(k ...))
       (begin e ...)
       (old-case val clause ...))])

; Equivalent syntax-rules
(define-syntax new-case
  (syntax-rules (else)      ; Literals declared here
    [(new-case val (else e ...))
     (begin e ...)]
    [(new-case val ((k ...) e ...) clause ...)
     (if (memv val '(k ...))
         (begin e ...)
         (new-case val clause ...))]))

When to use extend-syntax:

; Use extend-syntax only when:
; 1. Maintaining legacy code that uses it
; 2. Porting old code that depends on it
; 3. extend-syntax-specific features are needed

; For new code, prefer:
; - syntax-rules for simple pattern macros
; - syntax-case for complex macros

; Loading extend-syntax support
; May need to load compatibility file first:
; (load (string-append (scheme-directory) "/compat.ss"))

; Or import from compatibility library if available
; (import (compat))

; Check if extend-syntax is available
(guard (c [else #f])
  (eval '(extend-syntax (test-macro)
           [(test-macro) #t])
        (interaction-environment))
  #t)  ; #t if available

Structures

Legacy structure overview:

; Chez Scheme has two record/structure systems:
; 1. R6RS records (recommended): define-record-type
; 2. Legacy structures (compatibility): define-structure

; Legacy structures are simpler but less powerful
; They predate the R6RS record system

; Key differences:
; - Simpler syntax
; - No inheritance
; - No opacity control
; - No custom constructors
; - No mutable/immutable field control

; Use define-record-type for new code
; Use define-structure for compatibility

Defining structures:

; Basic structure definition
(define-structure (point x y))

; This creates:
; - Constructor: (make-point x y)
; - Predicate: (point? obj)
; - Accessors: (point-x p), (point-y p)
; - Mutators: (set-point-x! p val), (set-point-y! p val)

; Usage
(define p (make-point 10 20))
(point? p)                   ; #t
(point-x p)                  ; 10
(point-y p)                  ; 20
(set-point-x! p 15)
(point-x p)                  ; 15

; Structure with more fields
(define-structure (person name age address))

(define john (make-person "John" 30 "123 Main St"))
(person-name john)           ; "John"
(person-age john)            ; 30
(set-person-age! john 31)    ; Birthday!

Structure comparison with R6RS records:

Feature	define-structure	define-record-type
Syntax	Simple, compact	Verbose, explicit
Inheritance	No	Yes (parent clause)
Immutable fields	No (all mutable)	Yes (immutable keyword)
Opacity	No control	opaque/sealed/nongenerative
Custom constructor	No	Yes (protocol)
Named accessors	Auto-generated	User-specified
Portability	Chez-specific	R6RS standard

Advanced structure features:

; Structure with initialization
(define-structure (counter value)
  ([value 0]))               ; Default value

(define c (make-counter))    ; Uses default
(counter-value c)            ; 0

(define c2 (make-counter 10))
(counter-value c2)           ; 10

; Nested structures
(define-structure (rectangle top-left bottom-right))

(define rect (make-rectangle
               (make-point 0 0)
               (make-point 100 50)))

(point-x (rectangle-top-left rect))     ; 0
(point-y (rectangle-bottom-right rect)) ; 50

; Structure identity
(define p1 (make-point 1 2))
(define p2 (make-point 1 2))
(eq? p1 p1)                  ; #t
(eq? p1 p2)                  ; #f (different instances)
(equal? p1 p2)               ; May be #t (implementation-dependent)

Converting structures to records:

; Original define-structure
(define-structure (point x y))

; Equivalent define-record-type
(define-record-type point
  (fields
    (mutable x)
    (mutable y)))

; With custom names
(define-record-type point
  (fields
    (mutable x point-x set-point-x!)
    (mutable y point-y set-point-y!))
  (protocol
    (lambda (new)
      (lambda (x y)
        (new x y)))))

; Structure with defaults
(define-structure (config host port timeout)
  ([host "localhost"]
   [port 8080]
   [timeout 30]))

; Equivalent record with protocol
(define-record-type config
  (fields
    (mutable host)
    (mutable port)
    (mutable timeout))
  (protocol
    (lambda (new)
      (case-lambda
        [() (new "localhost" 8080 30)]
        [(host) (new host 8080 30)]
        [(host port) (new host port 30)]
        [(host port timeout) (new host port timeout)]))))

; Migration helper
(define-syntax define-compat-structure
  (syntax-rules ()
    [(_ (name field ...))
     (define-record-type name
       (fields (mutable field) ...))]))

Structure visualization:

Structure inspection:

; Structures can be inspected at runtime

(define-structure (point x y))
(define p (make-point 10 20))

; Structure type descriptor (implementation-specific)
; May not be directly accessible

; Printing structures
; Default print may show internals:
p                           ; #[point x: 10 y: 20] or similar

; Custom print can be set up if needed
; (record-writer (type-descriptor point)
;   (lambda (r p wr)
;     (fprintf p "#<point ~a,~a>" (point-x r) (point-y r))))

; Copying structures
(define (copy-point p)
  (make-point (point-x p) (point-y p)))

; Comparing structures
(define (point=? p1 p2)
  (and (= (point-x p1) (point-x p2))
       (= (point-y p1) (point-y p2))))

; Convert to list
(define (point->list p)
  (list (point-x p) (point-y p)))

; Create from list
(define (list->point lst)
  (apply make-point lst))

Compatibility File

Loading compatibility features:

; Chez Scheme provides a compatibility file
; Contains legacy features not in the default environment

; Find the compatibility file
(define compat-file
  (string-append (scheme-directory) "/compat.ss"))

; Load compatibility features
(load compat-file)

; Or specify full path if scheme-directory not set
(load "/usr/lib/csv9.5/compat.ss")  ; Path varies

; After loading, legacy features are available:
; - extend-syntax
; - define-structure
; - Legacy hash tables
; - Other compatibility procedures

; Check what's loaded
(guard (c [else #f])
  (extend-syntax (test) [(test) #t])
  'extend-syntax-available)

Compatibility file contents:

; The compatibility file typically includes:

; 1. extend-syntax macro system
(extend-syntax (name literals ...)
  [(pattern) template]
  ...)

; 2. define-structure for legacy records
(define-structure (name field ...)
  ([field default] ...))

; 3. Legacy hash table procedures
make-hash-table
hash-table-ref
hash-table-set!
hash-table-delete!
hash-table-for-each
; etc.

; 4. Legacy I/O procedures
; (if not already in base)

; 5. Legacy string procedures
; format variations, etc.

; 6. Other deprecated but useful forms

; The exact contents depend on Chez Scheme version
; Check the actual file for complete list

Creating your own compatibility layer:

; Custom compatibility library for project migration

(library (my-project compat)
  (export
    ; Re-export needed legacy features
    define-structure
    make-hash-table
    hash-table-ref
    hash-table-set!
    hash-table-delete!
    hash-table-for-each
    ; Add shims
    when unless
    push! pop!)
  (import
    (chezscheme)
    (only (compat) define-structure))  ; If available as library

  ; Or load directly
  ; (include "compat.ss")

  ; Legacy-style push!/pop! macros
  (define-syntax push!
    (syntax-rules ()
      [(_ item lst)
       (set! lst (cons item lst))]))

  (define-syntax pop!
    (syntax-rules ()
      [(_ lst)
       (let ([item (car lst)])
         (set! lst (cdr lst))
         item)]))

  ; Hash table compatibility shims using R6RS
  (define (make-hash-table . args)
    (case (length args)
      [(0) (make-eq-hashtable)]
      [(1) (let ([equiv? (car args)])
             (cond
               [(eq? equiv? eq?) (make-eq-hashtable)]
               [(eq? equiv? eqv?) (make-eqv-hashtable)]
               [else (make-hashtable equal-hash equal?)]))]
      [else (make-eq-hashtable)]))

  (define (hash-table-ref ht key default)
    (hashtable-ref ht key default))

  (define (hash-table-set! ht key value)
    (hashtable-set! ht key value))

  (define (hash-table-delete! ht key)
    (hashtable-delete! ht key))

  (define (hash-table-for-each ht proc)
    (let-values ([(keys vals) (hashtable-entries ht)])
      (vector-for-each proc keys vals))))

Version-specific compatibility:

; Handle differences between Chez Scheme versions

(define chez-version
  (let ([v (scheme-version)])
    (string->number
      (substring v 0 (string-index v #\.)))))

; Conditional definitions based on version
(meta-cond
  [(>= chez-version 9)
   ; Version 9+ features
   (define new-feature available)]
  [else
   ; Fallback for older versions
   (define new-feature
     (lambda args
       (error 'new-feature "not available")))])

; Feature detection instead of version checking
(define has-feature-x?
  (guard (c [else #f])
    (eval 'feature-x (scheme-environment))
    #t))

; Graceful degradation
(define (maybe-use-feature x)
  (if has-feature-x?
      (feature-x x)
      (fallback-implementation x)))

; Loading compatibility based on detected features
(unless (guard (c [else #f])
          (eval 'extend-syntax (interaction-environment)))
  (load (string-append (scheme-directory) "/compat.ss")))

Migration strategies:

Complete compatibility wrapper:

; Comprehensive compatibility wrapper library
(library (compat-wrapper)
  (export
    ; Structure compatibility
    define-structure

    ; Hash table compatibility
    make-hash-table
    hash-table?
    hash-table-ref
    hash-table-set!
    hash-table-delete!
    hash-table-contains?
    hash-table-size
    hash-table-clear!
    hash-table-keys
    hash-table-values
    hash-table-for-each
    hash-table-map
    hash-table-fold

    ; Other legacy forms
    when unless
    rec
    fluid-let)
  (import (chezscheme))

  ;; ============ Structure Compatibility ============

  ; If define-structure not built-in, implement it
  (define-syntax define-structure
    (lambda (x)
      (syntax-case x ()
        [(_ (name field ...))
         (with-syntax ([(accessor ...)
                        (map (lambda (f)
                               (datum->syntax #'name
                                 (string->symbol
                                   (format "~a-~a"
                                           (syntax->datum #'name)
                                           (syntax->datum f)))))
                             #'(field ...))]
                       [(mutator ...)
                        (map (lambda (f)
                               (datum->syntax #'name
                                 (string->symbol
                                   (format "set-~a-~a!"
                                           (syntax->datum #'name)
                                           (syntax->datum f)))))
                             #'(field ...))])
           #'(define-record-type name
               (fields (mutable field accessor mutator) ...)))])))

  ;; ============ Hash Table Compatibility ============

  (define-record-type compat-hash-table
    (fields ht equiv?))

  (define (make-hash-table . args)
    (let ([equiv? (if (null? args) eq? (car args))])
      (make-compat-hash-table
        (cond
          [(eq? equiv? eq?) (make-eq-hashtable)]
          [(eq? equiv? eqv?) (make-eqv-hashtable)]
          [(eq? equiv? equal?) (make-hashtable equal-hash equal?)]
          [(eq? equiv? string=?) (make-hashtable string-hash string=?)]
          [else (make-hashtable equal-hash equal?)])
        equiv?)))

  (define (hash-table? x)
    (compat-hash-table? x))

  (define (hash-table-ref ht key default)
    (hashtable-ref (compat-hash-table-ht ht) key default))

  (define (hash-table-set! ht key value)
    (hashtable-set! (compat-hash-table-ht ht) key value))

  (define (hash-table-delete! ht key)
    (hashtable-delete! (compat-hash-table-ht ht) key))

  (define (hash-table-contains? ht key)
    (hashtable-contains? (compat-hash-table-ht ht) key))

  (define (hash-table-size ht)
    (hashtable-size (compat-hash-table-ht ht)))

  (define (hash-table-clear! ht)
    (hashtable-clear! (compat-hash-table-ht ht)))

  (define (hash-table-keys ht)
    (vector->list (hashtable-keys (compat-hash-table-ht ht))))

  (define (hash-table-values ht)
    (let-values ([(keys vals)
                  (hashtable-entries (compat-hash-table-ht ht))])
      (vector->list vals)))

  (define (hash-table-for-each ht proc)
    (let-values ([(keys vals)
                  (hashtable-entries (compat-hash-table-ht ht))])
      (vector-for-each proc keys vals)))

  (define (hash-table-map ht proc)
    (let-values ([(keys vals)
                  (hashtable-entries (compat-hash-table-ht ht))])
      (let ([result '()])
        (vector-for-each
          (lambda (k v)
            (set! result (cons (proc k v) result)))
          keys vals)
        (reverse result))))

  (define (hash-table-fold ht proc init)
    (let-values ([(keys vals)
                  (hashtable-entries (compat-hash-table-ht ht))])
      (let ([acc init])
        (vector-for-each
          (lambda (k v)
            (set! acc (proc k v acc)))
          keys vals)
        acc)))

  ;; ============ Other Legacy Forms ============

  ; when/unless (already in Chez, but ensure available)
  (define-syntax when
    (syntax-rules ()
      [(_ test body ...)
       (if test (begin body ...))]))

  (define-syntax unless
    (syntax-rules ()
      [(_ test body ...)
       (if (not test) (begin body ...))]))

  ; rec - recursive definition shorthand
  (define-syntax rec
    (syntax-rules ()
      [(_ name expr)
       (letrec ([name expr]) name)]))

  ; fluid-let - dynamic binding (non-parameter version)
  (define-syntax fluid-let
    (syntax-rules ()
      [(_ ([var val] ...) body ...)
       (let ([old-var var] ...)
         (dynamic-wind
           (lambda () (set! var val) ...)
           (lambda () body ...)
           (lambda () (set! var old-var) ...)))]))
)

Startup file configuration:

; ~/.schemerc - Automatic compatibility setup

; Detect if running in compatibility mode
(define *compat-mode*
  (getenv "CHEZ_COMPAT_MODE"))

; Load compatibility features if needed
(when *compat-mode*
  (let ([compat-file (string-append (scheme-directory) "/compat.ss")])
    (when (file-exists? compat-file)
      (load compat-file)
      (printf "; Compatibility mode enabled~n"))))

; Or always load specific compatibility features
(define (ensure-compat-features)
  ; Check for extend-syntax
  (unless (guard (c [else #f])
            (eval 'extend-syntax (interaction-environment))
            #t)
    (let ([compat (string-append (scheme-directory) "/compat.ss")])
      (when (file-exists? compat)
        (load compat))))

  ; Add any shims needed
  (unless (top-level-bound? 'hash-table-for-each)
    ; Define compatibility shim
    (eval
      '(define (hash-table-for-each ht proc)
         (let-values ([(k v) (hashtable-entries ht)])
           (vector-for-each proc k v)))
      (interaction-environment))))

; Conditional compatibility based on code being loaded
(define (load-with-compat filename)
  (parameterize ([source-directories
                  (cons (path-directory filename)
                        (source-directories))])
    ; Check file for compatibility markers
    (when (file-uses-legacy-features? filename)
      (ensure-compat-features))
    (load filename)))

(define (file-uses-legacy-features? filename)
  (call-with-input-file filename
    (lambda (port)
      (let loop ()
        (let ([line (get-line port)])
          (cond
            [(eof-object? line) #f]
            [(or (string-contains line "extend-syntax")
                 (string-contains line "define-structure")
                 (string-contains line "make-hash-table"))
             #t]
            [else (loop)]))))))

File Conventions in Chez Scheme

Scheme File Extensions

Common file extensions used across Scheme implementations:

Extension	Common Usage	Notes
`.scm`	Generic Scheme	Used by MIT Scheme, Guile, Chicken, Gambit, and others
`.ss`	Chez Scheme, PLT Scheme	Historical convention; PLT Scheme is now Racket
`.sls`	R6RS library source	Used by Chez, Ikarus, Vicare for libraries
`.sps`	R6RS program source	Top-level R6RS programs
`.rkt`	Racket-specific	Not compatible with other Schemes
`.so`	Compiled Chez object	Chez Scheme compiled output

File extensions do NOT determine implementation compatibility:

; A .scm file might contain:

; MIT Scheme specific code
(declare (usual-integrations))        ; MIT Scheme only

; Guile specific code
(use-modules (ice-9 match))           ; Guile only

; Chicken specific code
(require-extension srfi-1)            ; Chicken only

; Chez Scheme specific code
(import (chezscheme))                 ; Chez only

; The extension doesn't tell you which!
; The CODE INSIDE determines compatibility

Extensions accepted by Chez Scheme:

; Chez Scheme will load any of these:
(load "mycode.scm")         ; Generic extension
(load "mycode.ss")          ; Traditional Chez extension
(load "mycode.sls")         ; R6RS library
(load "mycode.sps")         ; R6RS program
(load "mycode.txt")         ; Even arbitrary extensions!

; For compilation:
(compile-file "source.ss")  ; Produces source.so
(compile-file "source.scm") ; Produces source.so

; Library file lookup considers extensions
(library-extensions)        ; Shows configured extensions
; Default: ((".chezscheme.sls" . ".chezscheme.so")
;           (".ss" . ".so")
;           (".sls" . ".so")
;           (".scm" . ".so"))

Identifying Chez Scheme Files

The (import (chezscheme)) convention:

; Best practice: use (import (chezscheme)) at the top
(import (chezscheme))

; This serves multiple purposes:
; 1. Fails immediately on other implementations
; 2. Self-documents the requirement
; 3. Provides full Chez functionality

(printf "Running on Chez Scheme ~a~n" (scheme-version))
(format #t "Platform: ~a~n" (machine-type))

Why this works as an identifier:

Alternative identification methods:

; Method 1: Shebang for executable scripts
#!/usr/bin/env scheme-script
(import (chezscheme))
(display "Hello from Chez!\n")

; Method 2: Editor mode line (Emacs style)
; -*- mode: scheme; scheme-implementation: chez -*-
(import (chezscheme))
...

; Method 3: Vim modeline
; vim: set ft=scheme:
(import (chezscheme))
...

; Method 4: Comment header
;;;; myprogram.ss
;;;; Requires: Chez Scheme 9.5+
;;;;
(import (chezscheme))
...

Comparison of identification approaches:

Method	Machine Readable	Self-Enforcing	Portable Syntax
`(import (chezscheme))`	Yes	Yes (fails on others)	Yes (R6RS import)
Shebang	Yes (Unix)	Yes (execution)	No (Unix only)
Editor mode line	By editors only	No	Yes (comment)
Comment header	No	No	Yes (comment)
File extension (.ss)	No	No	N/A

R6RS Library and Program Files

R6RS library file structure (.sls):

; File: my-utils.sls
(library (my-utils)
  (export
    string-join
    string-repeat
    println)
  (import (chezscheme))

  (define (string-join lst sep)
    (if (null? lst)
        ""
        (fold-left
          (lambda (acc s) (string-append acc sep s))
          (car lst)
          (cdr lst))))

  (define (string-repeat s n)
    (apply string-append (make-list n s)))

  (define (println . args)
    (for-each display args)
    (newline)))

; The (import (chezscheme)) marks this as Chez-specific
; Other implementations will fail to load it

R6RS program file structure (.sps):

; File: main.sps
#!/usr/bin/env scheme-script
(import
  (chezscheme)
  (my-utils))

(println "Starting program...")
(println "Repeated: " (string-repeat "ab" 3))
(println "Joined: " (string-join '("a" "b" "c") ", "))

; Run with: scheme-script main.sps
; Or: scheme --script main.sps

Portable vs Chez-specific imports:

; Fully portable R6RS (works on Chez, Ikarus, Vicare, etc.)
(import (rnrs))

; Chez-specific (only works on Chez)
(import (chezscheme))

; Mixed: portable base with Chez extensions
(import
  (rnrs)
  (only (chezscheme) printf format pretty-print))

; Conditional for multiple implementations (advanced)
; Requires implementation-specific setup
(library (my-compat)
  (export println)
  (import (rnrs))

  ; Define portable fallback
  (define (println . args)
    (for-each display args)
    (newline)))

Library path visualization:

Executable Scripts

Creating executable Chez Scheme scripts:

#!/usr/bin/env scheme-script
; File: greet.ss
; Make executable: chmod +x greet.ss
; Run: ./greet.ss Alice Bob

(import (chezscheme))

(define (main args)
  (if (null? args)
      (printf "Usage: greet.ss <name> ...~n")
      (for-each
        (lambda (name)
          (printf "Hello, ~a!~n" name))
        args)))

; command-line returns: (script-name arg1 arg2 ...)
(main (cdr (command-line)))

Alternative shebang approaches:

; Using scheme-script (recommended)
#!/usr/bin/env scheme-script

; Using scheme with --script
#!/usr/bin/env -S scheme --script

; Using scheme with --program (R6RS program mode)
#!/usr/bin/env -S scheme --program

; Direct path (less portable)
#!/usr/local/bin/scheme-script

; Using petite (interpreter only, no compiler)
#!/usr/bin/env petite
(suppress-greeting #t)

Script vs program vs library:

Type	Extension	Shebang	Structure
Script	`.ss`, `.scm`	Optional	Top-level expressions
R6RS Program	`.sps`	Recommended	`(import ...) body...`
R6RS Library	`.sls`	No	`(library ...)` form
REPL Session	N/A	No	Interactive expressions

Compiled scripts for faster startup:

; Compile a script for faster execution
(compile-file "myscript.ss")     ; Creates myscript.so

; Load compiled version (much faster startup)
(load "myscript.so")

; Compile a whole program
(compile-program "main.sps")     ; Creates main.so

; Compile a library
(compile-library "mylib.sls")    ; Creates mylib.so

; For deployment: compile everything
(compile-whole-program "main.wpo" "main.sps")

; Run compiled program directly
; $ scheme --program main.so

Project Organization

Recommended project structure:

my-project/
├── README.md
├── main.sps                 ; Entry point (R6RS program)
├── lib/                     ; Project libraries
│   ├── my-project/
│   │   ├── core.sls         ; (my-project core)
│   │   ├── utils.sls        ; (my-project utils)
│   │   └── io.sls           ; (my-project io)
│   └── vendor/              ; Third-party libraries
│       └── json/
│           └── parse.sls    ; (vendor json parse)
├── test/
│   └── test-core.sps        ; Test program
├── bin/
│   └── run.ss               ; Executable script
└── compiled/                ; Compiled .so files
    └── ...

Setting up library paths:

; In main.sps or a setup script
(library-directories
  (cons "lib" (library-directories)))

; Or from command line
; $ scheme --libdirs lib:vendor main.sps

; In ~/.schemerc for global configuration
(library-directories
  (append '("~/scheme/lib" "~/projects/common")
          (library-directories)))

; Check current library directories
(printf "Library paths: ~s~n" (library-directories))

Startup file (~/.schemerc):

; ~/.schemerc - Loaded automatically by Chez Scheme

; Add personal library directories
(library-directories
  (cons (string-append (getenv "HOME") "/scheme/lib")
        (library-directories)))

; Configure source directories
(source-directories
  (cons "." (source-directories)))

; Personal preferences
(print-level 5)
(print-length 20)
(pretty-maximum-lines 50)

; Custom REPL helpers
(define (reload file)
  (printf "Reloading ~a...~n" file)
  (load file))

(define (cls)
  (system "clear"))

; Greeting (optional)
(printf "; Chez Scheme ~a on ~a~n"
        (scheme-version)
        (machine-type))

Summary of file conventions: