From 66977049f158bad2b8b07300b24e35930af0c0f2 Mon Sep 17 00:00:00 2001
From: "russell@unturf.com" <russell@unturf.com>
Date: Mon, 13 Apr 2026 12:27:06 -0400
Subject: [PATCH] Add string ports, error objects, rationals, modules, record
 inheritance, pretty-print
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Core additions:
- StringInputPort / StringOutputPort — open-input-string, open-output-string,
  get-output-string, read/read-char/peek-char/read-line on ports
- R7RS ErrorObject class — error-object?, error-object-message,
  error-object-irritants; guard and with-exception-handler now receive
  ErrorObject instances instead of raw strings
- Exact rational arithmetic via Fraction — (/ 1 3) => 1/3, literal 1/3
  syntax, numerator/denominator, exact/inexact conversions
- Module system — (module name (export ...) body...) and (import name) /
  (import (name sym ...)) for selective import
- define-record-type now a Python special form supporting (inherit parent)
  for single-inheritance with subtype predicates
- Pretty-printer — pp/pretty-print with configurable line width

Correctness:
- R7RS letrec* body semantics for internal defines — names pre-declared
  before any initializer runs, enabling mutual recursion in let bodies
- string->number detects #x/#b/#o/#d and 0x/0b/0o prefixes
- show() guarantees decimal point in float output
- number->string rounds through show() for consistent float representation

Performance:
- _body_env fast path: skip scan when first body form is not define/begin
- Proc.has_defs flag: skip _body_env entirely for procs without internal defines
- Single-form body optimization: skip begin wrapper, set expr directly

Tests: 396 → 455 (+59 new tests covering all new features)
---
 README.md       |  22 ++-
 tests.py        | 394 ++++++++++++++++++++++++++++++++++++++
 uncommonlisp.py | 498 +++++++++++++++++++++++++++++++++++++++---------
 3 files changed, 821 insertions(+), 93 deletions(-)

diff --git a/README.md b/README.md
index cf0a03f..19b42c5 100644
--- a/README.md
+++ b/README.md
@@ -29,6 +29,12 @@ python3 uncommonlisp.py -e '(+ 1 2)' # eval an expression
 - `values` / `call-with-values`
 - `dynamic-wind`, `guard`, `with-exception-handler`
 - `quasiquote` / `unquote` / `unquote-splicing` with proper nesting
+- R7RS internal defines → letrec* body semantics (mutual recursion in bodies)
+- R7RS error objects — `error-object?` `error-object-message` `error-object-irritants`
+- Exact rational arithmetic via `Fraction` — `(/ 1 3)` → `1/3`, `(+ 1/4 3/4)` → `1`
+- String ports — `open-input-string` `open-output-string` `get-output-string` `read` on ports
+- Module system — `module` / `import` with explicit export lists
+- `define-record-type` with `(inherit parent)` for single-inheritance
 
 **Special forms**
 `define` `set!` `lambda` `λ` `if` `cond` `case` `and` `or` `when` `unless`
@@ -36,24 +42,28 @@ python3 uncommonlisp.py -e '(+ 1 2)' # eval an expression
 `quasiquote` `define-macro` `define-syntax` `syntax-rules`
 `let-syntax` `letrec-syntax` `apply` `eval` `values` `call/cc`
 `dynamic-wind` `guard` `parameterize` `load` `error`
+`module` `import` `define-record-type`
 
 **Built-ins**
-- Arithmetic: `+` `-` `*` `/` `quotient` `remainder` `modulo` `expt` `sqrt` `abs` `floor` `ceiling` `round` `truncate` `min` `max` `gcd` `lcm` `log` `exp` `sin` `cos` `tan` `atan` and more
+- Arithmetic: `+` `-` `*` `/` `quotient` `remainder` `modulo` `expt` `sqrt` `abs` `floor` `ceiling` `round` `truncate` `min` `max` `gcd` `lcm` `log` `exp` `sin` `cos` `tan` `atan` `numerator` `denominator` and more
+- Rationals: `(/ 1 3)` → `1/3`, literal `1/3` syntax, exact arithmetic, `exact` / `inexact` conversion
 - Comparison: `=` `<` `>` `<=` `>=` `zero?` `positive?` `negative?` `odd?` `even?`
 - Booleans: `not` `boolean?` `boolean=?`
 - Equality: `eq?` `eqv?` `equal?`
 - Pairs & lists: `cons` `car` `cdr` `set-car!` `set-cdr!` `list` `list*` `length` `append` `reverse` `list-ref` `list-tail` `memq` `memv` `member` `assq` `assv` `assoc` `iota` `map` `for-each` `filter` `fold-left` `fold-right` `reduce` `any` `every` `count` `flat-map` `sort` `sort-by` `partition` `find` `take` `drop` `take-while` `drop-while` `take-right` `drop-right` `zip` `flatten` `concatenate` `list-tabulate` `unfold` and more
 - SRFI-1: `last` `first`–`fifth` `delete` `lset-union` `lset-intersection` `lset-difference` `proper-list?` `dotted-list?`
-- Strings: `string-length` `string-ref` `substring` `string-append` `string-upcase` `string-downcase` `string->list` `list->string` `string->symbol` `symbol->string` `string->number` `number->string` `string-contains` `string-split` `string-join` `string-trim` `string-replace` `format` and more
+- Strings: `string-length` `string-ref` `substring` `string-append` `string-upcase` `string-downcase` `string->list` `list->string` `string->symbol` `symbol->string` `string->number` (with `#x`/`0x`/`#b`/`#o` prefix detection) `number->string` `string-contains` `string-split` `string-join` `string-trim` `string-replace` `format` and more
 - Characters: `char->integer` `integer->char` `char-alphabetic?` `char-numeric?` `char-upcase` `char-downcase`
 - Vectors: `make-vector` `vector` `vector-ref` `vector-set!` `vector->list` `list->vector`
 - Hash tables: `make-hash-table` `hash-table-set!` `hash-table-ref` `hash-table-ref/default` `hash-table-delete!` `hash-table-exists?` `hash-table-keys` `hash-table-values` `hash-table->alist` `hash-table-walk` and more
-- Type predicates: `number?` `integer?` `real?` `string?` `symbol?` `pair?` `null?` `list?` `char?` `vector?` `boolean?` `procedure?` `exact?` `inexact?`
-- I/O: `display` `write` `newline` `read` `read-line` `load` `with-output-to-string`
+- Type predicates: `number?` `integer?` `real?` `rational?` `string?` `symbol?` `pair?` `null?` `list?` `char?` `vector?` `boolean?` `procedure?` `exact?` `inexact?`
+- I/O: `display` `write` `newline` `read` `read-char` `peek-char` `read-line` `load` `with-output-to-string` `open-input-string` `open-output-string` `get-output-string`
+- Error objects: `error-object?` `error-object-message` `error-object-irritants`
+- Pretty-print: `pp` / `pretty-print` — indented output respecting line width
 - Python interop: `py-eval` `py-exec` `py-import` `py-call` `py-attr`
 
 **Prelude** (loaded automatically)
-`when` `unless` `case` `while` `for` `define-record-type` `1+` `1-` `add1` `sub1` `square` `cube` `compose` `atom?` `range` `flatten` `string-map` `string-for-each`
+`when` `unless` `case` `while` `for` `define-record-type` (with inheritance) `1+` `1-` `add1` `sub1` `square` `cube` `compose` `atom?` `range` `flatten` `string-map` `string-for-each` `call-with-string-output-port`
 
 **Standard library** (`stdlib.lsp`, load explicitly)
 Syntax-rules versions of `let`/`and`/`or`/`cond`/`case`/`do`, `fluid-let`, `receive` (SRFI-8), `begin0`, `while`/`until`, `dotimes`/`dolist`, `push!`/`pop!`, `and-let*` (SRFI-2), string utilities, list utilities (`sum` `product` `maximum` `minimum` `average` `enumerate` `transpose` `chunks` `interleave`), numeric utilities (`factorial` `fib` `prime?` `primes-up-to` `clamp`), alist/hash utilities, tree utilities, simple object system, coroutines via `call/cc`
@@ -119,7 +129,7 @@ Syntax-rules versions of `let`/`and`/`or`/`cond`/`case`/`do`, `fluid-let`, `rece
 ## Running tests
 
 ```bash
-make test          # run 396 tests
+make test          # run 455 tests
 make test-verbose  # verbose output
 ```
 
diff --git a/tests.py b/tests.py
index 168d61a..db1978d 100644
--- a/tests.py
+++ b/tests.py
@@ -1635,6 +1635,400 @@ class TestEdgeCases(unittest.TestCase):
         assert r == '(1 "two" three #t #f)'
 
 
+###############################################################################
+# String ports
+###############################################################################
+
+class TestStringPorts(unittest.TestCase):
+    def setUp(self): self.g = fresh()
+
+    def test_open_output_string_display(self):
+        r = run('(let ((p (open-output-string))) (display "hello" p) (get-output-string p))', self.g)
+        assert r == 'hello'
+
+    def test_open_output_string_write(self):
+        r = run('(let ((p (open-output-string))) (write "hello" p) (get-output-string p))', self.g)
+        assert r == '"hello"'
+
+    def test_open_output_string_multiple(self):
+        r = run('(let ((p (open-output-string))) (display 1 p) (display 2 p) (display 3 p) (get-output-string p))', self.g)
+        assert r == '123'
+
+    def test_open_input_string_read(self):
+        r = run('(let ((p (open-input-string "(+ 1 2)"))) (read p))', self.g)
+        assert runs('(let ((p (open-input-string "(+ 1 2)"))) (read p))', self.g) == '(+ 1 2)'
+
+    def test_open_input_string_read_multiple(self):
+        r = runs('(let ((p (open-input-string "1 2 3"))) (list (read p) (read p) (read p)))', self.g)
+        assert r == '(1 2 3)'
+
+    def test_open_input_string_eof(self):
+        r = run('(let ((p (open-input-string ""))) (read p))', self.g)
+        from uncommonlisp import EOF
+        assert r is EOF
+
+    def test_open_input_string_read_char(self):
+        r = run('(let ((p (open-input-string "abc"))) (read-char p))', self.g)
+        assert r == 'a'
+
+    def test_open_input_string_peek_char(self):
+        r = run('(let ((p (open-input-string "abc"))) (list (peek-char p) (read-char p) (read-char p)))', self.g)
+        assert list(r) == ['a', 'a', 'b']
+
+    def test_read_line_from_string_port(self):
+        r = run('(let ((p (open-input-string "line1\nline2"))) (read-line p))', self.g)
+        assert r == 'line1'
+
+    def test_call_with_string_output_port(self):
+        r = run('(call-with-string-output-port (lambda (p) (display 42 p) (display " hi" p)))', self.g)
+        assert r == '42 hi'
+
+    def test_string_port_predicate(self):
+        assert run('(string-port? (open-output-string))', self.g) is True
+        assert run('(string-port? (open-input-string "x"))', self.g) is True
+        assert run('(output-port? (open-output-string))', self.g) is True
+        assert run('(input-port? (open-input-string "x"))', self.g) is True
+
+    def test_read_all_from_port(self):
+        r = runs('''
+          (let ((p (open-input-string "1 2 3")))
+            (let loop ((acc (quote ())))
+              (let ((x (read p)))
+                (if (eof-object? x)
+                    (reverse acc)
+                    (loop (cons x acc))))))
+        ''', self.g)
+        assert r == '(1 2 3)'
+
+
+###############################################################################
+# Error objects
+###############################################################################
+
+class TestErrorObjects(unittest.TestCase):
+    def setUp(self): self.g = fresh()
+
+    def test_error_object_predicate(self):
+        r = run('(guard (e (#t (error-object? e))) (error "test"))', self.g)
+        assert r is True
+
+    def test_error_object_message(self):
+        r = run('(guard (e (#t (error-object-message e))) (error "oops"))', self.g)
+        assert r == 'oops'
+
+    def test_error_object_irritants(self):
+        r = runs('(guard (e (#t (error-object-irritants e))) (error "bad" 1 2 3))', self.g)
+        assert r == '(1 2 3)'
+
+    def test_error_object_irritants_empty(self):
+        r = run('(guard (e (#t (error-object-irritants e))) (error "no-irritants"))', self.g)
+        from uncommonlisp import NIL
+        assert r is NIL
+
+    def test_with_exception_handler_gets_error_object(self):
+        r = run('(with-exception-handler (lambda (e) (error-object? e)) (lambda () (error "boom")))', self.g)
+        assert r is True
+
+    def test_with_exception_handler_message(self):
+        r = run('(with-exception-handler (lambda (e) (error-object-message e)) (lambda () (error "msg" 1)))', self.g)
+        assert r == 'msg'
+
+    def test_error_not_caught_reraises(self):
+        with self.assertRaises(Exception):
+            run('(guard (e ((string? e) "string-error")) (error "not-a-string-check"))', self.g)
+
+
+###############################################################################
+# string->number extended
+###############################################################################
+
+class TestStringToNumberExtended(unittest.TestCase):
+    def setUp(self): self.g = fresh()
+
+    def test_hex_prefix_hash(self):
+        assert run('(string->number "#xff")', self.g) == 255
+        assert run('(string->number "#xAB")', self.g) == 171
+
+    def test_bin_prefix_hash(self):
+        assert run('(string->number "#b1010")', self.g) == 10
+
+    def test_oct_prefix_hash(self):
+        assert run('(string->number "#o17")', self.g) == 15
+
+    def test_hex_prefix_0x(self):
+        assert run('(string->number "0xff")', self.g) == 255
+
+    def test_bin_prefix_0b(self):
+        assert run('(string->number "0b101")', self.g) == 5
+
+    def test_oct_prefix_0o(self):
+        assert run('(string->number "0o77")', self.g) == 63
+
+    def test_decimal_prefix(self):
+        assert run('(string->number "#d42")', self.g) == 42
+
+    def test_explicit_base_still_works(self):
+        assert run('(string->number "ff" 16)', self.g) == 255
+        assert run('(string->number "1010" 2)', self.g) == 10
+
+    def test_invalid_returns_false(self):
+        assert run('(string->number "not-a-number")', self.g) is False
+        assert run('(string->number "")', self.g) is False
+
+
+###############################################################################
+# Internal defines (letrec* body semantics)
+###############################################################################
+
+class TestInternalDefines(unittest.TestCase):
+    def setUp(self): self.g = fresh()
+
+    def test_mutual_recursion_in_body(self):
+        r = run('''
+          (define (f)
+            (define (even? n) (if (= n 0) #t (odd?  (- n 1))))
+            (define (odd?  n) (if (= n 0) #f (even? (- n 1))))
+            (list (even? 4) (odd? 3)))
+          (f)
+        ''', self.g)
+        assert list(r) == [True, True]
+
+    def test_sequential_body_defines(self):
+        r = run('''
+          (define (f)
+            (define x 1)
+            (define y 2)
+            (+ x y))
+          (f)
+        ''', self.g)
+        assert r == 3
+
+    def test_internal_define_in_let(self):
+        r = run('(let ((x 10)) (define y (* x 2)) y)', self.g)
+        assert r == 20
+
+    def test_internal_define_in_letrec(self):
+        r = run('(letrec ((x 5)) (define y (+ x 1)) y)', self.g)
+        assert r == 6
+
+    def test_internal_define_shadowing(self):
+        run('(define x 100)', self.g)
+        r = run('''
+          (define (f)
+            (define x 1)
+            x)
+          (list (f) x)
+        ''', self.g)
+        assert list(r) == [1, 100]
+
+    def test_predeclared_names_allow_mutual_ref(self):
+        # Both names pre-declared → each closure can reference the other
+        # ping(5)→pong(4)→ping(3)→pong(2)→ping(1)→pong(0) = "pong"
+        r = run('''
+          (let ()
+            (define (ping n) (if (= n 0) "ping" (pong (- n 1))))
+            (define (pong n) (if (= n 0) "pong" (ping (- n 1))))
+            (ping 5))
+        ''', self.g)
+        assert r == 'pong'
+
+
+###############################################################################
+# Module system
+###############################################################################
+
+class TestModuleSystem(unittest.TestCase):
+    def setUp(self): self.g = fresh()
+
+    def test_module_define_and_import(self):
+        run('''
+          (module mymath
+            (export square cube)
+            (define (square x) (* x x))
+            (define (cube x) (* x x x)))
+        ''', self.g)
+        run('(import mymath)', self.g)
+        assert run('(square 5)', self.g) == 25
+        assert run('(cube 3)', self.g) == 27
+
+    def test_module_hides_private(self):
+        run('''
+          (module secret
+            (export public-fn)
+            (define private-val 42)
+            (define (public-fn) private-val))
+        ''', self.g)
+        run('(import secret)', self.g)
+        assert run('(public-fn)', self.g) == 42
+        with self.assertRaises(Exception):
+            run('private-val', self.g)
+
+    def test_selective_import(self):
+        run('''
+          (module tools
+            (export add mul)
+            (define (add a b) (+ a b))
+            (define (mul a b) (* a b)))
+        ''', self.g)
+        run('(import (tools add))', self.g)
+        assert run('(add 3 4)', self.g) == 7
+        with self.assertRaises(Exception):
+            run('(mul 3 4)', self.g)
+
+    def test_module_import_unknown_raises(self):
+        with self.assertRaises(Exception):
+            run('(import no-such-module)', self.g)
+
+
+###############################################################################
+# define-record-type with inheritance
+###############################################################################
+
+class TestRecordTypeInheritance(unittest.TestCase):
+    def setUp(self): self.g = fresh()
+
+    def test_basic_record_unchanged(self):
+        run('''
+          (define-record-type vec2
+            (make-vec2 x y)
+            vec2?
+            (x vec2-x)
+            (y vec2-y set-vec2-y!))
+        ''', self.g)
+        run('(define v (make-vec2 3 4))', self.g)
+        assert run('(vec2? v)', self.g) is True
+        assert run('(vec2-x v)', self.g) == 3
+        assert run('(vec2-y v)', self.g) == 4
+        run('(set-vec2-y! v 99)', self.g)
+        assert run('(vec2-y v)', self.g) == 99
+
+    def test_inherited_predicate(self):
+        run('''
+          (define-record-type animal
+            (make-animal name)
+            animal?
+            (name animal-name))
+          (define-record-type dog
+            (inherit animal)
+            (make-dog name breed)
+            dog?
+            (name animal-name)
+            (breed dog-breed))
+        ''', self.g)
+        run('(define a (make-animal "cat"))', self.g)
+        run('(define d (make-dog "rex" "lab"))', self.g)
+        assert run('(animal? a)', self.g) is True
+        assert run('(animal? d)', self.g) is True   # dog is subtype of animal
+        assert run('(dog? d)', self.g) is True
+        assert run('(dog? a)', self.g) is False
+
+    def test_inherited_accessor(self):
+        run('''
+          (define-record-type shape
+            (make-shape color)
+            shape?
+            (color shape-color))
+          (define-record-type circle
+            (inherit shape)
+            (make-circle color radius)
+            circle?
+            (color shape-color)
+            (radius circle-radius))
+        ''', self.g)
+        run('(define c (make-circle "red" 5))', self.g)
+        assert run('(shape-color c)', self.g) == 'red'
+        assert run('(circle-radius c)', self.g) == 5
+        assert run('(shape? c)', self.g) is True
+
+    def test_deep_inheritance(self):
+        run('''
+          (define-record-type a (make-a x) a? (x a-x))
+          (define-record-type b (inherit a) (make-b x y) b? (x a-x) (y b-y))
+          (define-record-type c (inherit b) (make-c x y z) c? (x a-x) (y b-y) (z c-z))
+        ''', self.g)
+        run('(define obj (make-c 1 2 3))', self.g)
+        assert run('(a? obj)', self.g) is True
+        assert run('(b? obj)', self.g) is True
+        assert run('(c? obj)', self.g) is True
+        assert run('(a-x obj)', self.g) == 1
+        assert run('(b-y obj)', self.g) == 2
+        assert run('(c-z obj)', self.g) == 3
+
+
+###############################################################################
+# Rational numbers
+###############################################################################
+
+class TestRationals(unittest.TestCase):
+    def setUp(self): self.g = fresh()
+
+    def test_division_exact(self):
+        assert runs('(/ 1 3)', self.g) == '1/3'
+
+    def test_division_simplifies(self):
+        assert runs('(/ 2 4)', self.g) == '1/2'
+
+    def test_division_whole(self):
+        assert run('(/ 6 3)', self.g) == 2
+        assert isinstance(run('(/ 6 3)', self.g), int)
+
+    def test_rational_literal(self):
+        assert runs('1/3', self.g) == '1/3'
+
+    def test_rational_add(self):
+        assert runs('(+ 1/3 1/6)', self.g) == '1/2'
+
+    def test_rational_mul(self):
+        assert runs('(* 2/3 3/4)', self.g) == '1/2'
+
+    def test_rational_sub(self):
+        assert runs('(- 1 1/3)', self.g) == '2/3'
+
+    def test_rational_add_to_int(self):
+        assert run('(+ 1/4 1/4 1/4 1/4)', self.g) == 1
+        assert isinstance(run('(+ 1/4 1/4 1/4 1/4)', self.g), int)
+
+    def test_rational_exact(self):
+        assert run('(exact? 1/3)', self.g) is True
+        assert run('(inexact? 1/3)', self.g) is False
+
+    def test_rational_predicates(self):
+        assert run('(number? 1/3)', self.g) is True
+        assert run('(rational? 1/3)', self.g) is True
+        assert run('(integer? 1/3)', self.g) is False
+
+    def test_rational_comparison(self):
+        assert run('(= 1/2 0.5)', self.g) is True
+        assert run('(< 1/3 1/2)', self.g) is True
+        assert run('(> 2/3 1/2)', self.g) is True
+
+    def test_rational_inexact(self):
+        r = run('(inexact 1/4)', self.g)
+        assert abs(r - 0.25) < 1e-10
+
+    def test_numerator_denominator(self):
+        assert run('(numerator 2/3)', self.g) == 2
+        assert run('(denominator 2/3)', self.g) == 3
+        assert run('(numerator 3)', self.g) == 3
+        assert run('(denominator 3)', self.g) == 1
+
+    def test_number_to_string_rational(self):
+        assert run('(number->string 1/3)', self.g) == '1/3'
+
+    def test_string_to_number_rational(self):
+        assert runs('(string->number "1/3")', self.g) == '1/3'
+        assert runs('(string->number "2/4")', self.g) == '1/2'
+
+    def test_rational_mixed_arithmetic(self):
+        # Mix of int, rational, float
+        r = run('(+ 1/2 0.5)', self.g)
+        assert abs(r - 1.0) < 1e-10
+
+    def test_one_over_n(self):
+        assert runs('(/ 1 7)', self.g) == '1/7'
+        assert runs('(* 7 (/ 1 7))', self.g) == '1'
+
+
 ###############################################################################
 # Main
 ###############################################################################
diff --git a/uncommonlisp.py b/uncommonlisp.py
index 10a3548..1a2fb2e 100644
--- a/uncommonlisp.py
+++ b/uncommonlisp.py
@@ -6,6 +6,7 @@ Usage: python3 uncommonlisp.py [script.lsp]   # run a file
        python3 uncommonlisp.py -e '(+ 1 2)'   # eval expression
 """
 import sys, re, math, itertools
+from fractions import Fraction
 try: import readline
 except ImportError: pass
 
@@ -51,11 +52,17 @@ class Pair:
         while isinstance(n, Pair): parts.append(show(n.car)); n = n.cdr
         return '(' + ' '.join(parts) + ('' if n is NIL else ' . ' + show(n)) + ')'
 
+def _has_internal_defines(body):
+    """Check if body starts with a define form (for fast path in _body_env)."""
+    return bool(body) and isinstance(body[0], Pair) and (
+        body[0].car is S('define') or body[0].car is S('begin'))
+
 class Proc:
-    __slots__ = ('params', 'rest', 'body', 'env', 'name')
+    __slots__ = ('params', 'rest', 'body', 'env', 'name', 'has_defs')
     def __init__(self, params, rest, body, env, name=None):
         self.params = params; self.rest = rest
         self.body = body; self.env = env; self.name = name
+        self.has_defs = _has_internal_defines(body)
     def __repr__(self): return f'#<procedure {self.name or "λ"}>'
 
 class Macro:
@@ -177,7 +184,56 @@ class _EOF:
 
 EOF = _EOF()
 
-class LispErr(Exception): pass
+class LispErr(Exception):
+    def __init__(self, msg, obj=None):
+        super().__init__(msg); self.obj = obj  # obj is ErrorObject or None
+
+class ErrorObject:
+    """R7RS error object — carried by LispErr when raised via (error ...)."""
+    __slots__ = ('msg', 'irritants')
+    def __init__(self, msg, irritants=()):
+        self.msg = msg; self.irritants = list(irritants)
+    def __str__(self):
+        if self.irritants:
+            return self.msg + ': ' + ' '.join(show(x) for x in self.irritants)
+        return self.msg
+    def __repr__(self): return f'#<error-object {self.msg!r}>'
+
+class StringInputPort:
+    """String input port — (open-input-string s)."""
+    def __init__(self, s): self._src = s; self._pos = 0
+    def read(self, n=-1):
+        if n < 0: r = self._src[self._pos:]; self._pos = len(self._src); return r
+        r = self._src[self._pos:self._pos+n]; self._pos += len(r); return r
+    def readline(self):
+        end = self._src.find('\n', self._pos)
+        if end < 0: r = self._src[self._pos:]; self._pos = len(self._src)
+        else: r = self._src[self._pos:end+1]; self._pos = end+1
+        return r
+    def read_datum(self):
+        """Read one Lisp datum, advance position past it."""
+        remaining = self._src[self._pos:]
+        tok_spans = [(m.group(), m.end()) for m in _TOK_RE.finditer(remaining)
+                     if not m.group().startswith(';')]
+        if not tok_spans: return EOF
+        toks = [t for t, _ in tok_spans]
+        try:
+            expr, n = _read(toks, 0)
+            self._pos += tok_spans[n - 1][1]
+            return expr
+        except (LispErr, IndexError): return EOF
+    def peek_char(self):
+        return self._src[self._pos] if self._pos < len(self._src) else EOF
+    def char_ready(self): return self._pos < len(self._src)
+    def close(self): pass
+
+class StringOutputPort:
+    """String output port — (open-output-string)."""
+    def __init__(self): self._buf = []
+    def write(self, s): self._buf.append(s); return len(s)
+    def flush(self): pass
+    def close(self): pass
+    def getvalue(self): return ''.join(self._buf)
 
 ###############################################################################
 # Printer
@@ -188,6 +244,8 @@ def show(x, display=False):
     if x is VOID: return ''
     if x is True:  return '#t'
     if x is False: return '#f'
+    if isinstance(x, ErrorObject): return repr(x)
+    if isinstance(x, Fraction): return f'{x.numerator}/{x.denominator}'
     if isinstance(x, Pair): return repr(x)
     if isinstance(x, list):  # vector
         return '#(' + ' '.join(show(e) for e in x) + ')'
@@ -199,6 +257,11 @@ def show(x, display=False):
     if isinstance(x, float):
         if math.isinf(x): return '+inf.0' if x > 0 else '-inf.0'
         if math.isnan(x): return '+nan.0'
+        s = repr(x)
+        # Ensure a decimal point for Scheme compatibility
+        if '.' not in s and 'e' not in s and 'n' not in s and 'i' not in s:
+            s += '.0'
+        return s
     return repr(x)
 
 ###############################################################################
@@ -271,6 +334,12 @@ def _atom(t):
     if t == '+inf.0': return math.inf
     if t == '-inf.0': return -math.inf
     if t in ('+nan.0', '-nan.0'): return float('nan')
+    # Rational literal n/d (e.g. 1/3, -2/5)
+    if re.fullmatch(r'-?\d+/-?\d+', t):
+        try:
+            f = Fraction(t)
+            return f if f.denominator != 1 else f.numerator
+        except (ValueError, ZeroDivisionError): pass
     return S(t)
 
 def read_all(src):
@@ -311,6 +380,32 @@ def _formals(f):
 
 def _raise(e): raise e
 
+def _body_env(forms, env):
+    """Implement R7RS letrec* semantics for body internal defines.
+    Scans leading (define ...) forms, pre-declares all names as VOID in env,
+    returns the full form list unchanged (defines are re-evaluated sequentially).
+    This allows mutual recursion: both names exist before either body runs.
+    Short-circuits immediately when first form is not a define (common case)."""
+    # Fast path: no internal defines
+    if not forms: return forms
+    if not (isinstance(forms[0], Pair) and (forms[0].car is S('define') or forms[0].car is S('begin'))):
+        return forms
+    i = 0
+    while i < len(forms):
+        f = forms[i]
+        if isinstance(f, Pair) and f.car is S('define'):
+            a = _L(f.cdr)
+            name = a[0].car if isinstance(a[0], Pair) else a[0]
+            if isinstance(name, Symbol): env.define(name, VOID)
+            i += 1
+        elif isinstance(f, Pair) and f.car is S('begin'):
+            # Splice top-level begin (R7RS splicing begin in body)
+            spliced = _L(f.cdr)
+            forms = list(forms[:i]) + spliced + list(forms[i+1:])
+        else:
+            break
+    return forms
+
 ###############################################################################
 # Environment
 ###############################################################################
@@ -378,6 +473,92 @@ def _qq(tmpl, env, depth=0):
 # Evaluator (TCO via explicit loop)
 ###############################################################################
 
+def _define_record_type(a, env):
+    """Implement (define-record-type name [(inherit parent)] ctor pred slot...)
+    Representation: (tag field...) as a Lisp list.
+    (inherit parent) establishes the subtype relationship so parent? is true
+    of child instances. The child ctor lists ALL fields it stores (not auto-inherited).
+    Parent accessors work on child instances when child preserves parent's field layout."""
+    name = a[0]
+    rest = a[1:]
+
+    # Check for (inherit parent) clause
+    parent_name = None
+    if rest and isinstance(rest[0], Pair) and rest[0].car is S('inherit'):
+        parent_name = str(_L(rest[0])[1])
+        rest = rest[1:]
+
+    # ctor-spec: (constructor field-name...)
+    ctor_spec = _L(rest[0])
+    ctor_name = ctor_spec[0]
+    all_fields = [str(s) for s in ctor_spec[1:]]
+    pred_name = rest[1]
+    slot_specs = [_L(s) for s in rest[2:]]
+
+    # Register in type registry (for subtype checks)
+    _record_types[str(name)] = {'fields': all_fields, 'parent': parent_name}
+
+    # Constructor: produces (name field1 field2 ...)
+    tag = Pair(S('quote'), Pair(name, NIL))
+    all_syms = [S(f) for f in all_fields]
+    ctor_body = Pair(S('list'), Pair(tag, _P(all_syms)))
+    ctor_proc = Proc(all_syms, None, [ctor_body], env, name=str(ctor_name))
+    env.define(ctor_name, ctor_proc)
+
+    # Predicate: true if instance's type tag is `name` or a subtype of `name`
+    def _is_subtype(child_tag, ancestor):
+        """Is child_tag equal to or a descendant of ancestor?"""
+        if child_tag == ancestor: return True
+        rt = _record_types.get(child_tag)
+        while rt and rt['parent']:
+            if rt['parent'] == ancestor: return True
+            rt = _record_types.get(rt['parent'])
+        return False
+
+    def _make_pred(type_name):
+        sname = str(type_name)
+        def pred(args, _env):
+            x = args[0]
+            if not isinstance(x, Pair): return False
+            t = x.car
+            return isinstance(t, Symbol) and _is_subtype(str(t), sname)
+        return pred
+    env.define(pred_name, _make_pred(name))
+
+    # Accessors / mutators: each slot spec is (field-name getter) or (field-name getter setter)
+    # field-name in the spec is the slot identity tag (for documentation); getter/setter are names
+    for spec in slot_specs:
+        field_tag = spec[0]
+        getter_name = spec[1]
+        setter_name = spec[2] if len(spec) > 2 else None
+        field_str = str(field_tag)
+        try:
+            idx = all_fields.index(field_str) + 1  # +1 to skip type tag
+        except ValueError:
+            raise LispErr(f'define-record-type {name}: field {field_str!r} not in {all_fields}')
+
+        def _make_getter(i):
+            def getter_fn(args, _):
+                lst = args[0]
+                for _ in range(i): lst = _pair_val(lst).cdr
+                return _pair_val(lst).car
+            return getter_fn
+
+        def _make_setter(i):
+            def setter_fn(args, _):
+                lst = args[0]
+                for _ in range(i - 1): lst = _pair_val(lst).cdr
+                lst.cdr.car = args[1]
+                return VOID
+            return setter_fn
+
+        env.define(getter_name, _make_getter(idx))
+        if setter_name:
+            env.define(setter_name, _make_setter(idx))
+
+    return VOID
+
+
 def leval(expr, env):
     """Evaluate expr in env. Tail-call safe via while loop."""
     while True:
@@ -507,19 +688,24 @@ def leval(expr, env):
                 p = Proc(bps, None, body, c, name=str(name))
                 c.define(name, p)
                 env = c.child(bps, None, bvs)
+                if _has_internal_defines(body): body = _body_env(body, env)
                 expr = Pair(S('begin'), _P(body)); continue
             binds = _L(a[0]); body = a[1:]
             c = Env(env)
             for b in binds:
                 bp = _L(b); c.define(bp[0], leval(bp[1], env))
-            env = c; expr = Pair(S('begin'), _P(body)); continue
+            env = c
+            if _has_internal_defines(body): body = _body_env(body, env)
+            expr = Pair(S('begin'), _P(body)); continue
 
         if head is S('let*'):
             a = _L(tail)
             c = Env(env)
             for b in _L(a[0]):
                 bp = _L(b); c.define(bp[0], leval(bp[1], c))
-            env = c; expr = Pair(S('begin'), _P(a[1:])); continue
+            body = a[1:]
+            if _has_internal_defines(body): body = _body_env(body, c)
+            env = c; expr = Pair(S('begin'), _P(body)); continue
 
         if head is S('letrec') or head is S('letrec*'):
             a = _L(tail); binds = _L(a[0])
@@ -527,7 +713,9 @@ def leval(expr, env):
             for b in binds: c.define(_L(b)[0], VOID)
             for b in binds:
                 bp = _L(b); c.set(bp[0], leval(bp[1], c))
-            env = c; expr = Pair(S('begin'), _P(a[1:])); continue
+            body = a[1:]
+            if _has_internal_defines(body): body = _body_env(body, c)
+            env = c; expr = Pair(S('begin'), _P(body)); continue
 
         if head is S('do'):
             a = _L(tail)
@@ -614,7 +802,10 @@ def leval(expr, env):
             args = pre + _L(last)
             if isinstance(proc, Proc):
                 env = proc.env.child(proc.params, proc.rest, args)
-                expr = Pair(S('begin'), _P(proc.body)); continue
+                body = _body_env(proc.body, env) if proc.has_defs else proc.body
+                if len(body) == 1: expr = body[0]
+                else: expr = Pair(S('begin'), _P(body))
+                continue
             if callable(proc): return proc(args, env)
             raise LispErr(f'apply: not callable: {show(proc)}')
 
@@ -624,8 +815,47 @@ def leval(expr, env):
         if head is S('error'):
             a = _L(tail)
             msg = show(leval(a[0], env), display=True)
-            irr = [show(leval(x, env)) for x in a[1:]]
-            raise LispErr(msg + (': ' + ' '.join(irr) if irr else ''))
+            irr = [leval(x, env) for x in a[1:]]
+            obj = ErrorObject(msg, irr)
+            raise LispErr(str(obj), obj=obj)
+
+        if head is S('define-record-type'):
+            return _define_record_type(_L(tail), env)
+
+        if head is S('module'):
+            # (module name (export sym ...) body...)
+            a = _L(tail)
+            mod_name = str(a[0])
+            export_list = _L(a[1]) if isinstance(a[1], Pair) and a[1].car is S('export') else []
+            explicit_exports = [str(s) for s in export_list[1:]] if export_list else []
+            body = a[2:]
+            mod_env = Env(env)
+            for e in body[:-1]: leval(e, mod_env)
+            if body: leval(body[-1], mod_env)
+            exports = explicit_exports if explicit_exports else list(mod_env.b.keys())
+            _modules[mod_name] = mod_env
+            _mod_exports[mod_name] = exports
+            return VOID
+
+        if head is S('import'):
+            # (import module-name) or (import (module-name sym ...))
+            for spec in _L(tail):
+                if isinstance(spec, Symbol):
+                    name = str(spec)
+                    if name not in _modules: raise LispErr(f'import: unknown module: {name}')
+                    mod = _modules[name]
+                    for k in _mod_exports.get(name, list(mod.b.keys())):
+                        if k in mod.b: env.define(S(k), mod.b[k])
+                elif isinstance(spec, Pair):
+                    items = _L(spec)
+                    name = str(items[0])
+                    if name not in _modules: raise LispErr(f'import: unknown module: {name}')
+                    mod = _modules[name]
+                    syms = [str(s) for s in items[1:]] if len(items) > 1 else _mod_exports.get(name, list(mod.b.keys()))
+                    for k in syms:
+                        if k in mod.b: env.define(S(k), mod.b[k])
+                        else: raise LispErr(f'import: {name} has no export: {k}')
+            return VOID
 
         if head is S('load'):
             a = _L(tail); _load(leval(a[0], env), env); return VOID
@@ -660,7 +890,7 @@ def leval(expr, env):
             a = _L(tail)
             handler = leval(a[0], env); thunk = leval(a[1], env)
             try: return _call(thunk, [], env)
-            except LispErr as e: return _call(handler, [str(e)], env)
+            except LispErr as e: return _call(handler, [e.obj if e.obj else str(e)], env)
             except Exception as e: return _call(handler, [str(e)], env)
 
         if head is S('guard'):
@@ -670,7 +900,7 @@ def leval(expr, env):
                 for e in body[:-1]: leval(e, env)
                 return leval(body[-1], env)
             except LispErr as exc:
-                c = Env(env); c.define(var, str(exc))
+                c = Env(env); c.define(var, exc.obj if exc.obj else str(exc))
                 for cl in clauses:
                     cl = _L(cl)
                     if cl[0] is S('else') or _truthy(leval(cl[0], c)):
@@ -689,7 +919,10 @@ def leval(expr, env):
 
         if isinstance(proc, Proc):
             env  = proc.env.child(proc.params, proc.rest, args)
-            expr = Pair(S('begin'), _P(proc.body)); continue
+            body = _body_env(proc.body, env) if proc.has_defs else proc.body
+            if len(body) == 1: expr = body[0]
+            else: expr = Pair(S('begin'), _P(body))
+            continue
 
         if callable(proc): return proc(args, env)
 
@@ -700,8 +933,9 @@ def _call(proc, args, env):
     """Non-tail recursive call (for use inside builtins)."""
     if isinstance(proc, Proc):
         c = proc.env.child(proc.params, proc.rest, args)
-        for e in proc.body[:-1]: leval(e, c)
-        return leval(proc.body[-1], c)
+        body = _body_env(proc.body, c) if proc.has_defs else proc.body
+        for e in body[:-1]: leval(e, c)
+        return leval(body[-1], c)
     if callable(proc): return proc(args, env)
     raise LispErr(f'not callable: {show(proc)}')
 
@@ -716,9 +950,12 @@ def _load(path, env):
 ###############################################################################
 
 _gensym_ctr = itertools.count()
+_modules: dict = {}      # module-name → Env
+_mod_exports: dict = {}  # module-name → [export-names]
+_record_types: dict = {} # record-name → {'fields': [...], 'parent': name|None}
 
 def _num(x):
-    if isinstance(x, bool) or not isinstance(x, (int, float)):
+    if isinstance(x, bool) or not isinstance(x, (int, float, Fraction)):
         raise LispErr(f'not a number: {show(x)}')
     return x
 
@@ -737,7 +974,8 @@ def _pair_val(x):
 
 def _equal(a, b):
     if a is b: return True
-    if type(a) is not type(b) and not (isinstance(a, (int, float)) and isinstance(b, (int, float))): return False
+    _numeric = (int, float, Fraction)
+    if type(a) is not type(b) and not (isinstance(a, _numeric) and isinstance(b, _numeric)): return False
     if isinstance(a, Pair): return _equal(a.car, b.car) and _equal(a.cdr, b.cdr)
     if isinstance(a, list): return len(a) == len(b) and all(_equal(x, y) for x, y in zip(a, b))
     return a == b
@@ -802,23 +1040,67 @@ def _format(a):
     return ''.join(out)
 
 
+def _pprint(x, indent=0, width=72):
+    """Pretty-print a Lisp value with indentation."""
+    s = show(x)
+    if len(s) + indent <= width or not isinstance(x, Pair): return s
+    items = list(x)
+    if not items: return '()'
+    # (keyword arg1 arg2 ...) style: indent args under keyword
+    head = show(items[0])
+    if isinstance(items[0], Symbol) and len(items) > 1:
+        # Try to fit head + first arg on one line
+        first_col = indent + 2 + len(head)
+        parts = [_pprint(item, first_col, width) for item in items[1:]]
+        inner = ('\n' + ' ' * first_col).join(parts)
+        candidate = f'({head} {inner})'
+        if len(candidate.split('\n')[0]) + indent <= width or '\n' in inner:
+            return candidate
+    # Fall back: one item per line, indented by 1
+    col = indent + 1
+    parts = [_pprint(item, col, width) for item in items]
+    inner = ('\n' + ' ' * col).join(parts)
+    return f'({inner})'
+
+
 def make_global_env():
     g = Env()
     d = g.define
 
     # ── Arithmetic ───────────────────────────────────────────────────────────
-    d(S('+'), lambda a, _: sum(_num(x) for x in a) if a else 0)
-    d(S('-'), lambda a, _: (
-        _raise(LispErr('-: no args')) if not a else
-        -_num(a[0]) if len(a) == 1 else
-        _num(a[0]) - sum(_num(x) for x in a[1:])))
-    d(S('*'), lambda a, _: (r := 1, [r := r * _num(x) for x in a], r)[-1])
+    def _add(a, _):
+        if not a: return 0
+        result = _num(a[0])
+        for x in a[1:]: result = result + _num(x)
+        return result.numerator if isinstance(result, Fraction) and result.denominator == 1 else result
+    def _sub(a, _):
+        if not a: raise LispErr('-: no args')
+        if len(a) == 1: return -_num(a[0])
+        result = _num(a[0])
+        for x in a[1:]: result = result - _num(x)
+        return result.numerator if isinstance(result, Fraction) and result.denominator == 1 else result
+    def _mul(a, _):
+        result = 1
+        for x in a: result = result * _num(x)
+        return result.numerator if isinstance(result, Fraction) and result.denominator == 1 else result
+    d(S('+'), _add)
+    d(S('-'), _sub)
+    d(S('*'), _mul)
 
     def _div(a, _):
         if not a: raise LispErr('/: no args')
-        if len(a) == 1: return 1 / _num(a[0])
+        if len(a) == 1:
+            n = _num(a[0])
+            return Fraction(1, n) if isinstance(n, int) else 1.0 / n
         n = _num(a[0])
-        for x in a[1:]: n /= _num(x)
+        for x in a[1:]:
+            x = _num(x)
+            # Exact division: int/int or Fraction/int → Fraction, then simplify
+            if isinstance(n, (int, Fraction)) and isinstance(x, (int, Fraction)):
+                f = Fraction(n, x) if not isinstance(n, Fraction) else n / Fraction(x)
+                n = f.numerator if f.denominator == 1 else f
+            else:
+                n = float(n) / float(x)
         return n
     d(S('/'), _div)
     d(S('quotient'),   lambda a, _: int(_num(a[0]) / _num(a[1])))
@@ -846,13 +1128,20 @@ def make_global_env():
     d(S('max'),        lambda a, _: max(_num(x) for x in a))
     d(S('gcd'),        lambda a, _: math.gcd(int(_num(a[0])), int(_num(a[1]))))
     d(S('lcm'),        lambda a, _: abs(int(_num(a[0])) * int(_num(a[1]))) // (math.gcd(int(_num(a[0])), int(_num(a[1]))) or 1))
-    d(S('exact'),      lambda a, _: int(_num(a[0])) if isinstance(_num(a[0]), float) else _num(a[0]))
+    d(S('exact'),      lambda a, _: (Fraction(_num(a[0])).limit_denominator() if isinstance(_num(a[0]), float) else _num(a[0])))
     d(S('inexact'),    lambda a, _: float(_num(a[0])))
     d(S('exact->inexact'), lambda a, _: float(_num(a[0])))
-    d(S('inexact->exact'), lambda a, _: int(_num(a[0])))
-    d(S('number->string'), lambda a, _: (
-        format(int(_num(a[0])), {2: 'b', 8: 'o', 16: 'x'}.get(int(_num(a[1])), ''))
-        if len(a) > 1 else str(_num(a[0]))))
+    d(S('inexact->exact'), lambda a, _: (Fraction(_num(a[0])).limit_denominator() if isinstance(_num(a[0]), float) else _num(a[0])))
+    d(S('numerator'),  lambda a, _: _num(a[0]).numerator if isinstance(_num(a[0]), Fraction) else (int(_num(a[0])) if isinstance(_num(a[0]), int) else _num(a[0])))
+    d(S('denominator'),lambda a, _: _num(a[0]).denominator if isinstance(_num(a[0]), Fraction) else 1)
+    def _num_to_str(a):
+        n = _num(a[0])
+        if len(a) > 1:
+            base = int(_num(a[1]))
+            return format(int(n), {2: 'b', 8: 'o', 16: 'x'}.get(base, ''))
+        if isinstance(n, Fraction): return f'{n.numerator}/{n.denominator}'
+        return show(n)  # uses show for floats (decimal point guaranteed)
+    d(S('number->string'), lambda a, _: _num_to_str(a))
     d(S('zero?'),      lambda a, _: _num(a[0]) == 0)
     d(S('positive?'),  lambda a, _: _num(a[0]) > 0)
     d(S('negative?'),  lambda a, _: _num(a[0]) < 0)
@@ -883,11 +1172,11 @@ def make_global_env():
     d(S('equal?'), lambda a, _: _equal(a[0], a[1]))
 
     # ── Type predicates ──────────────────────────────────────────────────────
-    d(S('number?'),    lambda a, _: isinstance(a[0], (int, float)) and not isinstance(a[0], bool))
-    d(S('integer?'),   lambda a, _: (isinstance(a[0], int) and not isinstance(a[0], bool)) or (isinstance(a[0], float) and a[0].is_integer()))
-    d(S('real?'),      lambda a, _: isinstance(a[0], (int, float)) and not isinstance(a[0], bool))
-    d(S('rational?'),  lambda a, _: isinstance(a[0], (int, float)) and not isinstance(a[0], bool) and not math.isinf(a[0]) and not (isinstance(a[0], float) and math.isnan(a[0])))
-    d(S('exact?'),     lambda a, _: isinstance(a[0], int) and not isinstance(a[0], bool))
+    d(S('number?'),    lambda a, _: isinstance(a[0], (int, float, Fraction)) and not isinstance(a[0], bool))
+    d(S('integer?'),   lambda a, _: (isinstance(a[0], int) and not isinstance(a[0], bool)) or (isinstance(a[0], float) and a[0].is_integer()) or (isinstance(a[0], Fraction) and a[0].denominator == 1))
+    d(S('real?'),      lambda a, _: isinstance(a[0], (int, float, Fraction)) and not isinstance(a[0], bool))
+    d(S('rational?'),  lambda a, _: isinstance(a[0], (int, Fraction)) and not isinstance(a[0], bool) or (isinstance(a[0], float) and math.isfinite(a[0])))
+    d(S('exact?'),     lambda a, _: (isinstance(a[0], int) or isinstance(a[0], Fraction)) and not isinstance(a[0], bool))
     d(S('inexact?'),   lambda a, _: isinstance(a[0], float))
     d(S('pair?'),      lambda a, _: isinstance(a[0], Pair))
     d(S('null?'),      lambda a, _: a[0] is NIL)
@@ -1133,10 +1422,33 @@ def make_global_env():
 
     def _str_to_num(a):
         s = _str_val(a[0]); base = int(_num(a[1])) if len(a) > 1 else 10
+        orig = s
+        # R7RS/Scheme radix prefixes: #b #o #d #x (also 0x/0b/0o for convenience)
+        if len(s) >= 2 and s[0] == '#':
+            pfx = s[1].lower()
+            if pfx == 'x': s = s[2:]; base = 16
+            elif pfx == 'b': s = s[2:]; base = 2
+            elif pfx == 'o': s = s[2:]; base = 8
+            elif pfx == 'd': s = s[2:]; base = 10
+        elif len(a) == 1 and len(s) >= 2 and s[0] == '0':
+            pfx = s[1].lower()
+            if pfx == 'x': s = s[2:]; base = 16
+            elif pfx == 'b': s = s[2:]; base = 2
+            elif pfx == 'o': s = s[2:]; base = 8
         try: return int(s, base)
         except ValueError: pass
-        try: return float(s)
-        except ValueError: return False
+        if base == 10:
+            # Rational n/d
+            if re.fullmatch(r'-?\d+/-?\d+', s):
+                try:
+                    f = Fraction(s)
+                    return f if f.denominator != 1 else f.numerator
+                except (ValueError, ZeroDivisionError): pass
+            try:
+                v = float(orig)
+                return v
+            except ValueError: pass
+        return False
 
     d(S('string->number'), lambda a, _: _str_to_num(a))
 
@@ -1198,39 +1510,65 @@ def make_global_env():
     d(S('hash-table-update!'), lambda a, e: a[0].__setitem__(a[1], _call(a[2],[a[0].get(a[1], _call(a[3],[],e) if len(a)>3 else _raise(LispErr('hash-table-update!: missing key')))],e)) or VOID)
 
     # ── I/O ───────────────────────────────────────────────────────────────────
-    d(S('display'),   lambda a, _: print(show(a[0], display=True), end='', file=a[1] if len(a)>1 else sys.stdout, flush=True) or VOID)
-    d(S('write'),     lambda a, _: print(show(a[0]), end='', file=a[1] if len(a)>1 else sys.stdout, flush=True) or VOID)
+    def _port_out(a): return a[1] if len(a) > 1 else sys.stdout
+    def _port_in(a):  return a[0] if a and isinstance(a[0], StringInputPort) else None
+
+    d(S('display'),   lambda a, _: print(show(a[0], display=True), end='', file=_port_out(a), flush=True) or VOID)
+    d(S('write'),     lambda a, _: print(show(a[0]), end='', file=_port_out(a), flush=True) or VOID)
     d(S('newline'),   lambda a, _: print(file=a[0] if a else sys.stdout) or VOID)
     d(S('print'),     lambda a, _: print(show(a[0], display=True), flush=True) or VOID)
     d(S('println'),   lambda a, _: print(show(a[0], display=True), flush=True) or VOID)
     d(S('writeln'),   lambda a, _: print(show(a[0]), flush=True) or VOID)
-    d(S('write-string'), lambda a, _: print(_str_val(a[0]), end='', flush=True) or VOID)
-    d(S('read-char'), lambda a, _: sys.stdin.read(1) or EOF)
-    d(S('peek-char'), lambda a, _: EOF)  # simplified
-    d(S('write-char'),lambda a, _: print(a[0], end='', flush=True) or VOID)
-    d(S('read-line'), lambda a, _: _read_line())
-    d(S('read'),      lambda a, _: _read_one())
-    d(S('open-input-file'),  lambda a, _: open(_str_val(a[0])))
-    d(S('open-output-file'), lambda a, _: open(_str_val(a[0]), 'w'))
-    d(S('close-port'),       lambda a, _: a[0].close() or VOID)
-    d(S('close-input-port'), lambda a, _: a[0].close() or VOID)
-    d(S('close-output-port'),lambda a, _: a[0].close() or VOID)
+    d(S('write-string'), lambda a, _: ((_port_out(a) if len(a) > 1 else sys.stdout).write(_str_val(a[0])) or VOID))
+    d(S('read-char'), lambda a, _: _read_char_port(a[0] if a else None))
+    d(S('peek-char'), lambda a, _: _peek_char_port(a[0] if a else None))
+    d(S('char-ready?'), lambda a, _: (a[0].char_ready() if isinstance(a[0], StringInputPort) else True) if a else True)
+    d(S('write-char'),lambda a, _: print(a[0], end='', file=a[1] if len(a)>1 else sys.stdout, flush=True) or VOID)
+    d(S('read-line'), lambda a, _: _read_line_port(a[0] if a else None))
+    d(S('read'),      lambda a, _: _read_datum_port(a[0] if a else None))
+    d(S('open-input-file'),   lambda a, _: open(_str_val(a[0])))
+    d(S('open-output-file'),  lambda a, _: open(_str_val(a[0]), 'w'))
+    d(S('open-input-string'), lambda a, _: StringInputPort(_str_val(a[0])))
+    d(S('open-output-string'),lambda a, _: StringOutputPort())
+    d(S('get-output-string'), lambda a, _: a[0].getvalue() if isinstance(a[0], StringOutputPort) else '')
+    d(S('with-input-from-string'), lambda a, e: _with_input_from_string(_str_val(a[0]), a[1], e))
+    d(S('close-port'),        lambda a, _: a[0].close() or VOID)
+    d(S('close-input-port'),  lambda a, _: a[0].close() or VOID)
+    d(S('close-output-port'), lambda a, _: a[0].close() or VOID)
     d(S('current-input-port'), lambda a, _: sys.stdin)
     d(S('current-output-port'),lambda a, _: sys.stdout)
     d(S('current-error-port'), lambda a, _: sys.stderr)
-    d(S('port?'),      lambda a, _: hasattr(a[0], 'read') or hasattr(a[0], 'write'))
-    d(S('input-port?'),lambda a, _: hasattr(a[0], 'read'))
-    d(S('output-port?'),lambda a, _: hasattr(a[0], 'write'))
-    d(S('eof-object'), lambda a, _: EOF)
-    d(S('void'),       lambda a, _: VOID)
+    d(S('port?'),        lambda a, _: isinstance(a[0], (StringInputPort, StringOutputPort)) or hasattr(a[0], 'read') or hasattr(a[0], 'write'))
+    d(S('input-port?'),  lambda a, _: isinstance(a[0], StringInputPort) or hasattr(a[0], 'read'))
+    d(S('output-port?'), lambda a, _: isinstance(a[0], StringOutputPort) or hasattr(a[0], 'write'))
+    d(S('string-port?'), lambda a, _: isinstance(a[0], (StringInputPort, StringOutputPort)))
+    d(S('eof-object'),   lambda a, _: EOF)
+    d(S('void'),         lambda a, _: VOID)
     d(S('with-output-to-string'), lambda a, e: _output_to_string(a[0], e))
+    d(S('call-with-port'), lambda a, e: (_call(a[1], [a[0]], e), a[0].close(), None)[-1] or VOID)
+    d(S('call-with-string-output-port'), lambda a, e:
+        (lambda p: (_call(a[0], [p], e), p.getvalue())[1])(StringOutputPort()))
 
-    def _read_line():
+    def _read_char_port(port):
+        if isinstance(port, StringInputPort): ch = port.read(1); return ch if ch else EOF
+        return sys.stdin.read(1) or EOF
+
+    def _peek_char_port(port):
+        if isinstance(port, StringInputPort): return port.peek_char()
+        return EOF  # simplified for file ports
+
+    def _read_line_port(port):
+        if isinstance(port, StringInputPort):
+            line = port.readline(); return EOF if not line else line.rstrip('\n')
         try:
             line = sys.stdin.readline()
             return EOF if not line else line.rstrip('\n')
         except EOFError: return EOF
 
+    def _read_datum_port(port):
+        if isinstance(port, StringInputPort): return port.read_datum()
+        return _read_one()
+
     def _read_one():
         try:
             line = input()
@@ -1238,6 +1576,10 @@ def make_global_env():
             return exprs[0] if exprs else EOF
         except EOFError: return EOF
 
+    def _with_input_from_string(s, thunk, env):
+        port = StringInputPort(s)
+        return _call(thunk, [port], env)
+
     def _output_to_string(thunk, env):
         import io
         buf = io.StringIO()
@@ -1250,15 +1592,19 @@ def make_global_env():
 
     # ── Control ───────────────────────────────────────────────────────────────
     d(S('exit'),      lambda a, _: sys.exit(0 if not a else int(_num(a[0]))))
-    d(S('error'),     lambda a, _: _raise(LispErr(show(a[0],display=True) + (': ' + ' '.join(show(x) for x in a[1:]) if a[1:] else ''))))
-    d(S('raise'),     lambda a, _: _raise(LispErr(show(a[0]))))
+    d(S('error'),     lambda a, _: (lambda obj: _raise(LispErr(str(obj), obj=obj)))(
+        ErrorObject(show(a[0], display=True), a[1:])))
+    d(S('raise'),     lambda a, _: _raise(LispErr(str(a[0]) if isinstance(a[0], ErrorObject) else show(a[0]),
+                                                   obj=a[0] if isinstance(a[0], ErrorObject) else None)))
     d(S('raise-continuable'), lambda a, _: _raise(LispErr(show(a[0]))))
-    d(S('error-message'), lambda a, _: str(a[0]))
-    d(S('with-exception-handler'), lambda a, e: (
-        (lambda handler, thunk: (lambda: _call(thunk,[],e))()) if False else
-        None))  # handled as special form
-    d(S('condition?'), lambda a, _: isinstance(a[0], str))
-    d(S('condition/report-string'), lambda a, _: str(a[0]))
+    d(S('error-object?'),          lambda a, _: isinstance(a[0], ErrorObject))
+    d(S('error?'),                 lambda a, _: isinstance(a[0], ErrorObject))
+    d(S('error-object-message'),   lambda a, _: a[0].msg if isinstance(a[0], ErrorObject) else str(a[0]))
+    d(S('error-object-irritants'), lambda a, _: _P(a[0].irritants) if isinstance(a[0], ErrorObject) else NIL)
+    d(S('error-message'),          lambda a, _: a[0].msg if isinstance(a[0], ErrorObject) else str(a[0]))
+    d(S('condition?'),             lambda a, _: isinstance(a[0], (ErrorObject, str)))
+    d(S('condition/report-string'),lambda a, _: str(a[0]))
+    d(S('with-exception-handler'), lambda a, e: None)  # handled as special form
 
     # ── Misc ──────────────────────────────────────────────────────────────────
     d(S('not'),          lambda a, _: not _truthy(a[0]))
@@ -1284,6 +1630,8 @@ def make_global_env():
     d(S('object->string'), lambda a, _: show(a[0]))
     d(S('write-to-string'),lambda a, _: show(a[0]))
     d(S('display-to-string'), lambda a, _: show(a[0], display=True))
+    d(S('pretty-print'), lambda a, e: print(_pprint(a[0]), file=a[1] if len(a)>1 else sys.stdout) or VOID)
+    d(S('pp'),           lambda a, e: print(_pprint(a[0]), file=a[1] if len(a)>1 else sys.stdout) or VOID)
 
     # Python interop
     d(S('py-eval'),   lambda a, _: eval(_str_val(a[0])))
@@ -1342,37 +1690,13 @@ PRELUDE = r"""
 (define-macro (for var lst . body)
   `(for-each (lambda (,var) ,@body) ,lst))
 
-(define-macro (define-record-type name . rest)
-  (let* ((ctor-spec  (car rest))
-         (constructor (car ctor-spec))
-         (fields      (cdr ctor-spec))
-         (pred        (cadr rest))
-         (slot-specs  (cddr rest))
-         (tag         (list 'quote name)))
-    `(begin
-       (define (,constructor ,@fields)
-         (list ,tag ,@fields))
-       (define (,pred x)
-         (and (pair? x) (eq? (car x) ,tag)))
-       ,@(map (lambda (spec i)
-                (let* ((tag    (car spec))
-                       (getter (cadr spec))
-                       (setter (if (null? (cddr spec)) #f (caddr spec))))
-                  `(begin
-                     (define (,getter r) (list-ref r ,i))
-                     ,@(if setter
-                           `((define (,setter r v) (list-set! r ,i v)))
-                           '()))))
-              slot-specs
-              (iota (length slot-specs) 1)))))
+; define-record-type is now a Python special form (supports (inherit parent))
 
 (define (call-with-string-output-port proc)
   (let ((port (open-output-string)))
     (proc port)
     (get-output-string port)))
 
-(define (pp x) (writeln x))
-
 (define (1+ n) (+ n 1))
 (define (1- n) (- n 1))
 (define (-1+ n) (- n 1))