clojure: land all Tier 1 features — destructuring, ex-info, walk, combinators
ober
2dd95078e333ab641ebd44e140d552cdf4f25d0e
--- a/docs/clojure-vs-jerboa.md +++ b/docs/clojure-vs-jerboa.md @@ -1499,17 +1499,19 @@ Most of the features originally ranked "Tier 1 / Tier 2" are now in place. The C What's left, ranked by value-per-effort. Each entry links to the section above for the full discussion. -### Tier 1 — Biggest daily-ergonomics wins, low-to-medium effort +### Tier 1 — ✅ Landed (2026-04-11) -| Feature | Section | Effort | Why it's worth doing | -|---------|---------|--------|----------------------| -| **Map destructuring with `:keys` in `let`/`def`** | [§14](#14-destructuring-everywhere) | Easy–Medium | Single biggest "I miss this every day" gap for Clojure migrants. `(def (f {:keys [name age]}) ...)` in function params. A macro on top of the existing `match` machinery. | -| **`ex-info` / `ex-data` structured exceptions** | [§27](#27-exception-design-ex-info) | Easy | Ten-line shim over Jerboa's condition system. Makes every library catch-by-data-shape instead of catch-by-class. | -| **`memoize` / `iterate` / `repeatedly`** | [§26](#26-memoize-trampoline-and-friends) | Easy | The three missing functional combinators. Couple dozen lines total. | -| **`clojure.walk` (`postwalk` / `prewalk` / `keywordize-keys`)** | [§33](#33-clojurewalk) | Easy | Generic tree rewriting. Self-contained library, ~100 lines. | -| **`doto` macro** | [§38](#38-miscellaneous-small-things-that-add-up) | Trivial | Threads an object through side-effecting calls. One-macro add. | -| **Dynamic vars + `binding` sugar** | [§16](#16-dynamic-vars-and-thread-local-binding) | Easy | Wrap `make-parameter`/`parameterize` in `def-dynamic` + `binding` macros so Clojure porters don't have to know about Chez parameters. | -| **Map-convenience stragglers** | [§38](#38-miscellaneous-small-things-that-add-up) | Easy | `merge-with`, `zipmap`, `reduce-kv`, `min-key`/`max-key`. The handful of map-convenience functions not yet exported from `(std clojure)` (merge and select-keys already landed). Each is 5–15 lines. | +All Tier 1 items shipped in a single batch in `(std clojure)` and `(std clojure walk)`. + +| Feature | Section | Status | Notes | +|---------|---------|--------|-------| +| **Map destructuring with `:keys` in `let`/`def`** | [§14](#14-destructuring-everywhere) | ✅ Landed | `dlet` macro with list destructure, map `:keys`, `:as`, `:or` defaults. `dfn` for destructured function params. | +| **`ex-info` / `ex-data` structured exceptions** | [§27](#27-exception-design-ex-info) | ✅ Landed | `ex-info`, `ex-info?`, `ex-data`, `ex-message`, `ex-cause`. Condition-type based. | +| **`memoize` / `iterate` / `repeatedly`** | [§26](#26-memoize-trampoline-and-friends) | ✅ Landed | Re-exported from prelude internals. `iterate` is strict/bounded: `(iterate n f x)`. | +| **`clojure.walk` (`postwalk` / `prewalk` / `keywordize-keys`)** | [§33](#33-clojurewalk) | ✅ Landed | New `(std clojure walk)` module. Handles lists, vectors, pmaps, pvecs, psets. | +| **`doto` macro** | [§38](#38-miscellaneous-small-things-that-add-up) | ✅ Landed | `syntax-rules` macro in `(std clojure)`. | +| **Dynamic vars + `binding` sugar** | [§16](#16-dynamic-vars-and-thread-local-binding) | ✅ Landed | `def-dynamic` wraps `make-parameter`, `binding` wraps `parameterize`. | +| **Map-convenience stragglers** | [§38](#38-miscellaneous-small-things-that-add-up) | ✅ Landed | `merge-with`, `zipmap`, `reduce-kv`, `min-key`, `max-key`. | ### Tier 2 — High value, medium effort, self-contained @@ -1549,6 +1551,6 @@ What's left, ranked by value-per-effort. Each entry links to the section above f ### Recommendation -If I were picking the next pass after this campaign: **Tier 1 as a single batch**. Map destructuring, `ex-info`, `memoize`/`iterate`/`repeatedly`, `clojure.walk`, `doto`, and dynamic-var sugar together are maybe a few days of work and close most of the "I type this every hour and Jerboa doesn't have it" complaints from Clojure migrants. Tier 2 items become more attractive in isolation once Tier 1 is in place. Tier 3's STM is the only remaining "foundational" gap and deserves a real design round of its own. +Tier 1 is done. The next natural pass is **Tier 2 items in isolation** — lazy sequences, zippers, and Specter-style paths each stand alone and become more attractive now that the core ergonomics gap is closed. Tier 3's STM is the only remaining "foundational" gap and deserves a real design round of its own. The language features above are what you'd port. The culture is built alongside, one idiomatic library at a time. --- a/lib/std/clojure.sls +++ b/lib/std/clojure.sls @@ -39,7 +39,8 @@ (export ;; ---- Polymorphic collection ops (new in this module) ---- get assoc dissoc contains? count keys vals - merge update select-keys + merge merge-with update select-keys + zipmap reduce-kv min-key max-key first rest next last conj cons* empty? peek pop @@ -48,6 +49,22 @@ inc dec nil? some? true? false? + ;; ---- Functional combinators (re-exports + Clojure additions) ---- + memoize iterate repeatedly fnil + every-pred some-fn + + ;; ---- Sugar macros ---- + doto + + ;; ---- Destructuring (Clojure-style) ---- + dlet dfn + + ;; ---- Dynamic vars (Clojure-style binding) ---- + def-dynamic binding + + ;; ---- Structured exceptions (ex-info / ex-data) ---- + ex-info ex-info? ex-data ex-message ex-cause + ;; ---- Transients (Clojure-style polymorphic dispatch) ---- transient persistent! transient? assoc! dissoc! conj! @@ -127,6 +144,9 @@ (std misc atom) (std misc meta) (std misc nested) + (only (std misc func) fnil every-pred some-fn) + (rename (only (std misc memoize) memoize) (memoize clj-memoize)) + (only (std misc list) iterate-n) (std pqueue) (std sorted-set)) @@ -1037,4 +1057,452 @@ (define (superset? s1 s2) (subset? s2 s1)) + ;; ========================================================================= + ;; Map-convenience stragglers — Clojure's `merge-with`, `zipmap`, + ;; `reduce-kv`, and `min-key`/`max-key`. + ;; ========================================================================= + + ;; merge-with — like merge, but resolves key collisions by applying + ;; `f` to the existing and new values. Preserves the type of the + ;; leftmost map argument. + ;; (merge-with + {:a 1 :b 2} {:b 3 :c 4}) => {:a 1 :b 5 :c 4} + (define (merge-with f . maps) + (cond + [(null? maps) #f] ;; Clojure returns nil + [(null? (cdr maps)) (car maps)] + [else + (let ([first-map (car maps)]) + (reduce + (lambda (acc m) + (reduce + (lambda (acc2 kv) + (let ([k (car kv)] [v (cdr kv)]) + (if (contains? acc2 k) + (assoc acc2 k (f (get acc2 k) v)) + (assoc acc2 k v)))) + acc + (seq m))) + first-map + (cdr maps)))])) + + ;; zipmap — build a persistent-map from a list of keys and values. + ;; (zipmap '(a b c) '(1 2 3)) => {a 1 b 2 c 3} + ;; Extra items in either list are ignored, matching Clojure. + (define (zipmap ks vs) + (let loop ([ks ks] [vs vs] [acc pmap-empty]) + (cond + [(or (null? ks) (null? vs)) acc] + [else (loop (cdr ks) (cdr vs) + (persistent-map-set acc (car ks) (car vs)))]))) + + ;; reduce-kv — like reduce, but takes a 3-argument function (acc k v) + ;; and walks a map's entries. + ;; (reduce-kv (lambda (acc k v) (+ acc v)) 0 {:a 1 :b 2}) => 3 + (define (reduce-kv f init coll) + (cond + [(persistent-map? coll) + (persistent-map-fold + (lambda (acc k v) (f acc k v)) + init coll)] + [(concurrent-hash? coll) + (let ([acc init]) + (concurrent-hash-for-each + (lambda (k v) (set! acc (f acc k v))) + coll) + acc)] + [(hash-table? coll) + (let ([acc init]) + (hash-for-each + (lambda (k v) (set! acc (f acc k v))) + coll) + acc)] + [(and (record? coll) + (not (persistent-map? coll)) + (not (persistent-set? coll)) + (not (sorted-set? coll)) + (not (concurrent-hash? coll))) + (let loop ([fields (%record-fields-all coll)] [acc init]) + (if (null? fields) + acc + (let ([pair (car fields)]) + (loop (cdr fields) + (f acc (car pair) ((cdr pair) coll))))))] + [else (error 'reduce-kv "unsupported collection type" coll)])) + + ;; min-key — return the x in coll that minimizes (k x). + ;; (min-key count '("aa" "b" "ccc")) => "b" + (define (min-key k x . more) + (if (null? more) + x + (let loop ([best x] [best-key (k x)] [rest more]) + (if (null? rest) + best + (let* ([y (car rest)] [yk (k y)]) + (if (< yk best-key) + (loop y yk (cdr rest)) + (loop best best-key (cdr rest)))))))) + + ;; max-key — return the x in coll that maximizes (k x). + (define (max-key k x . more) + (if (null? more) + x + (let loop ([best x] [best-key (k x)] [rest more]) + (if (null? rest) + best + (let* ([y (car rest)] [yk (k y)]) + (if (> yk best-key) + (loop y yk (cdr rest)) + (loop best best-key (cdr rest)))))))) + + ;; ========================================================================= + ;; Functional combinators — memoize / iterate / repeatedly + ;; + ;; Clojure's `iterate` and `repeatedly` return lazy seqs; Jerboa has + ;; no lazy seqs in the prelude (Tier 2 item). For now we expose + ;; bounded, strict forms that require a count. + ;; ========================================================================= + + ;; memoize — cache f's results by argument list (unbounded). + (define memoize clj-memoize) + + ;; iterate — (iterate n f x) returns a list of n elements: + ;; (x (f x) (f (f x)) ... ) + ;; Clojure's (iterate f x) is lazy and infinite; Jerboa's strict form + ;; requires the count up front. Equivalent to Clojure's + ;; (take n (iterate f x)). + (define (iterate n f x) (iterate-n n f x)) + + ;; repeatedly — (repeatedly n f) calls f n times and returns the list + ;; of results. + ;; (repeatedly 3 (lambda () (random 10))) => (3 7 1) + (define (repeatedly n f) + (let loop ([i 0] [acc '()]) + (if (>= i n) + (reverse acc) + (loop (+ i 1) (cons (f) acc))))) + + ;; ========================================================================= + ;; doto — thread an object through side-effecting calls. + ;; + ;; (doto obj (f a b) (g c)) => (let ([x obj]) (f x a b) (g x c) x) + ;; + ;; Classic use: build up a mutable container. + ;; (doto (make-hash-table) + ;; (hash-put! 'a 1) + ;; (hash-put! 'b 2)) + ;; ========================================================================= + (define-syntax doto + (syntax-rules () + [(_ x) x] + [(_ x (f arg ...) rest ...) + (let ([tmp x]) + (f tmp arg ...) + (doto tmp rest ...))])) + + ;; ========================================================================= + ;; Destructuring — Clojure-style `dlet` and `dfn`. + ;; + ;; Destructuring `let` that supports sequential and map patterns: + ;; + ;; (dlet ([x 42] ;; plain binding + ;; [(a b c) '(1 2 3)] ;; list destructure + ;; [(h & t) '(10 20 30)] ;; head + rest + ;; [(keys: x y) m] ;; map :keys (keyword lookup) + ;; [(keys: x y as: all) m] ;; map + bind whole + ;; [(keys: x y or: ([y 100])) m]) ;; map + defaults + ;; body ...) + ;; + ;; `dfn` defines a function whose parameters are destructured: + ;; (dfn (name (keys: x y) z) body ...) + ;; → (define (name _tmp z) (dlet ([(keys: x y) _tmp]) body ...)) + ;; + ;; NOTES: + ;; - keys: lookups use Jerboa keywords (x: → #:x) via `get`. + ;; - List patterns walk via car/cdr — no length checking. + ;; - & binds the remainder of the list. + ;; ========================================================================= + + (define-syntax dlet + (lambda (stx) + ;; Is datum a Jerboa keyword (name:)? + ;; The Jerboa reader stores keywords as symbols with a trailing + ;; colon: keys: → symbol "keys:", x: → symbol "x:". + (define (kw-datum? d) + (and (symbol? d) + (let ([s (symbol->string d)]) + (and (>= (string-length s) 2) + (char=? (string-ref s (- (string-length s) 1)) #\:))))) + + ;; Does keyword datum match a specific name? + (define (kw=? d name) + (and (kw-datum? d) + (string=? (symbol->string d) + (string-append name ":")))) + + ;; symbol → keyword symbol: x → x: + (define (sym->kw s) + (string->symbol (string-append (symbol->string s) ":"))) + + ;; Parse the spec list after keys: keyword. + ;; Returns (values names as-name or-alist) + ;; names = list of symbols + ;; as-name = #f or symbol + ;; or-alist = ((name . default) ...) + (define (parse-keys-spec specs) + (let loop ([rest specs] [names '()] [as-name #f] [defaults '()]) + (cond + [(null? rest) + (values (reverse names) as-name defaults)] + ;; as: sym + [(and (kw=? (car rest) "as") (pair? (cdr rest))) + (loop (cddr rest) names (cadr rest) defaults)] + ;; or: ((name default) ...) + [(and (kw=? (car rest) "or") (pair? (cdr rest)) + (list? (cadr rest))) + (loop (cddr rest) names as-name + (append defaults + (map (lambda (pair) (cons (car pair) (cadr pair))) + (cadr rest))))] + ;; plain symbol + [(and (symbol? (car rest)) (not (kw-datum? (car rest)))) + (loop (cdr rest) (cons (car rest) names) as-name defaults)] + [else + (error 'dlet "invalid keys: spec" specs)]))) + + ;; Build car/cdr accessor chain for index i. + ;; 0 → (car tmp), 1 → (cadr tmp), 2 → (caddr tmp), etc. + (define (list-ref-expr tmp i) + (let loop ([i i] [expr tmp]) + (cond + [(zero? i) `(car ,expr)] + [else (loop (- i 1) `(cdr ,expr))]))) + + ;; Build cdr chain to get the tail after index i. + ;; (list-tail-expr tmp 2) → (cddr tmp) + (define (list-tail-expr tmp i) + (let loop ([i i] [expr tmp]) + (cond + [(zero? i) expr] + [else (loop (- i 1) `(cdr ,expr))]))) + + ;; Analyze a list pattern for & (rest capture). + ;; Returns (values before-syms rest-sym) + ;; where rest-sym is #f if no & found. + (define (parse-list-pattern elems) + (let loop ([rest elems] [before '()]) + (cond + [(null? rest) + (values (reverse before) #f)] + [(and (symbol? (car rest)) (string=? (symbol->string (car rest)) "&") + (pair? (cdr rest)) + (null? (cddr rest))) + (values (reverse before) (cadr rest))] + [else + (loop (cdr rest) (cons (car rest) before))]))) + + (syntax-case stx () + ;; Base: no bindings left + [(k () body ...) + #'(begin body ...)] + + ;; Symbol pattern — plain binding + [(k ([pat expr] . rest) body ...) + (identifier? #'pat) + #'(let ([pat expr]) + (dlet rest body ...))] + + ;; Compound pattern — inspect at datum level. + ;; Use #'expr as the lexical context for generated bindings + ;; so that they resolve in the user's scope. + [(k ([pat expr] . rest) body ...) + (let* ([p (syntax->datum #'pat)] + ;; Use the second element of pat (a user identifier) + ;; as the lexical context so generated names resolve + ;; in the user's scope. Fall back to the first body form. + [pat-elts (syntax->list #'pat)] + [ctx (if (and pat-elts (> (length pat-elts) 1)) + (cadr pat-elts) ;; first name in pattern + #'k)]) + (cond + ;; --- Map destructure: (keys: x y ...) --- + [(and (pair? p) (kw=? (car p) "keys")) + (let-values ([(names as-name defaults) + (parse-keys-spec (cdr p))]) + (let* ([tmp (gensym "map")] + [binds + (append + (if as-name (list (list as-name tmp)) '()) + (map (lambda (name) + (let ([kw (sym->kw name)] + [dflt (assq name defaults)]) + (if dflt + `(,name (if (contains? ,tmp ',kw) + (get ,tmp ',kw) + ,(cdr dflt))) + `(,name (get ,tmp ',kw))))) + names))]) + (with-syntax ([tmp-id (datum->syntax ctx tmp)] + [(bind ...) (datum->syntax ctx binds)] + [e #'expr] + [r #'rest] + [(bd ...) #'(body ...)]) + #'(let ([tmp-id e]) + (let* (bind ...) + (dlet r bd ...))))))] + + ;; --- List destructure: (a b c) or (a b & rest) --- + [(pair? p) + (let-values ([(before rest-sym) (parse-list-pattern p)]) + (let* ([tmp (gensym "seq")] + [binds + (append + (let loop ([i 0] [syms before] [acc '()]) + (if (null? syms) + (reverse acc) + (loop (+ i 1) + (cdr syms) + (cons (list (car syms) + (list-ref-expr tmp i)) + acc)))) + (if rest-sym + (list (list rest-sym + (list-tail-expr tmp + (length before)))) + '()))]) + (with-syntax ([tmp-id (datum->syntax ctx tmp)] + [(bind ...) (datum->syntax ctx binds)] + [e #'expr] + [r #'rest] + [(bd ...) #'(body ...)]) + #'(let ([tmp-id e]) + (let* (bind ...) + (dlet r bd ...))))))] + + [else (syntax-error #'pat "dlet: unsupported pattern")]))]))) + + ;; dfn — define a function with destructured parameters. + ;; + ;; Parameters that are compound patterns are destructured. Plain + ;; symbol parameters pass through. + ;; + ;; (dfn (name (keys: x y) z) body ...) + ;; → (define (name __tmp1 z) + ;; (dlet ([(keys: x y) __tmp1]) body ...)) + (define-syntax dfn + (lambda (stx) + ;; Returns #t for identifiers (plain symbols), #f for compound + ;; patterns that need destructuring. + (define (simple-param? d) + (and (symbol? d) + (not (pair? d)))) + + (syntax-case stx () + [(k (name params ...) body ...) + (identifier? #'name) + (let* ([ctx #'name] ;; use the function name as lexical context + [param-data (map syntax->datum (syntax->list #'(params ...)))] + [formals + (map (lambda (p) + (if (simple-param? p) p (gensym "arg"))) + param-data)] + [bindings + (let loop ([ps param-data] [fs formals] [acc '()]) + (cond + [(null? ps) (reverse acc)] + [(simple-param? (car ps)) + (loop (cdr ps) (cdr fs) acc)] + [else + (loop (cdr ps) (cdr fs) + (cons (list (car ps) (car fs)) acc))]))]) + (with-syntax ([(formal ...) (datum->syntax ctx formals)] + [binds (datum->syntax ctx bindings)] + [(bd ...) #'(body ...)]) + #'(define (name formal ...) + (dlet binds bd ...))))]))) + + ;; ========================================================================= + ;; Dynamic vars — Clojure-style `def-dynamic` + `binding`. + ;; + ;; Wraps Chez's `make-parameter` / `parameterize` with the Clojure + ;; surface syntax. + ;; + ;; (def-dynamic *debug* #f) + ;; (binding ([*debug* #t]) + ;; (log "hi")) + ;; + ;; A dynamic-var identifier is actually bound to a Chez parameter + ;; object — normal reads look like `(*debug*)`. The `binding` macro + ;; expands to `parameterize`, which rebinds the parameter for the + ;; dynamic extent of its body. + ;; + ;; NOTE: because a dynamic var IS a parameter, reading it requires + ;; calling it (e.g. `(*debug*)` not `*debug*`). This matches Chez's + ;; parameter discipline. For shorthand read-as-value access, wrap + ;; the parameter in a `define-syntax` identifier macro on the user + ;; side, or project your own helper. + ;; ========================================================================= + (define-syntax def-dynamic + (syntax-rules () + [(_ name default) + (define name (make-parameter default))] + [(_ name default guard) + (define name (make-parameter default guard))])) + + (define-syntax binding + (syntax-rules () + [(_ ([var val] ...) body ...) + (parameterize ([var val] ...) body ...)])) + + ;; ========================================================================= + ;; Structured exceptions — Clojure's `ex-info` / `ex-data` surface. + ;; + ;; Wraps Jerboa/Chez's condition system so handlers can match on + ;; a data map rather than a class hierarchy. + ;; + ;; (try + ;; (throw (ex-info "nsf" (hash-map :from a :to b :reason 'nsf))) + ;; (catch (e) + ;; (when (ex-info? e) + ;; (let ([data (ex-data e)]) + ;; (when (eq? (get data :reason) 'nsf) + ;; (handle-nsf)))))) + ;; + ;; `ex-info` creates a composite condition containing a data + ;; condition, a message condition, and optionally a nested cause. + ;; `ex-data`, `ex-message`, `ex-cause` extract the parts and return + ;; #f if the condition isn't an ex-info. + ;; ========================================================================= + + (define-condition-type &ex-info &condition + make-ex-info-condition ex-info-condition? + (data ex-info-condition-data) + (cause ex-info-condition-cause)) + + (define ex-info + (case-lambda + [(msg data) (ex-info msg data #f)] + [(msg data cause) + (condition + (make-ex-info-condition data cause) + (make-message-condition msg))])) + + (define (ex-info? c) + (and (condition? c) (ex-info-condition? c))) + + (define (ex-data c) + (and (condition? c) + (ex-info-condition? c) + (ex-info-condition-data c))) + + (define (ex-message c) + (cond + [(and (condition? c) (message-condition? c)) + (condition-message c)] + [else #f])) + + (define (ex-cause c) + (and (condition? c) + (ex-info-condition? c) + (ex-info-condition-cause c))) + ) ;; end library new file mode 100644 --- /dev/null +++ b/tests/test-clojure-tier1.ss @@ -0,0 +1,140 @@ +(import (except (jerboa prelude) hash-map) + (std clojure) + (std clojure walk)) + +(define pass 0) +(define fail 0) +(define-syntax chk + (syntax-rules (=>) + [(_ expr => expected) + (let ([r expr] [e expected]) + (if (equal? r e) + (set! pass (+ pass 1)) + (begin (set! fail (+ fail 1)) + (display "FAIL: ") (write 'expr) + (display " => ") (write r) + (display " expected ") (write e) (newline))))])) + +;; ========== merge-with ========== +(chk (let ([m (merge-with + (hash-map 'a 1 'b 2) (hash-map 'b 3 'c 4))]) + (list (get m 'a) (get m 'b) (get m 'c))) + => '(1 5 4)) + +;; ========== zipmap ========== +(chk (let ([m (zipmap '(a b c) '(1 2 3))]) + (list (get m 'a) (get m 'b) (get m 'c))) + => '(1 2 3)) +;; extra keys ignored +(chk (let ([m (zipmap '(a b) '(1 2 3))]) + (count m)) + => 2) + +;; ========== reduce-kv ========== +(chk (reduce-kv (lambda (acc k v) (+ acc v)) 0 (hash-map 'a 1 'b 2 'c 3)) + => 6) + +;; ========== min-key / max-key ========== +(chk (min-key string-length "aa" "b" "ccc") => "b") +(chk (max-key string-length "aa" "b" "ccc") => "ccc") +(chk (min-key car '(3 x) '(1 x) '(2 x)) => '(1 x)) + +;; ========== memoize ========== +(chk (let* ([calls 0] + [f (memoize (lambda (x) (set! calls (+ calls 1)) (* x x)))]) + (f 4) (f 4) (f 5) (f 4) + (list (f 4) (f 5) calls)) + => '(16 25 2)) + +;; ========== iterate ========== +(chk (iterate 5 (lambda (x) (* x 2)) 1) => '(1 2 4 8 16)) +(chk (iterate 0 (lambda (x) x) 1) => '()) + +;; ========== repeatedly ========== +(chk (repeatedly 3 (lambda () 42)) => '(42 42 42)) +(chk (repeatedly 0 (lambda () 1)) => '()) + +;; ========== doto ========== +(chk (let ([h (doto (make-hash-table) + (hash-put! 'a 1) + (hash-put! 'b 2))]) + (list (hash-ref h 'a) (hash-ref h 'b))) + => '(1 2)) + +;; ========== def-dynamic / binding ========== +;; tested via script rather than inline (requires top-level define) + +;; ========== ex-info / ex-data ========== +(chk (try (raise (ex-info "oops" (hash-map 'reason 'nsf 'amount 100))) + (catch (e) + (list (ex-info? e) (ex-message e) (get (ex-data e) 'reason)))) + => '(#t "oops" nsf)) + +(chk (try (raise (ex-info "fail" (hash-map 'code 42) (make-message-condition "cause"))) + (catch (e) (ex-info? e))) + => #t) + +(chk (ex-data (make-message-condition "not ex-info")) => #f) + +;; ========== dlet — list destructure ========== +(chk (dlet ([(a b c) '(1 2 3)]) (+ a b c)) => 6) +(chk (dlet ([(h & t) '(10 20 30)]) (list h t)) => '(10 (20 30))) + +;; ========== dlet — map destructure ========== +(chk (dlet ([(keys: x y) (hash-map 'x: 10 'y: 20)]) (+ x y)) => 30) + +;; ========== dlet — :as ========== +(chk (dlet ([(keys: x as: m) (hash-map 'x: 42)]) + (list x (persistent-map? m))) + => '(42 #t)) + +;; ========== dlet — :or defaults ========== +(chk (dlet ([(keys: x y or: ([y 99])) (hash-map 'x: 10)]) + (list x y)) + => '(10 99)) + +;; ========== dlet — multiple bindings ========== +(chk (dlet ([a 1] [(b c) '(2 3)] [(keys: d) (hash-map 'd: 4)]) + (+ a b c d)) + => 10) + +;; ========== dfn ========== +(dfn (sum-pair (a b)) (+ a b)) +(chk (sum-pair '(3 7)) => 10) + +(dfn (get-x (keys: x)) x) +(chk (get-x (hash-map 'x: 42)) => 42) + +(dfn (mixed (keys: x) y) (+ x y)) +(chk (mixed (hash-map 'x: 10) 20) => 30) + +;; ========== clojure.walk — postwalk ========== +(chk (postwalk (lambda (x) (if (number? x) (* x 2) x)) + '(1 (2 3) 4)) + => '(2 (4 6) 8)) + +;; ========== clojure.walk — prewalk ========== +(chk (prewalk (lambda (x) (if (and (list? x) (not (null? x)) (eq? (car x) 'skip)) + 'SKIPPED x)) + '(a (skip b) c)) + => '(a SKIPPED c)) + +;; ========== clojure.walk — postwalk-replace ========== +(chk (postwalk-replace (hash-map 'x 1 'y 2) '(x y z)) + => '(1 2 z)) + +;; ========== clojure.walk — keywordize-keys ========== +(chk (let ([m (keywordize-keys (hash-map "a" 1 "b" 2))]) + (sort (keys m) + (lambda (a b) (string<? (symbol->string a) (symbol->string b))))) + => (list (string->keyword "a") (string->keyword "b"))) + +;; ========== clojure.walk — stringify-keys ========== +(chk (let ([m (stringify-keys (hash-map (string->keyword "a") 1))]) + (keys m)) + => '("a")) + +(newline) +(display "clojure tier-1: ") +(display pass) (display " passed, ") +(display fail) (display " failed") (newline) +(when (> fail 0) (exit 1))