diff --git a/.clj-kondo/.cache/v1/clj/jolt.lang.persistent-vector.transit.json b/.clj-kondo/.cache/v1/clj/jolt.lang.persistent-vector.transit.json new file mode 100644 index 0000000..6cb410a --- /dev/null +++ b/.clj-kondo/.cache/v1/clj/jolt.lang.persistent-vector.transit.json @@ -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"]] \ No newline at end of file diff --git a/.clj-kondo/.cache/v1/clj/user.transit.json b/.clj-kondo/.cache/v1/clj/user.transit.json index 7c19c4a..4d1ef42 100644 --- a/.clj-kondo/.cache/v1/clj/user.transit.json +++ b/.clj-kondo/.cache/v1/clj/user.transit.json @@ -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"] \ No newline at end of file +["^ ","~$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"] \ No newline at end of file diff --git a/.dirge/memory/MEMORY.md b/.dirge/memory/MEMORY.md index db3a1b8..842ee1a 100644 --- a/.dirge/memory/MEMORY.md +++ b/.dirge/memory/MEMORY.md @@ -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. diff --git a/.dirge/memory/PITFALLS.md b/.dirge/memory/PITFALLS.md index fe3b1c9..61be9e5 100644 --- a/.dirge/memory/PITFALLS.md +++ b/.dirge/memory/PITFALLS.md @@ -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. diff --git a/.dirge/skills/.usage.json b/.dirge/skills/.usage.json index 14d059a..1c71596 100644 --- a/.dirge/skills/.usage.json +++ b/.dirge/skills/.usage.json @@ -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, diff --git a/.dirge/skills/jolt-dev/SKILL.md b/.dirge/skills/jolt-dev/SKILL.md index c0bee6f..42d2dde 100644 --- a/.dirge/skills/jolt-dev/SKILL.md +++ b/.dirge/skills/jolt-dev/SKILL.md @@ -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` \ No newline at end of file + 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 +``` \ No newline at end of file diff --git a/src/jolt/api.janet b/src/jolt/api.janet index cc502ff..946fc87 100644 --- a/src/jolt/api.janet +++ b/src/jolt/api.janet @@ -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 diff --git a/src/jolt/clojure/lang/persistent_hash_map.clj b/src/jolt/clojure/lang/persistent_hash_map.clj new file mode 100644 index 0000000..504bb9e --- /dev/null +++ b/src/jolt/clojure/lang/persistent_hash_map.clj @@ -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)))) diff --git a/src/jolt/clojure/lang/persistent_vector.clj b/src/jolt/clojure/lang/persistent_vector.clj new file mode 100644 index 0000000..6dced9d --- /dev/null +++ b/src/jolt/clojure/lang/persistent_vector.clj @@ -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)) diff --git a/src/jolt/core.janet b/src/jolt/core.janet index ac67852..e714faf 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -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] diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index 795718b..55a5f31 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -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)