diff --git a/.dirge/memory/MEMORY.md b/.dirge/memory/MEMORY.md index 03efb7b..10a960d 100644 --- a/.dirge/memory/MEMORY.md +++ b/.dirge/memory/MEMORY.md @@ -1,9 +1,18 @@ -Test files: test/phase6-final.janet (47 tests, 58 assertions — collections, math, predicates, comparison, seq ops, special forms, macros, complex nesting). Phase 1 tests appended to test/compiler-test.janet (ns accessors, ns form extensions). All 317 tests pass. +Jolt Compiler Architecture (Phases 1-6, dfa9874→1de109f): Two-phase — analyze-form (Clojure form → annotated AST) → emit-ast (→ Janet source string) or emit-expr (→ Janet data structures for eval). analyze-form takes [form bindings &opt ctx]; ctx needed for macro expansion. Symbol classification: bindings first (:local), then core-renames (:core-symbol), then plain (:symbol). Two emitter paths: string (compile-form) and data structures (compile-ast). Core fn values resolved via core-fn-values table. compile-and-eval takes [form ctx]; pass nil for no macro ctx. + +Key naming/facts: +- Clojure - → core-sub (NOT core--) +- core-nth did not exist — had to add both the function and core-bindings entry +- Missing from core-renames early: fn?, list, name, subs +- Bare tuples in Janet eval → treated as function calls. Always emit (tuple ...) or ['tuple ...] +- make-symbol: / at position 0 means unqualified symbol (was parsing empty ns) +- raw-form->janet converter for quote: don't re-analyze quoted forms, pass through verbatim +- emit-try-expr: Janet format is (try body ([err] handler)) not (try body (catch sym handler)) +- Loop compilation: (do (var _loop_N nil) (set _loop_N (fn [params] body)) (_loop_N init-vals...)) +- Recur compilation: rewrites to (loop-name arg1 arg2...) via :loop-name in AST + +eval-string dispatch: When :compile? true, stateful forms (defmacro, ns, deftype, defmulti, defmethod, require, in-ns) use interpreter. All others (def, macros like defn) go through compile-and-eval. Macros expanded at analyze time via resolve-macro. + +Remaining: syntax-quote, set! compiler support. deftype/defmulti/defmethod routed to interpreter. § -Phase 3 (Var system): find-var (ctx-based, resolve-q/nq symbol), alter-meta!, reset-meta!, var-get/var-set/var?/alter-var-root all in types.janet + evaluator dispatch arms + core-bindings wrappers. core-meta fixed: (var? x) branch → var-meta, struct? branch → :meta. 10 tests pass. -§ -Phase 4 (deftype/defrecord): deftype instances are tables with :jolt/deftype key (e.g. "user.Point"). Field access via (. obj field), mutation via (set! (.-field obj) val) — reader parses .-field as (. -field obj) in array form. core-map? recognizes table+deftype. core-count skips :jolt/deftype key. core-defrecord emits (deftype ...) + ->TypeName arrow factory + map->TypeName factory (deferred). 11 tests pass including record equality. 317 total, 0 fail. -§ -Key implementation facts: find-var MUST be placed after ctx-find-ns in types.janet (forward-reference). intern dispatch arm needs eval-form on args. core-meta: check (var? x) before (struct? x) — var-meta returns metadata for vars. core-binding uses array-map (plain struct) not hash-map/PHM — PHM's phm-get incompatible with var-get in push-thread-bindings. -§ -Phase 5 (Multimethods + hierarchy): Not yet started. defmulti/defmethod exist in evaluator.janet (lines 611-656) but are routed to interpreter in compile mode. core-derive, core-isa?, core-ancestors, core-descendants are stubs in core.janet. +Janet gotchas: (1) `parse` returns `[form, consumed-count]`, NOT `[form, error?]` — use parser/new→consume→eof→produce pipeline. (2) `:#inst` is invalid keyword literal — use `(keyword "#inst")` dynamically. (3) Janet `case` works for multi-arity simulation when `defn ([] body) ([x] body)` fails. (4) Bare tuples in eval are function calls — always use `['tuple ...]`. (5) Core `-` maps to `core-sub` NOT `core--`. diff --git a/.dirge/skills/.usage.json b/.dirge/skills/.usage.json index 555fa0a..d291046 100644 --- a/.dirge/skills/.usage.json +++ b/.dirge/skills/.usage.json @@ -1,38 +1,16 @@ { - "jolt-compiler": { - "created_by": "agent", - "use_count": 6, - "view_count": 10, - "patch_count": 8, - "last_used_at": "2026-06-03T01:15:04.055288+00:00", - "last_viewed_at": "2026-06-03T01:15:04.048271+00:00", - "last_patched_at": "2026-06-03T01:15:38.021717+00:00", - "created_at": "2026-06-02T17:54:38.690279+00:00", - "state": "active", - "pinned": false - }, "jolt-dev": { "created_by": "agent", - "use_count": 33, - "view_count": 48, + "use_count": 34, + "view_count": 49, "patch_count": 41, - "last_used_at": "2026-06-03T01:13:54.913664+00:00", - "last_viewed_at": "2026-06-03T01:13:54.902684+00:00", + "last_used_at": "2026-06-03T03:03:32.578112+00:00", + "last_viewed_at": "2026-06-03T03:03:32.570889+00:00", "last_patched_at": "2026-06-03T01:14:59.915995+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": 15, - "patch_count": 0, - "last_viewed_at": "2026-06-02T21:03:17.897587+00:00", - "created_at": "2026-06-01T20:56:39.144222+00:00", - "state": "active", - "pinned": false - }, "jolt-bootstrap": { "created_by": "agent", "use_count": 9, @@ -44,5 +22,27 @@ "created_at": "2026-06-01T21:49:51.101718+00:00", "state": "active", "pinned": false + }, + "jolt-compiler": { + "created_by": "agent", + "use_count": 7, + "view_count": 11, + "patch_count": 9, + "last_used_at": "2026-06-03T03:02:46.825298+00:00", + "last_viewed_at": "2026-06-03T03:02:46.818525+00:00", + "last_patched_at": "2026-06-03T03:03:27.524946+00:00", + "created_at": "2026-06-02T17:54:38.690279+00:00", + "state": "active", + "pinned": false + }, + "jpm-build": { + "created_by": "agent", + "use_count": 0, + "view_count": 15, + "patch_count": 0, + "last_viewed_at": "2026-06-02T21:03:17.897587+00:00", + "created_at": "2026-06-01T20:56:39.144222+00:00", + "state": "active", + "pinned": false } } \ No newline at end of file diff --git a/.dirge/skills/jolt-compiler/SKILL.md b/.dirge/skills/jolt-compiler/SKILL.md index ad41725..4463384 100644 --- a/.dirge/skills/jolt-compiler/SKILL.md +++ b/.dirge/skills/jolt-compiler/SKILL.md @@ -1,7 +1,6 @@ # jolt-compiler -# Jolt Compiler -Source-to-source Clojure→Janet compiler. Two-phase: analyze-form (classify + macro expand) → emit-ast (generate). +Jolt Compiler — Clojure→Janet source compiler with data-structure emission path. ## Architecture @@ -29,17 +28,6 @@ emit-core-symbol-expr → (get core-fn-values janet-name) Source-to-source (`compile-form` + `emit-ast`) still exists for debugging but is NOT used by `compile-and-eval`. -## Macro expansion - -`analyze-form` checks whether the head symbol of a list resolves to a macro var before dispatching to special form handling: - -1. Look up symbol in current ns → core ns via `resolve-macro` -2. If `var-macro?` is true, call `(var-get macro-var)` to get the fn -3. `(apply macro-fn (tuple/slice form 1))` to expand -4. `(analyze-form expanded ...)` to re-analyze the result - -Macros expand at analyze time, before emission. `defn` expands to `(def name (fn* ...))`, `when` to `(if test (do ...) nil)`, etc. - ## Symbol classification (in analyze-form) Order: qualified ns → local binding → core-symbol → bare symbol @@ -51,18 +39,19 @@ Order: qualified ns → local binding → core-symbol → bare symbol → :symbol) ``` -core-renames MUST match actual fn names: `"-"` → `"core-sub"` (not `"core--"`), `"not"` → `"core-not"`. Verify against `core.janet` bindings. +## core-renames vs core-fn-values -## core-fn-values +core-renames maps Clojure name strings → Janet function name strings (used by both emitter paths). +core-fn-values maps Janet function name strings → actual function values (used by data-structure emitter only). -Maps Janet string names to actual function values. Must be kept in sync with core-renames. When adding a new core fn, update BOTH tables. +MUST keep both in sync. When adding a new core fn, update BOTH. +**Missing entries → symbol treated as unknown global, returns nil.** -Functions that need special mapping (name differs): +Key name mappings: +- `"-"` → `"core-sub"` (NOT `"core--"`) - `"apply"` → `apply` (Janet built-in) -- `"-"` → `"core-sub"` (not `core--`) - `"some"` → `core-some?` (shared with `core-some?`) - `"pr-str"` → `core-str` (alias) -- `"nth"` → `core-nth` (separate function, added in Phase 6) - `"list"` → `core-list`, `"name"` → `core-name`, `"subs"` → `core-subs` ## Loop/recur compilation @@ -76,62 +65,53 @@ Functions that need special mapping (name differs): `recur` saves `:loop-name` in the AST (looked up from bindings `:jolt/current-loop`), then `emit-recur-expr` rewrites to `(loop-name arg1 arg2...)`. -In the string emitter, recur similarly emits `(loop-name arg ...)`. - ## Throw/try compilation - `throw` → `(error val)` in Janet -- `try/catch` → `(try body ([err] handler-body))` — NOTE: Janet uses `([sym] handler)` format, NOT `(catch sym handler)` -- `try/finally` → appends do-block after catch clause in the Janet tuple +- `try/catch` → `(try body ([err] handler-body))` — Janet uses `([sym] handler)` format + +## emi-vector-expr critical fix + +**Bare tuples in Janet eval are function calls**: `[1 2 3]` tries to call `1` as a function. Always emit `['tuple ...]` or `(tuple ...)`. ## Quote in data-structure emitter -Don't re-analyze quoted forms. Use `raw-form->janet` to pass Jolt reader forms through verbatim to Janet's `quote`: +Use `raw-form->janet` to pass Jolt reader forms through verbatim to Janet's `quote`: ``` (emit-quote-expr expr) → ['quote (raw-form->janet expr)] ``` -raw-form->janet converts symbols to Janet symbols, arrays/tuples recursively. +raw-form->janet converts Jolt symbols to Janet symbols, recursively for arrays/tuples. -## Remaining ops (interpreter only) +## make-symbol fix (reader.janet) -`syntax-quote`, `set!`, `deftype`, `defmulti`, `defmethod` — these are stateful or complex and always use the interpreter path even in compile mode. +`/` at position 0 means unqualified symbol. Use `(if (and slash (> slash 0)) ...)` — only split on `/` when it's not at the start. -## deftype in interpreter (eval-list arm) +## :data-readers key construction -deftype creates a constructor function returning a Janet table with `:jolt/deftype` key (`"ns.TypeName"`). Evaluator `set!` handles `(.-field obj)` field mutation (reader creates `(. -field obj)` array form). `instance?` checks `:jolt/deftype` tag. defrecord macro in core.janet emits `(do (deftype Name [fields]) (def ->Name ...) (def map->Name ...))`. - -## Stateful forms (must use interpreter, NOT compiler) - -These forms modify context state and cannot be compiled: -- `defmacro`, `ns`, `deftype`, `defmulti`, `defmethod`, `require`, `in-ns` -- `syntax-quote`, `set!`, `var`, `.`, `new` - -Note: `def` IS handled by the compiler (compiles to Janet `def`, since macros are expanded at analyze time). +`:data-readers` uses dynamic table construction because `:#inst` is invalid Janet keyword literal syntax (`:#` triggers reader macro): +```janet +:data-readers (let [dr @{}] + (put dr (keyword "#inst") (fn [s] s)) + (put dr (keyword "#uuid") (fn [s] s)) + dr) +``` ## eval-string dispatch (compile mode) ```janet (if (or (= head-name "defmacro") (= head-name "ns") (= head-name "deftype") (= head-name "defmulti") (= head-name "defmethod") - (= head-name "require") (= head-name "in-ns") - (= head-name "syntax-quote") (= head-name "set!") - (= head-name "var") (= head-name ".") (= head-name "new")) + (= head-name "require") (= head-name "in-ns")) (eval-form ctx @{} form) ; interpret (compile-and-eval form ctx)) ; compile ``` -## Adding a new op - -1. Add `analyze-form` match arm for the special form -2. Add `emit-ast` match arm (source string path) -3. Add `emit-expr` match arm (data structure path) -4. Add `core-renames` entry if it's a core fn (name → Janet string name) -5. Add `core-fn-values` entry (Janet string name → actual fn value) -6. Add tests in `test/compiler-test.janet` - ## Test files -- `test/compiler-test.janet` — Phase 2-5 tests (source output + compile-eval + macro tests) +- `test/compiler-test.janet` — Phases 0-4 tests (source output + compile-eval + macro tests) - `test/phase6-final.janet` — Phase 6 comprehensive compile-mode tests (47 assertions) +- `test/phase5-test.janet` — Phase 5 multimethod + hierarchy tests +- `test/phase6-test.janet` — Phase 6 reader extension tests +- `test/hash-map-test.janet` — Phase 2 PersistentHashMap tests -Run: `janet test/compiler-test.janet` or `janet test/phase6-final.janet` or `jpm test` \ No newline at end of file +Run: `janet test/.janet` or `jpm test` \ No newline at end of file diff --git a/src/jolt/core.janet b/src/jolt/core.janet index 8300be7..9f44e18 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -33,9 +33,10 @@ (defn core-empty? [coll] (if (nil? coll) true - (if (phm? coll) (= 0 (coll :cnt)) - (if (struct? coll) (= 0 (length (keys coll))) - (= 0 (length coll)))))) + (if (set? coll) (= 0 (coll :cnt)) + (if (phm? coll) (= 0 (coll :cnt)) + (if (struct? coll) (= 0 (length (keys coll))) + (= 0 (length coll))))))) (defn core-every? [pred coll] (var result true) @@ -103,10 +104,8 @@ (defn core-conj [coll & xs] (if (tuple? coll) - # vector: add to end (tuple/slice (tuple ;(array/concat (array/slice coll) xs))) (if (array? coll) - # list: add to front (reverse xs, push each) (do (var result coll) (var i 0) @@ -114,15 +113,25 @@ (set result (array/insert result 0 (xs i))) (++ i)) result) - # struct/map: add [k v] pairs - (do - (var result coll) - (var i 0) - (while (< i (length xs)) - (let [pair (xs i)] - (set result (merge result {(pair 0) (pair 1)}))) - (++ i)) - result)))) + (if (set? coll) + (apply phs-conj coll xs) + (if (phm? coll) + (do + (var result coll) + (var i 0) + (while (< i (length xs)) + (let [pair (xs i)] + (set result (phm-assoc result (pair 0) (pair 1)))) + (++ i)) + result) + (do + (var result coll) + (var i 0) + (while (< i (length xs)) + (let [pair (xs i)] + (set result (merge result {(pair 0) (pair 1)}))) + (++ i)) + result)))))) (defn core-assoc [m & kvs] (if (phm? m) @@ -140,13 +149,14 @@ (defn core-get [m k &opt default] (default default nil) (if (nil? m) default - (if (phm? m) (phm-get m k default) - (if (or (struct? m) (table? m)) - (let [v (m k)] - (if (nil? v) default v)) - (if (and (or (tuple? m) (array? m)) (number? k) (>= k 0) (< k (length m))) - (in m k) - default))))) + (if (set? m) (phs-get m k default) + (if (phm? m) (phm-get m k default) + (if (or (struct? m) (table? m)) + (let [v (m k)] + (if (nil? v) default v)) + (if (and (or (tuple? m) (array? m)) (number? k) (>= k 0) (< k (length m))) + (in m k) + default)))))) (defn core-get-in [m ks &opt default] (default default nil) @@ -159,28 +169,33 @@ (if (nil? current) default current)) (defn core-contains? [coll key] - (if (phm? coll) (let [b (get (coll :buckets) (phm-hash-key key))] (if b (phm-bucket-contains? b key) false)) - (if (struct? coll) (not (nil? (coll key))) - (if (table? coll) (not (nil? (coll key))) - (if (or (tuple? coll) (array? coll)) - (and (number? key) (>= key 0) (< key (length coll))) - false))))) + (if (set? coll) (phs-contains? coll key) + (if (phm? coll) (let [b (get (coll :buckets) (phm-hash-key key))] (if b (phm-bucket-contains? b key) false)) + (if (struct? coll) (not (nil? (coll key))) + (if (table? coll) (not (nil? (coll key))) + (if (or (tuple? coll) (array? coll)) + (and (number? key) (>= key 0) (< key (length coll))) + false)))))) (defn core-count [coll] - (if (phm? coll) (coll :cnt) - (if (and (table? coll) (get coll :jolt/deftype)) (- (length (keys coll)) 1) - (length coll)))) + (if (lazy-seq? coll) (ls-count coll) + (if (set? coll) (coll :cnt) + (if (phm? coll) (coll :cnt) + (if (and (table? coll) (get coll :jolt/deftype)) (- (length (keys coll)) 1) + (length coll)))))) (defn core-first [coll] - (if (or (nil? coll) (= 0 (length coll))) nil - (in coll 0))) + (if (lazy-seq? coll) (ls-first coll) + (if (or (nil? coll) (= 0 (length coll))) nil + (in coll 0)))) (defn core-rest [coll] - (if (or (nil? coll) (= 0 (length coll))) - @[] - (if (tuple? coll) - (tuple/slice coll 1) - (array/slice coll 1)))) + (if (lazy-seq? coll) (ls-rest coll) + (if (or (nil? coll) (= 0 (length coll))) + @[] + (if (tuple? coll) + (tuple/slice coll 1) + (array/slice coll 1))))) (defn core-next [coll] (let [r (core-rest coll)] @@ -196,11 +211,13 @@ (defn core-seq [coll] (if (or (nil? coll) (and (or (tuple? coll) (array? coll)) (= 0 (length coll)))) nil - (if (phm? coll) (tuple ;(phm-entries coll)) - (if (tuple? coll) (tuple/slice coll) - (if (string? coll) (map |(string/from-bytes $) (string/bytes coll)) - (if (struct? coll) (tuple ;(keys coll)) - coll)))))) + (if (lazy-seq? coll) (ls-seq coll) + (if (set? coll) (phs-seq coll) + (if (phm? coll) (tuple ;(phm-entries coll)) + (if (tuple? coll) (tuple/slice coll) + (if (string? coll) (map |(string/from-bytes $) (string/bytes coll)) + (if (struct? coll) (tuple ;(keys coll)) + coll)))))))) (defn core-vec [coll] (if (tuple? coll) coll @@ -445,6 +462,19 @@ (++ i)) result)) +(defn core-iterate [f x] + "Macro: (iterate f x) → lazy infinite sequence x, (f x), (f (f x)), ..." + (def sym-x (gensym "x")) + (def sym-f (gensym "f")) + @[{:jolt/type :symbol :ns nil :name "lazy-seq"} + @[{:jolt/type :symbol :ns nil :name "let*"} + @[sym-x x sym-f f] + @[{:jolt/type :symbol :ns nil :name "cons"} + sym-x + @[{:jolt/type :symbol :ns nil :name "iterate"} + sym-f + @[{:jolt/type :symbol :ns nil :name sym-f} sym-x]]]]]) + (defn core-repeatedly [n f] (var result @[]) (var i 0) @@ -522,9 +552,15 @@ (table/to-struct result)) (defn core-hash-set [& xs] - (var result @{}) - (each x xs (put result x true)) - {:jolt/type :jolt/set :value (tuple ;(keys result))}) + (apply make-phs xs)) + +(defn core-set? [x] (set? x)) +(defn core-disj [s & ks] + (if (set? s) (apply phs-disj s ks) (error "disj expects a set"))) + +(defn core-lazy-seq [& body] + @[{:jolt/type :symbol :ns nil :name "make-lazy-seq"} + @[{:jolt/type :symbol :ns nil :name "fn*"} [] ;body]]) (defn core-set [coll] (apply core-hash-set (if (tuple? coll) (array/slice coll) coll))) @@ -1104,6 +1140,7 @@ "partition-by" core-partition-by "range" core-range "repeat" core-repeat + "iterate" core-iterate "repeatedly" core-repeatedly "identity" core-identity "constantly" core-constantly @@ -1118,6 +1155,10 @@ "hash-set" core-hash-set "set" core-set "list" core-list + "set?" core-set? + "disj" core-disj + "lazy-seq" core-lazy-seq + "make-lazy-seq" make-lazy-seq "str" core-str "name" core-name "subs" core-subs @@ -1229,7 +1270,7 @@ (defn core-macro-names "Set of core binding names that are macros." [] - @{"and" true "or" true "when" true "when-not" true "if-let" true "when-let" true "if-some" true "when-some" true "doto" true "defn" true "defn-" true "declare" true "fn" true "let" true "loop" true "defrecord" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "proxy" true "definterface" true "comment" true "binding" true}) + @{"and" true "or" true "when" true "when-not" true "if-let" true "when-let" true "if-some" true "when-some" true "doto" true "defn" true "defn-" true "declare" true "fn" true "let" true "loop" true "defrecord" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "proxy" true "definterface" true "comment" true "binding" true "lazy-seq" true}) (def init-core! (fn [& args] diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index f019e3a..1a66a01 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -2,6 +2,7 @@ # Direct interpreter for Clojure forms on Janet. (use ./types) +(use ./phm) (defn- sym-name? [sym-s name-str] @@ -18,7 +19,8 @@ (= name "deftype") (= name "new") (= name ".") (= name "var-get") (= name "var-set") (= name "var?") (= name "alter-var-root") (= name "find-var") (= name "intern") - (= name "alter-meta!") (= name "reset-meta!"))) + (= name "alter-meta!") (= name "reset-meta!") + (= name "disj") (= name "set?"))) (var eval-form nil) @@ -602,6 +604,12 @@ val (eval-form ctx bindings (in form 3)) ns (ctx-find-ns ctx (if (struct? ns-name) (ns-name :name) ns-name))] (ns-intern ns (if (struct? sym-name) (sym-name :name) sym-name) val)) + "disj" (let [s (eval-form ctx bindings (in form 1)) + ks (map |(eval-form ctx bindings $) (tuple/slice form 2))] + (if (set? s) + (apply phs-disj s ks) + (error "disj expects a set"))) + "set?" (set? (eval-form ctx bindings (in form 1))) "locking" (eval-form ctx bindings (in form 2)) "instance?" (let [type-sym (in form 1) val (eval-form ctx bindings (in form 2))] @@ -785,6 +793,8 @@ (struct? form) (if (= :symbol (form :jolt/type)) (resolve-sym ctx bindings form) + (if (= :jolt/set (form :jolt/type)) + (apply make-phs (form :value)) (if (= :jolt/tagged (form :jolt/type)) (let [tag (form :tag) data-readers (get (ctx :env) :data-readers) @@ -794,7 +804,7 @@ (error (string "No reader function for tag " tag)))) (if (get form :jolt/type) (error (string "Unexpected tagged form: " (form :jolt/type))) - form))) + form)))) (array? form) (if (= 0 (length form)) @[] diff --git a/src/jolt/phm.janet b/src/jolt/phm.janet index 77e7613..ee8fca0 100644 --- a/src/jolt/phm.janet +++ b/src/jolt/phm.janet @@ -98,6 +98,12 @@ (++ bi)) (table/to-struct result)) +(defn phm-count [m] (m :cnt)) + +(defn phm-contains? [m k] + (let [bucket (get (m :buckets) (phm-hash-key k))] + (if bucket (phm-bucket-contains? bucket k) false))) + (defn make-phm [&opt kvs] (default kvs nil) (var m @{:jolt/deftype "jolt.lang.persistent-hash-map.PersistentHashMap" @@ -106,3 +112,85 @@ (var i 0) (var n (length kvs)) (while (< i n) (set m (phm-assoc m (kvs i) (kvs (+ i 1)))) (+= i 2))) m) + +# ============================================================ +# LazySeq — realize-once lazy sequence +# ============================================================ + +(defn lazy-seq? + "Check if x is a LazySeq." + [x] + (and (table? x) (= :jolt/lazy-seq (x :jolt/type)))) + +(defn- realize-ls + "Force a LazySeq. Returns the realized value, caching it." + [ls] + (if (get ls :realized) + (ls :val) + (let [v ((ls :fn)) + vf (if (lazy-seq? v) (realize-ls v) v)] + (put ls :realized true) + (put ls :val vf) + vf))) + +(defn ls-first [ls] + (let [val (realize-ls ls)] + (if (nil? val) nil + (if (and (indexed? val) (> (length val) 0)) (in val 0) nil)))) + +(defn ls-rest [ls] + (let [val (realize-ls ls)] + (if (nil? val) nil + (if (indexed? val) (if (tuple? val) (tuple/slice val 1) (array/slice val 1)) nil)))) + +(defn ls-seq [ls] + (let [val (realize-ls ls)] + (when val (if (tuple? val) (tuple/slice val) (if (array? val) (array/slice val) val))))) + +(defn ls-count [ls] + (let [val (realize-ls ls)] + (if (nil? val) 0 (length val)))) + +(defn make-lazy-seq [thunk] + @{:jolt/type :jolt/lazy-seq :fn thunk :realized false :val nil}) + +# ============================================================ +# PersistentHashSet — backed by PersistentHashMap +# ============================================================ + +(defn set? + "Check if x is a PersistentHashSet." + [x] + (and (table? x) (= :jolt/set (x :jolt/type)))) + +(defn make-phs [& xs] + "Create a PersistentHashSet from items." + (var m (make-phm)) + (each x xs (set m (phm-assoc m x true))) + @{:jolt/type :jolt/set :phm m :cnt (phm-count m)}) + +(defn phs-conj [s & xs] + (var m (s :phm)) + (each x xs (set m (phm-assoc m x true))) + @{:jolt/type :jolt/set :phm m :cnt (phm-count m)}) + +(defn phs-disj [s & xs] + (var m (s :phm)) + (each x xs (set m (phm-dissoc m x))) + @{:jolt/type :jolt/set :phm m :cnt (phm-count m)}) + +(defn phs-contains? [s x] + (phm-contains? (s :phm) x)) + +(defn phs-count [s] + (s :cnt)) + +(defn phs-empty? [s] + (= 0 (s :cnt))) + +(defn phs-seq [s] + (tuple ;(keys (phm-to-struct (s :phm))))) + +(defn phs-get [s x &opt default] + (default default nil) + (if (phm-contains? (s :phm) x) x default)) diff --git a/test/phase7-test.janet b/test/phase7-test.janet new file mode 100644 index 0000000..d715674 --- /dev/null +++ b/test/phase7-test.janet @@ -0,0 +1,25 @@ +# Phase 7: LazySeq + PersistentHashSet completion +(use ../src/jolt/api) +(defn ct-eval [ctx s] (eval-string ctx s)) + +(print "32: lazy-seq...") +(let [ctx (init)] + (let [ls (ct-eval ctx "(lazy-seq (cons 1 (lazy-seq (cons 2 nil))))")] + (assert (not (nil? ls)) "lazy-seq returns non-nil") + (assert (= 1 (ct-eval ctx "(first (lazy-seq (cons 1 nil)))")) "first of lazy")) + (assert (= [1 2 3] (ct-eval ctx "(seq (lazy-seq [1 2 3]))")) "seq forces lazy") + (eval-string ctx "(def counter (atom 0))") + (def val (ct-eval ctx "(let [ls (lazy-seq (do (swap! counter inc) [1 2 3]))] (seq ls) (seq ls) @counter)")) + (assert (= 1 val) "realized once")) +(print " passed") + +(print "33: PersistentHashSet...") +(let [ctx (init)] + (assert (= true (ct-eval ctx "(set? #{1 2 3})")) "set? true") + (assert (= false (ct-eval ctx "(set? [1 2 3])")) "set? false") + (assert (= 4 (ct-eval ctx "(count (conj #{1 2 3} 4))")) "conj add") + (assert (= 2 (ct-eval ctx "(count (disj #{1 2 3} 3))")) "disj") + (assert (= 3 (ct-eval ctx "(count #{1 2 3})")) "count")) +(print " passed") + +(print "\nAll Phase 7 tests passed!")