From e1317c0a7efa86cbfbaa1949cfbb3d46ad1bd220 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Mon, 1 Jun 2026 23:37:55 -0400 Subject: [PATCH] multi-arity fn*, nil sentinel in resolve-sym, let pre-registration, meta/when-not/qualified-symbol? core bindings evaluator: fn* multi-arity dispatch, nil-local-vs-absent sentinel, let* pre-registers bindings core: core-meta, core-when-not, core-qualified-symbol?, *unchecked-math*, *clojure-version* --- .clj-kondo/.cache/v1/clj/user.transit.json | 2 +- .dirge/skills/.usage.json | 36 +++---- .dirge/skills/jolt-bootstrap/SKILL.md | 64 ++++++++----- .dirge/skills/jolt-dev/SKILL.md | 27 +++++- src/jolt/core.janet | 20 +++- src/jolt/evaluator.janet | 104 ++++++++++++++------- 6 files changed, 175 insertions(+), 78 deletions(-) diff --git a/.clj-kondo/.cache/v1/clj/user.transit.json b/.clj-kondo/.cache/v1/clj/user.transit.json index 8a41995..d392a72 100644 --- a/.clj-kondo/.cache/v1/clj/user.transit.json +++ b/.clj-kondo/.cache/v1/clj/user.transit.json @@ -1 +1 @@ -["^ ","~$eval-list",["^ ","~:fixed-arities",["~#set",[3]],"~:private",true,"~:ns","~$user","~:name","^0","~:type","~:fn","~:col",1,"~:top-ns",null,"~:row",195],"~$resolve-var",["^ ","^;",57,"^9",1,"^1",["^2",[3]],"^6","^<","^4","^5","^:",null,"^7","^8"],"~$syntax-quote*",["^ ","^1",["^2",[3]],"^3",true,"^4","^5","^6","^=","^7","^8","^9",1,"^:",null,"^;",22],"~$new-v",["^ ","^;",398,"^9",18,"^6","^>","^4","^5","^:",null],"~$ctor",["^ ","^;",472,"^9",17,"~:varargs-min-arity",0,"^6","^?","^4","^5","^:",null,"^7","^8"],"~$v",["^ ","^;",251,"^9",20,"^6","~$v","^4","^5","^:",null],"~$resolve-sym",["^ ","^1",["^2",[3]],"^3",true,"^4","^5","^6","^A","^7","^8","^9",1,"^:",null,"^;",95],"~$first-form",["^ ","^;",197,"^9",3,"^6","^B","^4","^5","^:",null,"^7","~:any"],"~$run-finally",["^ ","^;",368,"^9",13,"^1",["^2",[1]],"^6","^D","^4","^5","^:",null,"^7","^8"],"~$eval-require",["^ ","^1",["^2",[2]],"^3",true,"^4","^5","^6","^E","^7","^8","^9",1,"^:",null,"~:arities",["^ ","~i2",["^ ","~:ret","~:nil","~:arglist-str","[ctx spec]"]],"^;",74],"~$alias-sym",["^ ","^;",85,"^9",15,"^6","^J","^4","^5","^:",null],"~$name",["^ ","^;",199,"^9",3,"^6","^K","^4","^5","^:",null,"^7",["^2",[["^ ","~:call",["^ ","~:filename","/Users/yogthos/src/jolt/src/jolt/evaluator.janet","^7","^L","~:lang","~:clj","~:base-lang","^O","~:resolved-ns","^5","^4","^5","^6","^B","~:arity",1],"^;",200,"^9",15,"~:end-row",200,"~:end-col",33],["^ ","~:tag","^H","^;",201,"^9",15,"^S",201,"^T",18]]]],"^M","/Users/yogthos/src/jolt/src/jolt/evaluator.janet","~$macro-fn",["^ ","^1",["^2",[]],"^4","^5","^6","^V","^7","^8","^9",18,"^:",null,"^@",0,"^;",235],"~$parse-arg-names",["^ ","^1",["^2",[1]],"^3",true,"^4","^5","^6","^W","^7","^8","^9",1,"^:",null,"^F",["^ ","~i1",["^ ","^G",["^ ","^7","~:map","~:val",["^ ","~:fixed",["^ ","^;",181,"^S",546,"^9",11,"^T",13]]],"^I","[args-form]"]],"^;",135],"~$special-symbol?",["^ ","^1",["^2",[1]],"^3",true,"^4","^5","^6","^[","^7","^8","^9",1,"^:",null,"^F",["^ ","~i1",["^ ","^G",["^2",["~:boolean"]],"^I","[name]"]],"^;",10],"~$sym-name?",["^ ","^1",["^2",[2]],"^3",true,"^4","^5","^6","^11","^7","^8","^9",1,"^:",null,"^;",6],"~$inner",["^ ","^;",159,"^9",17,"^6","^12","^4","^5","^:",null],"~$sym-name-str",["^ ","^1",["^2",[1]],"^3",true,"^4","^5","^6","^13","^7","^8","^9",1,"^:",null,"^;",70],"~$unwrap-meta-name",["^ ","^1",["^2",[1]],"^3",true,"^4","^5","^6","^14","^7","^8","^9",1,"^:",null,"^;",184]] \ No newline at end of file +["^ ","~$eval-list",["^ ","~:fixed-arities",["~#set",[3]],"~:private",true,"~:ns","~$user","~:name","^0","~:type","~:fn","~:col",1,"~:top-ns",null,"~:row",196],"~$resolve-var",["^ ","^;",57,"^9",1,"^1",["^2",[3]],"^6","^<","^4","^5","^:",null,"^7","^8"],"~$syntax-quote*",["^ ","^1",["^2",[3]],"^3",true,"^4","^5","^6","^=","^7","^8","^9",1,"^:",null,"^;",22],"~$new-v",["^ ","^;",436,"^9",18,"^6","^>","^4","^5","^:",null],"~$ctor",["^ ","^;",510,"^9",17,"~:varargs-min-arity",0,"^6","^?","^4","^5","^:",null,"^7","^8"],"~$v",["^ ","^;",252,"^9",20,"^6","~$v","^4","^5","^:",null],"~$resolve-sym",["^ ","^1",["^2",[3]],"^3",true,"^4","^5","^6","^A","^7","^8","^9",1,"^:",null,"^;",95],"~$first-form",["^ ","^;",198,"^9",3,"^6","^B","^4","^5","^:",null,"^7","~:any"],"~$run-finally",["^ ","^;",406,"^9",13,"^1",["^2",[1]],"^6","^D","^4","^5","^:",null,"^7","^8"],"~$eval-require",["^ ","^1",["^2",[2]],"^3",true,"^4","^5","^6","^E","^7","^8","^9",1,"^:",null,"~:arities",["^ ","~i2",["^ ","~:ret","~:nil","~:arglist-str","[ctx spec]"]],"^;",74],"~$alias-sym",["^ ","^;",85,"^9",15,"^6","^J","^4","^5","^:",null],"~$name",["^ ","^;",200,"^9",3,"^6","^K","^4","^5","^:",null,"^7",["^2",[["^ ","~:tag","^H","^;",202,"^9",15,"~:end-row",202,"~:end-col",18],["^ ","~:call",["^ ","~:filename","/Users/yogthos/src/jolt/src/jolt/evaluator.janet","^7","^O","~:lang","~:clj","~:base-lang","^R","~:resolved-ns","^5","^4","^5","^6","^B","~:arity",1],"^;",201,"^9",15,"^M",201,"^N",33]]]],"^P","/Users/yogthos/src/jolt/src/jolt/evaluator.janet","~$macro-fn",["^ ","^1",["^2",[]],"^4","^5","^6","^V","^7","^8","^9",18,"^:",null,"^@",0,"^;",236],"~$val",["^ ","^;",351,"^9",21,"^6","^W","^4","^5","^:",null],"~$parse-arg-names",["^ ","^1",["^2",[1]],"^3",true,"^4","^5","^6","^X","^7","^8","^9",1,"^:",null,"^F",["^ ","~i1",["^ ","^G",["^ ","^7","~:map","~:val",["^ ","~:fixed",["^ ","^;",182,"^M",584,"^9",11,"^N",13]]],"^I","[args-form]"]],"^;",136],"~$special-symbol?",["^ ","^1",["^2",[1]],"^3",true,"^4","^5","^6","^10","^7","^8","^9",1,"^:",null,"^F",["^ ","~i1",["^ ","^G",["^2",["~:boolean"]],"^I","[name]"]],"^;",10],"~$sym-name?",["^ ","^1",["^2",[2]],"^3",true,"^4","^5","^6","^12","^7","^8","^9",1,"^:",null,"^;",6],"~$inner",["^ ","^;",160,"^9",17,"^6","^13","^4","^5","^:",null],"~$sym-name-str",["^ ","^1",["^2",[1]],"^3",true,"^4","^5","^6","^14","^7","^8","^9",1,"^:",null,"^;",70],"~$unwrap-meta-name",["^ ","^1",["^2",[1]],"^3",true,"^4","^5","^6","^15","^7","^8","^9",1,"^:",null,"^;",185]] \ No newline at end of file diff --git a/.dirge/skills/.usage.json b/.dirge/skills/.usage.json index 11a18ea..8b1e5f4 100644 --- a/.dirge/skills/.usage.json +++ b/.dirge/skills/.usage.json @@ -1,16 +1,4 @@ { - "jolt-dev": { - "created_by": "agent", - "use_count": 6, - "view_count": 15, - "patch_count": 12, - "last_used_at": "2026-06-02T03:23:57.409721+00:00", - "last_viewed_at": "2026-06-02T03:23:57.400994+00:00", - "last_patched_at": "2026-06-02T02:52:21.531624+00:00", - "created_at": "2026-06-01T21:26:06.614465+00:00", - "state": "active", - "pinned": false - }, "jpm-build": { "created_by": "agent", "use_count": 0, @@ -23,14 +11,26 @@ }, "jolt-bootstrap": { "created_by": "agent", - "use_count": 5, - "view_count": 14, - "patch_count": 7, - "last_used_at": "2026-06-02T03:23:57.420498+00:00", - "last_viewed_at": "2026-06-02T03:23:57.415106+00:00", - "last_patched_at": "2026-06-02T02:51:30.047986+00:00", + "use_count": 6, + "view_count": 15, + "patch_count": 9, + "last_used_at": "2026-06-02T03:25:24.143420+00:00", + "last_viewed_at": "2026-06-02T03:25:24.137076+00:00", + "last_patched_at": "2026-06-02T03:25:52.625469+00:00", "created_at": "2026-06-01T21:49:51.101718+00:00", "state": "active", "pinned": false + }, + "jolt-dev": { + "created_by": "agent", + "use_count": 6, + "view_count": 15, + "patch_count": 14, + "last_used_at": "2026-06-02T03:23:57.409721+00:00", + "last_viewed_at": "2026-06-02T03:23:57.400994+00:00", + "last_patched_at": "2026-06-02T03:24:21.695870+00:00", + "created_at": "2026-06-01T21:26:06.614465+00:00", + "state": "active", + "pinned": false } } \ No newline at end of file diff --git a/.dirge/skills/jolt-bootstrap/SKILL.md b/.dirge/skills/jolt-bootstrap/SKILL.md index b6ffae5..12b604a 100644 --- a/.dirge/skills/jolt-bootstrap/SKILL.md +++ b/.dirge/skills/jolt-bootstrap/SKILL.md @@ -1,7 +1,6 @@ ---- -name: jolt-bootstrap -description: TDD workflow for bootstrapping a Clojure interpreter on Janet ---- +# jolt-bootstrap + +TDD workflow for bootstrapping a Clojure interpreter on Janet # Bootstrapping a Clojure interpreter on Janet @@ -20,27 +19,34 @@ description: TDD workflow for bootstrapping a Clojure interpreter on Janet ## Current bootstrap progress -**Loaded (all .cljc, #? resolved at read time):** -- `sci.impl.macros` — 4/4 (ns, defmacro deftime, defmacro usetime, deftime(? macro)) -- `sci.impl.protocols` — 15/17 -- `sci.impl.utils` — 39/47 -- `sci.impl.types` — 22/27 -- `sci.impl.unrestrict` — 2/2 -- `sci.impl.vars` — 28/28 (comment block parses via :jolt/skip sentinel) -- `sci.lang` — 10/10 (IVar resolves via class-name pattern lookup) -- `sci.ctx-store` — 6/6 -- `sci.impl.namespaces` — 93/98 (parse crash at unmatched brace) -- `sci.core` — 60/69 (namespaces/*1/*2/*3/*e unresolved) +**All files parse cleanly. Eval status:** -**Special forms (22):** quote, syntax-quote, unquote, unquote-splicing, do, if, def, defmacro, fn*, let*, loop*, recur, throw, try, set!, var, locking, instance?, defmulti, defmethod, deftype, new, . +| File | Forms | Eval OK | Failures | +|------|-------|---------|----------| +| sci.impl.macros | 4/4 | 4 | 0 | +| sci.impl.protocols | 15/17 | 15 | 2 (resolution stubs) | +| sci.impl.utils | 39/47 | 39 | 8 (multi-arity, missing deps) | +| sci.impl.types | 22/27 | 22 | 5 (resolution stubs) | +| sci.impl.unrestrict | 2/2 | 2 | 0 | +| sci.impl.vars | 28/28 | 28 | 0 | +| sci.lang | 10/10 | 10 | 0 | +| sci.ctx-store | 6/6 | 6 | 0 | +| sci.impl.namespaces | 93/98 | 93 | 5 (missing copy-core-var dep) | +| sci.core | 60/69 | 60 | 4 (*1/*2/*3/*e unresolved) | -**Reader:** `#?(:clj ...)`, `#?@(:clj ...)` with splicing, `#_` discard (returns :jolt/skip sentinel), `#\` var-quote, `^` metadata. Comments `;` skip via :jolt/skip. Closing delimiters `)`, `]`, `}` produce explicit "Unmatched" errors. +**Loading order:** macros → protocols → types → unrestrict → vars(27/28, skip comment block) → lang → utils → ctx-store → namespaces → core -**Core macros:** when, defn (with docstring), defn-, declare, fn (wraps fn*), defprotocol, extend-type, extend-protocol, extend, reify, proxy, definterface, comment (ignores body), prefer-method (stub) +**Added special forms:** quote, syntax-quote, unquote, unquote-splicing, do, if, def, defmacro, fn*, let*, loop*, recur, throw, try, set!, var, locking, instance?, defmulti, defmethod, deftype, new, . (22 total) -**Key utilities:** `unwrap-meta-name` — recursively unwraps `(with-meta sym meta)` to extract raw symbol. Used in def, ns, deftype, defmethod. +**Core additions:** when (macro), defn (macro with docstring), declare (macro), fn (macro — wraps fn*), Object (interop stub), derive, isa?, ancestors, descendants (hierarchy stubs), defprotocol (macro), extend-type, extend-protocol (macro), extend (macro), reify, satisfies?, extends?, implements?, type->str, comment (macro), prefer-method (stub), *unchecked-math* (false), *clojure-version* ({:major 1 :minor 11}) -**Class-name resolution:** unqualified symbols with dots (`Foo.Bar.Baz`) are resolved by splitting at last dot into ns+name. +**Reader:** `#?(:clj ...)`, `#?@(:clj ...)` with splicing, `#_` discard, `#\` var-quote, `^` metadata, `;` comments → skip, nil `#?(:cljs ...)` → skip (non-splicing), empty `#?@(:cljs ...)` → empty splice, unmatched `)]}` → explicit errors + +## Current blockers +1. `sci.impl.copy-vars` not yet loaded — needed for `copy-core-var`, `copy-var`, `macrofy`, `new-var` +2. `sci.impl.resolve`, `sci.impl.cljs`, `sci.impl.multimethods`, `sci.impl.deftype` not yet loaded +3. Multi-arity function dispatch edge cases in utils (forms 36-37, 44-45) +4. ~9 remaining eval failures across namespaces (5) and sci.core (4) — all tracing back to missing deps ## Key patterns @@ -58,6 +64,8 @@ description: TDD workflow for bootstrapping a Clojure interpreter on Janet ### Reader conditional `#?` Resolves at read time: scans for `:clj` keyword, picks next form. `#?@` wraps resolved form in `:jolt/splice` struct for list/vec/set splicing. +Nil results (e.g. `#?(:cljs X)` on CLJ) now return `{:jolt/type :jolt/skip}` for non-splicing +and `{:jolt/type :jolt/splice :items @[]}` for splicing — preventing orphaned keys in maps. ### Callable forms check ```janet @@ -66,6 +74,13 @@ Resolves at read time: scans for `:clj` keyword, picks next form. (get f (first args))) ; table/struct lookup ``` +### unwrap-meta-name helper +Recursively unwraps `(with-meta sym meta)` to extract the underlying symbol. +Used in `def`, `ns`, `deftype`, `defmethod` to handle metadata-wrapped names. + +### deftype →TypeName constructor +`deftype` interns both `TypeName` and `->TypeName` (Clojure arrow constructor convention). + ## Pitfalls - Janet `let` can't bind to nil; use `(var x nil)` then `(set x val)` - `(get table)` with 1 arg = compile error, use `(table :key)` shorthand @@ -76,7 +91,8 @@ Resolves at read time: scans for `:clj` keyword, picks next form. - **`core-macro-names`** is a zero-arg fn returning a table: `(get (core-macro-names) name)`. Don't call it as `(core-macro-names name)` — that's arity mismatch - **Janet `#{}` sets** can cause parse issues — use `@[]` instead for stub collections - **`break` in `while`** doesn't return a value in Janet — use `(var done nil)` + `(while (and cond (not done)) ... (set done result))` pattern instead -- **`read-reader-conditional`** for `#?(:cljs X)` with no `:clj` branch returns `[nil new-pos]`. For `#?@(:cljs X)` wrapping, nil gets wrapped in splice struct with `@[nil]` items -- **`#_` discard** now works in lists, vectors, and sets — wraps the skipped form in `{:jolt/type :jolt/skip}` and readers check for this -- **`read-regex`** now works with `(var done nil)` pattern to return value from while loop -- **`#?@` splicing inside vectors** — if the resolved :clj branch is itself a vector, items are extracted and spliced. Works for both lists and vectors. +- **`(last string)` returns nil** — `last` works only on indexed types. Use `(s (- (length s) 1))` for last char of string +- **`(set [a b] tuple)` doesn't work** — Janet's `set` doesn't support destructuring. Use `(tuple 0)` / `(tuple 1)` +- **`#_` discard** works in lists, vectors, sets, and maps — wraps skipped form in `{:jolt/type :jolt/skip}` and readers check for this +- **Map reader** must handle `:jolt/skip` and `:jolt/splice` in both key and value positions +- **`comment` macro** must be registered in `core-macro-names` to avoid evaluating its body \ No newline at end of file diff --git a/.dirge/skills/jolt-dev/SKILL.md b/.dirge/skills/jolt-dev/SKILL.md index 42f1f50..b69f153 100644 --- a/.dirge/skills/jolt-dev/SKILL.md +++ b/.dirge/skills/jolt-dev/SKILL.md @@ -66,6 +66,31 @@ The match arm receives `ctx`, `bindings`, and `form` (the full list). Use `(in f - `(first struct)` calls `:jolt/type` method — use `(get struct :key)` instead of positional access - Janet `(struct ;[:x nil])` silently drops the nil entry — the map becomes `{}`. Use `@{}` tables for nil-safe entries - `(length struct)` counts key-value pairs, not keys. Use `(length (keys struct))` for key count +- **`(last string)` returns nil** — `last` works only on indexed types (tuple, array). For strings use `(s (- (length s) 1))` or `(string/slice s (- (length s) 1))` +- **`(set [a b] tuple)` doesn't work** — Janet's `set` doesn't support destructuring. Use `(tuple 0)` / `(tuple 1)` or explicit individual assignments + +### unwrap-meta-name helper +Recursively unwraps `(with-meta sym meta)` forms to extract the underlying symbol. Used in `def`, `ns`, `deftype`, `defmethod` to handle metadata-wrapped names: +```janet +(defn- unwrap-meta-name [form] + (if (and (array? form) (> (length form) 0) + (struct? (in form 0)) + (= :symbol ((in form 0) :jolt/type)) + (= "with-meta" ((in form 0) :name))) + (unwrap-meta-name (in form 1)) + form)) +``` + +### Reader map k/v handling +The map reader must handle three special value types in both key and value positions: +- `:jolt/skip` — discarded form (comment, `#_`, nil `#?(:cljs ...)`): skip the K/V pair entirely +- `:jolt/splice` — `#?@` splicing: concat items into the kvs array. If splice has 0 items (nil `:cljs` branch), don't push the key + +### `#?(:cljs X)` returns nil → `:jolt/skip` +The non-splicing `#?` reader now returns `{:jolt/type :jolt/skip}` for nil results (e.g., `#?(:cljs X)` on CLJ). This prevents orphaned nil keys/values in maps and lists. `parse-next` and `parse-string` skip past skip markers to return the next real form. + +### deftype →TypeName constructor +`deftype` now interns both the type name and `->TypeName` arrow constructor (Clojure convention). The dot-suffix constructor check uses `(sym-name (- (length sym-name) 1))` instead of broken `(last sym-name)`. ## Comment Handling @@ -119,7 +144,7 @@ This resolves symbols like `IVar` that are interned in `sci.impl.vars` but refer - `#_` — discard reader macro, reads next form and returns it as position only ### Core macros (in core.janet) -- `core-macro-names` returns `@{"when" true "defn" true "declare" true "defprotocol" true "extend-type" true "reify" true "fn" true "proxy" true "definterface" true "defn-" true}` — a table +- `core-macro-names` returns `@{"when" true "defn" true "declare" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "fn" true "proxy" true "definterface" true "comment" true "defn-" true}` — a table - `init-core!` calls `(get (core-macro-names) name)` to check, then `(put v :macro true)` - Order matters: macro functions must be defined BEFORE `core-bindings` map references them diff --git a/src/jolt/core.janet b/src/jolt/core.janet index a71e811..1b028a6 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -448,6 +448,14 @@ (defn core-complement [f] (fn [& args] (not (apply f args)))) +(defn core-qualified-symbol? [x] + "Returns true if x is a symbol with a namespace." + (and (struct? x) (= :symbol (x :jolt/type)) (not (nil? (x :ns))))) + +(defn core-meta [x] + "Returns the metadata of x, or nil." + (if (struct? x) (get x :meta) nil)) + (def core-comp (fn [& fs] (case (length fs) @@ -602,6 +610,13 @@ test arr]) +(defn core-when-not + "Macro: (when-not test & body) -> (when (not test) & body)" + [test & body] + (def not-form @[{:jolt/type :symbol :ns nil :name "not"} test]) + @[{:jolt/type :symbol :ns nil :name "if"} not-form + @[{:jolt/type :symbol :ns nil :name "do"} ;body]]) + (defn core-defn "Macro: (defn name [args] body) -> (def name (fn* [args] body))" [fn-name args-form & body] @@ -799,6 +814,7 @@ "swap!" core-swap! "not" core-not "when" core-when + "when-not" core-when-not "defn" core-defn "defn-" core-defn- "derive" core-derive @@ -827,6 +843,8 @@ "definterface" core-definterface "comment" core-comment "prefer-method" core-prefer-method + "qualified-symbol?" core-qualified-symbol? + "meta" core-meta # Dynamic vars — stubs for SCI bootstrap "*unchecked-math*" false "*clojure-version*" {:major 1 :minor 11 :incremental 0 :qualifier nil}}) @@ -834,7 +852,7 @@ (defn core-macro-names "Set of core binding names that are macros." [] - @{"when" true "defn" true "defn-" true "declare" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "fn" true "proxy" true "definterface" true "comment" true}) + @{"when" true "when-not" true "defn" true "defn-" true "declare" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "fn" true "proxy" true "definterface" true "comment" true}) (def init-core! (fn [& args] diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index dea7de0..f864176 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -102,8 +102,9 @@ (if v (var-get v) (error (string "Unable to resolve symbol: " ns "/" name)))) (let [target-ns (ctx-find-ns ctx ns) v (ns-find target-ns name)] (if v (var-get v) (error (string "Unable to resolve symbol: " ns "/" name)))))) - (let [local (get bindings name)] - (if (not (nil? local)) local + # Use :jolt/not-found sentinel to distinguish nil binding from absent binding + (let [local (get bindings name :jolt/not-found)] + (if (not= local :jolt/not-found) local (let [current-ns (ctx-current-ns ctx) ns (ctx-find-ns ctx current-ns) v (ns-find ns name)] (if v (var-get v) # Check clojure.core as auto-referred fallback @@ -281,38 +282,75 @@ (ctx-set-current-ns ctx ns-name) (ctx-find-ns ctx ns-name) nil) - "fn*" (let [args-form (in form 1) - body (tuple/slice form 2) - arg-info (parse-arg-names args-form) - fixed-names (arg-info :fixed) - rest-name (arg-info :rest)] - (var self nil) - (set self (fn [& fn-args] - (var fn-bindings @{}) - (table/setproto fn-bindings bindings) - (var i 0) - (each arg-name fixed-names - (put fn-bindings arg-name (fn-args i)) - (++ i)) - (when rest-name - (put fn-bindings rest-name (tuple/slice fn-args i))) - (put fn-bindings :jolt/loop-fn self) - (var result nil) - (each body-form body - (set result (eval-form ctx fn-bindings body-form))) - result)) - self) + "fn*" (if (array? (in form 1)) + # Multi-arity: (fn* ([args] body...) ([args] body...)...) + (let [pairs (tuple/slice form 1) + arities @{}] + (var self nil) + (each pair pairs + (let [args-form (in pair 0) + body (tuple/slice pair 1) + arg-info (parse-arg-names args-form) + fixed-names (arg-info :fixed) + rest-name (arg-info :rest) + n-fixed (length fixed-names)] + (put arities n-fixed + (fn [& fn-args] + (var fn-bindings @{}) + (table/setproto fn-bindings bindings) + (var i 0) + (each arg-name fixed-names + (put fn-bindings arg-name (fn-args i)) + (++ i)) + (when rest-name + (put fn-bindings rest-name (tuple/slice fn-args i))) + (put fn-bindings :jolt/loop-fn self) + (var result nil) + (each body-form body + (set result (eval-form ctx fn-bindings body-form))) + result)))) + (set self (fn [& fn-args] + (let [n (length fn-args) + f (get arities n)] + (if f + (apply f fn-args) + (error (string "Wrong number of args (" n ") passed to fn")))))) + self) + # Single-arity: (fn* [args] body...) + (let [args-form (in form 1) + body (tuple/slice form 2) + arg-info (parse-arg-names args-form) + fixed-names (arg-info :fixed) + rest-name (arg-info :rest)] + (var self nil) + (set self (fn [& fn-args] + (var fn-bindings @{}) + (table/setproto fn-bindings bindings) + (var i 0) + (each arg-name fixed-names + (put fn-bindings arg-name (fn-args i)) + (++ i)) + (when rest-name + (put fn-bindings rest-name (tuple/slice fn-args i))) + (put fn-bindings :jolt/loop-fn self) + (var result nil) + (each body-form body + (set result (eval-form ctx fn-bindings body-form))) + result)) + self)) "let*" (let [bind-vec (in form 1) - body (tuple/slice form 2)] - (var new-bindings @{}) - (table/setproto new-bindings bindings) - (var i 0) - (let [len (length bind-vec)] - (while (< i len) - (let [sym (bind-vec i) - val (eval-form ctx new-bindings (bind-vec (+ i 1)))] - (put new-bindings (sym :name) val) - (+= i 2)))) + body (tuple/slice form 2)] + (var new-bindings @{}) + (table/setproto new-bindings bindings) + (var i 0) + (let [len (length bind-vec)] + (while (< i len) + (let [sym (bind-vec i)] + # Pre-register with nil to prevent proto fallthrough to global scope + (put new-bindings (sym :name) nil) + (def val (eval-form ctx new-bindings (bind-vec (+ i 1)))) + (put new-bindings (sym :name) val) + (+= i 2)))) (var result nil) (each body-form body (set result (eval-form ctx new-bindings body-form)))