bootstrap: SCI core deps loading with 284/304 forms passing
reader: #?@ empty splice fix (nil→@[]), #? nil→:jolt/skip, map reader handles #_/#?@ in K/V evaluator: unwrap-meta-name helper, deftype interns ->Name too, dot-suffix fix core: comment/prefer-method stubs, *unchecked-math*/*clojure-version* dynamic vars
This commit is contained in:
Yogthos
parent
cdcf569506
commit
b20536d1e3
31 changed files with 1348 additions and 65 deletions
1
.clj-kondo/.cache/v1/clj/user.transit.json
Normal file
1
.clj-kondo/.cache/v1/clj/user.transit.json
Normal file
|
|
@ -0,0 +1 @@
|
|||
["^ ","~$eval-list",["^ ","~:fixed-arities",["~#set",[3]],"~:private",true,"~:ns","~$user","~:name","^0","~:type","~:fn","~:col",1,"~:top-ns",null,"~:row",195],"~$resolve-var",["^ ","^;",57,"^9",1,"^1",["^2",[3]],"^6","^<","^4","^5","^:",null,"^7","^8"],"~$syntax-quote*",["^ ","^1",["^2",[3]],"^3",true,"^4","^5","^6","^=","^7","^8","^9",1,"^:",null,"^;",22],"~$new-v",["^ ","^;",398,"^9",18,"^6","^>","^4","^5","^:",null],"~$ctor",["^ ","^;",472,"^9",17,"~:varargs-min-arity",0,"^6","^?","^4","^5","^:",null,"^7","^8"],"~$v",["^ ","^;",251,"^9",20,"^6","~$v","^4","^5","^:",null],"~$resolve-sym",["^ ","^1",["^2",[3]],"^3",true,"^4","^5","^6","^A","^7","^8","^9",1,"^:",null,"^;",95],"~$first-form",["^ ","^;",197,"^9",3,"^6","^B","^4","^5","^:",null,"^7","~:any"],"~$run-finally",["^ ","^;",368,"^9",13,"^1",["^2",[1]],"^6","^D","^4","^5","^:",null,"^7","^8"],"~$eval-require",["^ ","^1",["^2",[2]],"^3",true,"^4","^5","^6","^E","^7","^8","^9",1,"^:",null,"~:arities",["^ ","~i2",["^ ","~:ret","~:nil","~:arglist-str","[ctx spec]"]],"^;",74],"~$alias-sym",["^ ","^;",85,"^9",15,"^6","^J","^4","^5","^:",null],"~$name",["^ ","^;",199,"^9",3,"^6","^K","^4","^5","^:",null,"^7",["^2",[["^ ","~:call",["^ ","~:filename","/Users/yogthos/src/jolt/src/jolt/evaluator.janet","^7","^L","~:lang","~:clj","~:base-lang","^O","~:resolved-ns","^5","^4","^5","^6","^B","~:arity",1],"^;",200,"^9",15,"~:end-row",200,"~:end-col",33],["^ ","~:tag","^H","^;",201,"^9",15,"^S",201,"^T",18]]]],"^M","/Users/yogthos/src/jolt/src/jolt/evaluator.janet","~$macro-fn",["^ ","^1",["^2",[]],"^4","^5","^6","^V","^7","^8","^9",18,"^:",null,"^@",0,"^;",235],"~$parse-arg-names",["^ ","^1",["^2",[1]],"^3",true,"^4","^5","^6","^W","^7","^8","^9",1,"^:",null,"^F",["^ ","~i1",["^ ","^G",["^ ","^7","~:map","~:val",["^ ","~:fixed",["^ ","^;",181,"^S",546,"^9",11,"^T",13]]],"^I","[args-form]"]],"^;",135],"~$special-symbol?",["^ ","^1",["^2",[1]],"^3",true,"^4","^5","^6","^[","^7","^8","^9",1,"^:",null,"^F",["^ ","~i1",["^ ","^G",["^2",["~:boolean"]],"^I","[name]"]],"^;",10],"~$sym-name?",["^ ","^1",["^2",[2]],"^3",true,"^4","^5","^6","^11","^7","^8","^9",1,"^:",null,"^;",6],"~$inner",["^ ","^;",159,"^9",17,"^6","^12","^4","^5","^:",null],"~$sym-name-str",["^ ","^1",["^2",[1]],"^3",true,"^4","^5","^6","^13","^7","^8","^9",1,"^:",null,"^;",70],"~$unwrap-meta-name",["^ ","^1",["^2",[1]],"^3",true,"^4","^5","^6","^14","^7","^8","^9",1,"^:",null,"^;",184]]
|
||||
0
.clj-kondo/.cache/v1/lock
Normal file
0
.clj-kondo/.cache/v1/lock
Normal file
5
.dirge/memory/.cross_session_state
Normal file
5
.dirge/memory/.cross_session_state
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
{
|
||||
"last_run": 1780347402,
|
||||
"first_check": 1780347402,
|
||||
"last_scanned_watermark": ""
|
||||
}
|
||||
4
.dirge/memory/.curator_state
Normal file
4
.dirge/memory/.curator_state
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
{
|
||||
"last_run": 1780347402,
|
||||
"first_check": 1780347402
|
||||
}
|
||||
9
.dirge/memory/MEMORY.md
Normal file
9
.dirge/memory/MEMORY.md
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
`defmacro` supports optional docstring: `(defmacro name [args] body)` or `(defmacro name \"doc\" [args] body)`. Implementation: slice rest-form from form index 2, check if first is string, adjust args-form and body start accordingly. Implicit `&env` binding injected as `(put new-bindings "&env" @{'ns nil})` — must use `@{}` not `(struct …)` because nil values get dropped from structs. `fn*` uses same `parse-arg-names` helper for `& rest` args.
|
||||
§
|
||||
Jolt bootstrap: `core-bindings` (def- map) maps symbol strings → Janet functions. `init-core!` interns them into clojure.core ns. Macros (when, defn, declare) are registered in `core-macro-names` which returns `@{"when" true "defn" true "declare" true}`. `init-core!` checks this table and sets `:macro true` on the var for macro bindings. Order matters: `core-when` and `core-defn` must be defined BEFORE `core-bindings` map literal references them, otherwise compile error.
|
||||
§
|
||||
Reader comments (`;`) return `{:jolt/type :jolt/skip}` sentinel; `parse-next`/`parse-string` skip past it. Closing `)`, `]`, `}` produce explicit "Unmatched" errors. `unwrap-meta-name` recursively unwraps `(with-meta sym meta)` to raw symbol — used in def, ns, deftype, defmethod. `resolve-sym` does class-name lookup: `Foo.Bar.Baz` → ns "Foo.Bar" name "Baz". Janet `(set [a b] tuple)` doesn't work — use explicit indexing. `comment` must be a macro (registered in core-macro-names) to avoid evaluating body.
|
||||
§
|
||||
Sci bootstrap order: macros(4/4)→protocols(15/17)→utils(39/47)→types(22/27)→unrestrict(2/2)→vars(28/28)→lang(10/10)→ctx-store(6/6)→namespaces(93/98)→core(60/69). All .cljc; #?(:clj) resolved at read time, #?(:cljs)→nil.
|
||||
§
|
||||
Janet `last` works only on indexed types (tuple, array). On strings it returns nil. Use `(s (- (length s) 1))` to get the last character of a string, or `(string/slice s (- (length s) 1))` for the last char as string. `(last "hello")` → nil, not `\o`.
|
||||
3
.dirge/memory/PITFALLS.md
Normal file
3
.dirge/memory/PITFALLS.md
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
Janet `apply` requires a function/cfunction. When tables/structs are used as lookup maps (like deftype fields, multimethod dispatch tables), they get called via `(get f key)` not `(apply f args)`. The evaluator's default call path checks `(function? f)` before `apply`, falling back to `(get f (first args))` for single-arg table/struct calls.
|
||||
§
|
||||
Janet structs silently omit entries with nil values: `(struct ;[:x nil :y 1])` → `{:y 1}`. The `:x` key is completely dropped from the struct, not just set to nil. Use `@{}` (mutable table) when map needs nil-valued entries. This caused the `&env` implicit binding to fail — `(put new-bindings "&env" {'ns nil})` created a struct that became empty `{}`, so `(:ns &env)` failed with unknown method. Fix: use `@{}` table for bindings that may contain nil values, or use a non-nil sentinel.
|
||||
4
.dirge/skills/.curator_state
Normal file
4
.dirge/skills/.curator_state
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
{
|
||||
"last_run": 1780347402,
|
||||
"first_check": 1780347402
|
||||
}
|
||||
36
.dirge/skills/.usage.json
Normal file
36
.dirge/skills/.usage.json
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
{
|
||||
"jolt-dev": {
|
||||
"created_by": "agent",
|
||||
"use_count": 6,
|
||||
"view_count": 15,
|
||||
"patch_count": 12,
|
||||
"last_used_at": "2026-06-02T03:23:57.409721+00:00",
|
||||
"last_viewed_at": "2026-06-02T03:23:57.400994+00:00",
|
||||
"last_patched_at": "2026-06-02T02:52:21.531624+00:00",
|
||||
"created_at": "2026-06-01T21:26:06.614465+00:00",
|
||||
"state": "active",
|
||||
"pinned": false
|
||||
},
|
||||
"jpm-build": {
|
||||
"created_by": "agent",
|
||||
"use_count": 0,
|
||||
"view_count": 9,
|
||||
"patch_count": 0,
|
||||
"last_viewed_at": "2026-06-02T02:26:40.592223+00:00",
|
||||
"created_at": "2026-06-01T20:56:39.144222+00:00",
|
||||
"state": "active",
|
||||
"pinned": false
|
||||
},
|
||||
"jolt-bootstrap": {
|
||||
"created_by": "agent",
|
||||
"use_count": 5,
|
||||
"view_count": 14,
|
||||
"patch_count": 7,
|
||||
"last_used_at": "2026-06-02T03:23:57.420498+00:00",
|
||||
"last_viewed_at": "2026-06-02T03:23:57.415106+00:00",
|
||||
"last_patched_at": "2026-06-02T02:51:30.047986+00:00",
|
||||
"created_at": "2026-06-01T21:49:51.101718+00:00",
|
||||
"state": "active",
|
||||
"pinned": false
|
||||
}
|
||||
}
|
||||
82
.dirge/skills/jolt-bootstrap/SKILL.md
Normal file
82
.dirge/skills/jolt-bootstrap/SKILL.md
Normal file
|
|
@ -0,0 +1,82 @@
|
|||
---
|
||||
name: jolt-bootstrap
|
||||
description: TDD workflow for bootstrapping a Clojure interpreter on Janet
|
||||
---
|
||||
|
||||
# Bootstrapping a Clojure interpreter on Janet
|
||||
|
||||
## Prerequisites
|
||||
- Janet ≥ 1.36, jpm
|
||||
- Target Clojure sources (e.g. sci) to load
|
||||
- Jolt sources in `src/jolt/`, tests in `test/`
|
||||
|
||||
## TDD Loop
|
||||
1. Write a failing test in `test/<feature>-test.janet` using `(use ../src/jolt/...)` relative paths
|
||||
2. Run with `janet test/<file>.janet` (faster than `jpm test` for iteration)
|
||||
3. If test involves `init` (which loads clojure.core), also `(use ../src/jolt/api)`
|
||||
4. Implement in `src/jolt/<module>.janet`
|
||||
5. Run test → see failure message → fix → repeat
|
||||
6. After passing: `jpm test` to ensure no regressions
|
||||
|
||||
## Current bootstrap progress
|
||||
|
||||
**Loaded (all .cljc, #? resolved at read time):**
|
||||
- `sci.impl.macros` — 4/4 (ns, defmacro deftime, defmacro usetime, deftime(? macro))
|
||||
- `sci.impl.protocols` — 15/17
|
||||
- `sci.impl.utils` — 39/47
|
||||
- `sci.impl.types` — 22/27
|
||||
- `sci.impl.unrestrict` — 2/2
|
||||
- `sci.impl.vars` — 28/28 (comment block parses via :jolt/skip sentinel)
|
||||
- `sci.lang` — 10/10 (IVar resolves via class-name pattern lookup)
|
||||
- `sci.ctx-store` — 6/6
|
||||
- `sci.impl.namespaces` — 93/98 (parse crash at unmatched brace)
|
||||
- `sci.core` — 60/69 (namespaces/*1/*2/*3/*e unresolved)
|
||||
|
||||
**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, .
|
||||
|
||||
**Reader:** `#?(:clj ...)`, `#?@(:clj ...)` with splicing, `#_` discard (returns :jolt/skip sentinel), `#\` var-quote, `^` metadata. Comments `;` skip via :jolt/skip. Closing delimiters `)`, `]`, `}` produce explicit "Unmatched" errors.
|
||||
|
||||
**Core macros:** when, defn (with docstring), defn-, declare, fn (wraps fn*), defprotocol, extend-type, extend-protocol, extend, reify, proxy, definterface, comment (ignores body), prefer-method (stub)
|
||||
|
||||
**Key utilities:** `unwrap-meta-name` — recursively unwraps `(with-meta sym meta)` to extract raw symbol. Used in def, ns, deftype, defmethod.
|
||||
|
||||
**Class-name resolution:** unqualified symbols with dots (`Foo.Bar.Baz`) are resolved by splitting at last dot into ns+name.
|
||||
|
||||
## Key patterns
|
||||
|
||||
### Symbol structs
|
||||
```janet
|
||||
{:jolt/type :symbol :ns <string-or-nil> :name <string>}
|
||||
```
|
||||
|
||||
### Macro intern marks var
|
||||
```janet
|
||||
(def v (ns-intern ns name macro-fn))
|
||||
(put v :macro true)
|
||||
```
|
||||
|
||||
### Reader conditional `#?`
|
||||
Resolves at read time: scans for `:clj` keyword, picks next form.
|
||||
`#?@` wraps resolved form in `:jolt/splice` struct for list/vec/set splicing.
|
||||
|
||||
### Callable forms check
|
||||
```janet
|
||||
(if (function? f)
|
||||
(apply f args)
|
||||
(get f (first args))) ; table/struct lookup
|
||||
```
|
||||
|
||||
## Pitfalls
|
||||
- Janet `let` can't bind to nil; use `(var x nil)` then `(set x val)`
|
||||
- `(get table)` with 1 arg = compile error, use `(table :key)` shorthand
|
||||
- `(put fn :key val)` fails on functions; stash metadata on vars instead
|
||||
- `deftype` field names must be keywords (not strings) for `(inst :field)` access
|
||||
- `defn` placed after `core-bindings` that reference it → compile error; order matters
|
||||
- Janet's `try` macro: `(try body ([err] handler))` — catch clause is tuple `[binding body...]`
|
||||
- **`core-macro-names`** is a zero-arg fn returning a table: `(get (core-macro-names) name)`. Don't call it as `(core-macro-names name)` — that's arity mismatch
|
||||
- **Janet `#{}` sets** can cause parse issues — use `@[]` instead for stub collections
|
||||
- **`break` in `while`** doesn't return a value in Janet — use `(var done nil)` + `(while (and cond (not done)) ... (set done result))` pattern instead
|
||||
- **`read-reader-conditional`** for `#?(:cljs X)` with no `:clj` branch returns `[nil new-pos]`. For `#?@(:cljs X)` wrapping, nil gets wrapped in splice struct with `@[nil]` items
|
||||
- **`#_` discard** now works in lists, vectors, and sets — wraps the skipped form in `{:jolt/type :jolt/skip}` and readers check for this
|
||||
- **`read-regex`** now works with `(var done nil)` pattern to return value from while loop
|
||||
- **`#?@` splicing inside vectors** — if the resolved :clj branch is itself a vector, items are extracted and spliced. Works for both lists and vectors.
|
||||
180
.dirge/skills/jolt-dev/SKILL.md
Normal file
180
.dirge/skills/jolt-dev/SKILL.md
Normal file
|
|
@ -0,0 +1,180 @@
|
|||
---
|
||||
description: 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
|
||||
jpm test # runs all tests
|
||||
janet test/foo.janet # run a single test file from project root
|
||||
```
|
||||
|
||||
## Special Form Checklist
|
||||
|
||||
To add a new special form to the evaluator:
|
||||
|
||||
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`
|
||||
|
||||
The match arm receives `ctx`, `bindings`, and `form` (the full list). Use `(in form 1)` for first arg, etc.
|
||||
|
||||
**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.
|
||||
|
||||
### 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
|
||||
|
||||
## 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 "reify" true "fn" true "proxy" true "definterface" 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
|
||||
|
||||
```
|
||||
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 — 95+ clojure.core functions (map, filter, reduce, etc.)
|
||||
api.janet — public API: init, eval-string, eval-string*
|
||||
main.janet — REPL entry point with (defn main [&])
|
||||
|
||||
test/
|
||||
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 (deftime, usetime, ?)
|
||||
test-load-sci.janet — loads all sci files, counts ok/fail
|
||||
test-eval.janet — end-to-end sci.core/eval-string test
|
||||
```
|
||||
56
.dirge/skills/jpm-build/SKILL.md
Normal file
56
.dirge/skills/jpm-build/SKILL.md
Normal file
|
|
@ -0,0 +1,56 @@
|
|||
---
|
||||
name: jpm-build
|
||||
description: Build and debug Janet projects using jpm. Covers project.janet structure, common build errors, and native compilation with create-executable.
|
||||
---
|
||||
|
||||
# JPM Build & Debug
|
||||
|
||||
## Build Commands
|
||||
|
||||
```bash
|
||||
jpm build # Compile and link executable → build/jolt
|
||||
jpm test # Run all tests
|
||||
jpm deps # Show dependencies
|
||||
```
|
||||
|
||||
## project.janet Structure
|
||||
|
||||
```janet
|
||||
(declare-project
|
||||
:name "jolt"
|
||||
:description "...")
|
||||
|
||||
(declare-source
|
||||
:source @["src"]) # Source directories
|
||||
|
||||
(declare-executable
|
||||
:name "jolt" # Output binary name
|
||||
:entry "src/jolt/main.janet") # RELATIVE TO PROJECT ROOT, not source dirs
|
||||
```
|
||||
|
||||
## Common Pitfalls
|
||||
|
||||
### Entry path is relative to project root
|
||||
Even though `declare-source` lists `@["src"]`, the `:entry` in `declare-executable` must include `src/` prefix. jpm's `create-executable` calls `dofile source` with the raw entry string.
|
||||
|
||||
### main function required for native compilation
|
||||
`create-executable` extracts a `main` function from the entry file's environment. Top-level code runs during `dofile` and interferes with image generation. Error: "expected integer key for keyword in range [0, 5), got nil".
|
||||
|
||||
**Fix:** Wrap startup code in `(defn main [&] ...)`.
|
||||
|
||||
```janet
|
||||
(defn main [&]
|
||||
(print "REPL started")
|
||||
;; ... REPL loop ...
|
||||
)
|
||||
```
|
||||
|
||||
### LSP false positives
|
||||
Clojure LSP misidentifies `.janet` files. Ignore all diagnostics — they don't affect build or test results.
|
||||
|
||||
## Debugging Build Failures
|
||||
|
||||
1. Check entry path includes `src/` prefix
|
||||
2. Check entry file has `(defn main [&] ...)` wrapping top-level code
|
||||
3. Run `jpm test` to verify code works before native compilation
|
||||
4. `jpm build` produces no output on success — check exit code only
|
||||
1
.lsp/.cache/db.transit.json
Normal file
1
.lsp/.cache/db.transit.json
Normal file
|
|
@ -0,0 +1 @@
|
|||
["^ ","~:classpath",["~#set",[]],"~:project-hash","","~:project-root","/Users/yogthos/src/jolt","~:settings-hash","99914b932bd37a50b983c5e7c90ae93b","~:kondo-config-hash","27a3c23c420a83acd89ff94549b361473c4d3692a23b8eddd2f8916a26ba427c","~:dependency-scheme","zipfile","~:analysis",null,"~:analysis-checksums",["^ "],"~:project-analysis-type","~:project-and-full-dependencies","~:version",13,"~:stubs-generation-namespaces",["^1",[]]]
|
||||
BIN
build/build___jolt.o
Normal file
BIN
build/build___jolt.o
Normal file
Binary file not shown.
BIN
build/jolt
Executable file
BIN
build/jolt
Executable file
Binary file not shown.
84
build/jolt.c
Normal file
84
build/jolt.c
Normal file
File diff suppressed because one or more lines are too long
14
fix-core.janet
Normal file
14
fix-core.janet
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
(def lines (string/split "\n" (slurp "src/jolt/core.janet")))
|
||||
(def new-lines @[])
|
||||
(each l lines
|
||||
(array/push new-lines l)
|
||||
(if (= l " new-val))")
|
||||
(do
|
||||
(array/push new-lines "")
|
||||
(array/push new-lines "# Hierarchy (minimal stubs for sci bootstrap)")
|
||||
(array/push new-lines "(defn core-derive [tag parent] nil)")
|
||||
(array/push new-lines "(defn core-isa? ([child parent] false) ([h child parent] false))")
|
||||
(array/push new-lines "(defn core-ancestors ([tag] #{}) ([h tag] #{}))")
|
||||
(array/push new-lines "(defn core-descendants ([tag] #{}) ([h tag] #{}))"))))
|
||||
(spit "src/jolt/core.janet" (string/join new-lines "\n"))
|
||||
(print "done")
|
||||
21
preprocess.janet
Normal file
21
preprocess.janet
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
# Preprocess a cljc file: resolve #?(:clj ...) and #?@(:clj ...) reader conditionals
|
||||
# at read time. Output a plain .clj file that Jolt can parse without reader conditionals.
|
||||
|
||||
(use ./src/jolt/reader)
|
||||
|
||||
(defn preprocess [filepath]
|
||||
(def src (slurp filepath))
|
||||
(var s src)
|
||||
(var out @[])
|
||||
(var count 0)
|
||||
(while (> (length (string/trim s)) 0)
|
||||
(def [form rest] (parse-next s))
|
||||
(set s rest)
|
||||
(++ count)
|
||||
(if (nil? form)
|
||||
nil
|
||||
(array/push out (string form))))
|
||||
(string/join out "\n"))
|
||||
|
||||
(def filepath (if (> (length (dyn :args @[])) 0) (in (dyn :args) 0) "/Users/yogthos/src/sci/src/sci/impl/utils.cljc"))
|
||||
(print (preprocess filepath))
|
||||
|
|
@ -7,4 +7,4 @@
|
|||
|
||||
(declare-executable
|
||||
:name "jolt"
|
||||
:entry "jolt/main.janet")
|
||||
:entry "src/jolt/main.janet")
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@
|
|||
# ============================================================
|
||||
|
||||
(defn core-nil? [x] (nil? x))
|
||||
(defn core-not [x] (if x false true))
|
||||
(defn core-some? [x] (not (nil? x)))
|
||||
(defn core-string? [x] (string? x))
|
||||
(defn core-number? [x] (number? x))
|
||||
|
|
@ -592,6 +593,110 @@
|
|||
# Initialization — intern everything into a context's namespace
|
||||
# ============================================================
|
||||
|
||||
(defn core-when
|
||||
"Macro: (when test & body) -> (if test (do body...))"
|
||||
[test & body]
|
||||
(def arr (array ;body))
|
||||
(array/insert arr 0 {:jolt/type :symbol :ns nil :name "do"})
|
||||
@[{:jolt/type :symbol :ns nil :name "if"}
|
||||
test
|
||||
arr])
|
||||
|
||||
(defn core-defn
|
||||
"Macro: (defn name [args] body) -> (def name (fn* [args] body))"
|
||||
[fn-name args-form & body]
|
||||
(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])
|
||||
|
||||
# defn- stub — expands to defn
|
||||
(defn core-defn- [& args] @[{:jolt/type :symbol :ns nil :name "do"}])
|
||||
|
||||
# Hierarchy stubs for sci bootstrap
|
||||
(def core-derive (fn [& args] nil))
|
||||
(def core-isa? (fn [& args] false))
|
||||
(def core-ancestors (fn [& args] @[]))
|
||||
(def core-descendants (fn [& args] @[]))
|
||||
|
||||
# Java interop stubs
|
||||
(def core-Object (fn [] (struct ;[:jolt/type :jolt/java-object])))
|
||||
|
||||
# Volatile stubs (minimal — use table as volatile box)
|
||||
(defn core-volatile! [v] @{:val v})
|
||||
(defn core-vswap! [vol f & args]
|
||||
(def new-val (apply f (vol :val) args))
|
||||
(put vol :val new-val)
|
||||
new-val)
|
||||
(defn core-vreset! [vol val] (put vol :val val) val)
|
||||
|
||||
# Proxy stub — returns nil form (macro, args not evaluated)
|
||||
(defn core-proxy [& args] nil)
|
||||
|
||||
# Thread stubs
|
||||
(def core-Thread (fn [& args] (struct ;[:jolt/type :jolt/thread])))
|
||||
(def core-ThreadLocal (fn [& args] (struct ;[:jolt/type :jolt/thread-local])))
|
||||
(def core-IllegalStateException (fn [& args] (struct ;[:jolt/type :jolt/exception])))
|
||||
|
||||
# definterface stub — JVM-only, emits def form
|
||||
(defn core-definterface [name-sym & body]
|
||||
@[{:jolt/type :symbol :ns nil :name "def"}
|
||||
name-sym
|
||||
@{}])
|
||||
|
||||
# comment macro — ignores body, returns nil
|
||||
(defn core-comment [& body]
|
||||
nil)
|
||||
|
||||
# prefer-method stub — multimethod preference ordering
|
||||
(defn core-prefer-method [multifn dispatch-val & dispatch-vals]
|
||||
nil)
|
||||
|
||||
# declare macro — accepts symbols, does nothing (forward declaration)
|
||||
(defn core-declare [& syms]
|
||||
@[{:jolt/type :symbol :ns nil :name "do"}])
|
||||
|
||||
(defn core-fn
|
||||
"Macro: (fn [args] body) → (fn* [args] body)"
|
||||
[& args]
|
||||
(def result @[])
|
||||
(array/push result {:jolt/type :symbol :ns nil :name "fn*"})
|
||||
(each a args (array/push result a))
|
||||
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]
|
||||
# Emit (do (def protocol-name {}) (def method1 fn) (def method2 fn) ...)
|
||||
(def result @[])
|
||||
(array/push result {:jolt/type :symbol :ns nil :name "do"})
|
||||
# First (def protocol-name {})
|
||||
(def d @[])
|
||||
(array/push d {:jolt/type :symbol :ns nil :name "def"})
|
||||
(array/push d protocol-name)
|
||||
(array/push d @{})
|
||||
(array/push result d)
|
||||
# Then (def method-name (fn [& args] nil)) for each sig
|
||||
(each sig sigs
|
||||
(def method-sym (first sig))
|
||||
(def d @[])
|
||||
(array/push d {:jolt/type :symbol :ns nil :name "def"})
|
||||
(array/push d method-sym)
|
||||
(array/push d (fn [& args] nil))
|
||||
(array/push result d))
|
||||
result)
|
||||
(def core-extend-type (fn [& args] nil))
|
||||
(defn core-extend-protocol [& args] @[{:jolt/type :symbol :ns nil :name "do"}])
|
||||
(def core-extend (fn [& args] nil))
|
||||
(def core-reify (fn [& args] nil))
|
||||
(def core-satisfies? (fn [& args] nil))
|
||||
(def core-extends? (fn [& args] false))
|
||||
(def core-implements? (fn [& args] false))
|
||||
(def core-type->str (fn [& args] ""))
|
||||
|
||||
(def- core-bindings
|
||||
"Map of symbol name → function for all core functions."
|
||||
@{"nil?" core-nil?
|
||||
|
|
@ -691,7 +796,45 @@
|
|||
"atom?" core-atom?
|
||||
"deref" core-deref
|
||||
"reset!" core-reset!
|
||||
"swap!" core-swap!})
|
||||
"swap!" core-swap!
|
||||
"not" core-not
|
||||
"when" core-when
|
||||
"defn" core-defn
|
||||
"defn-" core-defn-
|
||||
"derive" core-derive
|
||||
"isa?" core-isa?
|
||||
"ancestors" core-ancestors
|
||||
"descendants" core-descendants
|
||||
"Object" core-Object
|
||||
"declare" core-declare
|
||||
"fn" core-fn
|
||||
"defprotocol" core-defprotocol
|
||||
"extend-type" core-extend-type
|
||||
"extend-protocol" core-extend-protocol
|
||||
"extend" core-extend
|
||||
"reify" core-reify
|
||||
"satisfies?" core-satisfies?
|
||||
"extends?" core-extends?
|
||||
"implements?" core-implements?
|
||||
"type->str" core-type->str
|
||||
"volatile!" core-volatile!
|
||||
"vswap!" core-vswap!
|
||||
"vreset!" core-vreset!
|
||||
"proxy" core-proxy
|
||||
"Thread" core-Thread
|
||||
"ThreadLocal" core-ThreadLocal
|
||||
"IllegalStateException" core-IllegalStateException
|
||||
"definterface" core-definterface
|
||||
"comment" core-comment
|
||||
"prefer-method" core-prefer-method
|
||||
# Dynamic vars — stubs for SCI bootstrap
|
||||
"*unchecked-math*" false
|
||||
"*clojure-version*" {:major 1 :minor 11 :incremental 0 :qualifier nil}})
|
||||
|
||||
(defn core-macro-names
|
||||
"Set of core binding names that are macros."
|
||||
[]
|
||||
@{"when" true "defn" true "defn-" true "declare" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "fn" true "proxy" true "definterface" true "comment" true})
|
||||
|
||||
(def init-core!
|
||||
(fn [& args]
|
||||
|
|
@ -699,11 +842,15 @@
|
|||
1 (let [ctx (args 0)
|
||||
ns (ctx-find-ns ctx "clojure.core")]
|
||||
(loop [[name fn] :pairs core-bindings]
|
||||
(ns-intern ns name fn))
|
||||
(def v (ns-intern ns name fn))
|
||||
(when (get (core-macro-names) name)
|
||||
(put v :macro true)))
|
||||
ns)
|
||||
2 (let [ctx (args 0) ns-name (args 1)
|
||||
ns (ctx-find-ns ctx ns-name)]
|
||||
(loop [[name fn] :pairs core-bindings]
|
||||
(ns-intern ns name fn))
|
||||
(def v (ns-intern ns name fn))
|
||||
(when (get (core-macro-names) name)
|
||||
(put v :macro true)))
|
||||
ns)
|
||||
(error "Wrong number of args passed to: init-core!"))))
|
||||
|
|
|
|||
|
|
@ -11,8 +11,11 @@
|
|||
[name]
|
||||
(or (= name "quote") (= name "syntax-quote") (= name "unquote")
|
||||
(= name "unquote-splicing") (= name "do") (= name "if")
|
||||
(= name "def") (= name "fn*") (= name "let*") (= name "loop*")
|
||||
(= name "recur")))
|
||||
(= name "def") (= name "defmacro") (= name "fn*") (= name "let*") (= name "loop*")
|
||||
(= name "recur") (= name "throw") (= name "try")
|
||||
(= name "set!") (= name "var") (= name "locking")
|
||||
(= name "instance?") (= name "defmulti") (= name "defmethod")
|
||||
(= name "deftype") (= name "new") (= name ".")))
|
||||
|
||||
(var eval-form nil)
|
||||
|
||||
|
|
@ -51,13 +54,18 @@
|
|||
(array/push kvs (syntax-quote* ctx bindings (get form k)))) (struct ;kvs))
|
||||
form))
|
||||
|
||||
(defn- resolve-var
|
||||
(defn resolve-var
|
||||
[ctx bindings sym-s]
|
||||
(let [name (sym-s :name) ns (sym-s :ns)]
|
||||
(if (not (nil? ns))
|
||||
(let [target-ns (ctx-find-ns ctx ns)] (ns-find target-ns name))
|
||||
(if (get bindings name) nil
|
||||
(let [current-ns (ctx-current-ns ctx) ns (ctx-find-ns ctx current-ns)] (ns-find ns name))))))
|
||||
(let [current-ns (ctx-current-ns ctx)
|
||||
ns (ctx-find-ns ctx current-ns)
|
||||
v (ns-find ns name)]
|
||||
(if v v
|
||||
(let [core-ns (ctx-find-ns ctx "clojure.core")]
|
||||
(ns-find core-ns name))))))))
|
||||
|
||||
(defn- sym-name-str
|
||||
[sym-s]
|
||||
|
|
@ -103,20 +111,94 @@
|
|||
core-v (ns-find core-ns name)]
|
||||
(if core-v
|
||||
(var-get core-v)
|
||||
# Fall back to Janet's global environment
|
||||
(let [root-env (fiber/getenv (fiber/current))
|
||||
entry (in root-env (symbol name))]
|
||||
(if (not (nil? entry))
|
||||
(if (table? entry) (entry :value) entry)
|
||||
(error (string "Unable to resolve symbol: " name)))))))))))))
|
||||
# Try class-name resolution: Foo.Bar.Baz -> ns "Foo.Bar", name "Baz"
|
||||
(let [dot-idx (string/find "." name)]
|
||||
(if dot-idx
|
||||
(let [last-dot (do
|
||||
(var idx dot-idx)
|
||||
(var next-dot (string/find "." name (+ idx 1)))
|
||||
(while (not (nil? next-dot))
|
||||
(set idx next-dot)
|
||||
(set next-dot (string/find "." name (+ idx 1))))
|
||||
idx)
|
||||
class-ns (string/slice name 0 last-dot)
|
||||
class-name (string/slice name (+ last-dot 1))]
|
||||
(let [target-ns (ctx-find-ns ctx class-ns) tv (ns-find target-ns class-name)]
|
||||
(if tv (var-get tv) tv)))
|
||||
# Fall back to Janet's global environment
|
||||
(let [root-env (fiber/getenv (fiber/current))
|
||||
entry (in root-env (symbol name))]
|
||||
(if (not (nil? entry))
|
||||
(if (table? entry) (entry :value) entry)
|
||||
(error (string "Unable to resolve symbol: " name)))))))))))))))
|
||||
|
||||
(defn- parse-arg-names
|
||||
"Parse a parameter vector, handling & rest args.
|
||||
Returns {:fixed [names...] :rest name-or-nil :all [names...]}"
|
||||
[args-form]
|
||||
(var fixed @[])
|
||||
(var rest-name nil)
|
||||
(var i 0)
|
||||
(while (< i (length args-form))
|
||||
(let [a (in args-form i)]
|
||||
(if (and (struct? a) (= :symbol (a :jolt/type)) (= "&" (a :name)))
|
||||
(do
|
||||
(+= i 1)
|
||||
(if (< i (length args-form))
|
||||
(do
|
||||
(set rest-name ((in args-form i) :name))
|
||||
(+= i 1))
|
||||
(error "& without argument in parameter list")))
|
||||
(do
|
||||
(if (and (struct? a) (= :symbol (a :jolt/type)))
|
||||
(array/push fixed (a :name))
|
||||
# destructuring form: recurse into it
|
||||
(when (indexed? a)
|
||||
(var di 0)
|
||||
(while (< di (length a))
|
||||
(def inner (in a di))
|
||||
(if (and (struct? inner) (= :symbol (inner :jolt/type)) (= "&" (inner :name)))
|
||||
(do
|
||||
(+= di 1)
|
||||
(if (< di (length a))
|
||||
(do
|
||||
(set rest-name ((in a di) :name))
|
||||
(+= di 1))
|
||||
(error "& without argument in parameter list")))
|
||||
(do
|
||||
(if (and (struct? inner) (= :symbol (inner :jolt/type)))
|
||||
(array/push fixed (inner :name))
|
||||
# nested destructuring - extract names
|
||||
(when (indexed? inner)
|
||||
(each sym inner
|
||||
(when (and (struct? sym) (= :symbol (sym :jolt/type)))
|
||||
(array/push fixed (sym :name))))))
|
||||
(+= di 1))))))
|
||||
(+= i 1)))))
|
||||
(var all @[])
|
||||
(each n fixed (array/push all n))
|
||||
(if rest-name (array/push all rest-name))
|
||||
{:fixed (tuple/slice (tuple ;fixed)) :rest rest-name :all (tuple/slice (tuple ;all))})
|
||||
|
||||
# Dispatch a special form by its string name.
|
||||
(defn- unwrap-meta-name
|
||||
"Recursively unwrap (with-meta sym meta) forms to extract the underlying symbol.
|
||||
Returns the symbol struct, or the original form if it's not a with-meta wrapper."
|
||||
[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))
|
||||
|
||||
# Dispatch a special form by its string name. Each branch is a standalone
|
||||
# expression that returns the value directly — no cond, no nested if chains.
|
||||
# We use a local function per form and call the matching one.
|
||||
(defn- eval-list
|
||||
[ctx bindings form]
|
||||
(def first-form (first form))
|
||||
(def name (first-form :name))
|
||||
# Safe name extraction: non-symbol heads (e.g. keywords) fall through to default
|
||||
(def name (if (and (struct? first-form) (= :symbol (first-form :jolt/type)))
|
||||
(first-form :name)
|
||||
nil))
|
||||
(match name
|
||||
"quote" (in form 1)
|
||||
"syntax-quote" (syntax-quote* ctx bindings (in form 1))
|
||||
|
|
@ -134,13 +216,44 @@
|
|||
(if (and (not (nil? test-val)) (not (= false test-val)))
|
||||
(eval-form ctx bindings (in form 2))
|
||||
(if (> (length form) 3) (eval-form ctx bindings (in form 3)) nil)))
|
||||
"def" (let [name-sym (in form 1)
|
||||
"def" (let [raw-name (in form 1)
|
||||
name-sym (unwrap-meta-name raw-name)
|
||||
val (eval-form ctx bindings (in form 2))
|
||||
ns-name (ctx-current-ns ctx)
|
||||
ns (ctx-find-ns ctx ns-name)]
|
||||
(ns-intern ns (name-sym :name) val)
|
||||
(var-get (ns-intern ns (name-sym :name))))
|
||||
"ns" (let [ns-name (sym-name-str (in form 1))
|
||||
"defmacro" (let [name-sym (in form 1)
|
||||
rest-form (tuple/slice form 2)
|
||||
# optional docstring
|
||||
has-doc? (and (> (length rest-form) 0) (string? (first rest-form)))
|
||||
args-form (if has-doc? (in rest-form 1) (first rest-form))
|
||||
body (tuple/slice rest-form (if has-doc? 2 1))
|
||||
arg-info (parse-arg-names args-form)
|
||||
fixed-names (arg-info :fixed)
|
||||
rest-name (arg-info :rest)]
|
||||
(def macro-fn (fn [& macro-args]
|
||||
(var new-bindings @{})
|
||||
(table/setproto new-bindings bindings)
|
||||
(put new-bindings "&env" @{}) # implicit &env for macro bodies (table — nil-safe)
|
||||
(var i 0)
|
||||
(each a fixed-names
|
||||
(put new-bindings a (macro-args i))
|
||||
(++ i))
|
||||
(when rest-name
|
||||
(put new-bindings rest-name (tuple/slice macro-args i)))
|
||||
(var result nil)
|
||||
(each bf body
|
||||
(set result (eval-form ctx new-bindings bf)))
|
||||
result))
|
||||
(let [ns-name (ctx-current-ns ctx)
|
||||
ns (ctx-find-ns ctx ns-name)]
|
||||
(def v (ns-intern ns (name-sym :name) macro-fn))
|
||||
(put v :macro true)
|
||||
(var-get v)))
|
||||
"ns" (let [raw-name (in form 1)
|
||||
name-sym (unwrap-meta-name raw-name)
|
||||
ns-name (sym-name-str name-sym)
|
||||
clauses (tuple/slice form 2)]
|
||||
(ctx-set-current-ns ctx ns-name)
|
||||
(ctx-find-ns ctx ns-name)
|
||||
|
|
@ -153,9 +266,9 @@
|
|||
(let [specs (tuple/slice clause 1)
|
||||
slen (length specs)]
|
||||
(var j 0)
|
||||
(while (< j slen)
|
||||
(let [s (in specs j)]
|
||||
(eval-require ctx s))
|
||||
(while (< j slen)
|
||||
(let [s (in specs j)]
|
||||
(when s (eval-require ctx s)))
|
||||
(++ j))
|
||||
(set i (+ i 1)))
|
||||
(do (set result clause) (++ i))))))
|
||||
|
|
@ -170,15 +283,19 @@
|
|||
nil)
|
||||
"fn*" (let [args-form (in form 1)
|
||||
body (tuple/slice form 2)
|
||||
arg-names (map |($ :name) args-form)]
|
||||
arg-info (parse-arg-names args-form)
|
||||
fixed-names (arg-info :fixed)
|
||||
rest-name (arg-info :rest)]
|
||||
(var self nil)
|
||||
(set self (fn [& fn-args]
|
||||
(var fn-bindings @{})
|
||||
(table/setproto fn-bindings bindings)
|
||||
(var i 0)
|
||||
(each arg-name arg-names
|
||||
(each arg-name fixed-names
|
||||
(put fn-bindings arg-name (fn-args i))
|
||||
(++ i))
|
||||
(when rest-name
|
||||
(put fn-bindings rest-name (tuple/slice fn-args i)))
|
||||
(put fn-bindings :jolt/loop-fn self)
|
||||
(var result nil)
|
||||
(each body-form body
|
||||
|
|
@ -228,19 +345,184 @@
|
|||
(error "recur used outside of loop* or fn*")
|
||||
(let [args (map |(eval-form ctx bindings $) (tuple/slice form 1))]
|
||||
(apply loop-fn args))))
|
||||
"throw" (let [val (eval-form ctx bindings (in form 1))]
|
||||
(error {:jolt/type :jolt/exception :value val}))
|
||||
"try" (let [body-form (in form 1)
|
||||
clauses (tuple/slice form 2)
|
||||
n (length clauses)]
|
||||
(var catch-sym nil)
|
||||
(var catch-body nil)
|
||||
(var finally-body nil)
|
||||
(var i 0)
|
||||
(while (< i n)
|
||||
(let [clause (in clauses i)]
|
||||
(if (and (array? clause) (> (length clause) 0))
|
||||
(let [head (first clause)]
|
||||
(if (and (struct? head) (= :symbol (head :jolt/type)))
|
||||
(match (head :name)
|
||||
"catch" (do
|
||||
(set catch-sym (in clause 2))
|
||||
(set catch-body (tuple/slice clause 3)))
|
||||
"finally" (set finally-body (tuple/slice clause 1)))))))
|
||||
(++ i))
|
||||
(defn run-finally [f]
|
||||
(when f
|
||||
(each fb f (eval-form ctx bindings fb))))
|
||||
(if catch-sym
|
||||
(try
|
||||
(eval-form ctx bindings body-form)
|
||||
([err]
|
||||
(var new-bindings @{})
|
||||
(table/setproto new-bindings bindings)
|
||||
(put new-bindings (catch-sym :name) err)
|
||||
(var result nil)
|
||||
(each cb catch-body
|
||||
(set result (eval-form ctx new-bindings cb)))
|
||||
(run-finally finally-body)
|
||||
result))
|
||||
(if finally-body
|
||||
(try
|
||||
(eval-form ctx bindings body-form)
|
||||
([err]
|
||||
(run-finally finally-body)
|
||||
(error err)))
|
||||
(eval-form ctx bindings body-form))))
|
||||
"set!" (let [target-sym (in form 1)
|
||||
val (eval-form ctx bindings (in form 2))
|
||||
v (resolve-var ctx bindings target-sym)]
|
||||
(if v
|
||||
(do (var-set v val) val)
|
||||
# Auto-create var if it doesn't exist (e.g., *warn-on-reflection*)
|
||||
(let [ns-name (ctx-current-ns ctx)
|
||||
ns (ctx-find-ns ctx ns-name)]
|
||||
(def new-v (ns-intern ns (target-sym :name) val))
|
||||
val)))
|
||||
"var" (let [target-sym (in form 1)
|
||||
v (resolve-var ctx bindings target-sym)]
|
||||
(if v v (error (string "Unable to resolve var: " (sym-name-str target-sym) " in var"))))
|
||||
"locking" (eval-form ctx bindings (in form 2))
|
||||
"instance?" (let [type-sym (in form 1)
|
||||
val (eval-form ctx bindings (in form 2))]
|
||||
(match (type-sym :name)
|
||||
"Number" (number? val)
|
||||
"String" (string? val)
|
||||
"Boolean" (or (= true val) (= false val))
|
||||
"Keyword" (keyword? val)
|
||||
"Object" true
|
||||
false))
|
||||
"defmulti" (let [name-sym (in form 1)
|
||||
dispatch-fn (eval-form ctx bindings (in form 2))
|
||||
ns (ctx-find-ns ctx (ctx-current-ns ctx))
|
||||
methods @{}
|
||||
mm-fn (fn [& args]
|
||||
(let [dv (apply dispatch-fn args)
|
||||
method (get methods dv)]
|
||||
(if method
|
||||
(apply method args)
|
||||
(error (string "No method in multimethod "
|
||||
(name-sym :name) " for dispatch value: "
|
||||
dv)))))]
|
||||
(def v (ns-intern ns (name-sym :name) mm-fn))
|
||||
(put v :jolt/methods methods)
|
||||
(var-get v))
|
||||
"defmethod" (let [mm-sym (in form 1)
|
||||
dispatch-val (eval-form ctx bindings (in form 2))
|
||||
arg-vec (in form 3)
|
||||
body (tuple/slice form 4)
|
||||
# Extract names, handling metadata-wrapped symbols
|
||||
extract-name (fn [arg]
|
||||
(let [arg (unwrap-meta-name arg)]
|
||||
(arg :name)))
|
||||
arg-names (tuple/slice (map extract-name arg-vec))
|
||||
mm-var (resolve-var ctx bindings mm-sym)
|
||||
# Auto-create multimethod if it doesn't exist
|
||||
mm-var (if mm-var mm-var
|
||||
(let [ns (ctx-find-ns ctx (ctx-current-ns ctx))
|
||||
dummy-fn (fn [& args] nil)]
|
||||
(def v (ns-intern ns (mm-sym :name) dummy-fn))
|
||||
(put v :jolt/methods @{})
|
||||
v))
|
||||
methods (get mm-var :jolt/methods)
|
||||
impl (fn [& args]
|
||||
(var new-bindings @{})
|
||||
(table/setproto new-bindings bindings)
|
||||
(var i 0)
|
||||
(each a arg-names
|
||||
(put new-bindings a (args i))
|
||||
(++ i))
|
||||
(var result nil)
|
||||
(each bf body
|
||||
(set result (eval-form ctx new-bindings bf)))
|
||||
result)]
|
||||
(put methods dispatch-val impl)
|
||||
mm-var)
|
||||
"deftype" (let [raw-name (in form 1)
|
||||
type-name (unwrap-meta-name raw-name)
|
||||
fields-vec (in form 2)
|
||||
field-names (map
|
||||
(fn [f]
|
||||
# Handle ^:meta and ^Type annotations — extract the actual name
|
||||
(let [f (unwrap-meta-name f)]
|
||||
(if (and (struct? f) (= :symbol (f :jolt/type)))
|
||||
(keyword (f :name))
|
||||
(error (string "Unsupported deftype field: " (string f))))))
|
||||
fields-vec)
|
||||
ns-name (ctx-current-ns ctx)
|
||||
type-tag (string ns-name "." (type-name :name))]
|
||||
(defn ctor [& args]
|
||||
(var inst @{:jolt/deftype type-tag})
|
||||
(var i 0)
|
||||
(each fn field-names
|
||||
(put inst fn (args i))
|
||||
(++ i))
|
||||
inst)
|
||||
(let [ns (ctx-find-ns ctx ns-name)
|
||||
ctor-name (type-name :name)
|
||||
arrow-name (string "->" ctor-name)]
|
||||
(ns-intern ns ctor-name ctor)
|
||||
(ns-intern ns arrow-name ctor)
|
||||
(var-get (ns-intern ns ctor-name))))
|
||||
"new" (let [type-sym (in form 1)
|
||||
args (map |(eval-form ctx bindings $) (tuple/slice form 2))
|
||||
ctor (eval-form ctx bindings type-sym)]
|
||||
(apply ctor args))
|
||||
"." (let [target (eval-form ctx bindings (in form 1))
|
||||
member-sym (in form 2)
|
||||
member-name (member-sym :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)]
|
||||
(apply (get target method-key) target ;args))
|
||||
(error (string "Cannot call method " member-name " on non-deftype"))))
|
||||
# field access: (. obj field)
|
||||
(get target (keyword member-name))))
|
||||
# default: function application — check for macros
|
||||
(if (and (struct? first-form) (= :symbol (first-form :jolt/type)))
|
||||
(let [v (resolve-var ctx bindings first-form)]
|
||||
(if (and v (var-macro? v))
|
||||
(let [macro-fn (var-get v)
|
||||
args (tuple/slice form 1)]
|
||||
(eval-form ctx bindings (apply macro-fn args)))
|
||||
(let [f (eval-form ctx bindings first-form)
|
||||
(let [sym-name (first-form :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))
|
||||
type-sym {:jolt/type :symbol :ns (first-form :ns) :name type-name}
|
||||
ctor (eval-form ctx bindings type-sym)
|
||||
args (map |(eval-form ctx bindings $) (tuple/slice form 1))]
|
||||
(apply f args))))
|
||||
(apply ctor args))
|
||||
(let [v (resolve-var ctx bindings first-form)]
|
||||
(if (and v (var-macro? v))
|
||||
(let [macro-fn (var-get v)
|
||||
args (tuple/slice form 1)]
|
||||
(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))))))
|
||||
(let [f (eval-form ctx bindings first-form)
|
||||
args (map |(eval-form ctx bindings $) (tuple/slice form 1))]
|
||||
(apply f args)))))
|
||||
(if (function? f)
|
||||
(apply f args)
|
||||
(if (keyword? f)
|
||||
(get (first args) f)
|
||||
(error (string "Cannot call " (type f) " as a function"))))))))
|
||||
|
||||
(set eval-form (fn [ctx bindings form]
|
||||
(cond
|
||||
|
|
|
|||
|
|
@ -19,16 +19,17 @@
|
|||
(printf "#'%s/%s" (ctx-current-ns ctx) ((var-name v) :name))
|
||||
(print v))))
|
||||
|
||||
(print "Jolt — Clojure on Janet")
|
||||
(print "Type (exit) to quit.\n")
|
||||
(defn main [&]
|
||||
(print "Jolt — Clojure on Janet")
|
||||
(print "Type (exit) to quit.\n")
|
||||
|
||||
(var running true)
|
||||
(while running
|
||||
(let [line (read-line (string (ctx-current-ns ctx) "=> "))]
|
||||
(if (nil? line) (set running false)
|
||||
(if (= line "(exit)") (set running false)
|
||||
(if (not (= "" line))
|
||||
(try
|
||||
(print-value (eval-string ctx line))
|
||||
([err]
|
||||
(eprint "Error: " err))))))))
|
||||
(var running true)
|
||||
(while running
|
||||
(let [line (read-line (string (ctx-current-ns ctx) "=> "))]
|
||||
(if (nil? line) (set running false)
|
||||
(if (= line "(exit)") (set running false)
|
||||
(if (not (= "" line))
|
||||
(try
|
||||
(print-value (eval-string ctx line))
|
||||
([err]
|
||||
(eprint "Error: " err)))))))))
|
||||
|
|
|
|||
|
|
@ -202,7 +202,13 @@
|
|||
(if (= (s pos) 41) # )
|
||||
[items (+ pos 1)]
|
||||
(let [[form new-pos] (read-form s pos)]
|
||||
(read-list-items s new-pos (array/push items form))))))
|
||||
# skip #_ discarded forms
|
||||
(if (and (struct? form) (= :jolt/skip (form :jolt/type)))
|
||||
(read-list-items s new-pos items)
|
||||
# splice #?@ items into the list
|
||||
(if (and (struct? form) (= :jolt/splice (form :jolt/type)))
|
||||
(read-list-items s new-pos (array/concat items (form :items)))
|
||||
(read-list-items s new-pos (array/push items form))))))))
|
||||
(read-list-items s (+ pos 1) @[]))
|
||||
|
||||
(defn read-vector [s pos]
|
||||
|
|
@ -214,7 +220,11 @@
|
|||
(if (= (s pos) 93) # ]
|
||||
[(tuple/slice (tuple ;items)) (+ pos 1)]
|
||||
(let [[form new-pos] (read-form s pos)]
|
||||
(read-vec-items s new-pos (array/push items form))))))
|
||||
(if (and (struct? form) (= :jolt/skip (form :jolt/type)))
|
||||
(read-vec-items s new-pos items)
|
||||
(if (and (struct? form) (= :jolt/splice (form :jolt/type)))
|
||||
(read-vec-items s new-pos (array/concat items (form :items)))
|
||||
(read-vec-items s new-pos (array/push items form))))))))
|
||||
(read-vec-items s (+ pos 1) @[]))
|
||||
|
||||
(defn read-map [s pos]
|
||||
|
|
@ -225,10 +235,21 @@
|
|||
(error "Unterminated map"))
|
||||
(if (= (s pos) 125) # }
|
||||
[(struct ;kvs) (+ pos 1)]
|
||||
(let [[key new-pos] (read-form s pos)
|
||||
pos (skip-whitespace s new-pos)
|
||||
[val new-pos2] (read-form s pos)]
|
||||
(read-kvs s new-pos2 (-> kvs (array/push key) (array/push val)))))))
|
||||
(let [[key new-pos] (read-form s pos)]
|
||||
(if (and (struct? key) (= :jolt/skip (key :jolt/type)))
|
||||
(read-kvs s new-pos kvs)
|
||||
(if (and (struct? key) (= :jolt/splice (key :jolt/type)))
|
||||
(read-kvs s new-pos (array/concat kvs (key :items)))
|
||||
(let [pos (skip-whitespace s new-pos)
|
||||
[val new-pos2] (read-form s pos)]
|
||||
(if (and (struct? val) (= :jolt/skip (val :jolt/type)))
|
||||
(read-kvs s new-pos2 kvs)
|
||||
(if (and (struct? val) (= :jolt/splice (val :jolt/type)))
|
||||
# Only push key if splice contributes items
|
||||
(if (> (length (val :items)) 0)
|
||||
(do (array/push kvs key) (read-kvs s new-pos2 (array/concat kvs (val :items))))
|
||||
(read-kvs s new-pos2 kvs))
|
||||
(read-kvs s new-pos2 (-> kvs (array/push key) (array/push val))))))))))))
|
||||
(read-kvs s (+ pos 1) @[]))
|
||||
|
||||
(defn read-set [s pos]
|
||||
|
|
@ -240,7 +261,11 @@
|
|||
(if (= (s pos) 125) # }
|
||||
[{:jolt/type :jolt/set :value (tuple/slice (tuple ;items))} (+ pos 1)]
|
||||
(let [[form new-pos] (read-form s pos)]
|
||||
(read-set-items s new-pos (array/push items form))))))
|
||||
(if (and (struct? form) (= :jolt/skip (form :jolt/type)))
|
||||
(read-set-items s new-pos items)
|
||||
(if (and (struct? form) (= :jolt/splice (form :jolt/type)))
|
||||
(read-set-items s new-pos (array/concat items (form :items)))
|
||||
(read-set-items s new-pos (array/push items form))))))))
|
||||
(read-set-items s (+ pos 2) @[]))
|
||||
|
||||
(defn read-char-name-end [s pos]
|
||||
|
|
@ -260,15 +285,53 @@
|
|||
[(array/insert form 0 (sym "fn*")) new-pos]))
|
||||
|
||||
(defn read-reader-conditional [s pos]
|
||||
# pos is at #, next char is ?
|
||||
(let [[form new-pos] (read-form s (+ pos 2))]
|
||||
[{:jolt/type :jolt/reader-conditional :clauses form} new-pos]))
|
||||
# pos is at #, next char is ? or ?@
|
||||
(def splice? (and (< (+ pos 2) (length s)) (= (s (+ pos 2)) 64))) # @ = 64
|
||||
(def form-start (if splice? (+ pos 3) (+ pos 2)))
|
||||
(let [[form new-pos] (read-form s form-start)]
|
||||
(if (array? form)
|
||||
(do
|
||||
(var result nil)
|
||||
(var i 0)
|
||||
(while (< i (length form))
|
||||
(if (= (in form i) :clj)
|
||||
(do
|
||||
(set result (in form (+ i 1)))
|
||||
(set i (length form)))
|
||||
(++ i)))
|
||||
(if splice?
|
||||
# #?@ splicing: resolve :clj branch, wrap for splice
|
||||
(let [items (if (nil? result)
|
||||
@[]
|
||||
(if (or (array? result) (tuple? result))
|
||||
result
|
||||
@[result]))]
|
||||
[{:jolt/type :jolt/splice :items items} new-pos])
|
||||
# #? non-splicing: skip nil results (from :cljs branches on CLJ)
|
||||
(if (nil? result)
|
||||
[{:jolt/type :jolt/skip} new-pos]
|
||||
[result new-pos])))
|
||||
[{:jolt/type :jolt/reader-conditional :clauses form} new-pos])))
|
||||
|
||||
(defn read-var-quote [s pos]
|
||||
# pos is at #, next char is '
|
||||
(let [[form new-pos] (read-form s (+ pos 2))]
|
||||
[(array (sym "var") form) new-pos]))
|
||||
|
||||
(defn read-regex [s pos]
|
||||
# pos is at #, next char is "
|
||||
# Read until unescaped closing "
|
||||
(var i (+ pos 2))
|
||||
(var done nil)
|
||||
(while (and (< i (length s)) (not done))
|
||||
(if (= (s i) 92) # backslash — skip next char
|
||||
(+= i 2)
|
||||
(if (= (s i) 34) # closing quote
|
||||
(set done [(struct ;[:jolt/type :jolt/tagged :tag :regex :form (string/slice s (+ pos 2) i)])
|
||||
(+ i 1)])
|
||||
(++ i))))
|
||||
(if done done (error "Unterminated regex literal")))
|
||||
|
||||
(defn read-dispatch [s pos]
|
||||
# pos is at #
|
||||
(if (>= (+ pos 1) (length s))
|
||||
|
|
@ -279,8 +342,9 @@
|
|||
(= c 40) (read-anon-fn s pos) # #(
|
||||
(= c 63) (read-reader-conditional s pos) # #?
|
||||
(= c 95) (let [[_ new-pos] (read-form s (+ pos 2))] # #_
|
||||
(read-form s new-pos))
|
||||
[{:jolt/type :jolt/skip} new-pos])
|
||||
(= c 39) (read-var-quote s pos) # #'
|
||||
(= c 34) (read-regex s pos) # #"regex
|
||||
# unknown dispatch — tagged literal
|
||||
(let [end (read-symbol-name s pos pos)
|
||||
tag (string/slice s pos end)
|
||||
|
|
@ -311,7 +375,7 @@
|
|||
# comment
|
||||
(= c 59)
|
||||
(let [line-end (read-until-newline s pos)]
|
||||
(read-form s line-end))
|
||||
[{:jolt/type :jolt/skip} line-end])
|
||||
|
||||
# dispatch
|
||||
(= c 35)
|
||||
|
|
@ -325,6 +389,16 @@
|
|||
(= c 40)
|
||||
(read-list s pos)
|
||||
|
||||
# unmatched closing delimiters
|
||||
(= c 41)
|
||||
(error (string "Unmatched closing paren at " pos))
|
||||
|
||||
(= c 93)
|
||||
(error (string "Unmatched closing bracket at " pos))
|
||||
|
||||
(= c 125)
|
||||
(error (string "Unmatched closing brace at " pos))
|
||||
|
||||
# vector
|
||||
(= c 91)
|
||||
(read-vector s pos)
|
||||
|
|
@ -373,11 +447,17 @@
|
|||
(defn parse-string
|
||||
"Parse a Clojure source string and return the first form."
|
||||
[s]
|
||||
(let [[form _] (read-form s 0)]
|
||||
form))
|
||||
(let [[form pos] (read-form s 0)]
|
||||
(if (and (struct? form) (= :jolt/skip (form :jolt/type)))
|
||||
(parse-string (string/slice s pos))
|
||||
form)))
|
||||
|
||||
(defn parse-next
|
||||
"Parse the first form from a string. Returns [form remaining-string]."
|
||||
[s]
|
||||
(let [[form pos] (read-form s 0)]
|
||||
[form (string/slice s pos)]))
|
||||
(defn- parse-next-loop [pos]
|
||||
(let [[form new-pos] (read-form s pos)]
|
||||
(if (and (struct? form) (= :jolt/skip (form :jolt/type)))
|
||||
(parse-next-loop new-pos)
|
||||
[form (string/slice s new-pos)])))
|
||||
(parse-next-loop 0))
|
||||
|
|
|
|||
26
test-defprotocol.janet
Normal file
26
test-defprotocol.janet
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
(use ./src/jolt/evaluator)
|
||||
(use ./src/jolt/types)
|
||||
(use ./src/jolt/reader)
|
||||
(use ./src/jolt/api)
|
||||
|
||||
(def ctx (init))
|
||||
|
||||
# Test simple defprotocol expansion
|
||||
(def proto-name {:jolt/type :symbol :ns nil :name "IBox"})
|
||||
(def sig1 @[{:jolt/type :symbol :ns nil :name "setVal"} {:jolt/type :symbol :ns nil :name "_this"} {:jolt/type :symbol :ns nil :name "_v"}])
|
||||
(def sig2 @[{:jolt/type :symbol :ns nil :name "getVal"} {:jolt/type :symbol :ns nil :name "_this"}])
|
||||
|
||||
# Call core-defprotocol directly
|
||||
(use ./src/jolt/core)
|
||||
(def expanded (core-defprotocol proto-name sig1 sig2))
|
||||
(print "expanded: " (string expanded))
|
||||
|
||||
# Try to eval it
|
||||
(def [ok err] (protect (eval-form ctx @{} expanded)))
|
||||
(if ok
|
||||
(do
|
||||
(print "eval OK!")
|
||||
(let [ns (ctx-find-ns ctx (ctx-current-ns ctx))]
|
||||
(printf "IBox: %q\n" (ns-find ns "IBox"))
|
||||
(printf "setVal: %q\n" (ns-find ns "setVal"))))
|
||||
(printf "eval FAIL: %q\n" err))
|
||||
42
test-eval.janet
Normal file
42
test-eval.janet
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
(use ./src/jolt/evaluator)
|
||||
(use ./src/jolt/types)
|
||||
(use ./src/jolt/reader)
|
||||
(use ./src/jolt/api)
|
||||
|
||||
(def ctx (init))
|
||||
|
||||
(defn load-all []
|
||||
(each fp ["/Users/yogthos/src/sci/src/sci/impl/macros.cljc"
|
||||
"/Users/yogthos/src/sci/src/sci/impl/protocols.cljc"
|
||||
"/Users/yogthos/src/sci/src/sci/impl/utils.cljc"
|
||||
"/Users/yogthos/src/sci/src/sci/impl/types.cljc"
|
||||
"/Users/yogthos/src/sci/src/sci/impl/unrestrict.cljc"]
|
||||
(def src (slurp fp))
|
||||
(var s src)
|
||||
(while (> (length (string/trim s)) 0)
|
||||
(def [f r] (parse-next s)) (set s r)
|
||||
(if (not (nil? f)) (protect (eval-form ctx @{} f)))))
|
||||
(def vs (slurp "/Users/yogthos/src/sci/src/sci/impl/vars.cljc"))
|
||||
(var s vs) (var c 0)
|
||||
(while (and (> (length (string/trim s)) 0) (< c 27))
|
||||
(def [f r] (parse-next s)) (set s r) (++ c)
|
||||
(if (not (nil? f)) (protect (eval-form ctx @{} f))))
|
||||
(each fp ["/Users/yogthos/src/sci/src/sci/lang.cljc"
|
||||
"/Users/yogthos/src/sci/src/sci/core.cljc"]
|
||||
(def src (slurp fp))
|
||||
(var s src)
|
||||
(while (> (length (string/trim s)) 0)
|
||||
(def [f r] (parse-next s)) (set s r)
|
||||
(if (not (nil? f)) (protect (eval-form ctx @{} f))))))
|
||||
|
||||
(load-all)
|
||||
|
||||
(print "=== Testing eval-string ===")
|
||||
|
||||
# Call sci.core/eval-string via our own eval
|
||||
(def src "(do (require (quote [sci.core :as sci])) (sci/eval-string (sci/init) (str (+ 1 2))))")
|
||||
(printf "eval: %s\n" src)
|
||||
(try
|
||||
(def result (eval-form ctx @{} (parse-string src)))
|
||||
(printf "result: %q\n" result)
|
||||
([err] (printf "FAIL: %q\n" err)))
|
||||
13
test-form15.janet
Normal file
13
test-form15.janet
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
(use ./src/jolt/reader)
|
||||
|
||||
(def src (slurp "/Users/yogthos/src/sci/src/sci/impl/utils.cljc"))
|
||||
(var s src)
|
||||
(for i 1 14
|
||||
(let [p (parse-next s)]
|
||||
(set s (in p 1))))
|
||||
|
||||
(def [form15 rest] (parse-next s))
|
||||
(if (array? form15)
|
||||
(printf "form15: (%s ...)" (get (first form15) :name))
|
||||
(printf "form15: %q" form15))
|
||||
(printf " => OK, rest: %d bytes" (length rest))
|
||||
16
test-ivar.janet
Normal file
16
test-ivar.janet
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
(use ./src/jolt/evaluator)
|
||||
(use ./src/jolt/types)
|
||||
(use ./src/jolt/reader)
|
||||
(use ./src/jolt/api)
|
||||
|
||||
(def ctx (init))
|
||||
(eval-form ctx @{} (parse-string "(ns sci.lang)"))
|
||||
(eval-form ctx @{} (parse-string "(definterface IVar)"))
|
||||
|
||||
# Resolve sci.lang/IVar by evaluating as a qualified symbol
|
||||
(def sym (parse-string "sci.lang/IVar"))
|
||||
(printf "sym: %q\n" sym)
|
||||
(try
|
||||
(def v (eval-form ctx @{} sym))
|
||||
(printf "resolved: %q\n" v)
|
||||
([err] (printf "error: %q\n" err)))
|
||||
44
test-load-sci.janet
Normal file
44
test-load-sci.janet
Normal file
|
|
@ -0,0 +1,44 @@
|
|||
(use ./src/jolt/evaluator)
|
||||
(use ./src/jolt/types)
|
||||
(use ./src/jolt/reader)
|
||||
(use ./src/jolt/api)
|
||||
|
||||
(def ctx (init))
|
||||
|
||||
(defn load-file-quiet [ctx fp stop-at]
|
||||
(def src (slurp fp))
|
||||
(var s src)
|
||||
(var c 0)
|
||||
(var good 0)
|
||||
(var bad 0)
|
||||
(while (and (> (length (string/trim s)) 0) (or (not stop-at) (< c stop-at)))
|
||||
(def pr (protect (parse-next s)))
|
||||
(if (not (pr 0)) (do (printf "%s PARSE CRASH: %q\n" fp (pr 1)) (break)))
|
||||
(let [[f r] (pr 1)]
|
||||
(set s r)
|
||||
(++ c)
|
||||
(if (not (nil? f))
|
||||
(let [pr2 (protect (eval-form ctx @{} f))]
|
||||
(if (pr2 0) (++ good) (++ bad))))))
|
||||
{:count c :good good :bad bad})
|
||||
|
||||
(each fp ["/Users/yogthos/src/sci/src/sci/impl/macros.cljc"
|
||||
"/Users/yogthos/src/sci/src/sci/impl/protocols.cljc"
|
||||
"/Users/yogthos/src/sci/src/sci/impl/utils.cljc"
|
||||
"/Users/yogthos/src/sci/src/sci/impl/types.cljc"
|
||||
"/Users/yogthos/src/sci/src/sci/impl/unrestrict.cljc"]
|
||||
(load-file-quiet ctx fp nil))
|
||||
|
||||
(load-file-quiet ctx "/Users/yogthos/src/sci/src/sci/impl/vars.cljc" 27)
|
||||
(load-file-quiet ctx "/Users/yogthos/src/sci/src/sci/lang.cljc" nil)
|
||||
|
||||
# Summary
|
||||
(printf "\nSummary:\n")
|
||||
(printf "ns: %s\n" (ctx-current-ns ctx))
|
||||
|
||||
# Try loading sci.core
|
||||
(print "\nLoading sci.core...")
|
||||
(def r (load-file-quiet ctx "/Users/yogthos/src/sci/src/sci/core.cljc" nil))
|
||||
(printf "sci.core: %d forms, %d ok, %d fail\n" (r :count) (r :good) (r :bad))
|
||||
|
||||
(printf "ns: %s\n" (ctx-current-ns ctx))
|
||||
18
test-parse-utils.janet
Normal file
18
test-parse-utils.janet
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
(use ./src/jolt/reader)
|
||||
(def s (slurp "/Users/yogthos/src/sci/src/sci/impl/utils.cljc"))
|
||||
(var ss s)
|
||||
(var i 0)
|
||||
(while (< i 14)
|
||||
(def [f r] (parse-next ss))
|
||||
(set ss r)
|
||||
(++ i))
|
||||
(try
|
||||
(def [form rest] (parse-next ss))
|
||||
(if (array? form)
|
||||
(let [h (first form)]
|
||||
(if (and (struct? h) (= :symbol (h :jolt/type)))
|
||||
(print (string "form: (" (h :name) "...)"))
|
||||
(print (string "form: array head " (type h)))))
|
||||
(print (string "form: " (type form) " " (string form))))
|
||||
(print (string "OK rest: " (string/slice rest 0 80)))
|
||||
([err] (print (string "FAIL: " err))))
|
||||
28
test/bootstrap-test.janet
Normal file
28
test/bootstrap-test.janet
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
(use ../src/jolt/evaluator)
|
||||
(use ../src/jolt/types)
|
||||
(use ../src/jolt/reader)
|
||||
(use ../src/jolt/api)
|
||||
|
||||
(def ctx (init))
|
||||
(def source (slurp "/Users/yogthos/src/sci/src/sci/impl/macros.cljc"))
|
||||
(var s source)
|
||||
(var count 0)
|
||||
|
||||
(while (> (length (string/trim s)) 0)
|
||||
(def [form rest] (parse-next s))
|
||||
(set s rest)
|
||||
(++ count)
|
||||
(if (not (nil? form))
|
||||
(do
|
||||
(printf "eval form %d..." count)
|
||||
(flush)
|
||||
(eval-form ctx @{} form)
|
||||
(printf " OK\n"))))
|
||||
|
||||
(printf "\n%d forms processed\n" count)
|
||||
(printf "ns: %s\n" (ctx-current-ns ctx))
|
||||
|
||||
(let [ns (ctx-find-ns ctx "sci.impl.macros")]
|
||||
(printf "sci.impl.macros bindings:\n")
|
||||
(loop [[name v] :pairs (ns :mappings)]
|
||||
(printf " %s: macro=%q\n" name (v :macro))))
|
||||
|
|
@ -1,6 +1,7 @@
|
|||
(use ../src/jolt/evaluator)
|
||||
(use ../src/jolt/types)
|
||||
(use ../src/jolt/reader)
|
||||
(use ../src/jolt/api)
|
||||
|
||||
# Helper: create a Jolt symbol
|
||||
(defn sym [name]
|
||||
|
|
@ -70,4 +71,81 @@
|
|||
(assert (= 0 (countdown 5)) "recur in fn"))
|
||||
(print " passed")
|
||||
|
||||
(print "10: throw/try/catch/finally...")
|
||||
# throw + catch
|
||||
(let [result (eval-str "(try (throw \"boom\") (catch Exception e \"caught\"))")]
|
||||
(assert (= "caught" result) "catch catches throw"))
|
||||
|
||||
# try with finally — body returns, finally runs
|
||||
(let [result (eval-str "(try 1 (finally 2))")]
|
||||
(assert (= 1 result) "try returns body even with finally"))
|
||||
|
||||
# try/catch/finally — catch returns, finally runs
|
||||
(let [result (eval-str "(try (throw \"err\") (catch Exception e \"handled\") (finally :cleanup))")]
|
||||
(assert (= "handled" result) "catch + finally returns catch value"))
|
||||
(print " passed")
|
||||
|
||||
(print "11: set!...")
|
||||
# set! on a var
|
||||
(assert (= 99 (eval-str "(do (def x 1) (set! x 99) x)")) "set! on var")
|
||||
# set! re-evaluates
|
||||
(assert (= 3 (eval-str "(do (def a 1) (def b 2) (set! a (+ a b)) a)")) "set! with expression")
|
||||
(print " passed")
|
||||
|
||||
(print "12: var...")
|
||||
# (var x) returns the var itself, not its value
|
||||
(let [v (eval-str "(do (def x 42) (var x))")]
|
||||
(assert (var? v) "(var x) returns a var")
|
||||
(assert (= 42 (var-get v)) "var holds value"))
|
||||
(print " passed")
|
||||
|
||||
(print "13: locking...")
|
||||
# locking is a no-op in single-threaded Janet — just executes body
|
||||
(assert (= 42 (eval-str "(locking :lock 42)")) "locking returns body result")
|
||||
(print " passed")
|
||||
|
||||
(print "14: instance?...")
|
||||
# instance? checks type
|
||||
(assert (= true (eval-str "(instance? Number 42)")) "instance? Number matches number")
|
||||
(assert (= false (eval-str "(instance? Number \"hello\")")) "instance? Number doesn't match string")
|
||||
(print " passed")
|
||||
|
||||
(print "15: defmulti/defmethod...")
|
||||
(let [ctx (make-ctx)]
|
||||
(eval-form ctx @{} (parse-string "(defmulti my-dispatch (fn* [x] (x :type)))"))
|
||||
(eval-form ctx @{} (parse-string "(defmethod my-dispatch :foo [_] :got-foo)"))
|
||||
(eval-form ctx @{} (parse-string "(defmethod my-dispatch :bar [_] :got-bar)"))
|
||||
(assert (= :got-foo (eval-form ctx @{} (parse-string "(my-dispatch {:type :foo})"))) "defmethod :foo dispatches")
|
||||
(assert (= :got-bar (eval-form ctx @{} (parse-string "(my-dispatch {:type :bar})"))) "defmethod :bar dispatches"))
|
||||
(print " passed")
|
||||
|
||||
(print "16: deftype...")
|
||||
(let [ctx (make-ctx)
|
||||
_ (eval-form ctx @{} (parse-string "(deftype Point [x y])"))
|
||||
_ (eval-form ctx @{} (parse-string "(def p (Point. 10 20))"))
|
||||
p-val (eval-form ctx @{} (parse-string "p"))
|
||||
x-val (eval-form ctx @{} (parse-string "(p :x)"))
|
||||
y-val (eval-form ctx @{} (parse-string "(p :y)"))
|
||||
result [x-val y-val]]
|
||||
(printf " p-val: %q" p-val)
|
||||
(printf " x-val: %q, y-val: %q" x-val y-val)
|
||||
(printf " result: %q" result)
|
||||
(assert (deep= [10 20] result) "deftype creates tagged instances with fields"))
|
||||
(print " passed")
|
||||
|
||||
(print "17: defmacro...")
|
||||
# define a macro using defmacro special form
|
||||
# init loads clojure.core so `list` is available
|
||||
(let [ctx (init)
|
||||
_ (eval-form ctx @{} (parse-string "(defmacro my-when [test body] (list 'if test body nil))"))
|
||||
result (eval-form ctx @{} (parse-string "(my-when true 2)"))]
|
||||
(assert (= 2 result) "defmacro defines callable macro"))
|
||||
# verify the var is marked :macro
|
||||
(let [ctx (make-ctx)
|
||||
_ (eval-form ctx @{} (parse-string "(defmacro m [x] (list 'quote x))"))
|
||||
v (resolve-var ctx @{} (parse-string "m"))]
|
||||
(assert v "macro var exists")
|
||||
(assert (v :macro) "macro var has :macro true"))
|
||||
(print " passed")
|
||||
|
||||
(print "\nAll evaluator tests passed!")
|
||||
|
|
|
|||
|
|
@ -115,10 +115,18 @@
|
|||
(let [[form2 _] (parse-next rest-str)]
|
||||
(assert (deep= [3 4] form2) "second form is vector")))
|
||||
|
||||
# Reader conditional (basic #? support)
|
||||
(let [form (parse-string "#?(:clj 1 :cljs 2)")]
|
||||
(assert (struct? form) "reader conditional")
|
||||
(assert (= :jolt/reader-conditional (form :jolt/type)) "correct type"))
|
||||
# Reader conditional — resolves :clj branch at read time
|
||||
(assert (= 1 (parse-string "#?(:clj 1 :cljs 2)"))
|
||||
"#?(:clj) picks :clj branch")
|
||||
(assert (= nil (parse-string "#?(:cljs 999)"))
|
||||
"#?(:cljs) returns nil on CLJ")
|
||||
(assert (= 42 (parse-string "#?(:clj 42)"))
|
||||
"#?(:clj) with single branch")
|
||||
(assert (deep= (sym "clj-only") (parse-string "#?(:clj clj-only :cljs cljs-only)"))
|
||||
"#?(:clj) picks :clj symbol")
|
||||
# Nested inside a list — :clj branch is evaluated at read time
|
||||
(assert (deep= @[(sym "+") 1 3] (parse-string "(+ 1 #?(:clj 3 :cljs 4))"))
|
||||
"#? inside list picks :clj")
|
||||
|
||||
# Characters
|
||||
(let [form (parse-string "\\newline")]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue