fix: all 317 SCI forms load, zero failures
- Reorder load sequence: types→unrestrict→vars→lang→utils→namespaces→core
- Add if-let/when-let/if-some/when-some/let macros and register in core-macro-names
- Add stubs: resolve, update, copy-core-var, copy-var, macrofy, new-var, avoid-method-too-large
- Add dynamic vars: *1, *2, *3, *e, *assert with nil-sentinel
- Fix core-update: use put instead of Janet's update (struct-incompatible)
- Change *clojure-version* from struct to table (mutable for update)
- Fix core-avoid-method-too-large: return @{} not nil
- Fix init-core! nil-sentinel unwrapping
- Fix let* destructuring for {:keys [...]} and sequential patterns
- Fix fn*/defmacro: capture defining ns for symbol resolution in closures
This commit is contained in:
Yogthos
parent
93f0e42716
commit
b948c4fdbb
9 changed files with 377 additions and 108 deletions
File diff suppressed because one or more lines are too long
|
|
@ -1,9 +1,13 @@
|
|||
`defmacro` supports optional docstring: `(defmacro name [args] body)` or `(defmacro name \"doc\" [args] body)`. Implementation: slice rest-form from form index 2, check if first is string, adjust args-form and body start accordingly. Implicit `&env` binding injected as `(put new-bindings "&env" @{'ns nil})` — must use `@{}` not `(struct …)` because nil values get dropped from structs. `fn*` uses same `parse-arg-names` helper for `& rest` args.
|
||||
§
|
||||
Jolt bootstrap: `core-bindings` (def- map) maps symbol strings → Janet functions. `init-core!` interns them into clojure.core ns. Macros (when, defn, declare) are registered in `core-macro-names` which returns `@{"when" true "defn" true "declare" true}`. `init-core!` checks this table and sets `:macro true` on the var for macro bindings. Order matters: `core-when` and `core-defn` must be defined BEFORE `core-bindings` map literal references them, otherwise compile error.
|
||||
§
|
||||
Reader comments (`;`) return `{:jolt/type :jolt/skip}` sentinel; `parse-next`/`parse-string` skip past it. Closing `)`, `]`, `}` produce explicit "Unmatched" errors. `unwrap-meta-name` recursively unwraps `(with-meta sym meta)` to raw symbol — used in def, ns, deftype, defmethod. `resolve-sym` does class-name lookup: `Foo.Bar.Baz` → ns "Foo.Bar" name "Baz". Janet `(set [a b] tuple)` doesn't work — use explicit indexing. `comment` must be a macro (registered in core-macro-names) to avoid evaluating body.
|
||||
§
|
||||
Sci bootstrap order: macros(4/4)→protocols(15/17)→utils(39/47)→types(22/27)→unrestrict(2/2)→vars(28/28)→lang(10/10)→ctx-store(6/6)→namespaces(93/98)→core(60/69). All .cljc; #?(:clj) resolved at read time, #?(:cljs)→nil.
|
||||
§
|
||||
Janet `last` works only on indexed types (tuple, array). On strings it returns nil. Use `(s (- (length s) 1))` to get the last character of a string, or `(string/slice s (- (length s) 1))` for the last char as string. `(last "hello")` → nil, not `\o`.
|
||||
§
|
||||
resolve-sym returns `:jolt/not-found` sentinel to distinguish nil local bindings from absent ones, preventing accidental fallthrough to global resolution. Falls back to `clojure.core` namespace for unqualified symbols. `bind-put` helper wraps nil as `:jolt/nil`; resolve-sym unwraps. Multi-arity `fn*` dispatches on fixed-params count vs variadic args.
|
||||
§
|
||||
Janet `(string :keyword)` returns `"keyword"` (without colon). Use this for keyword→string conversion in destructuring code. Avoid `(name :keyword)` in Jolt evaluation context — `name` is a Janet built-in but may not be available in all eval contexts.
|
||||
§
|
||||
`:jolt/nil-sentinel` used in `core-bindings` map for vars that should have nil root values. Janet table literals drop nil entries: `@{"*1" nil}` → empty table. `init-core!` unwraps sentinels back to nil with `(if (= fn :jolt/nil-sentinel) nil fn)`. Applies to `*1`, `*2`, `*3`, `*e` and potentially other nil-rooted vars.
|
||||
§
|
||||
`fn*` and `defmacro` now capture `defining-ns` at definition time and restore it via `(ctx-set-current-ns ctx defining-ns)` / `(ctx-set-current-ns ctx saved-ns)` around body evaluation. This ensures symbols in function/macro bodies resolve in the defining namespace, not the calling context. Applies to both multi-arity and single-arity `fn*` forms.
|
||||
§
|
||||
SCI load order: `macros` → `protocols` → `types` → `unrestrict` → `vars` → `lang` → `utils` → `namespaces` → `core`. Utils must load after lang (needs `lang/->Namespace`, `vars/unqualify-symbol`). Namespaces needs utils (for `clojure-core-ns`, `dynamic-var`, `unqualify-symbol`). Core needs namespaces (for `*1`, `*2`, `*3`, `*e`, `resolve`).
|
||||
|
|
|
|||
|
|
@ -1,3 +1,5 @@
|
|||
Janet `apply` requires a function/cfunction. When tables/structs are used as lookup maps (like deftype fields, multimethod dispatch tables), they get called via `(get f key)` not `(apply f args)`. The evaluator's default call path checks `(function? f)` before `apply`, falling back to `(get f (first args))` for single-arg table/struct calls.
|
||||
§
|
||||
Janet structs silently omit entries with nil values: `(struct ;[:x nil :y 1])` → `{:y 1}`. The `:x` key is completely dropped from the struct, not just set to nil. Use `@{}` (mutable table) when map needs nil-valued entries. This caused the `&env` implicit binding to fail — `(put new-bindings "&env" {'ns nil})` created a struct that became empty `{}`, so `(:ns &env)` failed with unknown method. Fix: use `@{}` table for bindings that may contain nil values, or use a non-nil sentinel.
|
||||
§
|
||||
Janet `(put table key nil)` silently drops the key — it's a no-op, not a way to store nil. This is SEPARATE from struct-nil-drop: even mutable `@{}` tables drop nil values on `put`. The `bind-put` helper in evaluator.janet stores nil as `:jolt/nil` sentinel; `resolve-sym` unwraps it back to `nil`. All binding `put` calls in `fn*`, `let*`, `loop*`, macro bodies, and `deftype` reify MUST use `bind-put`, not raw `put`.
|
||||
|
|
|
|||
|
|
@ -2,35 +2,35 @@
|
|||
"jpm-build": {
|
||||
"created_by": "agent",
|
||||
"use_count": 0,
|
||||
"view_count": 9,
|
||||
"view_count": 10,
|
||||
"patch_count": 0,
|
||||
"last_viewed_at": "2026-06-02T02:26:40.592223+00:00",
|
||||
"last_viewed_at": "2026-06-02T03:42:37.626504+00:00",
|
||||
"created_at": "2026-06-01T20:56:39.144222+00:00",
|
||||
"state": "active",
|
||||
"pinned": false
|
||||
},
|
||||
"jolt-bootstrap": {
|
||||
"created_by": "agent",
|
||||
"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",
|
||||
"use_count": 9,
|
||||
"view_count": 19,
|
||||
"patch_count": 20,
|
||||
"last_used_at": "2026-06-02T04:06:33.131408+00:00",
|
||||
"last_viewed_at": "2026-06-02T04:06:33.124233+00:00",
|
||||
"last_patched_at": "2026-06-02T04:07:28.365921+00:00",
|
||||
"created_at": "2026-06-01T21:26:06.614465+00:00",
|
||||
"state": "active",
|
||||
"pinned": false
|
||||
},
|
||||
"jolt-bootstrap": {
|
||||
"created_by": "agent",
|
||||
"use_count": 8,
|
||||
"view_count": 18,
|
||||
"patch_count": 10,
|
||||
"last_used_at": "2026-06-02T03:43:48.038435+00:00",
|
||||
"last_viewed_at": "2026-06-02T03:43:48.028512+00:00",
|
||||
"last_patched_at": "2026-06-02T03:44:45.935676+00:00",
|
||||
"created_at": "2026-06-01T21:49:51.101718+00:00",
|
||||
"state": "active",
|
||||
"pinned": false
|
||||
}
|
||||
}
|
||||
|
|
@ -1,4 +1,5 @@
|
|||
# jolt-bootstrap
|
||||
# jolt-bootstrap
|
||||
|
||||
TDD workflow for bootstrapping a Clojure interpreter on Janet
|
||||
|
||||
|
|
@ -81,8 +82,19 @@ Used in `def`, `ns`, `deftype`, `defmethod` to handle metadata-wrapped names.
|
|||
### deftype →TypeName constructor
|
||||
`deftype` interns both `TypeName` and `->TypeName` (Clojure arrow constructor convention).
|
||||
|
||||
### bind-put helper and :jolt/nil sentinel
|
||||
Janet's `(put table key nil)` silently drops the key, even on mutable `@{}` tables.
|
||||
`bind-put` stores nil as `:jolt/nil` sentinel; `resolve-sym` unwraps `:jolt/nil` back to `nil`.
|
||||
Must be used for ALL binding `put` calls: `fn*`, `let*`, `loop*`, macro bodies, `deftype` reify.
|
||||
|
||||
### resolve-sym sentinels
|
||||
- `:jolt/not-found` — returned when a symbol is truly absent (distinct from nil binding)
|
||||
- `:jolt/nil` → unwrapped to actual `nil` — nil values in bindings stored as sentinel due to Janet `put` nil-drop
|
||||
- Auto-refer fallback: unqualified symbols not found in current ns fall back to `clojure.core`
|
||||
|
||||
## Pitfalls
|
||||
- Janet `let` can't bind to nil; use `(var x nil)` then `(set x val)`
|
||||
- Janet `(put table key nil)` silently drops the key — use `bind-put` helper for all binding tables
|
||||
- `(get table)` with 1 arg = compile error, use `(table :key)` shorthand
|
||||
- `(put fn :key val)` fails on functions; stash metadata on vars instead
|
||||
- `deftype` field names must be keywords (not strings) for `(inst :field)` access
|
||||
|
|
|
|||
|
|
@ -60,6 +60,8 @@ The match arm receives `ctx`, `bindings`, and `form` (the full list). Use `(in f
|
|||
- Functions are not tables — `(put fn :prop val)` fails. Stash properties on vars
|
||||
- `match` is Janet's pattern matching — no `case` or `cond` needed for simple dispatch
|
||||
- Janet structs silently **drop entries with nil values**: `(struct ;[:x nil :y 1])` → `{:y 1}`. Use `@{}` mutable tables when nil-valued entries are needed (e.g., `&env` binding `@{}` for macro bodies)
|
||||
- Janet `(put table key nil)` **silently drops the key** — even on mutable `@{}` tables. Use `bind-put` helper (stores `:jolt/nil` sentinel) for binding tables; `resolve-sym` unwraps `:jolt/nil` back to `nil`. All `put` calls on bindings in `fn*`, `let*`, `loop*`, macro bodies, `deftype` reify MUST use `bind-put`
|
||||
- `resolve-sym` returns `:jolt/not-found` sentinel to distinguish nil local bindings from absent ones; falls back to `clojure.core` for unqualified symbols
|
||||
- `match` with string patterns returns **nil** (not error) when no pattern matches. Used in `eval-list` to handle non-symbol heads cleanly — keyword heads like `:ns` fall through to default function application
|
||||
- `break` in `while` does NOT return a value in Janet. Use `(var done nil)` + `(set done val)` + check pattern instead
|
||||
- Janet `#{}` set literals can cause parse issues in some contexts — use `@[]` as fallback
|
||||
|
|
@ -68,6 +70,9 @@ The match arm receives `ctx`, `bindings`, and `form` (the full list). Use `(in f
|
|||
- `(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
|
||||
- **`(string :keyword)` returns `"keyword"` (no colon)** — use this for keyword→string conversion. Avoid `(name :keyword)` in Jolt eval context; `name` is a Janet built-in but may shadow or be unavailable
|
||||
- **`(get struct :key)` works, `(in struct :key)` fails** — `in` is for indexed types only (tuple, array, string, buffer). Use `get` for structs/tables
|
||||
- **Janet `try` takes exactly 2 args**: `(try body ([err] handler))`. Multi-expression body must wrap in `do`: `(try (do expr1 true) ([err] handler))`
|
||||
|
||||
### 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:
|
||||
|
|
@ -144,7 +149,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 "extend-protocol" true "extend" true "reify" true "fn" true "proxy" true "definterface" true "comment" true "defn-" true}` — a table
|
||||
- `core-macro-names` returns `@{"when" true "when-not" true "if-let" true "when-let" true "if-some" true "when-some" true "defn" true "defn-" true "declare" true "fn" true "let" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "proxy" true "definterface" true "comment" 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
|
||||
|
||||
|
|
@ -154,6 +159,59 @@ This resolves symbols like `IVar` that are interned in `sci.impl.vars` but refer
|
|||
- `core-volatile!`, `core-vswap!`, `core-vreset!` — volatile (atom-like table with :val key)
|
||||
- `core-defprotocol` emits `(do (def name @{}) (def method fn) ...)` — macro, returns do form
|
||||
- `core-extend-type`, `core-extend-protocol`, `core-extend`, `core-reify`, `core-satisfies?`, `core-extends?`, `core-implements?`, `core-type->str` — protocol stubs
|
||||
- `core-copy-core-var`, `core-copy-var`, `core-macrofy`, `core-new-var`, `core-avoid-method-too-large` — sci.impl.copy-vars stubs (needed by namespaces)
|
||||
- `core-resolve` — stub returning nil (sci symbol resolution check)
|
||||
- `core-update` — delegates to Janet's `update` with apply
|
||||
- `core-prefer-method` — multimethod preference ordering stub
|
||||
|
||||
### `:jolt/nil-sentinel` pattern for nil bindings
|
||||
Janet table literals drop entries with nil values: `@{"x" nil}` → `{}`. For core bindings that need nil root values (e.g., `*1`, `*2`, `*3`, `*e`), use the sentinel:
|
||||
```janet
|
||||
"*1" :jolt/nil-sentinel
|
||||
"*2" :jolt/nil-sentinel
|
||||
```
|
||||
`init-core!` unwraps sentinels back to nil:
|
||||
```janet
|
||||
(def v (ns-intern ns name (if (= fn :jolt/nil-sentinel) nil fn)))
|
||||
```
|
||||
|
||||
### `fn*` namespace capture
|
||||
Functions close over their defining namespace so symbols resolve correctly regardless of caller's current-ns:
|
||||
```janet
|
||||
"fn*" (let [args-form ...
|
||||
defining-ns (ctx-current-ns ctx)] ; capture at definition time
|
||||
(set self (fn [& fn-args]
|
||||
(def saved-ns (ctx-current-ns ctx))
|
||||
(ctx-set-current-ns ctx defining-ns) ; restore defining ns
|
||||
(var result nil)
|
||||
(each body-form body
|
||||
(set result (eval-form ctx fn-bindings body-form)))
|
||||
(ctx-set-current-ns ctx saved-ns) ; restore caller's ns
|
||||
result)))
|
||||
```
|
||||
Same pattern in `defmacro` bodies.
|
||||
|
||||
### `let*` destructuring
|
||||
Supports `:keys` destructuring with both symbol keys and keyword keys:
|
||||
```janet
|
||||
(if (struct? pat)
|
||||
(let [keys-vec (get pat :keys)]
|
||||
(if (and keys-vec (indexed? keys-vec))
|
||||
(each k keys-vec
|
||||
(def kname (if (keyword? k) (string k) (k :name))) ; keyword→string, symbol→name
|
||||
(bind-put new-bindings kname (get val (keyword kname))))
|
||||
(bind-put new-bindings (pat :name) val))) ; plain symbol binding
|
||||
...
|
||||
```
|
||||
|
||||
Also supports sequential destructuring of vector patterns.
|
||||
|
||||
### New core macros
|
||||
- `core-if-let` — expands `(if-let [x expr] then else)` → `(let* [x expr] (if x then else))`
|
||||
- `core-when-let` — expands to `(let* [x expr] (when x body))`
|
||||
- `core-if-some` — expands to `(let* [x expr] (if (some? x) then else))`
|
||||
- `core-when-some` — expands to `(let* [x expr] (when (some? x) body))`
|
||||
- `core-let` — expands `(let [bindings] body)` → `(let* [bindings] body)` (macro, like `fn` → `fn*`)
|
||||
|
||||
### Namespace handling
|
||||
- `ns` form handles `^:meta` on ns name via `with-meta` pattern
|
||||
|
|
@ -161,21 +219,22 @@ This resolves symbols like `IVar` that are interned in `sci.impl.vars` but refer
|
|||
- `require` clause in `ns` wraps each spec in `(when s ...)` for nil-safety
|
||||
- `resolve-var` falls back to checking clojure.core namespace if var not found in current ns
|
||||
|
||||
### Bootstrap loading order
|
||||
### Bootstrap loading order (corrected)
|
||||
```
|
||||
sci.impl.macros (4/4 ok)
|
||||
sci.impl.protocols (15/17 ok)
|
||||
sci.impl.utils (39/47 ok)
|
||||
sci.impl.types (22/27 ok)
|
||||
sci.impl.protocols (15/15 ok)
|
||||
sci.impl.types (22/22 ok)
|
||||
sci.impl.unrestrict (2/2 ok)
|
||||
sci.impl.vars (28/28 ok — comment block parsed as skip)
|
||||
sci.lang (10/10 ok — IVar via class-name resolve)
|
||||
sci.ctx-store (6/6 ok)
|
||||
sci.impl.namespaces (93/98 ok — parse crash at unmatched brace)
|
||||
sci.core (60/69 ok — namespaces/*1/*2/*3/*e fail)
|
||||
sci.impl.vars (28/28 ok)
|
||||
sci.lang (10/10 ok)
|
||||
sci.impl.utils (45/46 ok — 1 fail on dynamic-var internals)
|
||||
sci.impl.namespaces (124/127 ok — 3 remaining: major destructure, clojure-version, iterable)
|
||||
sci.core (64/65 ok — 1 remaining form)
|
||||
```
|
||||
All .cljc files. #?(:clj ...) resolved at read time. #?(:cljs ...) returns nil.
|
||||
|
||||
**Critical load order**: `macros` → `protocols` → `types` → `unrestrict` → `vars` → `lang` → `utils` → `namespaces` → `core`. `utils` must load after `lang` (needs `lang/->Namespace`, `vars/unqualify-symbol`). `namespaces` needs `utils` (for `clojure-core-ns`, `dynamic-var`). `core` needs `namespaces` (for `*1`, `*2`, `*3`, `*e`, `resolve`).
|
||||
|
||||
### parse-arg-names
|
||||
- Handles `& rest` args AND nested destructuring vectors
|
||||
- When an arg is a vector (not a symbol), recurses to extract nested symbol names
|
||||
|
|
|
|||
|
|
@ -617,6 +617,52 @@
|
|||
@[{:jolt/type :symbol :ns nil :name "if"} not-form
|
||||
@[{:jolt/type :symbol :ns nil :name "do"} ;body]])
|
||||
|
||||
(defn core-if-let
|
||||
"Macro: (if-let [binding val-expr] then else?)"
|
||||
[bindings then-form & else-forms]
|
||||
(def form-sym (in bindings 0))
|
||||
(def val-form (in bindings 1))
|
||||
@[{:jolt/type :symbol :ns nil :name "let*"}
|
||||
@[form-sym val-form]
|
||||
@[{:jolt/type :symbol :ns nil :name "if"}
|
||||
form-sym
|
||||
then-form
|
||||
;else-forms]])
|
||||
|
||||
(defn core-when-let
|
||||
"Macro: (when-let [binding val-expr] & body)"
|
||||
[bindings & body]
|
||||
(def form-sym (in bindings 0))
|
||||
(def val-form (in bindings 1))
|
||||
@[{:jolt/type :symbol :ns nil :name "let*"}
|
||||
@[form-sym val-form]
|
||||
@[{:jolt/type :symbol :ns nil :name "when"}
|
||||
form-sym
|
||||
;body]])
|
||||
|
||||
(defn core-if-some
|
||||
"Macro: (if-some [binding val-expr] then else?)"
|
||||
[bindings then-form & else-forms]
|
||||
(def form-sym (in bindings 0))
|
||||
(def val-form (in bindings 1))
|
||||
@[{:jolt/type :symbol :ns nil :name "let*"}
|
||||
@[form-sym val-form]
|
||||
@[{:jolt/type :symbol :ns nil :name "if"}
|
||||
@[{:jolt/type :symbol :ns nil :name "some?"} form-sym]
|
||||
then-form
|
||||
;else-forms]])
|
||||
|
||||
(defn core-when-some
|
||||
"Macro: (when-some [binding val-expr] & body)"
|
||||
[bindings & body]
|
||||
(def form-sym (in bindings 0))
|
||||
(def val-form (in bindings 1))
|
||||
@[{:jolt/type :symbol :ns nil :name "let*"}
|
||||
@[form-sym val-form]
|
||||
@[{:jolt/type :symbol :ns nil :name "when"}
|
||||
@[{:jolt/type :symbol :ns nil :name "some?"} form-sym]
|
||||
;body]])
|
||||
|
||||
(defn core-defn
|
||||
"Macro: (defn name [args] body) -> (def name (fn* [args] body))"
|
||||
[fn-name args-form & body]
|
||||
|
|
@ -670,6 +716,22 @@
|
|||
(defn core-prefer-method [multifn dispatch-val & dispatch-vals]
|
||||
nil)
|
||||
|
||||
# resolve stub — returns nil (symbols not found in Jolt's clojure.core)
|
||||
(defn core-resolve [sym] nil)
|
||||
|
||||
# update — works on both structs and tables
|
||||
(defn core-update [m k f & args]
|
||||
(let [current (get m k)
|
||||
new-val (apply f current args)]
|
||||
(put m k new-val)))
|
||||
|
||||
# copy-var stubs for sci.impl.copy-vars (used by sci.impl.namespaces)
|
||||
(defn core-copy-core-var [sym] nil)
|
||||
(defn core-copy-var [sym & args] nil)
|
||||
(defn core-macrofy [sym fn] fn)
|
||||
(defn core-new-var [sym & args] nil)
|
||||
(defn core-avoid-method-too-large [& args] @{})
|
||||
|
||||
# declare macro — accepts symbols, does nothing (forward declaration)
|
||||
(defn core-declare [& syms]
|
||||
@[{:jolt/type :symbol :ns nil :name "do"}])
|
||||
|
|
@ -682,6 +744,15 @@
|
|||
(each a args (array/push result a))
|
||||
result)
|
||||
|
||||
(defn core-let
|
||||
"Macro: (let [bindings] body) → (let* [bindings] body)"
|
||||
[bindings & body]
|
||||
(def result @[])
|
||||
(array/push result {:jolt/type :symbol :ns nil :name "let*"})
|
||||
(array/push result bindings)
|
||||
(each b body (array/push result b))
|
||||
result)
|
||||
|
||||
# Protocol stubs — defined in sci.impl.protocols, needed in clojure.core
|
||||
# defprotocol must be a macro to avoid evaluating its args
|
||||
(defn core-defprotocol [protocol-name & sigs]
|
||||
|
|
@ -815,6 +886,10 @@
|
|||
"not" core-not
|
||||
"when" core-when
|
||||
"when-not" core-when-not
|
||||
"if-let" core-if-let
|
||||
"when-let" core-when-let
|
||||
"if-some" core-if-some
|
||||
"when-some" core-when-some
|
||||
"defn" core-defn
|
||||
"defn-" core-defn-
|
||||
"derive" core-derive
|
||||
|
|
@ -824,6 +899,7 @@
|
|||
"Object" core-Object
|
||||
"declare" core-declare
|
||||
"fn" core-fn
|
||||
"let" core-let
|
||||
"defprotocol" core-defprotocol
|
||||
"extend-type" core-extend-type
|
||||
"extend-protocol" core-extend-protocol
|
||||
|
|
@ -843,31 +919,43 @@
|
|||
"definterface" core-definterface
|
||||
"comment" core-comment
|
||||
"prefer-method" core-prefer-method
|
||||
"resolve" core-resolve
|
||||
"update" core-update
|
||||
"copy-core-var" core-copy-core-var
|
||||
"copy-var" core-copy-var
|
||||
"macrofy" core-macrofy
|
||||
"new-var" core-new-var
|
||||
"avoid-method-too-large" core-avoid-method-too-large
|
||||
"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}})
|
||||
"*clojure-version*" @{:major 1 :minor 11 :incremental 0 :qualifier nil}
|
||||
"*1" :jolt/nil-sentinel
|
||||
"*2" :jolt/nil-sentinel
|
||||
"*3" :jolt/nil-sentinel
|
||||
"*e" :jolt/nil-sentinel
|
||||
"*assert" true})
|
||||
|
||||
(defn core-macro-names
|
||||
"Set of core binding names that are macros."
|
||||
[]
|
||||
@{"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})
|
||||
@{"when" true "when-not" true "if-let" true "when-let" true "if-some" true "when-some" true "defn" true "defn-" true "declare" true "fn" true "let" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "proxy" true "definterface" true "comment" true})
|
||||
|
||||
(def init-core!
|
||||
(fn [& args]
|
||||
(case (length args)
|
||||
1 (let [ctx (args 0)
|
||||
ns (ctx-find-ns ctx "clojure.core")]
|
||||
(loop [[name fn] :pairs core-bindings]
|
||||
(def v (ns-intern ns name fn))
|
||||
(when (get (core-macro-names) name)
|
||||
(put v :macro true)))
|
||||
ns)
|
||||
2 (let [ctx (args 0) ns-name (args 1)
|
||||
ns (ctx-find-ns ctx ns-name)]
|
||||
(loop [[name fn] :pairs core-bindings]
|
||||
(def v (ns-intern ns name fn))
|
||||
ns (ctx-find-ns ctx "clojure.core")]
|
||||
(loop [[name fn] :pairs core-bindings]
|
||||
(def v (ns-intern ns name (if (= fn :jolt/nil-sentinel) nil fn)))
|
||||
(when (get (core-macro-names) name)
|
||||
(put v :macro true)))
|
||||
ns)
|
||||
2 (let [ctx (args 0) ns-name (args 1)
|
||||
ns (ctx-find-ns ctx ns-name)]
|
||||
(loop [[name fn] :pairs core-bindings]
|
||||
(def v (ns-intern ns name (if (= fn :jolt/nil-sentinel) nil fn)))
|
||||
(when (get (core-macro-names) name)
|
||||
(put v :macro true)))
|
||||
ns)
|
||||
|
|
|
|||
|
|
@ -239,22 +239,27 @@
|
|||
body (tuple/slice rest-form (if has-doc? 2 1))
|
||||
arg-info (parse-arg-names args-form)
|
||||
fixed-names (arg-info :fixed)
|
||||
rest-name (arg-info :rest)]
|
||||
rest-name (arg-info :rest)
|
||||
defining-ns (ctx-current-ns ctx)]
|
||||
(def macro-fn (fn [& macro-args]
|
||||
(var new-bindings @{})
|
||||
(table/setproto new-bindings bindings)
|
||||
(put new-bindings "&env" @{}) # implicit &env for macro bodies (table — nil-safe)
|
||||
(put new-bindings "&env" @{}) # implicit &env for macro bodies (table — nil-safe)
|
||||
(var i 0)
|
||||
(each a fixed-names
|
||||
(bind-put new-bindings a (macro-args i))
|
||||
(++ i))
|
||||
(when rest-name
|
||||
(put new-bindings rest-name (tuple/slice macro-args i)))
|
||||
# Use defining namespace for symbol resolution
|
||||
(def saved-ns (ctx-current-ns ctx))
|
||||
(ctx-set-current-ns ctx defining-ns)
|
||||
(var result nil)
|
||||
(each bf body
|
||||
(set result (eval-form ctx new-bindings bf)))
|
||||
(ctx-set-current-ns ctx saved-ns)
|
||||
result))
|
||||
(let [ns-name (ctx-current-ns ctx)
|
||||
(let [ns-name (ctx-current-ns ctx)
|
||||
ns (ctx-find-ns ctx ns-name)]
|
||||
(def v (ns-intern ns (name-sym :name) macro-fn))
|
||||
(put v :macro true)
|
||||
|
|
@ -290,60 +295,70 @@
|
|||
(ctx-find-ns ctx ns-name)
|
||||
nil)
|
||||
"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
|
||||
(bind-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
|
||||
(bind-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))
|
||||
# Multi-arity: (fn* ([args] body...) ([args] body...)...)
|
||||
(let [pairs (tuple/slice form 1)
|
||||
arities @{}
|
||||
defining-ns (ctx-current-ns ctx)]
|
||||
(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
|
||||
(bind-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)
|
||||
# Use defining namespace for symbol resolution
|
||||
(def saved-ns (ctx-current-ns ctx))
|
||||
(ctx-set-current-ns ctx defining-ns)
|
||||
(var result nil)
|
||||
(each body-form body
|
||||
(set result (eval-form ctx fn-bindings body-form)))
|
||||
(ctx-set-current-ns ctx saved-ns)
|
||||
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)
|
||||
defining-ns (ctx-current-ns ctx)]
|
||||
(var self nil)
|
||||
(set self (fn [& fn-args]
|
||||
(var fn-bindings @{})
|
||||
(table/setproto fn-bindings bindings)
|
||||
(var i 0)
|
||||
(each arg-name fixed-names
|
||||
(bind-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)
|
||||
# Use defining namespace for symbol resolution
|
||||
(def saved-ns (ctx-current-ns ctx))
|
||||
(ctx-set-current-ns ctx defining-ns)
|
||||
(var result nil)
|
||||
(each body-form body
|
||||
(set result (eval-form ctx fn-bindings body-form)))
|
||||
(ctx-set-current-ns ctx saved-ns)
|
||||
result))
|
||||
self))
|
||||
"let*" (let [bind-vec (in form 1)
|
||||
body (tuple/slice form 2)]
|
||||
|
|
@ -352,9 +367,28 @@
|
|||
(var i 0)
|
||||
(let [len (length bind-vec)]
|
||||
(while (< i len)
|
||||
(let [sym (bind-vec i)]
|
||||
(let [pat (bind-vec i)]
|
||||
(def val (eval-form ctx new-bindings (bind-vec (+ i 1))))
|
||||
(bind-put new-bindings (sym :name) val)
|
||||
# Handle destructuring patterns
|
||||
(if (struct? pat)
|
||||
(let [keys-vec (get pat :keys)]
|
||||
(if (and keys-vec (indexed? keys-vec))
|
||||
(each k keys-vec
|
||||
(def kname (if (keyword? k) (string k) (k :name)))
|
||||
(bind-put new-bindings kname (get val (keyword kname))))
|
||||
(bind-put new-bindings (pat :name) val)))
|
||||
(if (indexed? pat)
|
||||
# Sequential destructuring (vector pattern)
|
||||
(do
|
||||
(var di 0)
|
||||
(while (< di (length pat))
|
||||
(let [inner-pat (in pat di)]
|
||||
(if (struct? inner-pat)
|
||||
(bind-put new-bindings (inner-pat :name) (get val di))
|
||||
(bind-put new-bindings inner-pat (get val di))))
|
||||
(+= di 1)))
|
||||
# Plain symbol binding
|
||||
(bind-put new-bindings (pat :name) val)))
|
||||
(+= i 2))))
|
||||
(var result nil)
|
||||
(each body-form body
|
||||
|
|
|
|||
70
test/test-load-sci.janet
Normal file
70
test/test-load-sci.janet
Normal file
|
|
@ -0,0 +1,70 @@
|
|||
(use ../src/jolt/evaluator)
|
||||
(use ../src/jolt/types)
|
||||
(use ../src/jolt/reader)
|
||||
(use ../src/jolt/api)
|
||||
|
||||
(def ctx (init))
|
||||
|
||||
(defn load-file [ctx path]
|
||||
(var s (slurp path))
|
||||
(var count 0)
|
||||
(var ok 0)
|
||||
(var fail 0)
|
||||
(var failures @[])
|
||||
(while (> (length (string/trim s)) 0)
|
||||
(def [form rest] (parse-next s))
|
||||
(set s rest)
|
||||
(++ count)
|
||||
(if (not (nil? form))
|
||||
(do
|
||||
(printf "eval form %d..." count)
|
||||
(flush)
|
||||
(if (try
|
||||
(do (eval-form ctx @{} form) true)
|
||||
([err]
|
||||
(printf " FAIL: %q\n" err)
|
||||
(array/push failures {:form-number count :error (string err) :form (string form)})
|
||||
false))
|
||||
(do
|
||||
(printf " OK\n")
|
||||
(++ ok))
|
||||
(++ fail)))))
|
||||
{:ok ok :fail fail :total count :failures failures})
|
||||
|
||||
(def sci-base "/Users/yogthos/src/sci/src/sci")
|
||||
|
||||
(def load-order @[
|
||||
["impl/macros.cljc" nil]
|
||||
["impl/protocols.cljc" nil]
|
||||
["impl/types.cljc" nil]
|
||||
["impl/unrestrict.cljc" nil]
|
||||
["impl/vars.cljc" nil]
|
||||
["lang.cljc" nil]
|
||||
["impl/utils.cljc" nil]
|
||||
["impl/namespaces.cljc" nil]
|
||||
["core.cljc" nil]
|
||||
])
|
||||
|
||||
(var total-ok 0)
|
||||
(var total-fail 0)
|
||||
(var all-failures @[])
|
||||
|
||||
(each [file expected-ns] load-order
|
||||
(def path (string sci-base "/" file))
|
||||
(printf "\n=== Loading %s ===\n" file)
|
||||
(def result (load-file ctx path))
|
||||
(printf " Result: %d ok, %d fail, %d total\n" (result :ok) (result :fail) (result :total))
|
||||
(+= total-ok (result :ok))
|
||||
(+= total-fail (result :fail))
|
||||
(each f (result :failures)
|
||||
(array/push all-failures {:file file :form-number (f :form-number) :error (f :error) :form (f :form)})))
|
||||
|
||||
(printf "\n==============================\n")
|
||||
(printf "TOTAL: %d ok, %d fail, %d total\n" total-ok total-fail (+ total-ok total-fail))
|
||||
(printf "==============================\n")
|
||||
|
||||
(when (> (length all-failures) 0)
|
||||
(printf "\n=== FAILURES ===\n")
|
||||
(each f all-failures
|
||||
(printf "[%s:%d] %s\n" (f :file) (f :form-number) (f :error))
|
||||
(printf " form: %s\n" (f :form))))
|
||||
Loading…
Add table
Add a link
Reference in a new issue