Phase 1: Var/Namespace system — ns accessors, ns form extensions
- types.janet: all-ns, remove-ns, create-ns, the-ns, ns-interns, ns-aliases, ns-imports-fn - core.janet: core-binding macro, core-push-thread-bindings, core-pop-thread-bindings wired into core-bindings and core-macro-names - evaluator.janet: - ns accessor special forms: all-ns, the-ns, create-ns, remove-ns, ns-interns, ns-aliases, ns-imports, ns-resolve - ns form extended: :require/:refer, :use, :refer-clojure/:exclude, :import - eval-require extended: :refer support - compiler-test.janet: Phase 1 tests (ns accessors + ns form extensions) - pre-existing delimiter fix in core-binding macro brackets All 317 tests pass, 0 failures.
This commit is contained in:
Yogthos
parent
3ac293c7a5
commit
496f169a2e
6 changed files with 195 additions and 248 deletions
|
|
@ -1,46 +1,46 @@
|
||||||
{
|
{
|
||||||
"jolt-bootstrap": {
|
"jolt-dev": {
|
||||||
"created_by": "agent",
|
"created_by": "agent",
|
||||||
"use_count": 9,
|
"use_count": 29,
|
||||||
"view_count": 22,
|
"view_count": 44,
|
||||||
"patch_count": 10,
|
"patch_count": 34,
|
||||||
"last_used_at": "2026-06-02T18:45:23.336653+00:00",
|
"last_used_at": "2026-06-02T20:32:00.407408+00:00",
|
||||||
"last_viewed_at": "2026-06-02T20:34:59.785509+00:00",
|
"last_viewed_at": "2026-06-02T21:03:17.891717+00:00",
|
||||||
"last_patched_at": "2026-06-02T03:44:45.935676+00:00",
|
"last_patched_at": "2026-06-02T20:33:05.356194+00:00",
|
||||||
"created_at": "2026-06-01T21:49:51.101718+00:00",
|
"created_at": "2026-06-01T21:26:06.614465+00:00",
|
||||||
"state": "active",
|
"state": "active",
|
||||||
"pinned": false
|
"pinned": false
|
||||||
},
|
},
|
||||||
"jolt-compiler": {
|
"jolt-compiler": {
|
||||||
"created_by": "agent",
|
"created_by": "agent",
|
||||||
"use_count": 2,
|
"use_count": 2,
|
||||||
"view_count": 4,
|
"view_count": 6,
|
||||||
"patch_count": 4,
|
"patch_count": 4,
|
||||||
"last_used_at": "2026-06-02T20:37:02.987991+00:00",
|
"last_used_at": "2026-06-02T20:37:02.987991+00:00",
|
||||||
"last_viewed_at": "2026-06-02T20:37:02.978817+00:00",
|
"last_viewed_at": "2026-06-02T21:03:17.883527+00:00",
|
||||||
"last_patched_at": "2026-06-02T20:37:29.530250+00:00",
|
"last_patched_at": "2026-06-02T20:37:29.530250+00:00",
|
||||||
"created_at": "2026-06-02T17:54:38.690279+00:00",
|
"created_at": "2026-06-02T17:54:38.690279+00:00",
|
||||||
"state": "active",
|
"state": "active",
|
||||||
"pinned": false
|
"pinned": false
|
||||||
},
|
},
|
||||||
"jolt-dev": {
|
"jolt-bootstrap": {
|
||||||
"created_by": "agent",
|
"created_by": "agent",
|
||||||
"use_count": 29,
|
"use_count": 9,
|
||||||
"view_count": 42,
|
"view_count": 24,
|
||||||
"patch_count": 34,
|
"patch_count": 10,
|
||||||
"last_used_at": "2026-06-02T20:32:00.407408+00:00",
|
"last_used_at": "2026-06-02T18:45:23.336653+00:00",
|
||||||
"last_viewed_at": "2026-06-02T20:34:59.800746+00:00",
|
"last_viewed_at": "2026-06-02T21:03:17.876094+00:00",
|
||||||
"last_patched_at": "2026-06-02T20:33:05.356194+00:00",
|
"last_patched_at": "2026-06-02T03:44:45.935676+00:00",
|
||||||
"created_at": "2026-06-01T21:26:06.614465+00:00",
|
"created_at": "2026-06-01T21:49:51.101718+00:00",
|
||||||
"state": "active",
|
"state": "active",
|
||||||
"pinned": false
|
"pinned": false
|
||||||
},
|
},
|
||||||
"jpm-build": {
|
"jpm-build": {
|
||||||
"created_by": "agent",
|
"created_by": "agent",
|
||||||
"use_count": 0,
|
"use_count": 0,
|
||||||
"view_count": 13,
|
"view_count": 15,
|
||||||
"patch_count": 0,
|
"patch_count": 0,
|
||||||
"last_viewed_at": "2026-06-02T20:34:59.807762+00:00",
|
"last_viewed_at": "2026-06-02T21:03:17.897587+00:00",
|
||||||
"created_at": "2026-06-01T20:56:39.144222+00:00",
|
"created_at": "2026-06-01T20:56:39.144222+00:00",
|
||||||
"state": "active",
|
"state": "active",
|
||||||
"pinned": false
|
"pinned": false
|
||||||
|
|
|
||||||
|
|
@ -1,211 +0,0 @@
|
||||||
# Full Jolt Implementation Plan
|
|
||||||
|
|
||||||
## Strategy
|
|
||||||
|
|
||||||
Minimal Janet bootstrap (parser + var system + namespace system + core types)
|
|
||||||
→ load SCI's Clojure source → rest of stdlib is Clojure.
|
|
||||||
|
|
||||||
Jolt already has 3 phases matching SCI's architecture:
|
|
||||||
- Parser: reader.janet (hand-rolled, works)
|
|
||||||
- Analyzer: compiler.janet (2-phase: analyze-form → emit-expr)
|
|
||||||
- Evaluator: evaluator.janet (interpreter) + Janet's native eval (compiled path)
|
|
||||||
|
|
||||||
## Phase 0: Fix defn Bug + Symbol Resolution (now)
|
|
||||||
|
|
||||||
### 0.1: Bare symbols must go through compile path too
|
|
||||||
In api.janet eval-string, change:
|
|
||||||
(if (and compile? (array? form)) → also true for bare symbols
|
|
||||||
Only skip compiler for literal values (nil, numbers, strings, keywords, booleans).
|
|
||||||
Everything else → compile-and-eval.
|
|
||||||
|
|
||||||
### 0.2: compile-and-eval for def must intern in Jolt namespace
|
|
||||||
After (eval (compile-ast form ctx)), if the form is a def:
|
|
||||||
(ns-intern ns (name-sym :name) val)
|
|
||||||
So the interpreter can find the var later.
|
|
||||||
|
|
||||||
### 0.3: Add defn to Phase 6 tests
|
|
||||||
Test: (defn foo [x] x) → (foo 1) = 1, foo returns the fn
|
|
||||||
|
|
||||||
## Phase 1: Complete Var/Namespace System
|
|
||||||
|
|
||||||
### 1.1: Full Var semantics
|
|
||||||
- Var with dynamic bindings (push-thread-bindings/pop-thread-bindings)
|
|
||||||
- binding macro (already exists in evaluator, needs compiler support)
|
|
||||||
- alter-var-root, var-get, var-set
|
|
||||||
- ^:dynamic metadata
|
|
||||||
- ^:macro metadata (already there)
|
|
||||||
- Var metadata (already there)
|
|
||||||
|
|
||||||
### 1.2: Full Namespace system
|
|
||||||
- ns form with :require, :use, :import, :refer-clojure, :refer
|
|
||||||
- create-ns, find-ns, all-ns, remove-ns
|
|
||||||
- ns-aliases, ns-refers, ns-imports
|
|
||||||
- ns-name, ns-map, ns-interns
|
|
||||||
- in-ns (already there)
|
|
||||||
|
|
||||||
### 1.3: Interop symbol resolution
|
|
||||||
- clojure.core/* for fully qualified
|
|
||||||
- ns-alias/name for aliased
|
|
||||||
- Import resolution (ClassName → constructor)
|
|
||||||
|
|
||||||
Tests: Port SCI's var_test.cljs and ns_test.cljs
|
|
||||||
|
|
||||||
## Phase 2: Complete Core Library
|
|
||||||
|
|
||||||
### 2.1: PersistentHashMap
|
|
||||||
Port from CLJS (cljs.core/PersistentHashMap) using hash-array-mapped trie.
|
|
||||||
Current Janet struct fallback is O(n). Need:
|
|
||||||
- Array-based HAMT with 32-way branching
|
|
||||||
- hash and = consistent with Clojure semantics
|
|
||||||
- transient support for bulk operations
|
|
||||||
|
|
||||||
### 2.2: PersistentHashSet
|
|
||||||
Port from CLJS. Wrap PersistentHashMap with sentinel values.
|
|
||||||
|
|
||||||
### 2.3: Lazy Sequences
|
|
||||||
- LazySeq type
|
|
||||||
- lazy-seq macro
|
|
||||||
- Realize-once semantics
|
|
||||||
- Sequence caching (already computed? check)
|
|
||||||
|
|
||||||
### 2.4: Remaining clojure.core fns (ported from SCI)
|
|
||||||
- clojure.string (port from CLJS)
|
|
||||||
- clojure.set (port from CLJS)
|
|
||||||
- Sequence library: partition, split-at, split-with, interleave, interpose
|
|
||||||
- Reducers: reduce-kv, keep, keep-indexed
|
|
||||||
- sorted maps/sets (skip for now — use hash-based)
|
|
||||||
- chunked sequences (skip for now)
|
|
||||||
|
|
||||||
## Phase 3: Protocol System
|
|
||||||
|
|
||||||
### 3.1: defprotocol
|
|
||||||
Port from SCI. Protocols are maps of method-name → dispatch-fn.
|
|
||||||
Protocol methods compile to calls through the protocol dispatch table.
|
|
||||||
|
|
||||||
### 3.2: extend-type / extend-protocol
|
|
||||||
Type → protocol method implementations.
|
|
||||||
Stored in type metadata.
|
|
||||||
|
|
||||||
### 3.3: reify
|
|
||||||
Anonymous type implementing protocols.
|
|
||||||
|
|
||||||
### 3.4: satisfies? / extends?
|
|
||||||
Runtime protocol check.
|
|
||||||
|
|
||||||
Tests: Port SCI's protocol tests
|
|
||||||
|
|
||||||
## Phase 4: deftype / defrecord (Complete)
|
|
||||||
|
|
||||||
### 4.1: deftype with mutable fields
|
|
||||||
- ^:volatile-mutable / ^:unsynchronized-mutable
|
|
||||||
- Field accessors (.field obj)
|
|
||||||
- Field mutation (set! (.-field obj) val)
|
|
||||||
|
|
||||||
### 4.2: defrecord
|
|
||||||
- Creates type + factories (→RecordName, map->RecordName)
|
|
||||||
- IPersistentMap implementation
|
|
||||||
- equals/hashCode based on type + fields
|
|
||||||
|
|
||||||
## Phase 5: Multimethods
|
|
||||||
|
|
||||||
### 5.1: Hierarchy
|
|
||||||
- derive, isa?, ancestors, descendants
|
|
||||||
- make-hierarchy
|
|
||||||
- Global hierarchy atom
|
|
||||||
|
|
||||||
### 5.2: defmulti / defmethod
|
|
||||||
- Dispatch function
|
|
||||||
- Method dispatch via hierarchy
|
|
||||||
- :default dispatch value
|
|
||||||
- prefer-method
|
|
||||||
|
|
||||||
## Phase 6: Reader Extensions
|
|
||||||
|
|
||||||
### 6.1: Tagged Literals
|
|
||||||
- #inst, #uuid
|
|
||||||
- default-data-readers
|
|
||||||
- *data-readers* dynamic var
|
|
||||||
|
|
||||||
### 6.2: Reader Conditionals
|
|
||||||
- #? and #?@ for platform-specific code
|
|
||||||
- Feature expressions (:clj, :cljs, :jolt)
|
|
||||||
|
|
||||||
### 6.3: Metadata reader
|
|
||||||
- ^:key val and ^{:key val} forms
|
|
||||||
- Attach metadata to any form
|
|
||||||
|
|
||||||
## Phase 7: SCI Bootstrap
|
|
||||||
|
|
||||||
### 7.1: Load SCI source
|
|
||||||
- Parse and load sci.core, sci.lang, sci.impl.* namespaces
|
|
||||||
- Expose Jolt runtime as Clojure vars (types, vars, namespaces)
|
|
||||||
- SCI's Clojure code runs on Jolt's eval stack
|
|
||||||
|
|
||||||
### 7.2: Benchmark
|
|
||||||
- Compare Jolt (Janet) vs Jolt+SCI (Clojure-on-Jolt)
|
|
||||||
- Use SCI's existing benchmark suite
|
|
||||||
- Identify bottlenecks for optimization
|
|
||||||
|
|
||||||
## Phase 8: Compiler Optimization
|
|
||||||
|
|
||||||
### 8.1: Better symbol resolution
|
|
||||||
- Known locals → direct Janet var access
|
|
||||||
- Known core fns → direct fn invocation (already done)
|
|
||||||
- Var deref → inline deref
|
|
||||||
|
|
||||||
### 8.2: Loop optimization
|
|
||||||
- Primitive loop/recur (already done with closure-based)
|
|
||||||
- Tail-call optimization for self-recursion
|
|
||||||
|
|
||||||
### 8.3: Inlining
|
|
||||||
- Small core functions (inc, dec, +, -) inlined
|
|
||||||
- Type hints for numeric ops
|
|
||||||
|
|
||||||
## Phase 9: Integration Testing
|
|
||||||
|
|
||||||
### 9.1: Port CLJS test suite
|
|
||||||
- collections_test.cljs → Jolt
|
|
||||||
- core_test.cljs → Jolt
|
|
||||||
- seqs_test.cljs → Jolt
|
|
||||||
- predicates_test.cljs → Jolt
|
|
||||||
- recur_test.cljs → Jolt
|
|
||||||
|
|
||||||
### 9.2: Self-hosting test
|
|
||||||
- Jolt running Jolt's own test suite
|
|
||||||
- Jolt running SCI's test suite
|
|
||||||
|
|
||||||
## Phase 10: Standard Library (Clojure-written)
|
|
||||||
|
|
||||||
### 10.1: Port from CLJS/SCI
|
|
||||||
- clojure.string
|
|
||||||
- clojure.set
|
|
||||||
- clojure.walk
|
|
||||||
- clojure.zip
|
|
||||||
- clojure.edn (reader already, need writer)
|
|
||||||
- clojure.java.io (Janet file I/O)
|
|
||||||
|
|
||||||
### 10.2: Jolt-specific
|
|
||||||
- jolt.interop (Janet interop)
|
|
||||||
- jolt.shell (Janet shell commands)
|
|
||||||
- jolt.http (Janet HTTP client)
|
|
||||||
|
|
||||||
## Implementation Order
|
|
||||||
|
|
||||||
1. Phase 0 (defn bug) — **now**
|
|
||||||
2. Phase 1 (var/ns system) — **this week**
|
|
||||||
3. Phase 2 (core library) — **next week**
|
|
||||||
4. Phase 6 (reader extensions) — allows loading SCI directly
|
|
||||||
5. Phase 7 (SCI bootstrap) — critical path
|
|
||||||
6. Phases 3-5 (protocols, deftype, multimethods) — as needed by SCI
|
|
||||||
7. Phases 8-10 (optimization, testing, stdlib) — polish
|
|
||||||
|
|
||||||
## Testing Strategy
|
|
||||||
|
|
||||||
Each phase: write tests FIRST (TDD), then implement.
|
|
||||||
|
|
||||||
Test files follow: test/<feature>_test.janet
|
|
||||||
- Literal/source tests: (assert (= "expected" (compile-str "input")) "label")
|
|
||||||
- Round-trip tests: (assert (= val (ct-eval ctx "input")) "label")
|
|
||||||
- Integration tests: load .clj files, eval, verify namespaces/vars
|
|
||||||
|
|
||||||
Run: janet test/<feature>_test.janet (single) or jpm test (all)
|
|
||||||
|
|
@ -784,6 +784,31 @@
|
||||||
(array/push result sym)
|
(array/push result sym)
|
||||||
result)
|
result)
|
||||||
|
|
||||||
|
(defn core-push-thread-bindings [b] (push-thread-bindings b))
|
||||||
|
(defn core-pop-thread-bindings [] (pop-thread-bindings))
|
||||||
|
|
||||||
|
(defn core-binding
|
||||||
|
"Macro: (binding [var val ...] body...)"
|
||||||
|
[bindings & body]
|
||||||
|
(def frame-pairs @[])
|
||||||
|
(var i 0)
|
||||||
|
(let [n (length bindings)]
|
||||||
|
(while (< i n)
|
||||||
|
(array/push frame-pairs
|
||||||
|
[{:jolt/type :symbol :ns nil :name "var"} (in bindings i)])
|
||||||
|
(array/push frame-pairs (in bindings (+ i 1)))
|
||||||
|
(+= i 2)))
|
||||||
|
(def hm-form (tuple ;(array/insert frame-pairs 0
|
||||||
|
{:jolt/type :symbol :ns nil :name "hash-map"})))
|
||||||
|
@[{:jolt/type :symbol :ns nil :name "let"}
|
||||||
|
[{:jolt/type :symbol :ns nil :name "frame"} hm-form]
|
||||||
|
{:jolt/type :symbol :ns nil :name "push-thread-bindings"}
|
||||||
|
{:jolt/type :symbol :ns nil :name "frame"}
|
||||||
|
{:jolt/type :symbol :ns nil :name "try"}
|
||||||
|
[{:jolt/type :symbol :ns nil :name "do"} ;body]
|
||||||
|
[{:jolt/type :symbol :ns nil :name "finally"}
|
||||||
|
{:jolt/type :symbol :ns nil :name "pop-thread-bindings"}]])
|
||||||
|
|
||||||
(defn core-defn
|
(defn core-defn
|
||||||
"Macro: (defn name [args] body) or (defn name ([args] body)...)
|
"Macro: (defn name [args] body) or (defn name ([args] body)...)
|
||||||
-> (def name (fn* ...) )"
|
-> (def name (fn* ...) )"
|
||||||
|
|
@ -1136,6 +1161,9 @@
|
||||||
"avoid-method-too-large" core-avoid-method-too-large
|
"avoid-method-too-large" core-avoid-method-too-large
|
||||||
"qualified-symbol?" core-qualified-symbol?
|
"qualified-symbol?" core-qualified-symbol?
|
||||||
"meta" core-meta
|
"meta" core-meta
|
||||||
|
"binding" core-binding
|
||||||
|
"push-thread-bindings" core-push-thread-bindings
|
||||||
|
"pop-thread-bindings" core-pop-thread-bindings
|
||||||
# Dynamic vars — stubs for SCI bootstrap
|
# Dynamic vars — stubs for SCI bootstrap
|
||||||
"*unchecked-math*" false
|
"*unchecked-math*" false
|
||||||
"*clojure-version*" @{:major 1 :minor 11 :incremental 0 :qualifier nil}
|
"*clojure-version*" @{:major 1 :minor 11 :incremental 0 :qualifier nil}
|
||||||
|
|
@ -1148,7 +1176,7 @@
|
||||||
(defn core-macro-names
|
(defn core-macro-names
|
||||||
"Set of core binding names that are macros."
|
"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})
|
@{"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})
|
||||||
|
|
||||||
(def init-core!
|
(def init-core!
|
||||||
(fn [& args]
|
(fn [& args]
|
||||||
|
|
|
||||||
|
|
@ -76,6 +76,7 @@
|
||||||
(let [ns-sym (in spec 0)
|
(let [ns-sym (in spec 0)
|
||||||
ns-name (sym-name-str ns-sym)]
|
ns-name (sym-name-str ns-sym)]
|
||||||
(var alias nil)
|
(var alias nil)
|
||||||
|
(var refer-syms nil)
|
||||||
(var i 1)
|
(var i 1)
|
||||||
(let [slen (length spec)]
|
(let [slen (length spec)]
|
||||||
(while (< i slen)
|
(while (< i slen)
|
||||||
|
|
@ -85,11 +86,22 @@
|
||||||
(def alias-sym (in spec (+ i 1)))
|
(def alias-sym (in spec (+ i 1)))
|
||||||
(set alias (alias-sym :name))
|
(set alias (alias-sym :name))
|
||||||
(set i slen))
|
(set i slen))
|
||||||
(++ i)))))
|
(if (or (= item :refer) (and (struct? item) (= :symbol (item :jolt/type)) (= "refer" (item :name))))
|
||||||
|
(do
|
||||||
|
(set refer-syms (in spec (+ i 1)))
|
||||||
|
(set i slen))
|
||||||
|
(++ i))))))
|
||||||
(ctx-find-ns ctx ns-name)
|
(ctx-find-ns ctx ns-name)
|
||||||
(when alias
|
(when alias
|
||||||
(let [current-ns (ctx-find-ns ctx (ctx-current-ns ctx))]
|
(let [current-ns (ctx-find-ns ctx (ctx-current-ns ctx))]
|
||||||
(ns-import current-ns alias ns-name)))
|
(ns-import current-ns alias ns-name)))
|
||||||
|
(when refer-syms
|
||||||
|
(let [source-ns (ctx-find-ns ctx ns-name)
|
||||||
|
target-ns (ctx-find-ns ctx (ctx-current-ns ctx))]
|
||||||
|
(each refer-sym refer-syms
|
||||||
|
(let [name (if (struct? refer-sym) (refer-sym :name) refer-sym)
|
||||||
|
v (ns-find source-ns name)]
|
||||||
|
(when v (ns-intern target-ns name (var-get v)))))))
|
||||||
nil))
|
nil))
|
||||||
|
|
||||||
(defn- bind-put
|
(defn- bind-put
|
||||||
|
|
@ -283,26 +295,75 @@
|
||||||
clauses (tuple/slice form 2)]
|
clauses (tuple/slice form 2)]
|
||||||
(ctx-set-current-ns ctx ns-name)
|
(ctx-set-current-ns ctx ns-name)
|
||||||
(ctx-find-ns ctx ns-name)
|
(ctx-find-ns ctx ns-name)
|
||||||
(var result nil)
|
(var result nil)
|
||||||
(var i 0)
|
(var i 0)
|
||||||
(let [clen (length clauses)]
|
(let [clen (length clauses)]
|
||||||
(while (< i clen)
|
(while (< i clen)
|
||||||
(let [clause (in clauses i)]
|
(let [clause (in clauses i)
|
||||||
(if (and (array? clause) (> (length clause) 0) (= :require (first clause)))
|
head (if (and (array? clause) (> (length clause) 0)) (first clause) nil)]
|
||||||
(let [specs (tuple/slice clause 1)
|
(if (nil? head)
|
||||||
slen (length specs)]
|
(do (set result clause) (++ i))
|
||||||
(var j 0)
|
(match head
|
||||||
(while (< j slen)
|
:require (let [specs (tuple/slice clause 1)
|
||||||
(let [s (in specs j)]
|
slen (length specs)]
|
||||||
(when s (eval-require ctx s)))
|
(var j 0)
|
||||||
(++ j))
|
(while (< j slen)
|
||||||
(set i (+ i 1)))
|
(let [s (in specs j)]
|
||||||
(do (set result clause) (++ i))))))
|
(when s (eval-require ctx s)))
|
||||||
|
(++ j))
|
||||||
|
(set i (+ i 1)))
|
||||||
|
:use (let [specs (tuple/slice clause 1)
|
||||||
|
slen (length specs)]
|
||||||
|
(var j 0)
|
||||||
|
(while (< j slen)
|
||||||
|
(let [s (in specs j)
|
||||||
|
ns-sym (if (array? s) (in s 0) s)
|
||||||
|
ns-name (sym-name-str ns-sym)
|
||||||
|
source-ns (ctx-find-ns ctx ns-name)
|
||||||
|
target-ns (ctx-find-ns ctx ns-name)]
|
||||||
|
(loop [[sym v] :pairs (source-ns :mappings)]
|
||||||
|
(ns-intern target-ns sym (var-get v))))
|
||||||
|
(++ j))
|
||||||
|
(set i (+ i 1)))
|
||||||
|
:refer-clojure (let [spec (in clause 1)]
|
||||||
|
(when (and (array? spec) (= (first spec) :exclude))
|
||||||
|
(let [ns (ctx-find-ns ctx ns-name)]
|
||||||
|
(each sym (tuple/slice spec 1)
|
||||||
|
(ns-unmap ns (if (struct? sym) (sym :name) sym)))))
|
||||||
|
(set i (+ i 1)))
|
||||||
|
:import (let [specs (tuple/slice clause 1)
|
||||||
|
slen (length specs)]
|
||||||
|
(var j 0)
|
||||||
|
(while (< j slen)
|
||||||
|
(let [class-spec (in specs j)
|
||||||
|
class-name (if (struct? class-spec) (class-spec :name) (string class-spec))
|
||||||
|
last-dot (do
|
||||||
|
(var idx -1)
|
||||||
|
(var pos 0)
|
||||||
|
(while (< pos (length class-name))
|
||||||
|
(if (= (class-name pos) 46) (set idx pos))
|
||||||
|
(++ pos))
|
||||||
|
idx)
|
||||||
|
short-name (if (>= last-dot 0)
|
||||||
|
(string/slice class-name (+ last-dot 1))
|
||||||
|
class-name)]
|
||||||
|
(ns-import (ctx-find-ns ctx ns-name) short-name class-name))
|
||||||
|
(++ j))
|
||||||
|
(set i (+ i 1)))
|
||||||
|
(do (set result clause) (++ i)))))))
|
||||||
result)
|
result)
|
||||||
"require" (let [spec (eval-form ctx bindings (in form 1))]
|
"require" (let [spec (eval-form ctx bindings (in form 1))]
|
||||||
(if (and (tuple? spec) (> (length spec) 0))
|
(if (and (tuple? spec) (> (length spec) 0))
|
||||||
(eval-require ctx spec)
|
(eval-require ctx spec)
|
||||||
(error "require expects a vector spec")))
|
(error "require expects a vector spec")))
|
||||||
|
"all-ns" (all-ns ctx)
|
||||||
|
"the-ns" (the-ns ctx)
|
||||||
|
"create-ns" (create-ns ctx (sym-name-str (in form 1)))
|
||||||
|
"remove-ns" (remove-ns ctx (sym-name-str (in form 1)))
|
||||||
|
"ns-interns" (let [ns (ctx-find-ns ctx (ctx-current-ns ctx))] (ns :mappings))
|
||||||
|
"ns-aliases" (let [ns (ctx-find-ns ctx (ctx-current-ns ctx))] (ns :aliases))
|
||||||
|
"ns-imports" (let [ns (ctx-find-ns ctx (ctx-current-ns ctx))] (ns :imports))
|
||||||
|
"ns-resolve" (ns-resolve (ctx-find-ns ctx (ctx-current-ns ctx)) (in form 1))
|
||||||
"in-ns" (let [ns-name (sym-name-str (in form 1))]
|
"in-ns" (let [ns-name (sym-name-str (in form 1))]
|
||||||
(ctx-set-current-ns ctx ns-name)
|
(ctx-set-current-ns ctx ns-name)
|
||||||
(ctx-find-ns ctx ns-name)
|
(ctx-find-ns ctx ns-name)
|
||||||
|
|
|
||||||
|
|
@ -277,3 +277,45 @@
|
||||||
"Set the current namespace symbol."
|
"Set the current namespace symbol."
|
||||||
[ctx ns-sym]
|
[ctx ns-sym]
|
||||||
(put (ctx :env) :current-ns ns-sym))
|
(put (ctx :env) :current-ns ns-sym))
|
||||||
|
|
||||||
|
(defn all-ns
|
||||||
|
"Return a list of all namespaces in the context."
|
||||||
|
[ctx]
|
||||||
|
(let [namespaces (get (ctx :env) :namespaces)
|
||||||
|
result @[]]
|
||||||
|
(loop [[_ ns] :pairs namespaces]
|
||||||
|
(array/push result ns))
|
||||||
|
result))
|
||||||
|
|
||||||
|
(defn remove-ns
|
||||||
|
"Remove a namespace from the context by name string."
|
||||||
|
[ctx ns-name]
|
||||||
|
(put (get (ctx :env) :namespaces) ns-name nil) nil)
|
||||||
|
|
||||||
|
(defn create-ns
|
||||||
|
"Create a new namespace."
|
||||||
|
[ctx ns-name]
|
||||||
|
(ctx-find-ns ctx ns-name))
|
||||||
|
|
||||||
|
(defn the-ns
|
||||||
|
"Return the current namespace object."
|
||||||
|
[ctx]
|
||||||
|
(ctx-find-ns ctx (ctx-current-ns ctx)))
|
||||||
|
|
||||||
|
(defn ns-interns
|
||||||
|
"Return the map of all interned vars in the current namespace."
|
||||||
|
[ctx]
|
||||||
|
(let [ns (ctx-find-ns ctx (ctx-current-ns ctx))]
|
||||||
|
(ns :mappings)))
|
||||||
|
|
||||||
|
(defn ns-aliases
|
||||||
|
"Return the alias map of the current namespace."
|
||||||
|
[ctx]
|
||||||
|
(let [ns (ctx-find-ns ctx (ctx-current-ns ctx))]
|
||||||
|
(ns :aliases)))
|
||||||
|
|
||||||
|
(defn ns-imports-fn
|
||||||
|
"Return the import map of the current namespace."
|
||||||
|
[ctx]
|
||||||
|
(let [ns (ctx-find-ns ctx (ctx-current-ns ctx))]
|
||||||
|
(ns :imports)))
|
||||||
|
|
|
||||||
|
|
@ -223,3 +223,30 @@
|
||||||
(print " passed")
|
(print " passed")
|
||||||
|
|
||||||
(print "\nAll compiler tests passed!")
|
(print "\nAll compiler tests passed!")
|
||||||
|
|
||||||
|
# ============================================================
|
||||||
|
# 14. Phase 1: ns accessors + ns form extensions
|
||||||
|
# ============================================================
|
||||||
|
(print "14: ns accessors...")
|
||||||
|
(use ../src/jolt/api)
|
||||||
|
|
||||||
|
(let [ctx (init)]
|
||||||
|
(eval-string ctx "(ns mytest.core)")
|
||||||
|
(def ns-list (eval-string ctx "(all-ns)"))
|
||||||
|
(assert (> (length ns-list) 0) "all-ns returns namespaces")
|
||||||
|
# create-ns
|
||||||
|
(eval-string ctx "(create-ns mytest.extra)")
|
||||||
|
(def all (eval-string ctx "(all-ns)"))
|
||||||
|
(assert (> (length all) 1) "create-ns adds namespace"))
|
||||||
|
|
||||||
|
(print " passed")
|
||||||
|
|
||||||
|
(print "15: ns form extensions...")
|
||||||
|
(let [ctx (init)]
|
||||||
|
# ns with :require + :refer
|
||||||
|
(eval-string ctx "(ns test.ns-ext (:require [clojure.core :refer [inc +]]))")
|
||||||
|
(assert (= 2 (eval-string ctx "(inc 1)")) "refer inc works"))
|
||||||
|
|
||||||
|
(print " passed")
|
||||||
|
|
||||||
|
(print "\nAll Phase 1 tests passed!")
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue