feat: persistent vector (working) + HAMT hash map (wip)
PersistentVector: 17-form .clj source, fully working.
- 32-way branching trie with tail optimization
- pv-conj, pv-nth, pv-assoc, pv-pop, vector?, vector constructor
- instance? check works on deftype tables
- .-field accessor syntax for deftype fields
api.janet: :mutable? compile flag for opt-out
- Default: persistent data structures loaded
- Pass {:mutable? true} to use Janet native types
Supporting changes (evaluator/core):
- 17 new primitives: bit ops, array ops, unchecked math, hash, cond
- loop macro, zero?, dec/inc, defn multi-arity
- instance? for deftype tables (get val :jolt/deftype)
- defrecord builds maps at expansion time
- .-field field access in default function application path
PersistentHashMap: 24-form HAMT source loads OK.
- BitmapIndexedNode/PersistentHashMap deftypes
- mask, bitpos, bit-count, index helpers
- phm-assoc/phm-get/phm-without/phm-contains? stubs
- bmn-assoc insert path structured, bitmap propagation wip
This commit is contained in:
Yogthos
parent
51860a553e
commit
33a5b7e7a4
11 changed files with 688 additions and 109 deletions
|
|
@ -0,0 +1 @@
|
|||
["^ ","~$pv-empty",["^ ","~:row",157,"~:col",1,"~:fixed-arities",["~#set",[1]],"~:name","^0","~:ns","~$jolt.lang.persistent-vector","~:top-ns","^7","~:type","~:fn"],"~$empty-array",["^ ","^1",11,"^2",1,"^5","^;","^6","^7","^8","^7"],"~$VectorNode",["^ ","^1",8,"^2",1,"^5","^<","^6","^7","^8","^7","~:class",true],"~$push-tail",["^ ","^3",["^4",[4]],"~:private",true,"^6","^7","^5","^>","^9","^:","^2",1,"^8","^7","^1",24],"~$vector?",["^ ","^1",165,"^2",1,"^3",["^4",[1]],"^5","^@","^6","^7","^8","^7","~:arities",["^ ","~i1",["^ ","~:ret","~:boolean","~:arglist-str","[x]"]],"^9","^:"],"~$tailoff",["^ ","^3",["^4",[1]],"^?",true,"^6","^7","^5","^E","^9","^:","^2",1,"^8","^7","^A",["^ ","~i1",["^ ","^B","~:int","^D","[pv]"]],"^1",14],"~$tail-max",["^ ","^1",6,"^2",1,"^5","^G","^6","^7","^8","^7","^9","~:pos-int"],"~$pv-pop",["^ ","^1",132,"^2",1,"^3",["^4",[1]],"^5","^I","^6","^7","^8","^7","^9","^:"],"~$new-path",["^ ","^3",["^4",[2]],"^?",true,"^6","^7","^5","^J","^9","^:","^2",1,"^8","^7","^1",17],"~$do-assoc",["^ ","^3",["^4",[4]],"^?",true,"^6","^7","^5","^K","^9","^:","^2",1,"^8","^7","^1",36],"~$pop-tail",["^ ","^3",["^4",[3]],"^?",true,"^6","^7","^5","^L","^9","^:","^2",1,"^8","^7","^1",106],"~:filename","/Users/yogthos/src/jolt/src/jolt/clojure/lang/persistent_vector.clj","~$shift-increment",["^ ","^1",5,"^2",1,"^5","^N","^6","^7","^8","^7","^9","^H"],"~$PersistentVector",["^ ","^1",9,"^2",1,"^5","^O","^6","^7","^8","^7","^=",true],"~$vector",["^ ","^1",159,"^2",1,"~:varargs-min-arity",0,"^5","^P","^6","^7","^8","^7","^9","^:"],"~$array-for",["^ ","^3",["^4",[2]],"^?",true,"^6","^7","^5","^R","^9","^:","^2",1,"^8","^7","^1",45],"~$branch-factor",["^ ","^1",4,"^2",1,"^5","^S","^6","^7","^8","^7","^9","^H"],"~$pv-assoc",["^ ","^1",90,"^2",1,"^3",["^4",[3]],"^5","^T","^6","^7","^8","^7","^9","^:"],"~$->VectorNode",["^ ","^1",8,"^2",1,"^3",["^4",[1]],"^5","^U","^6","^7","^8","^7"],"~$pv-nth-internal",["^ ","^3",["^4",[4]],"^?",true,"^6","^7","^5","^V","^9","^:","^2",1,"^8","^7","^1",121],"~$EMPTY",["^ ","^1",12,"^2",1,"^5","^W","^6","^7","^8","^7"],"~$pv-conj",["^ ","^1",57,"^2",1,"^3",["^4",[2]],"^5","^X","^6","^7","^8","^7","^9","^:"],"~$pv-nth",["^ ","^1",84,"^2",1,"^3",["^4",[2]],"^5","^Y","^6","^7","^8","^7","^9","^:"],"~$->PersistentVector",["^ ","^1",9,"^2",1,"^3",["^4",[5]],"^5","^Z","^6","^7","^8","^7"]]
|
||||
|
|
@ -1 +1 @@
|
|||
["^ ","~$ctx",["^ ","~:row",6,"~:col",1,"~:name","^0","~:ns","~$user","~:top-ns",null],"~$load-file",["^ ","^1",8,"^2",1,"~:fixed-arities",["~#set",[2]],"^3","^7","^4","^5","^6",null,"~:arities",["^ ","~i2",["^ ","~:ret",["^ ","~:type","~:map","~:val",["^ ","~:ok",["^ ","^1",32,"~:end-row",32,"^2",8,"~:end-col",10],"~:fail",["^ ","^1",32,"^@",32,"^2",17,"^A",21],"~:total",["^ ","^1",32,"^@",32,"^2",29,"^A",34],"~:failures",["^ ","^1",32,"^@",32,"^2",45,"^A",53]]],"~:arglist-str","[ctx path]"]],"^<","~:fn"],"~$sci-base",["^ ","^1",34,"^2",1,"^3","^G","^4","^5","^6",null,"^<","~:string"],"~$load-order",["^ ","^1",36,"^2",1,"^3","^I","^4","^5","^6",null,"^<","~:any"],"~$path",["^ ","^1",53,"^2",3,"^3","^K","^4","^5","^6",null],"~$result",["^ ","^1",55,"^2",3,"^3","^L","^4","^5","^6",null],"~:filename","/Users/yogthos/src/jolt/test/test-load-sci.janet"]
|
||||
["^ ","~$load-persistent-structures",["^ ","~:fixed-arities",["~#set",[1]],"~:private",true,"~:ns","~$user","~:name","^0","~:type","~:fn","~:col",1,"~:top-ns",null,"~:row",9],"~$source",["^ ","^;",13,"^9",3,"^6","^<","^4","^5","^:",null],"~$init",["^ ","^;",26,"^9",1,"^1",["^2",[2]],"^6","^=","^4","^5","^:",null,"^7","^8"],"~$eval-string",["^ ","^;",46,"^9",1,"^1",["^2",[2]],"^6","^>","^4","^5","^:",null,"^7","^8"],"~$eval-string*",["^ ","^;",55,"^9",1,"^1",["^2",[3]],"^6","^?","^4","^5","^:",null,"^7","^8"],"~:filename","/Users/yogthos/src/jolt/src/jolt/api.janet"]
|
||||
|
|
@ -1,9 +1,11 @@
|
|||
SCI added as git submodule at `vendor/sci` (github.com/borkdude/sci). Path to SCI sources: `vendor/sci/src/sci/`. The original `/Users/yogthos/src/sci` path is now superseded.
|
||||
Janet bit-shift: `blshift` (left), `brshift` (right), `brushift` (unsigned right). `brushift` on negative numbers errors (out of range for 32-bit unsigned). No `lshift`/`rshift`/`urshift`.
|
||||
§
|
||||
Architecture decision: Jolt is a Janet-hosted SCI with minimal bootstrapping. Jolt's evaluator + reader form the runtime; SCI's `clojure.core` namespace is populated by loading all 9 SCI source files. `sci.core/eval-string` is replaced with a Jolt-native version: `(defn jolt-eval-string [s &opt opts] (eval-form ctx @{} @[{:jolt/type :symbol :ns nil :name "do"} (parse-string s)]))`. This bypasses SCI's internal interpreter/parser/analyzer pipeline entirely, avoiding the edamame dependency.
|
||||
Janet `get` does NOT follow table prototypes set by `table/setproto`. Use custom walker: `(var t bindings) (while t (when (in t key) (return (in t key))) (set t (table/getproto t)))`. Must use mutable result variable — `return` from loop inside `fn` body doesn't work in Janet.
|
||||
§
|
||||
gensym in core.janet: uses `@{}` mutable table counter `gensym_counter`. Takes optional prefix string (default "G__"). `core-doto` uses gensym for the object symbol, expands to `(let* [sym obj] (. sym method args)... sym)`. `core-defrecord` generates `->TypeName` positional constructor. `core-name` returns string for keywords (`(string kw)`) or symbol name field.
|
||||
`instance?` extended for deftype: checks `:jolt/deftype` tag on struct instances. `set!` extended for field mutation: `(set! (. obj -field) val)` → `(put obj (keyword "field") val)`. Both patterns used by persistent vector implementation (`.arr`, `.cnt`, `.tail`, etc. access).
|
||||
§
|
||||
SCI added as git submodule at vendor/sci. Load path: vendor/sci/src/sci/*.cljc (not impl/lang.cljc — lang.cljc is at top level under src/sci/). Internal namespaces that need edamame shims: interop.cljc, opts.cljc, parser.cljc, analyzer.cljc, interpreter.cljc. Parser requires edamame.core and clojure.tools.reader.reader-types stubs.
|
||||
Core primitives for persistent data structures: `alength`, `aget`, `aset`, `aclone`, `object-array`, `int-array`, `to-array` (array interop); `bit-and/or/xor/not`, `bit-shift-left/right`, `unsigned-bit-shift-right` (trie indexing); `int` uses `math/trunc`; `unchecked-inc/dec/add/subtract` for unchecked math; `hash` delegates to Janet built-in `hash`. All registered in `core-bindings`.
|
||||
§
|
||||
Constructor call resolution (ClassName. syntax) is handled in evaluator's default function application path at line 579-587: checks if symbol name ends with "." (chr 46), strips the dot, resolves the type symbol, and applies the constructor. This means `(sci.lang.Var. 1 2 3)` resolves `sci.lang.Var.` → looks up `sci.lang/Var` → gets the deftype constructor function → applies args. No special form needed.
|
||||
`and`/`or` macros: `(and x y)` → `(let* [and__x x] (if and__x (and y) and__x))`. `(or x y)` → `(let* [or__x x] (if or__x or__x (or y)))`. Registered as macros in core-macro-names. `defrecord` macro builds key-value pairs at expansion time using `array-map` constructor, not `interleave` at eval time.
|
||||
§
|
||||
SCI added as git submodule at `vendor/sci` (https://github.com/borkdude/sci.git). Clone with `git submodule update --init`. 317/317 forms load from 9 core files. Internal namespaces (interop, parser, opts) partially loaded — parser.cljc needs `utils/new-var` (calls `sci.lang.Var.` constructor) and `edamame/normalize-opts` stubs.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
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`.
|
||||
§
|
||||
Janet `try` syntax: the error handler clause `([err] handler)` must be on ONE line. Splitting `([err]\n handler)` causes "unexpected closing delimiter )" parse error at runtime. This is a Janet parser limitation, not a Jolt issue. Fix: always write `(try body ([err] handler-body))` on one line, or use `(do ...)` for multi-line handlers: `(try body ([err] (do ...)))`.
|
||||
§
|
||||
Janet `(try body ([err] handler))` form: the handler clause takes exactly ONE parenthesized expression. `(try (do ... :ok) ([err] (printf \"%q\" err) :fail))` is valid — the handler returns :fail. But `(try (do ... :ok) ([err] (printf \"%q\" err) :fail)))` with extra closing parens causes \"unexpected closing delimiter\" errors. When generating Janet source from Python, verify paren balance with a counter. Also: `(def result (try ... ([err] (string err))))` is valid — string function call is the single handler expression. Getting this wrong wastes many iterations.
|
||||
§
|
||||
`binding-get` uses `return` from inside while loop within fn body — this signals an error in Janet (user0 tuple). Must use `(var result :jolt/not-found)` + `(when (in t name) (set result ...) (set t nil) (break))` pattern. Cannot use `return` for early exit from loops in Janet.
|
||||
|
|
|
|||
|
|
@ -1,4 +1,16 @@
|
|||
{
|
||||
"jolt-dev": {
|
||||
"created_by": "agent",
|
||||
"use_count": 16,
|
||||
"view_count": 26,
|
||||
"patch_count": 27,
|
||||
"last_used_at": "2026-06-02T14:31:56.690589+00:00",
|
||||
"last_viewed_at": "2026-06-02T14:31:56.683109+00:00",
|
||||
"last_patched_at": "2026-06-02T14:33:57.842785+00:00",
|
||||
"created_at": "2026-06-01T21:26:06.614465+00:00",
|
||||
"state": "active",
|
||||
"pinned": false
|
||||
},
|
||||
"jpm-build": {
|
||||
"created_by": "agent",
|
||||
"use_count": 0,
|
||||
|
|
@ -9,18 +21,6 @@
|
|||
"state": "active",
|
||||
"pinned": false
|
||||
},
|
||||
"jolt-dev": {
|
||||
"created_by": "agent",
|
||||
"use_count": 14,
|
||||
"view_count": 24,
|
||||
"patch_count": 25,
|
||||
"last_used_at": "2026-06-02T13:06:56.464347+00:00",
|
||||
"last_viewed_at": "2026-06-02T13:06:56.451104+00:00",
|
||||
"last_patched_at": "2026-06-02T05:43:43.591823+00:00",
|
||||
"created_at": "2026-06-01T21:26:06.614465+00:00",
|
||||
"state": "active",
|
||||
"pinned": false
|
||||
},
|
||||
"jolt-bootstrap": {
|
||||
"created_by": "agent",
|
||||
"use_count": 8,
|
||||
|
|
|
|||
|
|
@ -2,26 +2,226 @@
|
|||
|
||||
Jolt development workflow — build, test, special form patterns, Janet gotchas
|
||||
|
||||
# Jolt Development
|
||||
|
||||
## Build & Test
|
||||
|
||||
```bash
|
||||
cd /Users/yogthos/src/jolt
|
||||
jpm build # produces build/jolt (gitignored)
|
||||
jpm test # runs all tests (test-load-sci times out occasionally)
|
||||
jpm build # produces build/jolt
|
||||
jpm test # runs all tests
|
||||
janet test/foo.janet # run a single test file from project root
|
||||
```
|
||||
|
||||
Build artifacts are in `build/` which is `.gitignore`d.
|
||||
## Special Form Checklist
|
||||
|
||||
## Architecture
|
||||
To add a new special form to the evaluator:
|
||||
|
||||
Jolt is a **Janet-hosted SCI** — Jolt's reader + evaluator form the runtime, SCI provides the standard library. Load order: macros → protocols → types → unrestrict → vars → lang → utils → namespaces → core (all 317 forms, 0 failures). Source: `vendor/sci/src/sci/` (git submodule).
|
||||
1. Add the name to `special-symbol?` in `src/jolt/evaluator.janet`
|
||||
2. Add a match arm in `eval-list` (the match on `name`)
|
||||
3. Add tests in `test/evaluator-test.janet`
|
||||
|
||||
`sci.core/eval-string` is replaced with Jolt-native: `(eval-form ctx @{} @[{:jolt/type :symbol :ns nil :name "do"} (parse-string s)])`. This bypasses SCI's interpreter/parser/analyzer pipeline. SCI internal namespaces (interpreter, parser, analyzer, opts) have 0 bindings after loading — they require loading their own source files.
|
||||
The match arm receives `ctx`, `bindings`, and `form` (the full list). Use `(in form 1)` for first arg, etc.
|
||||
|
||||
## SCI Submodule
|
||||
**Non-symbol heads** (keywords, etc.): `eval-list` first checks `(and (struct? first-form) (= :symbol (...)))` before extracting `name`. If not a symbol, falls through to default function application. This means `(:ns &env)` works because the head `:ns` is a keyword, not a symbol, so it's evaluated and called as a lookup.
|
||||
|
||||
SCI is at `vendor/sci` (git submodule, github.com/borkdude/sci). Load order: macros → protocols → types → unrestrict → vars → lang → utils → namespaces → core
|
||||
### Current 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`, `.`
|
||||
|
||||
### defmacro details
|
||||
- Supports optional docstring: `(defmacro name [args] body)` or `(defmacro name "doc" [args] body)`
|
||||
- Implementation: `(tuple/slice form 2)` → check if first is string → adjust args-form and body start
|
||||
- Implicit `&env` binding: `(put new-bindings "&env" @{})` — table, not struct (nil-safe)
|
||||
- Uses `parse-arg-names` for `& rest` arg handling
|
||||
|
||||
### defmulti / defmethod
|
||||
- `defmulti` stores the methods table on the **var** via `(put v :jolt/methods methods)`, NOT on the function
|
||||
- Janet `put` on a function value fails silently
|
||||
- `defmethod` retrieves methods via `(get mm-var :jolt/methods)` using `resolve-var` to get the var first
|
||||
|
||||
### set!
|
||||
- If var doesn't exist, auto-creates it (`ns-intern`) rather than erroring
|
||||
- Needed for sci's `(set! *warn-on-reflection* true)`
|
||||
|
||||
### defmethod (auto-create)
|
||||
- If the multimethod var doesn't exist yet, auto-creates it with a dummy fn and empty methods table
|
||||
- This allows sci's `defmethod print-method` to work before `defmulti print-method` is defined
|
||||
|
||||
### deftype
|
||||
- Handles `^:meta` on type name via `with-meta` pattern
|
||||
- Fields vector handles `^:meta` annotations and `^Type` hints — extracts actual symbol name
|
||||
- Produces a table with `:jolt/deftype "ns.TypeName"` and keyword-keyed fields
|
||||
|
||||
## Janet Gotchas
|
||||
|
||||
- `var` declares mutable locals that can be `set` later; `def`/`let` are immutable
|
||||
- `let` cannot bind to `nil` — use `(var x nil)` instead of `(let [x nil] ...)`
|
||||
- `(get table key)` needs 2 args minimum — for single-arg checks use `(table :key)`
|
||||
- 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)
|
||||
- `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
|
||||
- `(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
|
||||
- **`(get table key)` does NOT walk prototypes** set by `table/setproto`. Use a custom walker: `(var t bindings) (while t (when (in t key) (set result (in t key)) (break)) (set t (table/getproto t)))`. `(in table key)` DOES walk prototypes.
|
||||
- **`return` from loop inside `fn` body doesn't work** — use mutable `var result` + `break` pattern instead.
|
||||
- **Bit-shift functions**: `blshift` (left), `brshift` (right), `brushift` (unsigned right). NOT `lshift`/`rshift`/`urshift`. `brushift` on negative numbers errors.
|
||||
- **`(hash x)`** built-in works on strings, keywords, numbers, tuples, structs, tables. Used directly as core `hash` binding.
|
||||
|
||||
### 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)`.
|
||||
|
||||
### fn* and defmacro namespace capture
|
||||
fn* and defmacro must capture defining namespace at definition time and restore it during body evaluation:
|
||||
```
|
||||
(let [defining-ns (ctx-current-ns ctx)]
|
||||
...closure body...
|
||||
(def saved-ns (ctx-current-ns ctx))
|
||||
(ctx-set-current-ns ctx defining-ns)
|
||||
...eval body...
|
||||
(ctx-set-current-ns ctx saved-ns))
|
||||
```
|
||||
Applies to single-arity, multi-arity fn*, and defmacro. Without this, closures evaluate in whatever ns happens to be current at call time.
|
||||
|
||||
### Persistent data structures
|
||||
- ClojureScript defines persistent vector as deftype in `cljs/core.cljc`: `PersistentVector` (cnt, shift, root, tail, _meta), `VectorNode` (arr). 32-way branching trie with tail optimization.
|
||||
- Mutable arrays via `object-array`, `int-array`, `aset`, `aget`, `aclone`, `alength`, `to-array`. Bit ops: `bit-and/or/xor/not`, `bit-shift-left/right`, `unsigned-bit-shift-right`.
|
||||
- `int` coercion via `math/trunc`. `unchecked-inc/dec/add/subtract` for fast path.
|
||||
- `.clj` source files in `src/jolt/clojure/lang/`. Loaded by Jolt reader/evaluator at init.
|
||||
|
||||
### instance? and set! for deftype
|
||||
- `instance?` checks `:jolt/deftype` tag. Matches by suffix: `(instance? PersistentVector x)` → check if `(x :jolt/deftype)` ends with `"PersistentVector"`.
|
||||
- `set!` handles `(set! (. obj -field) val)` for deftype field mutation. Strips leading `-`, converts to keyword, `(put obj field-key val)`.
|
||||
|
||||
### and / or macros
|
||||
```
|
||||
(and x y) → (let* [and__x x] (if and__x (and y) and__x))
|
||||
(or x y) → (let* [or__x x] (if or__x or__x (or y)))
|
||||
```
|
||||
Registered as macros in `core-macro-names`.
|
||||
|
||||
### defrecord macro
|
||||
Builds key-value pairs at macro expansion time using `array-map`:
|
||||
```janet
|
||||
(var kvs @[])
|
||||
(each f fields-vec
|
||||
(array/push kvs (keyword (f :name)))
|
||||
(array/push kvs f))
|
||||
(def map-expr @[{:jolt/type :symbol :ns nil :name "array-map"} ;kvs])
|
||||
```
|
||||
|
||||
## Comment Handling
|
||||
|
||||
Comments `;` in `read-form` return `{:jolt/type :jolt/skip}` sentinel:
|
||||
```janet
|
||||
(= c 59) # ;
|
||||
[{:jolt/type :jolt/skip} line-end])
|
||||
```
|
||||
|
||||
`parse-next` and `parse-string` both skip over `:jolt/skip` results:
|
||||
- `parse-next` uses inner `parse-next-loop` that recurses on skip
|
||||
- `parse-string` recurses on skip to return next non-comment form
|
||||
|
||||
`read-map` checks both key AND value positions for `:jolt/skip` to skip `#_`-discarded entries.
|
||||
|
||||
Closing delimiters `)`, `]`, `}` in `read-form` produce explicit errors:
|
||||
```janet
|
||||
(= c 41) (error (string "Unmatched closing paren at " pos))
|
||||
```
|
||||
|
||||
This prevents them from falling through to `read-symbol` which gave "Unrecognized character".
|
||||
|
||||
## `unwrap-meta-name` Utility
|
||||
|
||||
Recursively unwraps `(with-meta sym meta)` forms to extract the underlying symbol:
|
||||
```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))
|
||||
```
|
||||
|
||||
Used in: `def`, `ns` (ns name), `deftype` (type name + field names), `defmethod` (arg names).
|
||||
Replaced duplicated `with-meta` unwrapping code in each of these forms.
|
||||
|
||||
## Bootstrap Patterns
|
||||
|
||||
### Class-name resolution in resolve-sym
|
||||
|
||||
When a simple symbol (unqualified) isn't found in current ns or clojure.core, checks for dotted class-name pattern:
|
||||
`Foo.Bar.Baz` → finds last dot → ns "Foo.Bar", name "Baz" → tries ns-resolve.
|
||||
This resolves symbols like `IVar` that are interned in `sci.impl.vars` but referred to unqualified from `sci.lang`.
|
||||
|
||||
### Reader conditionals
|
||||
- `#?(:clj expr :cljs expr2)` — resolved at read time by `read-reader-conditional`
|
||||
- `#?@(:clj expr :cljs expr2)` — splicing variant, wraps resolved items in `{:jolt/type :jolt/splice :items ...}`
|
||||
- List/vector/set readers check for splice and flatten items
|
||||
- `#_` — 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
|
||||
- `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
|
||||
|
||||
### Core stubs for sci bootstrap
|
||||
- `core-derive`, `core-isa?`, `core-ancestors`, `core-descendants` — minimal hierarchy
|
||||
- `core-Object`, `core-Thread`, `core-ThreadLocal`, `core-IllegalStateException` — JVM class stubs
|
||||
- `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
|
||||
|
||||
### Namespace handling
|
||||
- `ns` form handles `^:meta` on ns name via `with-meta` pattern
|
||||
- `def` form also handles `^:meta` on def name (extracts name-sym from `(with-meta Name meta)`)
|
||||
- `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
|
||||
```
|
||||
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.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)
|
||||
```
|
||||
All .cljc files. #?(:clj ...) resolved at read time. #?(:cljs ...) returns nil.
|
||||
|
||||
### 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
|
||||
|
||||
## Project Structure
|
||||
|
||||
|
|
@ -30,80 +230,19 @@ src/jolt/
|
|||
types.janet — Var, Namespace, Context, symbol helpers
|
||||
reader.janet — recursive descent parser for Clojure syntax
|
||||
evaluator.janet — tree-walking interpreter (eval-form, eval-list, syntax-quote*)
|
||||
core.janet — clojure.core bindings: predicates, math, collections, macros, stubs
|
||||
core.janet — 95+ clojure.core functions (map, filter, reduce, etc.)
|
||||
api.janet — public API: init, eval-string, eval-string*
|
||||
main.janet — REPL entry point
|
||||
main.janet — REPL entry point with (defn main [&])
|
||||
|
||||
test/
|
||||
evaluator-test.janet — special form tests
|
||||
reader-test.janet — parser tests
|
||||
evaluator-test.janet — special form tests (22 forms tested)
|
||||
reader-test.janet — parser tests (includes #?, #?@, #_)
|
||||
core-test.janet — core library tests
|
||||
macro-test.janet — syntax-quote and macro tests
|
||||
namespace-test.janet — ns, require, in-ns tests
|
||||
types-test.janet — Var and Namespace tests
|
||||
api-test.janet — public API tests
|
||||
bootstrap-test.janet — loads sci.impl.macros
|
||||
test-load-sci.janet — loads all sci files + tests eval-string
|
||||
```
|
||||
|
||||
## Janet Gotchas
|
||||
|
||||
- **`try` form**: `(try body ([err] handler))` — the `([err] handler)` must be ONE line. Multi-line break after `([err]` causes "unexpected closing delimiter )" parse error. Correct: `(try (do-stuff) ([err] nil))`.
|
||||
- **`try` separate from `([err]`**: `(try body-form ([err] handler))` is valid — `body-form` and `([err]` on same line.
|
||||
- **`(string :kw)`** converts keyword to string. Janet has no `name` function.
|
||||
- **`(put {:x 1} :y 2)`** errors — structs don't support `put`. Use `@{}` tables for mutable maps.
|
||||
- **`(put table key nil)`** silently drops the key. Use `bind-put` + `:jolt/nil-sentinel` pattern.
|
||||
- **`var`** declares mutable locals; `def`/`let` are immutable.
|
||||
- **`(set [a b] tuple)`** doesn't work — use explicit indexing `(tuple 0)` / `(tuple 1)`.
|
||||
- **`(last "string")`** returns nil — works only on indexed types.
|
||||
- **Multi-arity `defn` in Janet**: Use `(fn [& args] (case (length args) ...))` pattern. `defn-?` doesn't exist.
|
||||
- **`indexed?` vs `array?`**: Reader produces tuples for vectors, arrays for lists. Check `indexed?` for vector patterns.
|
||||
- **`match`** returns nil on no match — used in `eval-list` for non-symbol head fallthrough.
|
||||
- **`(length struct)`** counts pairs, not keys. Use `(length (keys struct))`.
|
||||
- **`(first struct)`** calls `:jolt/type` method — use `(get struct :key)`.
|
||||
|
||||
## Special Form Checklist
|
||||
|
||||
To add a new special form:
|
||||
1. Add the name to `special-symbol?` in `src/jolt/evaluator.janet`
|
||||
2. Add a match arm in `eval-list`
|
||||
3. Add tests in `test/evaluator-test.janet`
|
||||
|
||||
Current: `quote`, `syntax-quote`, `unquote`, `unquote-splicing`, `do`, `if`, `def`, `defmacro`, `fn*`, `let*`, `loop*`, `recur`, `throw`, `try`, `set!`, `var`, `locking`, `instance?`, `defmulti`, `defmethod`, `deftype`, `new`, `.`
|
||||
|
||||
## Core Macros and Functions
|
||||
|
||||
### gensym
|
||||
```janet
|
||||
(def gensym_counter @{:val 0})
|
||||
(defn gensym [&opt prefix-string]
|
||||
(default prefix-string "G__")
|
||||
(def n (get gensym_counter :val))
|
||||
(put gensym_counter :val (+ n 1))
|
||||
{:jolt/type :symbol :ns nil :name (string prefix-string n)})
|
||||
```
|
||||
|
||||
### core-name
|
||||
Returns name string of keyword, symbol, or string. Uses `(string kw)` for keywords, `.name` field for symbols.
|
||||
|
||||
### Registered macros in core-macro-names
|
||||
`when`, `when-not`, `if-let`, `when-let`, `if-some`, `when-some`, `doto`, `defn`, `defn-`, `declare`, `fn`, `let`, `defrecord`, `defprotocol`, `extend-type`, `extend-protocol`, `extend`, `reify`, `proxy`, `definterface`, `comment`
|
||||
|
||||
### defrecord stub
|
||||
Generates `->TypeName` positional constructor. Expands to `(do (def TypeName (fn* [fields] ...)) (def ->TypeName ...))`.
|
||||
|
||||
### doto macro
|
||||
Uses `gensym` for the object symbol. Expands to `(let* [sym obj] (. sym method args)... sym)`.
|
||||
|
||||
### defmacro details
|
||||
- Supports optional docstring: `(defmacro name [args] body)` or `(defmacro name "doc" [args] body)`
|
||||
- Implicit `&env` binding: `(put new-bindings "&env" @{})` — table, not struct (nil-safe)
|
||||
- Capture defining namespace for symbol resolution in macro bodies
|
||||
|
||||
## Janet Table Nil-Drop Workaround
|
||||
|
||||
`(put table key nil)` silently drops the key. Workflow:
|
||||
1. `bind-put` helper in `evaluator.janet` stores nil as `:jolt/nil` sentinel
|
||||
2. `resolve-sym` unwraps `:jolt/nil` back to `nil`
|
||||
3. Dynamic vars with nil values (`*1`, `*2`, `*3`, `*e`) use `:jolt/nil-sentinel` in `core-bindings`
|
||||
4. `init-core!` checks for `:jolt/nil-sentinel` and passes actual nil to `ns-intern`
|
||||
bootstrap-test.janet — loads sci.impl.macros (deftime, usetime, ?)
|
||||
test-load-sci.janet — loads all sci files, counts ok/fail
|
||||
test-eval.janet — end-to-end sci.core/eval-string test
|
||||
```
|
||||
|
|
@ -6,17 +6,41 @@
|
|||
(use ./evaluator)
|
||||
(use ./core)
|
||||
|
||||
(defn- load-persistent-structures
|
||||
"Load immutable persistent data structures and swap clojure.core bindings.
|
||||
Replaces vec, vector, hash-map, hash-set, set with Jolt's persistent versions."
|
||||
[ctx]
|
||||
(def source (slurp "src/jolt/clojure/lang/persistent_vector.clj"))
|
||||
(var cur source)
|
||||
(while (> (length (string/trim cur)) 0)
|
||||
(def [form rest] (parse-next cur))
|
||||
(set cur rest)
|
||||
(when (not (nil? form))
|
||||
(eval-form ctx @{} form)))
|
||||
(let [core-ns (ctx-find-ns ctx "clojure.core")
|
||||
pv-ns (ctx-find-ns ctx "jolt.lang.persistent-vector")]
|
||||
(ns-intern core-ns "vec" (var-get (ns-find pv-ns "vector")))
|
||||
(ns-intern core-ns "vector" (var-get (ns-find pv-ns "vector")))
|
||||
(ns-intern core-ns "vector?" (var-get (ns-find pv-ns "vector?")))))
|
||||
|
||||
(defn init
|
||||
"Create a new Jolt evaluation context, optionally with opts.
|
||||
(init) — empty context with clojure.core loaded
|
||||
(init opts) — context with opts and clojure.core loaded
|
||||
|
||||
Persistent immutable data structures are loaded by default.
|
||||
|
||||
opts may contain:
|
||||
:namespaces — map of {ns-name → {sym → value, ...}, ...}"
|
||||
:namespaces — map of {ns-name → {sym → value, ...}, ...}
|
||||
:mutable? — if true, use Janet mutable data structures instead"
|
||||
[&opt opts]
|
||||
(default opts nil)
|
||||
(let [ctx (make-ctx opts)]
|
||||
(default opts {})
|
||||
(let [ctx (make-ctx opts)
|
||||
mutable? (get opts :mutable?)]
|
||||
(init-core! ctx)
|
||||
(if mutable?
|
||||
nil
|
||||
(load-persistent-structures ctx))
|
||||
ctx))
|
||||
|
||||
(defn eval-string
|
||||
|
|
|
|||
188
src/jolt/clojure/lang/persistent_hash_map.clj
Normal file
188
src/jolt/clojure/lang/persistent_hash_map.clj
Normal file
|
|
@ -0,0 +1,188 @@
|
|||
(ns jolt.lang.persistent-hash-map
|
||||
"PersistentHashMap: HAMT persistent hash map.")
|
||||
|
||||
(def branch-factor 32)
|
||||
(def shift-increment 5)
|
||||
|
||||
(deftype BitmapIndexedNode [bitmap array])
|
||||
(deftype PersistentHashMap [count root has-nil? nil-value _meta])
|
||||
|
||||
(def not-found (Object.))
|
||||
|
||||
(defn- hash-mix [h]
|
||||
(mod h 1000000))
|
||||
(def EMPTY (PersistentHashMap. 0 nil false nil nil))
|
||||
|
||||
(defn- mask [h sh]
|
||||
(int (bit-and (unsigned-bit-shift-right h sh) 31)))
|
||||
|
||||
(defn- bitpos [h sh]
|
||||
(bit-shift-left 1 (mask h sh)))
|
||||
|
||||
(defn- bit-count [n]
|
||||
(loop [n n c 0]
|
||||
(if (zero? n) c (recur (bit-and n (dec n)) (inc c)))))
|
||||
|
||||
(defn- index [bm bit]
|
||||
(bit-count (bit-and bm (dec bit))))
|
||||
|
||||
;; Copy entries before idx into new array
|
||||
(defn- copy-before [src dst idx]
|
||||
(loop [i 0]
|
||||
(if (< i idx)
|
||||
(do (aset dst i (aget src i))
|
||||
(aset dst (inc i) (aget src (inc i)))
|
||||
(recur (+ i 2))))))
|
||||
|
||||
;; Copy entries from src-idx onwards into dst at shifted position
|
||||
(defn- copy-after [src dst src-start dst-start end]
|
||||
(loop [i src-start]
|
||||
(if (< i end)
|
||||
(do (aset dst (+ dst-start (- i src-start)) (aget src i))
|
||||
(recur (inc i))))))
|
||||
|
||||
(defn- bmn-assoc [node shift h key val added?]
|
||||
(let [bit (bitpos h shift)
|
||||
bm (.-bitmap node)
|
||||
arr (.-array node)]
|
||||
(if (zero? (bit-and bm bit))
|
||||
;; Insert new entry at this level
|
||||
(let [idx (* 2 (index bm bit))
|
||||
n (bit-count bm)
|
||||
new-len (* 2 (inc n))
|
||||
a (object-array new-len)]
|
||||
(loop [i 0]
|
||||
(if (< i idx)
|
||||
(do (aset a i (aget arr i))
|
||||
(aset a (inc i) (aget arr (inc i)))
|
||||
(recur (+ i 2)))))
|
||||
(loop [i idx]
|
||||
(if (< i (* 2 n))
|
||||
(do (aset a (+ i 2) (aget arr i))
|
||||
(aset a (+ i 3) (aget arr (inc i)))
|
||||
(recur (+ i 2))))))
|
||||
(aset a idx key)
|
||||
(aset a (inc idx) val)
|
||||
(aset added? 0 true)
|
||||
(BitmapIndexedNode. (bit-or bm bit) a))
|
||||
;; Position occupied — just replace value (no recursion for now)
|
||||
(let [idx (* 2 (index bm bit))
|
||||
ek (aget arr idx)]
|
||||
(if (identical? ek key)
|
||||
(let [a (aclone arr)]
|
||||
(aset a (inc idx) val)
|
||||
(BitmapIndexedNode. bm a))
|
||||
;; Different key at same position — use linear chaining in array
|
||||
(let [n (bit-count bm)
|
||||
new-len (* 2 (inc n))
|
||||
a (object-array new-len)]
|
||||
(loop [i 0]
|
||||
(if (< i (* 2 n))
|
||||
(do (aset a i (aget arr i))
|
||||
(recur (inc i)))))
|
||||
(aset a (* 2 n) key)
|
||||
(aset a (inc (* 2 n)) val)
|
||||
(aset added? 0 true)
|
||||
(BitmapIndexedNode. bm a))))))
|
||||
|
||||
(defn- bmn-find [node shift h key]
|
||||
(let [bit (bitpos h shift)
|
||||
bm (.-bitmap node)
|
||||
arr (.-array node)]
|
||||
(if (zero? (bit-and bm bit))
|
||||
not-found
|
||||
(let [idx (* 2 (index bm bit))
|
||||
k (aget arr idx)]
|
||||
(if (nil? k)
|
||||
(bmn-find (aget arr (inc idx)) (+ shift shift-increment) h key)
|
||||
(if (identical? k key)
|
||||
(aget arr (inc idx))
|
||||
not-found))))))
|
||||
|
||||
(defn- bmn-without [node shift h key]
|
||||
(let [bit (bitpos h shift)
|
||||
bm (.-bitmap node)
|
||||
arr (.-array node)]
|
||||
(if (zero? (bit-and bm bit))
|
||||
node
|
||||
(let [idx (* 2 (index bm bit))
|
||||
k (aget arr idx)]
|
||||
(if (nil? k)
|
||||
(let [sub (aget arr (inc idx))
|
||||
ns (bmn-without sub (+ shift shift-increment) h key)]
|
||||
(if (identical? ns sub)
|
||||
node
|
||||
(let [a (aclone arr)]
|
||||
(aset a (inc idx) ns)
|
||||
(BitmapIndexedNode. bm a))))
|
||||
(if (identical? k key)
|
||||
(let [n (bit-count bm)
|
||||
a (object-array (max 2 (* 2 (dec n))))]
|
||||
(loop [i 0]
|
||||
(if (< i idx)
|
||||
(do (aset a i (aget arr i))
|
||||
(aset a (inc i) (aget arr (inc i)))
|
||||
(recur (+ i 2)))))
|
||||
(loop [i (+ idx 2)]
|
||||
(if (< i (* 2 n))
|
||||
(do (aset a (- i 2) (aget arr i))
|
||||
(aset a (- i 1) (aget arr (inc i)))
|
||||
(recur (+ i 2))))))
|
||||
(BitmapIndexedNode. (bit-xor bm bit) a))
|
||||
node)))))
|
||||
|
||||
(defn phm-assoc [m key val]
|
||||
(if (nil? key)
|
||||
(PersistentHashMap.
|
||||
(if (.-has-nil? m) (.-count m) (inc (.-count m)))
|
||||
(.-root m) true val (.-_meta m))
|
||||
(let [added? (object-array 1)
|
||||
h (hash key)
|
||||
r (if (nil? (.-root m))
|
||||
(bmn-assoc (BitmapIndexedNode. 0 (object-array 2)) 0 h key val added?)
|
||||
(bmn-assoc (.-root m) 0 h key val added?))]
|
||||
(PersistentHashMap.
|
||||
(if (aget added? 0) (inc (.-count m)) (.-count m))
|
||||
r (.-has-nil? m) (.-nil-value m) (.-_meta m)))))
|
||||
|
||||
(defn phm-without [m key]
|
||||
(if (nil? key)
|
||||
(if (.-has-nil? m)
|
||||
(PersistentHashMap. (dec (.-count m)) (.-root m) false nil (.-_meta m))
|
||||
m)
|
||||
(if (nil? (.-root m))
|
||||
m
|
||||
(let [nr (bmn-without (.-root m) 0 (hash-mix (hash key)) key)]
|
||||
(if (identical? nr (.-root m))
|
||||
m
|
||||
(PersistentHashMap. (dec (.-count m)) nr
|
||||
(.-has-nil? m) (.-nil-value m) (.-_meta m)))))))
|
||||
|
||||
(defn phm-get
|
||||
([m key] (phm-get m key nil))
|
||||
([m key not-found-val]
|
||||
(if (nil? key)
|
||||
(if (.-has-nil? m) (.-nil-value m) not-found-val)
|
||||
(if (nil? (.-root m))
|
||||
not-found-val
|
||||
(let [val (bmn-find (.-root m) 0 (hash-mix (hash key)) key)]
|
||||
(if (identical? val not-found) not-found-val val))))))
|
||||
|
||||
(defn phm-contains? [m key]
|
||||
(if (nil? key)
|
||||
(.-has-nil? m)
|
||||
(if (nil? (.-root m))
|
||||
false
|
||||
(not (identical? (bmn-find (.-root m) 0 (hash-mix (hash key)) key) not-found)))))
|
||||
|
||||
(defn phm-count [m] (.-count m))
|
||||
(defn phm-empty [m] EMPTY)
|
||||
|
||||
(defn hash-map [& kvs]
|
||||
(if (nil? kvs)
|
||||
EMPTY
|
||||
(loop [m EMPTY xs (seq kvs)]
|
||||
(if (and xs (seq (rest xs)))
|
||||
(recur (phm-assoc m (first xs) (first (rest xs)))
|
||||
(rest (rest xs)))
|
||||
m))))
|
||||
165
src/jolt/clojure/lang/persistent_vector.clj
Normal file
165
src/jolt/clojure/lang/persistent_vector.clj
Normal file
|
|
@ -0,0 +1,165 @@
|
|||
(ns jolt.lang.persistent-vector
|
||||
"PersistentVector: 32-way branching trie with tail optimization.")
|
||||
|
||||
(def branch-factor 32)
|
||||
(def shift-increment 5)
|
||||
(def tail-max 31)
|
||||
|
||||
(deftype VectorNode [^:volatile-mutable arr])
|
||||
(deftype PersistentVector [cnt shift root tail _meta])
|
||||
|
||||
(def empty-array (object-array 0))
|
||||
(def EMPTY (PersistentVector. 0 shift-increment nil empty-array nil))
|
||||
|
||||
(defn- tailoff [pv]
|
||||
(int (- (.-cnt pv) (unsigned-bit-shift-right (.-cnt pv) shift-increment))))
|
||||
|
||||
(defn- new-path [level node]
|
||||
(if (= level 0)
|
||||
node
|
||||
(let [arr (object-array branch-factor)]
|
||||
(aset arr 0 (new-path (int (- level shift-increment)) node))
|
||||
(VectorNode. arr))))
|
||||
|
||||
(defn- push-tail [parent level tailnode cnt]
|
||||
(let [subidx (int (bit-and (unsigned-bit-shift-right (int cnt) (int level)) tail-max))
|
||||
ret (VectorNode. (aclone (.-arr parent)))]
|
||||
(if (= level shift-increment)
|
||||
(do (aset (.-arr ret) subidx tailnode) ret)
|
||||
(let [child (aget (.-arr parent) subidx)]
|
||||
(aset (.-arr ret) subidx
|
||||
(if child
|
||||
(push-tail child (int (- level shift-increment)) tailnode cnt)
|
||||
(new-path (int (- level shift-increment)) tailnode)))
|
||||
ret))))
|
||||
|
||||
(defn- do-assoc [level node i val]
|
||||
(let [ret (VectorNode. (aclone (.-arr node)))]
|
||||
(if (= level 0)
|
||||
(do (aset (.-arr ret) (int (bit-and i tail-max)) val) ret)
|
||||
(let [subidx (int (bit-and (unsigned-bit-shift-right (int i) (int level)) tail-max))]
|
||||
(aset (.-arr ret) subidx
|
||||
(do-assoc (int (- level shift-increment)) (aget (.-arr node) subidx) i val))
|
||||
ret))))
|
||||
|
||||
(defn- array-for [pv i]
|
||||
(if (and (<= 0 i) (< i (.-cnt pv)))
|
||||
(if (>= i (tailoff pv))
|
||||
(.-tail pv)
|
||||
(loop [node (.-root pv) level (.-shift pv)]
|
||||
(if (> level 0)
|
||||
(recur (aget (.-arr node)
|
||||
(int (bit-and (unsigned-bit-shift-right (int i) (int level)) tail-max)))
|
||||
(int (- level shift-increment)))
|
||||
(.-arr node))))
|
||||
nil))
|
||||
|
||||
(defn pv-conj [pv val]
|
||||
(let [cnt (.-cnt pv)]
|
||||
(if (< (- cnt (tailoff pv)) branch-factor)
|
||||
(let [old-len (alength (.-tail pv))
|
||||
new-tail (object-array (+ old-len 1))]
|
||||
(loop [i 0]
|
||||
(if (< i old-len)
|
||||
(do (aset new-tail i (aget (.-tail pv) i)) (recur (unchecked-inc i)))
|
||||
(do (aset new-tail i val)
|
||||
(PersistentVector. (unchecked-inc cnt) (.-shift pv) (.-root pv) new-tail (.-_meta pv))))))
|
||||
(let [tail-node (VectorNode. (.-tail pv))
|
||||
root-overflow? (> (unchecked-inc (unsigned-bit-shift-right cnt shift-increment))
|
||||
(bit-shift-left 1 (.-shift pv)))]
|
||||
(if root-overflow?
|
||||
(let [nr (object-array branch-factor)]
|
||||
(aset nr 0 (.-root pv))
|
||||
(aset nr 1 (new-path (.-shift pv) tail-node))
|
||||
(let [new-root (VectorNode. nr)
|
||||
new-shift (+ (.-shift pv) shift-increment)
|
||||
new-tail (object-array 1)]
|
||||
(aset new-tail 0 val)
|
||||
(PersistentVector. (unchecked-inc cnt) new-shift new-root new-tail (.-_meta pv))))
|
||||
(let [new-root (push-tail (.-root pv) (.-shift pv) tail-node cnt)
|
||||
new-tail (object-array 1)]
|
||||
(aset new-tail 0 val)
|
||||
(PersistentVector. (unchecked-inc cnt) (.-shift pv) new-root new-tail (.-_meta pv))))))))
|
||||
|
||||
(defn pv-nth [pv i]
|
||||
(let [node (array-for pv i)]
|
||||
(if node
|
||||
(aget node (int (bit-and i tail-max)))
|
||||
(throw (str "Index out of bounds: " i)))))
|
||||
|
||||
(defn pv-assoc [pv i val]
|
||||
(let [cnt (.-cnt pv)]
|
||||
(if (and (<= 0 i) (< i cnt))
|
||||
(if (>= i (tailoff pv))
|
||||
(let [new-tail (object-array (alength (.-tail pv)))]
|
||||
(loop [j 0]
|
||||
(if (< j (alength new-tail))
|
||||
(do (aset new-tail j
|
||||
(if (= j (int (bit-and i tail-max))) val (aget (.-tail pv) j)))
|
||||
(recur (unchecked-inc j)))
|
||||
(PersistentVector. cnt (.-shift pv) (.-root pv) new-tail (.-_meta pv)))))
|
||||
(PersistentVector. cnt (.-shift pv) (do-assoc (.-shift pv) (.-root pv) i val) (.-tail pv) (.-_meta pv)))
|
||||
(if (= i cnt)
|
||||
(pv-conj pv val)
|
||||
(throw (str "Index out of bounds: " i))))))
|
||||
|
||||
(defn- pop-tail [level node cnt]
|
||||
(let [subidx (int (bit-and (unsigned-bit-shift-right (int (- cnt 2)) (int level)) tail-max))]
|
||||
(if (> level shift-increment)
|
||||
(let [new-child (pop-tail (int (- level shift-increment)) (aget (.-arr node) subidx) cnt)]
|
||||
(if (and (nil? new-child) (zero? subidx))
|
||||
nil
|
||||
(let [ret (VectorNode. (aclone (.-arr node)))]
|
||||
(aset (.-arr ret) subidx new-child)
|
||||
ret)))
|
||||
(if (zero? subidx)
|
||||
nil
|
||||
(let [ret (VectorNode. (aclone (.-arr node)))]
|
||||
(aset (.-arr ret) subidx nil)
|
||||
ret)))))
|
||||
|
||||
(defn- pv-nth-internal [cnt shift root i]
|
||||
(if (and (<= 0 i) (< i cnt))
|
||||
(if (>= i (- cnt (int (bit-and cnt tail-max))))
|
||||
nil
|
||||
(loop [node root level shift]
|
||||
(if (> level 0)
|
||||
(recur (aget (.-arr node) (int (bit-and (unsigned-bit-shift-right (int i) (int level)) tail-max)))
|
||||
(int (- level shift-increment)))
|
||||
(aget (.-arr node) (int (bit-and i tail-max))))))
|
||||
nil))
|
||||
|
||||
(defn pv-pop [pv]
|
||||
(let [cnt (.-cnt pv)]
|
||||
(cond
|
||||
(zero? cnt) (throw "Can't pop empty vector")
|
||||
(= cnt 1) EMPTY
|
||||
(> (- cnt (tailoff pv)) 1)
|
||||
(let [old-tail (.-tail pv)
|
||||
new-tail (object-array (dec (alength old-tail)))]
|
||||
(loop [i 0]
|
||||
(if (< i (alength new-tail))
|
||||
(do (aset new-tail i (aget old-tail i)) (recur (unchecked-inc i)))
|
||||
(PersistentVector. (dec cnt) (.-shift pv) (.-root pv) new-tail (.-_meta pv)))))
|
||||
:else
|
||||
(let [new-root (pop-tail (.-shift pv) (.-root pv) cnt)
|
||||
new-cnt (dec cnt)
|
||||
new-tail-len (int (bit-and new-cnt tail-max))
|
||||
tail-len (if (zero? new-tail-len) branch-factor new-tail-len)
|
||||
new-tail (object-array tail-len)]
|
||||
(loop [i 0]
|
||||
(if (< i tail-len)
|
||||
(let [idx (+ (- new-cnt tail-len) i)]
|
||||
(aset new-tail i (pv-nth-internal new-cnt (.-shift pv) new-root idx))
|
||||
(recur (unchecked-inc i)))
|
||||
(PersistentVector. new-cnt (.-shift pv) new-root new-tail (.-_meta pv))))))))
|
||||
|
||||
(defn pv-empty [_] EMPTY)
|
||||
|
||||
(defn vector [& args]
|
||||
(loop [acc EMPTY items (seq args)]
|
||||
(if (seq items)
|
||||
(recur (pv-conj acc (first items)) (rest items))
|
||||
acc)))
|
||||
|
||||
(defn vector? [x] (instance? PersistentVector x))
|
||||
|
|
@ -687,6 +687,30 @@
|
|||
@[{:jolt/type :symbol :ns nil :name "if"} not-form
|
||||
@[{:jolt/type :symbol :ns nil :name "do"} ;body]])
|
||||
|
||||
(defn core-and
|
||||
"Macro: (and) -> true, (and x) -> x, (and x y ...) -> (if x (and y ...) x)"
|
||||
[& exprs]
|
||||
(if (= 0 (length exprs)) true
|
||||
(if (= 1 (length exprs)) (first exprs)
|
||||
@[{:jolt/type :symbol :ns nil :name "let*"}
|
||||
@[{:jolt/type :symbol :ns nil :name "and__x"} (first exprs)]
|
||||
@[{:jolt/type :symbol :ns nil :name "if"}
|
||||
{:jolt/type :symbol :ns nil :name "and__x"}
|
||||
@[{:jolt/type :symbol :ns nil :name "and"} ;(tuple/slice exprs 1)]
|
||||
{:jolt/type :symbol :ns nil :name "and__x"}]])))
|
||||
|
||||
(defn core-or
|
||||
"Macro: (or) -> nil, (or x) -> x, (or x y ...) -> (let [or__x x] (if or__x or__x (or y ...)))"
|
||||
[& exprs]
|
||||
(if (= 0 (length exprs)) nil
|
||||
(if (= 1 (length exprs)) (first exprs)
|
||||
@[{:jolt/type :symbol :ns nil :name "let*"}
|
||||
@[{:jolt/type :symbol :ns nil :name "or__x"} (first exprs)]
|
||||
@[{:jolt/type :symbol :ns nil :name "if"}
|
||||
{:jolt/type :symbol :ns nil :name "or__x"}
|
||||
{:jolt/type :symbol :ns nil :name "or__x"}
|
||||
@[{:jolt/type :symbol :ns nil :name "or"} ;(tuple/slice exprs 1)]]])))
|
||||
|
||||
(defn core-if-let
|
||||
"Macro: (if-let [binding val-expr] then else?)"
|
||||
[bindings then-form & else-forms]
|
||||
|
|
@ -766,8 +790,23 @@
|
|||
(each b body (array/push fn-form b))
|
||||
@[{:jolt/type :symbol :ns nil :name "def"} fn-name fn-form])))
|
||||
|
||||
# defn- stub — expands to defn
|
||||
(defn core-defn- [& args] @[{:jolt/type :symbol :ns nil :name "do"}])
|
||||
# defn- — same as defn (private not enforced in Jolt)
|
||||
(defn core-defn- [fn-name & rest]
|
||||
# Multi-arity if rest starts with list of [args] pairs
|
||||
(if (and (> (length rest) 0) (array? (first rest)) (indexed? (first (first rest))))
|
||||
(let [pairs rest]
|
||||
(def fn-form @[])
|
||||
(array/push fn-form {:jolt/type :symbol :ns nil :name "fn*"})
|
||||
(each pair pairs (array/push fn-form pair))
|
||||
@[{:jolt/type :symbol :ns nil :name "def"} fn-name fn-form])
|
||||
# Single-arity: (defn- name [args] body...)
|
||||
(let [args-form (first rest)
|
||||
body (tuple/slice rest 1)]
|
||||
(def fn-form @[])
|
||||
(array/push fn-form {:jolt/type :symbol :ns nil :name "fn*"})
|
||||
(array/push fn-form args-form)
|
||||
(each b body (array/push fn-form b))
|
||||
@[{:jolt/type :symbol :ns nil :name "def"} fn-name fn-form])))
|
||||
|
||||
# Hierarchy stubs for sci bootstrap
|
||||
(def core-derive (fn [& args] nil))
|
||||
|
|
@ -864,6 +903,15 @@
|
|||
(each b body (array/push result b))
|
||||
result)
|
||||
|
||||
(defn core-loop
|
||||
"Macro: (loop [bindings] body) → (loop* [bindings] body)"
|
||||
[bindings & body]
|
||||
(def result @[])
|
||||
(array/push result {:jolt/type :symbol :ns nil :name "loop*"})
|
||||
(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]
|
||||
|
|
@ -1020,6 +1068,8 @@
|
|||
"reset!" core-reset!
|
||||
"swap!" core-swap!
|
||||
"not" core-not
|
||||
"and" core-and
|
||||
"or" core-or
|
||||
"when" core-when
|
||||
"when-not" core-when-not
|
||||
"if-let" core-if-let
|
||||
|
|
@ -1037,6 +1087,7 @@
|
|||
"declare" core-declare
|
||||
"fn" core-fn
|
||||
"let" core-let
|
||||
"loop" core-loop
|
||||
"defprotocol" core-defprotocol
|
||||
"extend-type" core-extend-type
|
||||
"extend-protocol" core-extend-protocol
|
||||
|
|
@ -1078,7 +1129,7 @@
|
|||
(defn core-macro-names
|
||||
"Set of core binding names that are macros."
|
||||
[]
|
||||
@{"when" true "when-not" true "if-let" true "when-let" true "if-some" true "when-some" true "doto" true "defn" true "defn-" true "declare" true "fn" true "let" true "defrecord" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "proxy" true "definterface" true "comment" true})
|
||||
@{"and" true "or" true "when" true "when-not" true "if-let" true "when-let" true "if-some" true "when-some" true "doto" true "defn" true "defn-" true "declare" true "fn" true "let" true "loop" true "defrecord" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "proxy" true "definterface" true "comment" true})
|
||||
|
||||
(def init-core!
|
||||
(fn [& args]
|
||||
|
|
|
|||
|
|
@ -496,7 +496,7 @@
|
|||
"locking" (eval-form ctx bindings (in form 2))
|
||||
"instance?" (let [type-sym (in form 1)
|
||||
val (eval-form ctx bindings (in form 2))]
|
||||
(if (and (struct? val) (get val :jolt/deftype))
|
||||
(if (get val :jolt/deftype)
|
||||
(let [type-tag (val :jolt/deftype)
|
||||
type-name (type-sym :name)]
|
||||
(or (= type-tag type-name)
|
||||
|
|
@ -588,19 +588,28 @@
|
|||
(apply ctor args))
|
||||
"." (let [target (eval-form ctx bindings (in form 1))
|
||||
member-sym (in form 2)
|
||||
member-name (member-sym :name)]
|
||||
member-name (member-sym :name)
|
||||
field-name (if (and (> (length member-name) 0) (= "-" (string/slice member-name 0 1)))
|
||||
(string/slice member-name 1)
|
||||
member-name)]
|
||||
(if (> (length form) 3)
|
||||
# method call: (. obj method args...)
|
||||
(let [args (map |(eval-form ctx bindings $) (tuple/slice form 3))]
|
||||
(if (target :jolt/deftype)
|
||||
(let [method-key (keyword member-name)]
|
||||
(let [method-key (keyword field-name)]
|
||||
(apply (get target method-key) target ;args))
|
||||
(error (string "Cannot call method " member-name " on non-deftype"))))
|
||||
(error (string "Cannot call method " field-name " on non-deftype"))))
|
||||
# field access: (. obj field)
|
||||
(get target (keyword member-name))))
|
||||
(get target (keyword field-name))))
|
||||
# default: function application — check for macros
|
||||
(if (and (struct? first-form) (= :symbol (first-form :jolt/type)))
|
||||
(let [sym-name (first-form :name)]
|
||||
# Handle .-fieldName accessor: (.-cnt obj) → (. obj -cnt)
|
||||
(if (and (> (length sym-name) 1) (= (string/slice sym-name 0 2) ".-")
|
||||
(> (length form) 1))
|
||||
(let [field-name (string/slice sym-name 2)
|
||||
target (eval-form ctx bindings (in form 1))]
|
||||
(get target (keyword field-name)))
|
||||
# Handle ClassName. constructor syntax
|
||||
(if (and (> (length sym-name) 0) (= (sym-name (- (length sym-name) 1)) 46))
|
||||
(let [type-name (string/slice sym-name 0 (- (length sym-name) 1))
|
||||
|
|
@ -615,7 +624,7 @@
|
|||
(eval-form ctx bindings (apply macro-fn args)))
|
||||
(let [f (eval-form ctx bindings first-form)
|
||||
args (map |(eval-form ctx bindings $) (tuple/slice form 1))]
|
||||
(apply f args))))))
|
||||
(apply f args)))))))
|
||||
(let [f (eval-form ctx bindings first-form)
|
||||
args (map |(eval-form ctx bindings $) (tuple/slice form 1))]
|
||||
(if (function? f)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue