Phase 1+2: Clojure→Janet source compiler with symbol classification
- analyze-form: Clojure forms → annotated AST nodes (:op keys) - emit-ast: AST dispatch → Janet source via StringBuffer - compile-form: analyze → emit → Janet source string - Symbol classification: locals, core refs, qualified refs - Ops: const, do, if, def, fn, let, invoke, quote, vector, map - Local binding awareness in fn* and let* (shadowing works) - All 317 existing tests pass, 24 new compiler tests
This commit is contained in:
Yogthos
parent
679cc1d4ef
commit
dfa98746ee
6 changed files with 594 additions and 22 deletions
|
|
@ -1,7 +1,7 @@
|
|||
`:mutable?` compile flag in `api.janet` `init`: persistent Clojure data structures loaded by default. Pass `{:mutable? true}` to use Janet native mutable tuples/tables instead. `load-persistent-structures` function in api.janet loads `src/jolt/clojure/lang/persistent_vector.clj` (17 forms) and swaps `vec`/`vector`/`vector?` bindings in `clojure.core`. PersistentHashMap WIP in `src/jolt/clojure/lang/persistent_hash_map.clj` (24 forms, 328 parens balanced, bitmap calculation broken — inner let expression returns 0 instead of computed value).
|
||||
Compiler implementation plan (6 phases): Phase 1 — compiler.janet skeleton + emit* for const/do/if/let/fn/def/invoke. Phase 2 — symbol classifier (resolve locals/vars/core at analyze time). Phase 3 — loader.janet + api.janet wiring (:compile? flag, load-ns, caching). Phase 4 — macro integration (expand at analyze time via interpreter). Phase 5 — remaining ops (loop/recur, try/throw, quote, syntax-quote, set!, deftype, .). Phase 6 — tests + benchmarks. New files: src/jolt/compiler.janet, src/jolt/loader.janet, test/compiler-test.janet. Modified files: evaluator.janet (compiler fast-path), types.janet (compiled-cache table), api.janet (compile-string, load-ns). Reader and core unchanged.
|
||||
§
|
||||
SCI 9 core files (macros, protocols, types, unrestrict, vars, lang, utils, namespaces, core) load with 0 failures in order: macros→protocols→types→unrestrict→vars→lang→utils→namespaces→core. 46 namespaces populated. Internal SCI files (interop, opts, parser, analyzer, interpreter) need edamame/tools.reader stubs but public API works via Jolt-native eval-string that bypasses SCI's eval pipeline.
|
||||
Compiler is in `src/jolt/compiler.janet` (352 lines). Two-phase architecture: `analyze-form` produces annotated AST with `:op` keys, `emit-ast` dispatches on `:op` to emit Janet source, `compile-form` ties them together returning a Janet source string. Source-to-source (not bytecode). `core-renames` table maps Clojure core names to Janet function names (e.g., "inc" → "core-inc"). Phase 1 covers: const, do, if, def, fn*, let*, invoke, symbol, core-symbol, qualified-symbol, quote, vector, map. Tests in `test/compiler-test.janet` (79 lines). Phase 2 (symbol classification — locals/vars/core at analyze time) is the next step.
|
||||
§
|
||||
Janet `get` DOES follow table prototype chain — confirmed working: `(get child :key :not-found)` returns parent's value if child has prototype set via `table/setproto`. Earlier confusion about `get` not following prototypes was incorrect. The `binding-get` helper that walked prototypes manually was unnecessary and was reverted. Current `resolve-sym` uses: `(get bindings name :jolt/not-found-1)` then falls back to `binding-get` only if `:jolt/not-found-1` returned.
|
||||
After compiler Phase 1: 317 tests pass, 0 failures (was 253 before). Compiler tests add 8 test groups (literals, do, if, def, fn, let, invoke — 19 assertions). Run with `jpm test`.
|
||||
§
|
||||
Persistent data structures use simple array-based implementation (node-assoc/node-find/find-key-index), NOT HAMT bit-trie. HAMT failed because Janet uses 64-bit doubles and bit operations (brshift, brushift, band) require 32-bit signed ints — hash values from Janet's (hash) function exceed the 32-bit range. Array approach uses linear scan: find-key-index searches key-value pairs, node-assoc appends to array on insert or clones+updates on replace. O(n) lookup, acceptable for small maps.
|
||||
Compiler development workflow: (1) add match arm in `analyze-form` → produces `{:op :new-op ...}` AST, (2) add `emit-*` helper + dispatch arm in `emit-ast`, (3) add test assertions in `test/compiler-test.janet` using `compile-str` helper, (4) run `janet test/compiler-test.janet` then `jpm test`. Tests compare source-to-source output strings, not execution results. Any fn added to `core-bindings` in core.janet must also be added to `core-renames` in compiler.janet.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
Janet `struct?` returns false for tables. Deftypes created by Jolt's `deftype` special form are tables (via `@{}`), not structs. So `(struct? val)` fails for deftype instances but `(get val :jolt/deftype)` works. This broke `instance?` check for persistent vector — fixed by changing from `(and (struct? val) ...)` to `(get val :jolt/deftype)`. The `.` special form for deftype field access strips `-` prefix: `(.-cnt obj)` → `(get obj :cnt)`.
|
||||
§
|
||||
Missing comparison operators: `<`, `>`, `<=`, `>=` were NOT in `core-bindings`, causing silent nil returns in loop conditions. Each must be added as both a function binding (in `core-bindings` map) AND if it's a comparison used inside Clojure macros, it may need special handling. Symptom: `(loop [i 0] (if (< i 3) (recur (inc i)) i))` returns nil because `<` resolves to nothing → apply fails → returns nil.
|
||||
§
|
||||
Bit operations in Janet (brshift, brushift, band, bor, bxor) use 32-bit signed integers. Values from (hash key) can exceed 32-bit range (>2^31). brshift with out-of-range value fails with 'rhs must be valid 32-bit signed integer'. Use (band x 0xFFFFFFFF) before shifting, or use arithmetic approaches (mod, /, pow) instead of bit ops for hash-based data structures.
|
||||
§
|
||||
`.clj` source files are loaded at init time by Jolt's own reader/evaluator. PersistentVector (17 forms) and PersistentHashMap (12 forms) live in `src/jolt/clojure/lang/persistent_*.clj`. api.janet's `init` calls `load-persistent-structures` which slurps and eval-forms each file, then swaps clojure.core bindings (vec, vector, vector?, hash-map) to the persistent versions. Pass `{:mutable? true}` to skip loading and use Janet-native types.
|
||||
§
|
||||
Janet LSP produces false positives on `.janet` files — it doesn't understand Janet syntax (thinks docstring lines are unresolved symbols, doesn't know `declare-project`/`declare-source` macros, etc.). These are pre-existing and should be ignored — they don't affect runtime correctness.
|
||||
|
|
|
|||
|
|
@ -1,34 +1,43 @@
|
|||
{
|
||||
"jolt-dev": {
|
||||
"created_by": "agent",
|
||||
"use_count": 24,
|
||||
"view_count": 35,
|
||||
"patch_count": 30,
|
||||
"last_used_at": "2026-06-02T18:45:23.321430+00:00",
|
||||
"last_viewed_at": "2026-06-02T18:45:23.310874+00:00",
|
||||
"last_patched_at": "2026-06-02T17:27:24.746485+00:00",
|
||||
"created_at": "2026-06-01T21:26:06.614465+00:00",
|
||||
"state": "active",
|
||||
"pinned": false
|
||||
},
|
||||
"jolt-bootstrap": {
|
||||
"created_by": "agent",
|
||||
"use_count": 8,
|
||||
"view_count": 18,
|
||||
"use_count": 9,
|
||||
"view_count": 20,
|
||||
"patch_count": 10,
|
||||
"last_used_at": "2026-06-02T03:43:48.038435+00:00",
|
||||
"last_viewed_at": "2026-06-02T03:43:48.028512+00:00",
|
||||
"last_used_at": "2026-06-02T18:45:23.336653+00:00",
|
||||
"last_viewed_at": "2026-06-02T18:45:23.328485+00:00",
|
||||
"last_patched_at": "2026-06-02T03:44:45.935676+00:00",
|
||||
"created_at": "2026-06-01T21:49:51.101718+00:00",
|
||||
"state": "active",
|
||||
"pinned": false
|
||||
},
|
||||
"jolt-dev": {
|
||||
"jolt-compiler": {
|
||||
"created_by": "agent",
|
||||
"use_count": 20,
|
||||
"view_count": 30,
|
||||
"patch_count": 30,
|
||||
"last_used_at": "2026-06-02T17:27:04.417433+00:00",
|
||||
"last_viewed_at": "2026-06-02T17:27:04.404716+00:00",
|
||||
"last_patched_at": "2026-06-02T17:27:24.746485+00:00",
|
||||
"created_at": "2026-06-01T21:26:06.614465+00:00",
|
||||
"use_count": 0,
|
||||
"view_count": 0,
|
||||
"patch_count": 0,
|
||||
"created_at": "2026-06-02T17:54:38.690279+00:00",
|
||||
"state": "active",
|
||||
"pinned": false
|
||||
},
|
||||
"jpm-build": {
|
||||
"created_by": "agent",
|
||||
"use_count": 0,
|
||||
"view_count": 10,
|
||||
"view_count": 11,
|
||||
"patch_count": 0,
|
||||
"last_viewed_at": "2026-06-02T03:42:37.626504+00:00",
|
||||
"last_viewed_at": "2026-06-02T17:43:38.327259+00:00",
|
||||
"created_at": "2026-06-01T20:56:39.144222+00:00",
|
||||
"state": "active",
|
||||
"pinned": false
|
||||
|
|
|
|||
82
.dirge/skills/jolt-compiler/SKILL.md
Normal file
82
.dirge/skills/jolt-compiler/SKILL.md
Normal file
|
|
@ -0,0 +1,82 @@
|
|||
---
|
||||
description: Jolt compiler architecture and implementation plan
|
||||
---
|
||||
|
||||
# Jolt Compiler
|
||||
|
||||
Two-phase source-to-source compiler: Clojure forms → annotated AST → Janet source → Janet bytecode.
|
||||
|
||||
## Architecture
|
||||
|
||||
```
|
||||
Clojure source → Reader → raw AST
|
||||
↓
|
||||
analyze-form (classify symbols, produce :op AST)
|
||||
↓
|
||||
emit* dispatch (generate Janet source string)
|
||||
↓
|
||||
Janet compile → bytecode
|
||||
```
|
||||
|
||||
Follows CLJS `cljs.analyzer` / `cljs.compiler` pattern.
|
||||
|
||||
## Key decisions
|
||||
|
||||
- **Target**: Janet source text (fed to Janet's `compile`), not direct bytecode. Simpler, debuggable, portable across Janet versions.
|
||||
- **Mode gating**: Opt-in per context via `:compile?` flag on `init`. `eval-string` still interprets unless opted in.
|
||||
- **Caching**: In-memory bytecode cache in context first. Disk persistence (`.jimage` files) as follow-up.
|
||||
|
||||
## AST ops (CLJS subset + Jolt-specific)
|
||||
|
||||
Core: `const`, `var`, `local`, `binding`, `if`, `do`, `let`, `loop`, `recur`, `fn`, `fn-method`, `def`, `invoke`, `quote`, `try`, `throw`, `set!`, `new`, `host-field`, `host-call`
|
||||
|
||||
Jolt-specific: `deftype`, `defmulti`, `defmethod`, `syntax-quote`
|
||||
|
||||
## File layout
|
||||
|
||||
| File | Purpose |
|
||||
|------|---------|
|
||||
| `src/jolt/compiler.janet` | `analyze-form`, `emit*` dispatch, `compile-form`, symbol classifier |
|
||||
| `src/jolt/loader.janet` | `load-ns`, `reload-ns`, in-memory bytecode cache |
|
||||
| `test/compiler-test.janet` | Round-trip: compile-form → Janet eval → assert |
|
||||
|
||||
Modified files:
|
||||
- `evaluator.janet` — add compiler fast-path for `def`/`defn`/`defmacro` when `:compile?` set
|
||||
- `types.janet` — add `:compiled-cache` table to context
|
||||
- `api.janet` — expose `compile-string`, `load-ns`, `compile-file`; `init` gets `:compile?` flag
|
||||
- `reader.janet` — **no change**
|
||||
- `core.janet` — **no change**
|
||||
|
||||
## Emit target advantages
|
||||
|
||||
Both input and output are parenthesized prefix syntax, so many forms pass through almost unchanged:
|
||||
|
||||
```
|
||||
Clojure: (defn f [x] (+ x 1))
|
||||
AST: {:op :def :name "f" :init {:op :fn :methods [...]}}
|
||||
Janet: (defn f [x] (+ x 1)) ← nearly identical
|
||||
```
|
||||
|
||||
Main work:
|
||||
- Symbol resolution (Clojure's `clojure.core/+` → Janet's `core-+`)
|
||||
- Truthiness wrapping (`nil`/`false` are falsey in Clojure, Janet only `nil`)
|
||||
- Special form mapping (`loop*`/`recur` → Janet `loop` + explicit recur vars)
|
||||
- Vars → Janet table lookups
|
||||
|
||||
## Implementation phases
|
||||
|
||||
| Phase | What | Deliverable |
|
||||
|-------|------|-------------|
|
||||
| 1 | `compiler.janet` — `analyze-form` skeleton + `emit*` for `const`, `do`, `if`, `let`, `fn`, `def`, `invoke` | Basic forms compile and run |
|
||||
| 2 | Symbol classifier — resolve locals/vars/core at analyze time | No runtime `resolve-sym` in compiled code |
|
||||
| 3 | `loader.janet` + `api.janet` wiring — `:compile?` flag, `load-ns`, caching | File-based namespace loading works |
|
||||
| 4 | Macro integration — expand at analyze time via interpreter | Macros work in compiled code |
|
||||
| 5 | Remaining ops: `loop`/`recur`, `try`/`throw`, `quote`, `syntax-quote`, `set!`, `deftype`, `.` | Full language coverage |
|
||||
| 6 | Tests + benchmarks | Correctness + speedup measurement |
|
||||
|
||||
## Pitfalls
|
||||
|
||||
- Janet `compile` produces bytecode tied to Janet version — source-to-source avoids this
|
||||
- CLJS analyzer is ~5000 lines; Jolt's can be simpler because emit target is s-expressions
|
||||
- Symbol resolution must happen at analyze time, not runtime, for compiled code
|
||||
- Macro expansion still uses interpreter at analyze time — macros are not AOT-compiled
|
||||
386
src/jolt/compiler.janet
Normal file
386
src/jolt/compiler.janet
Normal file
|
|
@ -0,0 +1,386 @@
|
|||
# Jolt Compiler
|
||||
# Source-to-source: Clojure forms → Janet source
|
||||
# Two-phase: analyze-form (classify) → emit-ast (generate)
|
||||
|
||||
# Mapping from Clojure core names to Janet function names.
|
||||
# Populated at init time from the core-bindings map.
|
||||
(def- core-renames
|
||||
@{"+" "core-+"
|
||||
"-" "core--"
|
||||
"*" "core-*"
|
||||
"/" "core-/"
|
||||
"inc" "core-inc"
|
||||
"dec" "core-dec"
|
||||
"=" "core-="
|
||||
"not=" "core-not="
|
||||
"<" "core-<"
|
||||
">" "core->"
|
||||
"<=" "core-<="
|
||||
">=" "core->="
|
||||
"nil?" "core-nil?"
|
||||
"not" "core-not"
|
||||
"some?" "core-some?"
|
||||
"string?" "core-string?"
|
||||
"number?" "core-number?"
|
||||
"keyword?" "core-keyword?"
|
||||
"symbol?" "core-symbol?"
|
||||
"vector?" "core-vector?"
|
||||
"map?" "core-map?"
|
||||
"seq?" "core-seq?"
|
||||
"coll?" "core-coll?"
|
||||
"first" "core-first"
|
||||
"rest" "core-rest"
|
||||
"next" "core-next"
|
||||
"cons" "core-cons"
|
||||
"conj" "core-conj"
|
||||
"assoc" "core-assoc"
|
||||
"dissoc" "core-dissoc"
|
||||
"get" "core-get"
|
||||
"get-in" "core-get-in"
|
||||
"contains?" "core-contains?"
|
||||
"count" "core-count"
|
||||
"empty?" "core-empty?"
|
||||
"every?" "core-every?"
|
||||
"seq" "core-seq"
|
||||
"vec" "core-vec"
|
||||
"map" "core-map"
|
||||
"filter" "core-filter"
|
||||
"remove" "core-remove"
|
||||
"reduce" "core-reduce"
|
||||
"apply" "core-apply"
|
||||
"str" "core-str"
|
||||
"prn" "core-prn"
|
||||
"pr-str" "core-pr-str"
|
||||
"println" "core-println"
|
||||
"print" "core-print"
|
||||
"identity" "core-identity"
|
||||
"comp" "core-comp"
|
||||
"partial" "core-partial"
|
||||
"complement" "core-complement"
|
||||
"constantly" "core-constantly"
|
||||
"memoize" "core-memoize"
|
||||
"some" "core-some"
|
||||
"range" "core-range"
|
||||
"take" "core-take"
|
||||
"drop" "core-drop"
|
||||
"take-while" "core-take-while"
|
||||
"drop-while" "core-drop-while"
|
||||
"nth" "core-nth"
|
||||
"reverse" "core-reverse"
|
||||
"into" "core-into"
|
||||
"merge" "core-merge"
|
||||
"merge-with" "core-merge-with"
|
||||
"keys" "core-keys"
|
||||
"vals" "core-vals"
|
||||
"zipmap" "core-zipmap"
|
||||
"select-keys" "core-select-keys"
|
||||
"max" "core-max"
|
||||
"min" "core-min"
|
||||
"odd?" "core-odd?"
|
||||
"even?" "core-even?"
|
||||
"zero?" "core-zero?"
|
||||
"pos?" "core-pos?"
|
||||
"neg?" "core-neg?"
|
||||
"true?" "core-true?"
|
||||
"false?" "core-false?"
|
||||
"identical?" "core-identical?"
|
||||
"quot" "core-quot"
|
||||
"rem" "core-rem"
|
||||
"mod" "core-mod"})
|
||||
|
||||
(defn- literal?
|
||||
"Check if a form is a self-evaluating literal (not a symbol)."
|
||||
[form]
|
||||
(or (nil? form) (= true form) (= false form)
|
||||
(number? form) (string? form) (keyword? form) (bytes? form) (buffer? form)))
|
||||
|
||||
(defn- sym-name-str
|
||||
[sym-s]
|
||||
(if (sym-s :ns) (string (sym-s :ns) "/" (sym-s :name)) (sym-s :name)))
|
||||
|
||||
(defn- special-form?
|
||||
[name]
|
||||
(or (= name "quote") (= name "syntax-quote") (= name "do")
|
||||
(= name "if") (= name "def") (= name "defmacro") (= name "fn*")
|
||||
(= name "let*") (= name "loop*") (= name "recur") (= name "throw")
|
||||
(= name "try") (= name "set!") (= name "var") (= name ".")
|
||||
(= name "new") (= name "deftype") (= name "instance?")
|
||||
(= name "defmulti") (= name "defmethod") (= name "locking")))
|
||||
|
||||
# ============================================================
|
||||
# Analyzer — Clojure form → annotated AST node {:op ...}
|
||||
# ============================================================
|
||||
|
||||
(defn analyze-form
|
||||
"Analyze a Clojure form and return an AST node with :op key.
|
||||
Takes bindings (table) for local symbol classification.
|
||||
Recursively analyzes sub-expressions."
|
||||
[form bindings]
|
||||
(cond
|
||||
# Literals
|
||||
(literal? form)
|
||||
{:op :const :val form}
|
||||
|
||||
# Symbols
|
||||
(and (struct? form) (= :symbol (form :jolt/type)))
|
||||
(let [name (form :name)
|
||||
ns (form :ns)]
|
||||
(if ns
|
||||
{:op :qualified-symbol :ns ns :name name}
|
||||
# Check local bindings first (let vars, fn params)
|
||||
(if (get bindings name)
|
||||
{:op :local :name name}
|
||||
(if (and (not (special-form? name)) (get core-renames name))
|
||||
{:op :core-symbol :name name :janet-name (get core-renames name)}
|
||||
{:op :symbol :name name}))))
|
||||
|
||||
# Lists/arrays
|
||||
(array? form)
|
||||
(let [first-form (first form)
|
||||
head-name (if (and (struct? first-form) (= :symbol (first-form :jolt/type)))
|
||||
(first-form :name)
|
||||
nil)]
|
||||
(if head-name
|
||||
(match head-name
|
||||
"quote" {:op :quote :expr (in form 1)}
|
||||
"do" (let [all-statements (array/slice form 1)
|
||||
n (length all-statements)
|
||||
analyzed (map |(analyze-form $ bindings) all-statements)]
|
||||
{:op :do
|
||||
:statements (array/slice analyzed 0 (- n 1))
|
||||
:ret (in analyzed (- n 1))})
|
||||
"if" {:op :if
|
||||
:test (analyze-form (in form 1) bindings)
|
||||
:then (analyze-form (in form 2) bindings)
|
||||
:else (if (> (length form) 3)
|
||||
(analyze-form (in form 3) bindings)
|
||||
{:op :const :val nil})}
|
||||
"def" {:op :def
|
||||
:name (in form 1)
|
||||
:init (analyze-form (in form 2) bindings)}
|
||||
"fn*" (let [params (in form 1)
|
||||
# Augment bindings with param names so body refs are :local
|
||||
body-bindings (do
|
||||
(var bb @{})
|
||||
(loop [[k v] :pairs bindings] (put bb k v))
|
||||
(each p params
|
||||
(put bb (if (struct? p) (p :name) p) :jolt/local))
|
||||
bb)
|
||||
body-exprs (tuple/slice form 2)
|
||||
analyzed-body (map |(analyze-form $ body-bindings) body-exprs)
|
||||
n-body (length analyzed-body)]
|
||||
{:op :fn :params params
|
||||
:body (if (> n-body 1)
|
||||
{:op :do
|
||||
:statements (array/slice analyzed-body 0 (- n-body 1))
|
||||
:ret (last analyzed-body)}
|
||||
(first analyzed-body))})
|
||||
"let*" (let [bind-vec (in form 1)
|
||||
body-exprs (tuple/slice form 2)
|
||||
# Analyze binding init values with outer bindings
|
||||
n-binding-slots (length bind-vec)
|
||||
binding-pairs (do
|
||||
(var pairs @[])
|
||||
(var i 0)
|
||||
(while (< i n-binding-slots)
|
||||
(let [sym-s (in bind-vec i)
|
||||
name (if (struct? sym-s) (sym-s :name) sym-s)
|
||||
val-form (if (< (+ i 1) n-binding-slots) (in bind-vec (+ i 1)) nil)
|
||||
val-ast (if val-form (analyze-form val-form bindings) {:op :const :val nil})]
|
||||
(array/push pairs {:name name :init val-ast})
|
||||
(+= i 2)))
|
||||
pairs)
|
||||
# Augment bindings with let-bound names for body analysis
|
||||
body-bindings (do
|
||||
(var bb @{})
|
||||
(loop [[k v] :pairs bindings] (put bb k v))
|
||||
(each bp binding-pairs
|
||||
(put bb (bp :name) :jolt/local))
|
||||
bb)
|
||||
analyzed-body (map |(analyze-form $ body-bindings) body-exprs)
|
||||
n-body (length analyzed-body)]
|
||||
{:op :let
|
||||
:binding-pairs binding-pairs
|
||||
:body (if (> n-body 1)
|
||||
{:op :do
|
||||
:statements (array/slice analyzed-body 0 (- n-body 1))
|
||||
:ret (last analyzed-body)}
|
||||
(first analyzed-body))})
|
||||
# Default: function invocation
|
||||
(let [f-ast (analyze-form first-form bindings)
|
||||
args (map |(analyze-form $ bindings) (tuple/slice form 1))]
|
||||
{:op :invoke :fn f-ast :args args}))
|
||||
# Non-symbol head: function invocation
|
||||
(let [f-ast (analyze-form first-form bindings)
|
||||
args (map |(analyze-form $ bindings) (tuple/slice form 1))]
|
||||
{:op :invoke :fn f-ast :args args})))
|
||||
|
||||
# Tuples (vectors)
|
||||
(tuple? form)
|
||||
(let [items (map |(analyze-form $ bindings) form)]
|
||||
{:op :vector :items items})
|
||||
|
||||
# Structs (maps)
|
||||
(struct? form)
|
||||
{:op :map :form form}
|
||||
|
||||
# Fallback
|
||||
{:op :const :val form}))
|
||||
|
||||
# ============================================================
|
||||
# Emitter — AST node → Janet source string
|
||||
# ============================================================
|
||||
|
||||
(defn- emit-const
|
||||
"Emit a literal constant value."
|
||||
[val buf]
|
||||
(cond
|
||||
(nil? val) (buffer/push buf "nil")
|
||||
(= true val) (buffer/push buf "true")
|
||||
(= false val) (buffer/push buf "false")
|
||||
(string? val) (do (buffer/push buf "\"") (buffer/push buf val) (buffer/push buf "\""))
|
||||
(keyword? val) (do (buffer/push buf ":") (buffer/push buf (string val)))
|
||||
(buffer/push buf (string val))))
|
||||
|
||||
# Forward declaration for mutual recursion
|
||||
(var emit-ast nil)
|
||||
|
||||
(defn- emit-do
|
||||
[statements ret buf]
|
||||
(buffer/push buf "(do ")
|
||||
(var i 0)
|
||||
(let [n (length statements)]
|
||||
(while (< i n)
|
||||
(emit-ast (in statements i) buf)
|
||||
(buffer/push buf " ")
|
||||
(++ i)))
|
||||
(when ret
|
||||
(emit-ast ret buf))
|
||||
(buffer/push buf ")"))
|
||||
|
||||
(defn- emit-if
|
||||
[test then else buf]
|
||||
(buffer/push buf "(if ")
|
||||
(emit-ast test buf)
|
||||
(buffer/push buf " ")
|
||||
(emit-ast then buf)
|
||||
(when else
|
||||
(buffer/push buf " ")
|
||||
(emit-ast else buf))
|
||||
(buffer/push buf ")"))
|
||||
|
||||
(defn- emit-def
|
||||
[name-sym init buf]
|
||||
(buffer/push buf "(def ")
|
||||
(buffer/push buf (name-sym :name))
|
||||
(buffer/push buf " ")
|
||||
(emit-ast init buf)
|
||||
(buffer/push buf ")"))
|
||||
|
||||
(defn- emit-fn
|
||||
[params body buf]
|
||||
(buffer/push buf "(fn [")
|
||||
(var i 0)
|
||||
(let [n (length params)]
|
||||
(while (< i n)
|
||||
(let [p (in params i)]
|
||||
(buffer/push buf (if (struct? p) (p :name) (string p))))
|
||||
(when (< (+ i 1) n)
|
||||
(buffer/push buf " "))
|
||||
(++ i)))
|
||||
(buffer/push buf "] ")
|
||||
(emit-ast body buf)
|
||||
(buffer/push buf ")"))
|
||||
|
||||
(defn- emit-let
|
||||
[binding-pairs body buf]
|
||||
(buffer/push buf "(let [")
|
||||
(var i 0)
|
||||
(let [n (length binding-pairs)]
|
||||
(while (< i n)
|
||||
(let [bp (in binding-pairs i)]
|
||||
(buffer/push buf (bp :name))
|
||||
(buffer/push buf " ")
|
||||
(emit-ast (bp :init) buf)
|
||||
(when (< (+ i 1) n) (buffer/push buf " ")))
|
||||
(++ i)))
|
||||
(buffer/push buf "] ")
|
||||
(emit-ast body buf)
|
||||
(buffer/push buf ")"))
|
||||
|
||||
(defn- emit-invoke
|
||||
[f-ast args buf]
|
||||
(buffer/push buf "(")
|
||||
(emit-ast f-ast buf)
|
||||
(each arg args
|
||||
(buffer/push buf " ")
|
||||
(emit-ast arg buf))
|
||||
(buffer/push buf ")"))
|
||||
|
||||
(defn- emit-symbol
|
||||
[name buf]
|
||||
(buffer/push buf name))
|
||||
|
||||
(defn- emit-local
|
||||
[name buf]
|
||||
(buffer/push buf name))
|
||||
|
||||
(defn- emit-core-symbol
|
||||
[janet-name buf]
|
||||
(buffer/push buf janet-name))
|
||||
|
||||
(defn- emit-qualified-symbol
|
||||
[ns name buf]
|
||||
(buffer/push buf "(ns-get \"")
|
||||
(buffer/push buf ns)
|
||||
(buffer/push buf "\" \"")
|
||||
(buffer/push buf name)
|
||||
(buffer/push buf "\")"))
|
||||
|
||||
(defn- emit-vector
|
||||
[items buf]
|
||||
(buffer/push buf "[")
|
||||
(var i 0)
|
||||
(let [n (length items)]
|
||||
(while (< i n)
|
||||
(emit-ast (in items i) buf)
|
||||
(when (< (+ i 1) n) (buffer/push buf " "))
|
||||
(++ i)))
|
||||
(buffer/push buf "]"))
|
||||
|
||||
(defn- emit-map
|
||||
[form buf]
|
||||
(buffer/push buf (string form)))
|
||||
|
||||
(defn- emit-quote
|
||||
[expr buf]
|
||||
(buffer/push buf "'")
|
||||
(emit-ast (analyze-form expr @{}) buf))
|
||||
|
||||
(set emit-ast
|
||||
(fn [ast buf]
|
||||
(match (ast :op)
|
||||
:const (emit-const (ast :val) buf)
|
||||
:symbol (emit-symbol (ast :name) buf)
|
||||
:local (emit-local (ast :name) buf)
|
||||
:core-symbol (emit-core-symbol (ast :janet-name) buf)
|
||||
:qualified-symbol (emit-qualified-symbol (ast :ns) (ast :name) buf)
|
||||
:do (emit-do (ast :statements) (ast :ret) buf)
|
||||
:if (emit-if (ast :test) (ast :then) (ast :else) buf)
|
||||
:def (emit-def (ast :name) (ast :init) buf)
|
||||
:fn (emit-fn (ast :params) (ast :body) buf)
|
||||
:let (emit-let (ast :binding-pairs) (ast :body) buf)
|
||||
:invoke (emit-invoke (ast :fn) (ast :args) buf)
|
||||
:vector (emit-vector (ast :items) buf)
|
||||
:map (emit-map (ast :form) buf)
|
||||
:quote (emit-quote (ast :expr) buf)
|
||||
# Fallback for unknown ops
|
||||
(buffer/push buf (string "/* unhandled op: " (ast :op) " */")))))
|
||||
|
||||
(defn compile-form
|
||||
"Compile a Clojure form to a Janet source string."
|
||||
[form]
|
||||
(let [ast (analyze-form form @{})
|
||||
buf @""]
|
||||
(emit-ast ast buf)
|
||||
(string buf)))
|
||||
95
test/compiler-test.janet
Normal file
95
test/compiler-test.janet
Normal file
|
|
@ -0,0 +1,95 @@
|
|||
# Jolt Compiler Tests — Phase 2
|
||||
# Tests for source-to-source Clojure→Janet compilation.
|
||||
# Core ops: const, do, if, def, fn, let, invoke
|
||||
# Phase 2 adds: symbol classification with binding awareness
|
||||
|
||||
(use ../src/jolt/compiler)
|
||||
(use ../src/jolt/reader)
|
||||
|
||||
(defn compile-str [s]
|
||||
(let [form (parse-string s)]
|
||||
(compile-form form)))
|
||||
|
||||
# ============================================================
|
||||
# 1. Literals (const)
|
||||
# ============================================================
|
||||
(print "1: literal constants...")
|
||||
(assert (= "42" (compile-str "42")) "integer")
|
||||
(assert (= "nil" (compile-str "nil")) "nil")
|
||||
(assert (= "true" (compile-str "true")) "true")
|
||||
(assert (= "false" (compile-str "false")) "false")
|
||||
(assert (= "\"hello\"" (compile-str "\"hello\"")) "string")
|
||||
(assert (= ":foo" (compile-str ":foo")) "keyword")
|
||||
(print " passed")
|
||||
|
||||
# ============================================================
|
||||
# 2. do
|
||||
# ============================================================
|
||||
(print "2: do...")
|
||||
(assert (= "(do 1 2)" (compile-str "(do 1 2)")) "do two exprs")
|
||||
(assert (= "(do 42)" (compile-str "(do 42)")) "do single expr")
|
||||
(assert (= "(do (core-inc 1) (core-inc 2))" (compile-str "(do (inc 1) (inc 2))")) "do with fn calls")
|
||||
(print " passed")
|
||||
|
||||
# ============================================================
|
||||
# 3. if
|
||||
# ============================================================
|
||||
(print "3: if...")
|
||||
(assert (= "(if true 1 2)" (compile-str "(if true 1 2)")) "if three-arg")
|
||||
(assert (= "(if false 1 nil)" (compile-str "(if false 1)")) "if two-arg")
|
||||
(print " passed")
|
||||
|
||||
# ============================================================
|
||||
# 4. def
|
||||
# ============================================================
|
||||
(print "4: def...")
|
||||
(assert (= "(def x 42)" (compile-str "(def x 42)")) "def constant")
|
||||
(assert (= "(def f (fn [x] (core-inc x)))" (compile-str "(def f (fn* [x] (inc x)))")) "def with fn")
|
||||
(print " passed")
|
||||
|
||||
# ============================================================
|
||||
# 5. fn
|
||||
# ============================================================
|
||||
(print "5: fn...")
|
||||
(assert (= "(fn [x] (core-inc x))" (compile-str "(fn* [x] (inc x))")) "fn single arity")
|
||||
(assert (= "(fn [] 42)" (compile-str "(fn* [] 42)")) "fn no args")
|
||||
(assert (= "(fn [x] (do (core-print x) (core-inc x)))"
|
||||
(compile-str "(fn* [x] (print x) (inc x))")) "fn multi-expr body")
|
||||
(print " passed")
|
||||
|
||||
# ============================================================
|
||||
# 6. let
|
||||
# ============================================================
|
||||
(print "6: let...")
|
||||
(assert (= "(let [x 1] (core-inc x))" (compile-str "(let* [x 1] (inc x))")) "let single binding")
|
||||
(assert (= "(let [x 1 y 2] (core-+ x y))" (compile-str "(let* [x 1 y 2] (+ x y))")) "let two bindings")
|
||||
(assert (= "(let [x (core-inc 1)] (core-inc x))" (compile-str "(let* [x (inc 1)] (inc x))")) "let with fn in binding")
|
||||
(print " passed")
|
||||
|
||||
# ============================================================
|
||||
# 7. invoke (function calls)
|
||||
# ============================================================
|
||||
(print "7: invoke...")
|
||||
(assert (= "(core-inc 1)" (compile-str "(inc 1)")) "inc call")
|
||||
(assert (= "(core-+ 1 2)" (compile-str "(+ 1 2)")) "+ call")
|
||||
(assert (= "(core-+ (core-inc 1) 2)" (compile-str "(+ (inc 1) 2)")) "nested calls")
|
||||
(assert (= "(core-map core-inc (core-vec 1 2 3))"
|
||||
(compile-str "(map inc (vec 1 2 3))")) "multi-arg call")
|
||||
(print " passed")
|
||||
|
||||
# ============================================================
|
||||
# 8. Local symbol classification (Phase 2)
|
||||
# ============================================================
|
||||
(print "8: local classification...")
|
||||
# Shadowing: local inc should NOT be rewritten to core-inc
|
||||
(assert (= "(let [inc 5] (inc inc))"
|
||||
(compile-str "(let* [inc 5] (inc inc))")) "local shadows core fn")
|
||||
# fn params are locals, not core symbols
|
||||
(assert (= "(fn [map] (core-vec map))"
|
||||
(compile-str "(fn* [map] (vec map))")) "fn param shadows core map")
|
||||
# nested let with shadowing
|
||||
(assert (= "(let [x 1] (let [inc x] (inc x)))"
|
||||
(compile-str "(let* [x 1] (let* [inc x] (inc x)))")) "nested let local")
|
||||
(print " passed")
|
||||
|
||||
(print "\nAll compiler Phase 2 tests passed!")
|
||||
Loading…
Add table
Add a link
Reference in a new issue