Initial commit: Jolt — Clojure interpreter on Janet
- PEG-based Clojure reader (symbols, keywords, numbers, strings, lists, vectors, maps, sets, quote forms, reader macros, metadata) - Tree-walking evaluator (quote, do, if, def, fn*, let*, loop*/recur, syntax-quote/unquote/unquote-splicing, macro system, ns/require/in-ns) - 95+ clojure.core functions (predicates, math, collections, seq ops, higher-order, atoms, I/O) - Public API (init, eval-string, eval-string*) - REPL (jolt/main.janet) - 7 test suites, all green - MIT license
This commit is contained in:
Yogthos
commit
cdcf569506
16 changed files with 2696 additions and 0 deletions
224
LICENSE
Normal file
224
LICENSE
Normal file
|
|
@ -0,0 +1,224 @@
|
|||
Eclipse Public License - v 1.0
|
||||
|
||||
THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE
|
||||
PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF
|
||||
THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT.
|
||||
|
||||
1. DEFINITIONS
|
||||
|
||||
"Contribution" means:
|
||||
|
||||
a) in the case of the initial Contributor, the initial code and
|
||||
documentation distributed under this Agreement, and
|
||||
|
||||
b) in the case of each subsequent Contributor:
|
||||
|
||||
i) changes to the Program, and
|
||||
|
||||
ii) additions to the Program;
|
||||
|
||||
where such changes and/or additions to the Program originate from and
|
||||
are distributed by that particular Contributor. A Contribution
|
||||
'originates' from a Contributor if it was added to the Program by such
|
||||
Contributor itself or anyone acting on such Contributor's behalf.
|
||||
Contributions do not include additions to the Program which: (i) are
|
||||
separate modules of software distributed in conjunction with the Program
|
||||
under their own license agreement, and (ii) are not derivative works of
|
||||
the Program.
|
||||
|
||||
"Contributor" means any person or entity that distributes the Program.
|
||||
|
||||
"Licensed Patents" mean patent claims licensable by a Contributor which
|
||||
are necessarily infringed by the use or sale of its Contribution alone
|
||||
or when combined with the Program.
|
||||
|
||||
"Program" means the Contributions distributed in accordance with this
|
||||
Agreement.
|
||||
|
||||
"Recipient" means anyone who receives the Program under this Agreement,
|
||||
including all Contributors.
|
||||
|
||||
2. GRANT OF RIGHTS
|
||||
|
||||
a) Subject to the terms of this Agreement, each Contributor hereby
|
||||
grants Recipient a non-exclusive, worldwide, royalty-free copyright
|
||||
license to reproduce, prepare derivative works of, publicly display,
|
||||
publicly perform, distribute and sublicense the Contribution of such
|
||||
Contributor, if any, and such derivative works, in source code and
|
||||
object code form.
|
||||
|
||||
b) Subject to the terms of this Agreement, each Contributor hereby
|
||||
grants Recipient a non-exclusive, worldwide, royalty-free patent license
|
||||
under Licensed Patents to make, use, sell, offer to sell, import and
|
||||
otherwise transfer the Contribution of such Contributor, if any, in
|
||||
source code and object code form. This patent license shall apply to the
|
||||
combination of the Contribution and the Program if, at the time the
|
||||
Contribution is added by the Contributor, such addition of the
|
||||
Contribution causes such combination to be covered by the Licensed
|
||||
Patents. The patent license shall not apply to any other combinations
|
||||
which include the Contribution. No hardware per se is licensed
|
||||
hereunder.
|
||||
|
||||
c) Recipient understands that although each Contributor grants the
|
||||
licenses to its Contributions set forth herein, no assurances are
|
||||
provided by any Contributor that the Program does not infringe the
|
||||
patent or other intellectual property rights of any other entity. Each
|
||||
Contributor disclaims any liability to Recipient for claims brought by
|
||||
any other entity based on infringement of intellectual property rights
|
||||
or otherwise. As a condition to exercising the rights and licenses
|
||||
granted hereunder, each Recipient hereby assumes sole responsibility to
|
||||
secure any other intellectual property rights needed, if any. For
|
||||
example, if a third party patent license is required to allow Recipient
|
||||
to distribute the Program, it is Recipient's responsibility to acquire
|
||||
that license before distributing the Program.
|
||||
|
||||
d) Each Contributor represents that to its knowledge it has sufficient
|
||||
copyright rights in its Contribution, if any, to grant the copyright
|
||||
license set forth in this Agreement.
|
||||
|
||||
3. REQUIREMENTS
|
||||
|
||||
A Contributor may choose to distribute the Program in object code form
|
||||
under its own license agreement, provided that:
|
||||
|
||||
a) it complies with the terms and conditions of this Agreement; and
|
||||
|
||||
b) its license agreement:
|
||||
|
||||
i) effectively disclaims on behalf of all Contributors all warranties
|
||||
and conditions, express and implied, including warranties or conditions
|
||||
of title and non-infringement, and implied warranties or conditions of
|
||||
merchantability and fitness for a particular purpose;
|
||||
|
||||
ii) effectively excludes on behalf of all Contributors all liability for
|
||||
damages, including direct, indirect, special, incidental and
|
||||
consequential damages, such as lost profits;
|
||||
|
||||
iii) states that any provisions which differ from this Agreement are
|
||||
offered by that Contributor alone and not by any other party; and
|
||||
|
||||
iv) states that source code for the Program is available from such
|
||||
Contributor, and informs licensees how to obtain it in a reasonable
|
||||
manner on or through a medium customarily used for software exchange.
|
||||
|
||||
When the Program is made available in source code form:
|
||||
|
||||
a) it must be made available under this Agreement; and
|
||||
|
||||
b) a copy of this Agreement must be included with each copy of the
|
||||
Program.
|
||||
|
||||
Contributors may not remove or alter any copyright notices contained
|
||||
within the Program.
|
||||
|
||||
Each Contributor must identify itself as the originator of its
|
||||
Contribution, if any, in a manner that reasonably allows subsequent
|
||||
Recipients to identify the originator of the Contribution.
|
||||
|
||||
4. COMMERCIAL DISTRIBUTION
|
||||
|
||||
Commercial distributors of software may accept certain responsibilities
|
||||
with respect to end users, business partners and the like. While this
|
||||
license is intended to facilitate the commercial use of the Program, the
|
||||
Contributor who includes the Program in a commercial product offering
|
||||
should do so in a manner which does not create potential liability for
|
||||
other Contributors. Therefore, if a Contributor includes the Program in
|
||||
a commercial product offering, such Contributor ("Commercial
|
||||
Contributor") hereby agrees to defend and indemnify every other
|
||||
Contributor ("Indemnified Contributor") against any losses, damages and
|
||||
costs (collectively "Losses") arising from claims, lawsuits and other
|
||||
legal actions brought by a third party against the Indemnified
|
||||
Contributor to the extent caused by the acts or omissions of such
|
||||
Commercial Contributor in connection with its distribution of the
|
||||
Program in a commercial product offering. The obligations in this
|
||||
section do not apply to any claims or Losses relating to any actual or
|
||||
alleged intellectual property infringement. In order to qualify, an
|
||||
Indemnified Contributor must: a) promptly notify the Commercial
|
||||
Contributor in writing of such claim, and b) allow the Commercial
|
||||
Contributor to control, and cooperate with the Commercial Contributor
|
||||
in, the defense and any related settlement negotiations. The Indemnified
|
||||
Contributor may participate in any such claim at its own expense.
|
||||
|
||||
For example, a Contributor might include the Program in a commercial
|
||||
product offering, Product X. That Contributor is then a Commercial
|
||||
Contributor. If that Commercial Contributor then makes performance
|
||||
claims, or offers warranties related to Product X, those performance
|
||||
claims and warranties are such Commercial Contributor's responsibility
|
||||
alone. Under this section, the Commercial Contributor would have to
|
||||
defend claims against the other Contributors related to those
|
||||
performance claims and warranties, and if a court requires any other
|
||||
Contributor to pay any damages as a result, the Commercial Contributor
|
||||
must pay those damages.
|
||||
|
||||
5. NO WARRANTY
|
||||
|
||||
EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED
|
||||
ON AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND,
|
||||
EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES
|
||||
OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR
|
||||
A PARTICULAR PURPOSE. Each Recipient is solely responsible for
|
||||
determining the appropriateness of using and distributing the Program
|
||||
and assumes all risks associated with its exercise of rights under this
|
||||
Agreement, including but not limited to the risks and costs of program
|
||||
errors, compliance with applicable laws, damage to or loss of data,
|
||||
programs or equipment, and unavailability or interruption of operations.
|
||||
|
||||
6. DISCLAIMER OF LIABILITY
|
||||
|
||||
EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR
|
||||
ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT,
|
||||
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING
|
||||
WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF
|
||||
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
|
||||
NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR
|
||||
DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED
|
||||
HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
|
||||
|
||||
7. GENERAL
|
||||
|
||||
If any provision of this Agreement is invalid or unenforceable under
|
||||
applicable law, it shall not affect the validity or enforceability of
|
||||
the remainder of the terms of this Agreement, and without further action
|
||||
by the parties hereto, such provision shall be reformed to the minimum
|
||||
extent necessary to make such provision valid and enforceable.
|
||||
|
||||
If Recipient institutes patent litigation against any entity (including
|
||||
a cross-claim or counterclaim in a lawsuit) alleging that the Program
|
||||
itself (excluding combinations of the Program with other software or
|
||||
hardware) infringes such Recipient's patent(s), then such Recipient's
|
||||
rights granted under Section 2(b) shall terminate as of the date such
|
||||
litigation is filed.
|
||||
|
||||
All Recipient's rights under this Agreement shall terminate if it fails
|
||||
to comply with any of the material terms or conditions of this Agreement
|
||||
and does not cure such failure in a reasonable period of time after
|
||||
becoming aware of such noncompliance. If all Recipient's rights under
|
||||
this Agreement terminate, Recipient agrees to cease use and distribution
|
||||
of the Program as soon as reasonably practicable. However, Recipient's
|
||||
obligations under this Agreement and any licenses granted by Recipient
|
||||
relating to the Program shall continue and survive.
|
||||
|
||||
Everyone is permitted to copy and distribute copies of this Agreement,
|
||||
but in order to avoid inconsistency the Agreement is copyrighted and may
|
||||
only be modified in the following manner. The Agreement Steward reserves
|
||||
the right to publish new versions (including revisions) of this
|
||||
Agreement from time to time. No one other than the Agreement Steward has
|
||||
the right to modify this Agreement. The Eclipse Foundation is the
|
||||
initial Agreement Steward. The Eclipse Foundation may assign the
|
||||
responsibility to serve as the Agreement Steward to a suitable separate
|
||||
entity. Each new version of the Agreement will be given a distinguishing
|
||||
version number. The Program (including Contributions) may always be
|
||||
distributed subject to the version of the Agreement under which it was
|
||||
received. In addition, after a new version of the Agreement is
|
||||
published, Contributor may elect to distribute the Program (including
|
||||
its Contributions) under the new version. Except as expressly stated in
|
||||
Sections 2(a) and 2(b) above, Recipient receives no rights or licenses
|
||||
to the intellectual property of any Contributor under this Agreement,
|
||||
whether expressly, by implication, estoppel or otherwise. All rights in
|
||||
the Program not expressly granted under this Agreement are reserved.
|
||||
|
||||
This Agreement is governed by the laws of the State of New York and the
|
||||
intellectual property laws of the United States of America. No party to
|
||||
this Agreement will bring a legal action under this Agreement more than
|
||||
one year after the cause of action arose. Each party waives its rights
|
||||
to a jury trial in any resulting litigation.
|
||||
67
README.md
Normal file
67
README.md
Normal file
|
|
@ -0,0 +1,67 @@
|
|||
# Jolt
|
||||
|
||||
A Clojure interpreter running on [Janet](https://janet-lang.org). Jolt reads Clojure source text, evaluates it using an interpreter written in pure Janet, and exposes a Clojure-compatible standard library.
|
||||
|
||||
## What's inside
|
||||
|
||||
Jolt implements the core of Clojure in a single-process, no-dependency Janet project:
|
||||
|
||||
**Reader** — A recursive descent parser for Clojure syntax: symbols, keywords, numbers, strings, characters, lists, vectors, maps, sets, quote forms, reader macros (`#()`, `#_`, `#?`), metadata, deref, and tagged literals.
|
||||
|
||||
**Evaluator** — A tree-walking interpreter with special forms (`quote`, `do`, `if`, `def`, `fn*`, `let*`, `loop*`/`recur`), syntax-quote with unquote and unquote-splicing, a macro system, and namespace forms (`ns`, `require`, `in-ns`).
|
||||
|
||||
**Core library** — 95+ functions from `clojure.core`: predicates, math with Clojure arity semantics, comparison, collection operations (conj, assoc, dissoc, get, merge, keys, vals), sequence operations (map, filter, reduce, take, drop, take-while, drop-while, concat, reverse, sort, distinct, group-by, partition), range and repeat, higher-order functions (comp, complement, constantly, juxt, memoize, partial), collection constructors, string functions, I/O, and atoms.
|
||||
|
||||
## Build
|
||||
|
||||
```
|
||||
jpm build
|
||||
```
|
||||
|
||||
This compiles `src/jolt/*.janet` into a standalone `build/jolt` executable. Requires Janet ≥ 1.36 and `jpm`.
|
||||
|
||||
## Run
|
||||
|
||||
```
|
||||
build/jolt
|
||||
```
|
||||
|
||||
Drops into a read-eval-print loop where you can type Clojure expressions:
|
||||
|
||||
```
|
||||
user=> (+ 1 2)
|
||||
3
|
||||
user=> (map inc [1 2 3])
|
||||
[2 3 4]
|
||||
user=> (defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))
|
||||
#'user/fib
|
||||
user=> (fib 10)
|
||||
55
|
||||
```
|
||||
|
||||
## Use as a library
|
||||
|
||||
```janet
|
||||
(use jolt/api)
|
||||
|
||||
(def ctx (init))
|
||||
(eval-string ctx "(+ 1 2)") ;; → 3
|
||||
(eval-string ctx "(map inc [1 2 3])") ;; → [2 3 4]
|
||||
(eval-string ctx "(def x 42)") ;; → #'user/x
|
||||
(eval-string ctx "x") ;; → 42
|
||||
```
|
||||
|
||||
`(init)` returns a context with `clojure.core` loaded. Pass it to `eval-string` to evaluate Clojure source. Each context is isolated — use separate contexts for separate evaluation environments.
|
||||
|
||||
To pre-populate a context with values:
|
||||
|
||||
```janet
|
||||
(use jolt/api)
|
||||
|
||||
(def ctx (init {:namespaces {"user" {"greeting" "hello"}}}))
|
||||
(eval-string ctx "(str greeting \" world\")") ;; → "hello world"
|
||||
```
|
||||
|
||||
## License
|
||||
|
||||
[Eclipse Public License 1.0](https://opensource.org/licenses/EPL-1.0)
|
||||
10
project.janet
Normal file
10
project.janet
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
(declare-project
|
||||
:name "jolt"
|
||||
:description "Clojure interpreter on Janet")
|
||||
|
||||
(declare-source
|
||||
:source @["src"])
|
||||
|
||||
(declare-executable
|
||||
:name "jolt"
|
||||
:entry "jolt/main.janet")
|
||||
37
src/jolt/api.janet
Normal file
37
src/jolt/api.janet
Normal file
|
|
@ -0,0 +1,37 @@
|
|||
# Jolt Public API
|
||||
# High-level interface for the Clojure-on-Janet interpreter.
|
||||
|
||||
(use ./types)
|
||||
(use ./reader)
|
||||
(use ./evaluator)
|
||||
(use ./core)
|
||||
|
||||
(defn init
|
||||
"Create a new Jolt evaluation context, optionally with opts.
|
||||
(init) — empty context with clojure.core loaded
|
||||
(init opts) — context with opts and clojure.core loaded
|
||||
|
||||
opts may contain:
|
||||
:namespaces — map of {ns-name → {sym → value, ...}, ...}"
|
||||
[&opt opts]
|
||||
(default opts nil)
|
||||
(let [ctx (make-ctx opts)]
|
||||
(init-core! ctx)
|
||||
ctx))
|
||||
|
||||
(defn eval-string
|
||||
"Evaluate a Clojure source string in a Jolt context.
|
||||
(eval-string ctx s) → value
|
||||
|
||||
Returns the result of evaluating the first form in s."
|
||||
[ctx s]
|
||||
(let [form (parse-string s)]
|
||||
(eval-form ctx @{} form)))
|
||||
|
||||
(defn eval-string*
|
||||
"Evaluate a Clojure source string in a Jolt context.
|
||||
Like eval-string but with explicit bindings.
|
||||
(eval-string* ctx s bindings) → value"
|
||||
[ctx s bindings]
|
||||
(let [form (parse-string s)]
|
||||
(eval-form ctx bindings form)))
|
||||
709
src/jolt/core.janet
Normal file
709
src/jolt/core.janet
Normal file
|
|
@ -0,0 +1,709 @@
|
|||
# Jolt Core Library
|
||||
# Clojure-compatible core functions for the Jolt interpreter.
|
||||
|
||||
(use ./types)
|
||||
|
||||
# ============================================================
|
||||
# Predicates
|
||||
# ============================================================
|
||||
|
||||
(defn core-nil? [x] (nil? x))
|
||||
(defn core-some? [x] (not (nil? x)))
|
||||
(defn core-string? [x] (string? x))
|
||||
(defn core-number? [x] (number? x))
|
||||
(defn core-fn? [x] (or (function? x) (cfunction? x)))
|
||||
(defn core-keyword? [x] (keyword? x))
|
||||
(defn core-symbol? [x] (and (struct? x) (= :symbol (x :jolt/type))))
|
||||
(defn core-vector? [x] (tuple? x))
|
||||
(defn core-map? [x] (struct? x))
|
||||
(defn core-seq? [x] (or (array? x) (tuple? x)))
|
||||
(defn core-coll? [x] (or (array? x) (tuple? x) (struct? x)))
|
||||
|
||||
(defn core-true? [x] (= true x))
|
||||
(defn core-false? [x] (= false x))
|
||||
(defn core-identical? [a b] (= a b))
|
||||
|
||||
(defn core-zero? [x] (and (number? x) (= x 0)))
|
||||
(defn core-pos? [x] (and (number? x) (> x 0)))
|
||||
(defn core-neg? [x] (and (number? x) (< x 0)))
|
||||
(defn core-even? [n] (= 0 (% n 2)))
|
||||
(defn core-odd? [n] (not= 0 (% n 2)))
|
||||
|
||||
(defn core-empty? [coll]
|
||||
(if (nil? coll) true
|
||||
(if (struct? coll) (= 0 (length (keys coll)))
|
||||
(= 0 (length coll)))))
|
||||
|
||||
(defn core-every? [pred coll]
|
||||
(var result true)
|
||||
(each x coll (if (not (pred x)) (do (set result false) (break))))
|
||||
result)
|
||||
|
||||
# ============================================================
|
||||
# Math — Clojure semantics (variadic, / with one arg = reciprocal)
|
||||
# ============================================================
|
||||
|
||||
(def core-+ (fn [& args] (if (= 0 (length args)) 0 (+ ;args))))
|
||||
|
||||
(def core-sub
|
||||
(fn [& args]
|
||||
(if (= 0 (length args))
|
||||
(error "Wrong number of args (0) passed to: -")
|
||||
(apply - args))))
|
||||
|
||||
(def core-* (fn [& args] (if (= 0 (length args)) 1 (* ;args))))
|
||||
|
||||
(def core-/
|
||||
(fn [& args]
|
||||
(case (length args)
|
||||
0 (error "Wrong number of args (0) passed to: /")
|
||||
1 (/ 1 (args 0))
|
||||
(apply / args))))
|
||||
|
||||
(def core-inc inc)
|
||||
(def core-dec dec)
|
||||
(def core-mod %)
|
||||
(def core-rem %)
|
||||
(def core-quot (fn [n d] (math/floor (/ n d))))
|
||||
|
||||
(defn core-max [& args] (apply max args))
|
||||
(defn core-min [& args] (apply min args))
|
||||
|
||||
# ============================================================
|
||||
# Comparison
|
||||
# ============================================================
|
||||
|
||||
(defn core-= [& args]
|
||||
(if (< (length args) 2) true
|
||||
(do
|
||||
(var ok true)
|
||||
(var i 0)
|
||||
(while (and ok (< i (dec (length args))))
|
||||
(if (not (deep= (args i) (args (+ i 1))))
|
||||
(set ok false))
|
||||
(++ i))
|
||||
ok)))
|
||||
|
||||
(defn core-not= [& args] (not (apply core-= args)))
|
||||
|
||||
# ============================================================
|
||||
# Collections
|
||||
# ============================================================
|
||||
|
||||
(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)
|
||||
(while (< i (length xs))
|
||||
(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))))
|
||||
|
||||
(defn core-assoc [m & kvs]
|
||||
(var result @{})
|
||||
(when m
|
||||
(each k (if (struct? m) (keys m) (keys (table ;(pairs m))))
|
||||
(put result k (get m k))))
|
||||
(var i 0)
|
||||
(while (< i (length kvs))
|
||||
(let [k (kvs i) v (kvs (+ i 1))]
|
||||
(put result k v)
|
||||
(+= i 2)))
|
||||
(if (struct? m) (table/to-struct result) result))
|
||||
|
||||
(defn core-dissoc [m & ks]
|
||||
(var result @{})
|
||||
(each k (keys m)
|
||||
(var in-ks false)
|
||||
(each k2 ks
|
||||
(if (deep= k k2) (do (set in-ks true) (break))))
|
||||
(if (not in-ks) (put result k (m k))))
|
||||
(if (struct? m) (table/to-struct result) result))
|
||||
|
||||
(defn core-get [m k &opt default]
|
||||
(default default nil)
|
||||
(if (nil? m) 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)
|
||||
(var current m)
|
||||
(var i 0)
|
||||
(while (< i (length ks))
|
||||
(if (nil? current) (break))
|
||||
(set current (core-get current (ks i)))
|
||||
(++ i))
|
||||
(if (nil? current) default current))
|
||||
|
||||
(defn core-contains? [coll key]
|
||||
(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))))
|
||||
|
||||
(def core-count length)
|
||||
|
||||
(defn core-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))))
|
||||
|
||||
(defn core-next [coll]
|
||||
(let [r (core-rest coll)]
|
||||
(if (= 0 (length r)) nil r)))
|
||||
|
||||
(defn core-cons [x coll]
|
||||
(if (nil? coll)
|
||||
@[x]
|
||||
(if (tuple? coll)
|
||||
(tuple/slice (tuple ;(array/insert (array/slice coll) 0 x)))
|
||||
(array/insert coll 0 x))))
|
||||
|
||||
(defn core-seq [coll]
|
||||
(if (or (nil? coll) (and (or (tuple? coll) (array? coll)) (= 0 (length coll))))
|
||||
nil
|
||||
(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
|
||||
(if (array? coll) (tuple ;coll)
|
||||
(if (struct? coll) (tuple ;(map |(in (kvs coll) (+ (* $ 2) 1)) (range (/ (length (kvs coll)) 2))))
|
||||
(tuple)))))
|
||||
|
||||
(defn core-into [to from]
|
||||
(if (tuple? to)
|
||||
(tuple/slice (tuple ;(array/concat (array/slice to) (if (tuple? from) from (array/slice from)))))
|
||||
(if (array? to)
|
||||
(array/concat to from)
|
||||
(if (struct? to)
|
||||
(do
|
||||
(var result to)
|
||||
(each [k v] (pairs from)
|
||||
(set result (merge result {k v})))
|
||||
result)
|
||||
to))))
|
||||
|
||||
(defn core-merge [& maps]
|
||||
(var result (struct))
|
||||
(each m maps
|
||||
(set result (merge result m)))
|
||||
result)
|
||||
|
||||
(defn core-merge-with [f & maps]
|
||||
(var result @{})
|
||||
(each m maps
|
||||
(each k (keys m)
|
||||
(let [existing (result k)]
|
||||
(put result k (if (nil? existing) (m k) (f existing (m k)))))))
|
||||
(table/to-struct result))
|
||||
|
||||
(defn core-keys [m]
|
||||
(tuple ;(keys m)))
|
||||
|
||||
(defn core-vals [m]
|
||||
(tuple ;(map |(m $) (keys m))))
|
||||
|
||||
(defn core-select-keys [m ks]
|
||||
(var result @{})
|
||||
(each k ks
|
||||
(let [v (core-get m k)]
|
||||
(if (not (nil? v)) (put result k v))))
|
||||
(if (struct? m) (table/to-struct result) result))
|
||||
|
||||
(defn core-zipmap [ks vs]
|
||||
(var result @{})
|
||||
(var i 0)
|
||||
(while (and (< i (length ks)) (< i (length vs)))
|
||||
(put result (ks i) (vs i))
|
||||
(++ i))
|
||||
(table/to-struct result))
|
||||
|
||||
# ============================================================
|
||||
# Sequence operations
|
||||
# ============================================================
|
||||
|
||||
(defn core-map [f & colls]
|
||||
(let [first-coll (colls 0)
|
||||
result (if (= 1 (length colls))
|
||||
(array ;(map f first-coll))
|
||||
(do
|
||||
(var res @[])
|
||||
(var idxs @{})
|
||||
(each _ first-coll (array/push idxs 0))
|
||||
(var done false)
|
||||
(while (not done)
|
||||
(var args @[])
|
||||
(var i 0)
|
||||
(while (< i (length colls))
|
||||
(let [c (colls i) j (idxs i)]
|
||||
(if (>= j (length c))
|
||||
(do (set done true) (break))
|
||||
(array/push args (c j))))
|
||||
(++ i))
|
||||
(if (not done) (array/push res (apply f args)))
|
||||
(var k 0)
|
||||
(while (< k (length colls))
|
||||
(set (idxs k) (+ (idxs k) 1))
|
||||
(++ k)))
|
||||
res))]
|
||||
(if (tuple? first-coll) (tuple/slice (tuple ;result)) result)))
|
||||
|
||||
(defn core-filter [pred coll]
|
||||
(var result @[])
|
||||
(each x coll
|
||||
(if (pred x) (array/push result x)))
|
||||
(if (tuple? coll) (tuple/slice (tuple ;result)) result))
|
||||
|
||||
(defn core-remove [pred coll]
|
||||
(core-filter (fn [x] (not (pred x))) coll))
|
||||
|
||||
(def core-reduce
|
||||
(fn [& args]
|
||||
(case (length args)
|
||||
2 (let [f (args 0) coll (args 1)]
|
||||
(if (= 0 (length coll))
|
||||
(f)
|
||||
(do
|
||||
(var acc (coll 0))
|
||||
(var i 1)
|
||||
(while (< i (length coll))
|
||||
(set acc (f acc (coll i)))
|
||||
(++ i))
|
||||
acc)))
|
||||
3 (let [f (args 0) val (args 1) coll (args 2)]
|
||||
(var acc val)
|
||||
(each x coll (set acc (f acc x)))
|
||||
acc)
|
||||
(error "Wrong number of args passed to: reduce"))))
|
||||
|
||||
(defn core-take [n coll]
|
||||
(var result @[])
|
||||
(var i 0)
|
||||
(while (and (< i n) (< i (length coll)))
|
||||
(array/push result (coll i))
|
||||
(++ i))
|
||||
(if (tuple? coll) (tuple/slice (tuple ;result)) result))
|
||||
|
||||
(defn core-drop [n coll]
|
||||
(if (tuple? coll)
|
||||
(tuple/slice coll (min n (length coll)))
|
||||
(array/slice coll (min n (length coll)))))
|
||||
|
||||
(defn core-take-while [pred coll]
|
||||
(var result @[])
|
||||
(each x coll
|
||||
(if (pred x) (array/push result x) (break)))
|
||||
(if (tuple? coll) (tuple/slice (tuple ;result)) result))
|
||||
|
||||
(defn core-drop-while [pred coll]
|
||||
(var start 0)
|
||||
(while (and (< start (length coll)) (pred (coll start)))
|
||||
(++ start))
|
||||
(if (tuple? coll)
|
||||
(tuple/slice coll start)
|
||||
(array/slice coll start)))
|
||||
|
||||
(defn core-concat [& colls]
|
||||
(var result @[])
|
||||
(each c colls
|
||||
(each x c (array/push result x)))
|
||||
result)
|
||||
|
||||
(defn core-reverse [coll]
|
||||
(var result @[])
|
||||
(var i (dec (length coll)))
|
||||
(while (>= i 0)
|
||||
(array/push result (coll i))
|
||||
(-- i))
|
||||
(if (tuple? coll) (tuple/slice (tuple ;result)) result))
|
||||
|
||||
(defn core-sort [coll]
|
||||
(let [arr (if (tuple? coll) (array/slice coll) coll)
|
||||
sorted (sort arr)]
|
||||
(if (tuple? coll) (tuple/slice (tuple ;sorted)) sorted)))
|
||||
|
||||
(defn core-sort-by [keyfn coll]
|
||||
(let [arr (if (tuple? coll) (array/slice coll) coll)
|
||||
sorted (sort-by keyfn arr)]
|
||||
(if (tuple? coll) (tuple/slice (tuple ;sorted)) sorted)))
|
||||
|
||||
(defn core-distinct [coll]
|
||||
(var seen @{})
|
||||
(var result @[])
|
||||
(each x coll
|
||||
(if (nil? (seen x))
|
||||
(do
|
||||
(put seen x true)
|
||||
(array/push result x))))
|
||||
(if (tuple? coll) (tuple/slice (tuple ;result)) result))
|
||||
|
||||
(defn core-group-by [f coll]
|
||||
(var result @{})
|
||||
(each x coll
|
||||
(let [k (f x)]
|
||||
(put result k (array/push (core-get result k @[]) x))))
|
||||
result)
|
||||
|
||||
(defn core-frequencies [coll]
|
||||
(core-group-by identity coll))
|
||||
|
||||
(defn core-partition [n coll]
|
||||
(var result @[])
|
||||
(var i 0)
|
||||
(while (< i (length coll))
|
||||
(var part @[])
|
||||
(var j 0)
|
||||
(while (and (< j n) (< (+ i j) (length coll)))
|
||||
(array/push part (coll (+ i j)))
|
||||
(++ j))
|
||||
(if (= (length part) n) (array/push result (tuple/slice (tuple ;part))))
|
||||
(+= i n))
|
||||
result)
|
||||
|
||||
(defn core-partition-by [f coll]
|
||||
(var result @[])
|
||||
(var part @[])
|
||||
(var last-k nil)
|
||||
(each x coll
|
||||
(let [k (f x)]
|
||||
(if (and last-k (deep= k last-k))
|
||||
(array/push part x)
|
||||
(do
|
||||
(if (> (length part) 0) (array/push result (tuple/slice (tuple ;part))))
|
||||
(set part @[x])
|
||||
(set last-k k)))))
|
||||
(if (> (length part) 0) (array/push result (tuple/slice (tuple ;part))))
|
||||
result)
|
||||
|
||||
# ============================================================
|
||||
# Sequence generators
|
||||
# ============================================================
|
||||
|
||||
(def core-range
|
||||
(fn [& args]
|
||||
(let [start (if (> (length args) 1) (args 0) 0)
|
||||
end (if (> (length args) 1) (args 1) (args 0))
|
||||
step (if (> (length args) 2) (args 2) 1)]
|
||||
(var result @[])
|
||||
(var i start)
|
||||
(while (if (pos? step) (< i end) (> i end))
|
||||
(array/push result i)
|
||||
(+= i step))
|
||||
(tuple/slice (tuple ;result)))))
|
||||
|
||||
(def core-repeat (fn [n x]
|
||||
(var result @[])
|
||||
(var i 0)
|
||||
(while (< i n)
|
||||
(array/push result x)
|
||||
(++ i))
|
||||
result))
|
||||
|
||||
(defn core-repeatedly [n f]
|
||||
(var result @[])
|
||||
(var i 0)
|
||||
(while (< i n)
|
||||
(array/push result (f))
|
||||
(++ i))
|
||||
result)
|
||||
|
||||
# ============================================================
|
||||
# Higher-order functions
|
||||
# ============================================================
|
||||
|
||||
(def core-identity (fn [x] x))
|
||||
|
||||
(def core-constantly (fn [x] (fn [& _] x)))
|
||||
|
||||
(defn core-complement [f]
|
||||
(fn [& args] (not (apply f args))))
|
||||
|
||||
(def core-comp
|
||||
(fn [& fs]
|
||||
(case (length fs)
|
||||
0 identity
|
||||
1 (fs 0)
|
||||
2 (let [f (fs 0) g (fs 1)] (fn [& args] (f (apply g args))))
|
||||
(let [f (last fs)
|
||||
gs (array/slice fs 0 (dec (length fs)))]
|
||||
(fn [& args]
|
||||
(var result (apply (last gs) args))
|
||||
(var i (- (length gs) 2))
|
||||
(while (>= i 0)
|
||||
(set result ((gs i) result))
|
||||
(-- i))
|
||||
(f result))))))
|
||||
|
||||
(defn core-partial [f & args]
|
||||
(fn [& more] (apply f (array/concat (array/slice args) more))))
|
||||
|
||||
(defn core-juxt [& fs]
|
||||
(fn [& args]
|
||||
(tuple ;(map |(apply $ args) fs))))
|
||||
|
||||
(defn core-memoize [f]
|
||||
(var cache @{})
|
||||
(fn [& args]
|
||||
(let [key (tuple ;args)]
|
||||
(if-let [v (get cache key)]
|
||||
v
|
||||
(let [result (apply f args)]
|
||||
(put cache key result)
|
||||
result)))))
|
||||
|
||||
# ============================================================
|
||||
# Collection constructors
|
||||
# ============================================================
|
||||
|
||||
(defn core-vector [& xs] (tuple ;xs))
|
||||
(defn core-hash-map [& kvs]
|
||||
(var result @{})
|
||||
(var i 0)
|
||||
(while (< i (length kvs))
|
||||
(put result (kvs i) (kvs (+ i 1)))
|
||||
(+= i 2))
|
||||
(table/to-struct result))
|
||||
|
||||
(defn core-array-map [& kvs]
|
||||
(var result @{})
|
||||
(var i 0)
|
||||
(while (< i (length kvs))
|
||||
(put result (kvs i) (kvs (+ i 1)))
|
||||
(+= i 2))
|
||||
(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))})
|
||||
|
||||
(defn core-set [coll]
|
||||
(apply core-hash-set (if (tuple? coll) (array/slice coll) coll)))
|
||||
|
||||
(defn core-list [& xs]
|
||||
(array ;xs))
|
||||
|
||||
# ============================================================
|
||||
# String functions
|
||||
# ============================================================
|
||||
|
||||
(defn core-str [& xs]
|
||||
(if (= 0 (length xs)) ""
|
||||
(do
|
||||
(var result @[])
|
||||
(each x xs
|
||||
(if (nil? x) nil # skip nil
|
||||
(array/push result (if (string? x) x (string x)))))
|
||||
(string/join result ""))))
|
||||
|
||||
(def core-subs
|
||||
(fn [& args]
|
||||
(case (length args)
|
||||
2 (string/slice (args 0) (args 1))
|
||||
3 (string/slice (args 0) (args 1) (args 2))
|
||||
(error "Wrong number of args passed to: subs"))))
|
||||
|
||||
# ============================================================
|
||||
# I/O — minimal wrappers
|
||||
# ============================================================
|
||||
|
||||
(def core-print print)
|
||||
(def core-println (fn [& xs] (apply print xs) (print "\n") nil))
|
||||
|
||||
(defn core-pr [& xs]
|
||||
(var i 0)
|
||||
(while (< i (length xs))
|
||||
(if (> i 0) (prin " "))
|
||||
(prin (xs i))
|
||||
(++ i))
|
||||
nil)
|
||||
|
||||
(defn core-prn [& xs]
|
||||
(apply core-pr xs)
|
||||
(print "\n")
|
||||
nil)
|
||||
|
||||
# ============================================================
|
||||
# Atom
|
||||
# ============================================================
|
||||
|
||||
(defn core-atom [val]
|
||||
@{:jolt/type :jolt/atom :value val :watches @{}})
|
||||
|
||||
(defn core-atom? [x]
|
||||
(and (table? x) (= :jolt/atom (x :jolt/type))))
|
||||
|
||||
(defn core-deref [ref]
|
||||
(cond
|
||||
# Jolt atom
|
||||
(and (table? ref) (= :jolt/atom (ref :jolt/type)))
|
||||
(ref :value)
|
||||
# Jolt var (from types.janet)
|
||||
(and (table? ref) (= :jolt/var (ref :jolt/type)))
|
||||
(ref :root)
|
||||
# default: return as-is
|
||||
ref))
|
||||
|
||||
(defn core-reset! [atm val]
|
||||
(put atm :value val)
|
||||
val)
|
||||
|
||||
(defn core-swap! [atm f & args]
|
||||
(let [new-val (apply f (atm :value) args)]
|
||||
(put atm :value new-val)
|
||||
new-val))
|
||||
|
||||
# ============================================================
|
||||
# Threading macros (as regular functions? No, as macros in Clojure)
|
||||
# These need to be defined as macros in the Jolt namespace system.
|
||||
# For now, skip — they need proper macro definition via the evaluator.
|
||||
# ============================================================
|
||||
|
||||
# ============================================================
|
||||
# Initialization — intern everything into a context's namespace
|
||||
# ============================================================
|
||||
|
||||
(def- core-bindings
|
||||
"Map of symbol name → function for all core functions."
|
||||
@{"nil?" core-nil?
|
||||
"some?" core-some?
|
||||
"string?" core-string?
|
||||
"number?" core-number?
|
||||
"fn?" core-fn?
|
||||
"keyword?" core-keyword?
|
||||
"symbol?" core-symbol?
|
||||
"vector?" core-vector?
|
||||
"map?" core-map?
|
||||
"seq?" core-seq?
|
||||
"coll?" core-coll?
|
||||
"true?" core-true?
|
||||
"false?" core-false?
|
||||
"identical?" core-identical?
|
||||
"zero?" core-zero?
|
||||
"pos?" core-pos?
|
||||
"neg?" core-neg?
|
||||
"even?" core-even?
|
||||
"odd?" core-odd?
|
||||
"empty?" core-empty?
|
||||
"every?" core-every?
|
||||
"+" core-+
|
||||
"-" core-sub
|
||||
"*" core-*
|
||||
"/" core-/
|
||||
"inc" core-inc
|
||||
"dec" core-dec
|
||||
"mod" core-mod
|
||||
"rem" core-rem
|
||||
"quot" core-quot
|
||||
"max" core-max
|
||||
"min" core-min
|
||||
"=" core-=
|
||||
"not=" core-not=
|
||||
"conj" core-conj
|
||||
"assoc" core-assoc
|
||||
"dissoc" core-dissoc
|
||||
"get" core-get
|
||||
"get-in" core-get-in
|
||||
"contains?" core-contains?
|
||||
"count" core-count
|
||||
"first" core-first
|
||||
"rest" core-rest
|
||||
"next" core-next
|
||||
"cons" core-cons
|
||||
"seq" core-seq
|
||||
"vec" core-vec
|
||||
"into" core-into
|
||||
"merge" core-merge
|
||||
"merge-with" core-merge-with
|
||||
"keys" core-keys
|
||||
"vals" core-vals
|
||||
"select-keys" core-select-keys
|
||||
"zipmap" core-zipmap
|
||||
"map" core-map
|
||||
"filter" core-filter
|
||||
"remove" core-remove
|
||||
"reduce" core-reduce
|
||||
"take" core-take
|
||||
"drop" core-drop
|
||||
"take-while" core-take-while
|
||||
"drop-while" core-drop-while
|
||||
"concat" core-concat
|
||||
"reverse" core-reverse
|
||||
"sort" core-sort
|
||||
"sort-by" core-sort-by
|
||||
"distinct" core-distinct
|
||||
"group-by" core-group-by
|
||||
"frequencies" core-frequencies
|
||||
"partition" core-partition
|
||||
"partition-by" core-partition-by
|
||||
"range" core-range
|
||||
"repeat" core-repeat
|
||||
"repeatedly" core-repeatedly
|
||||
"identity" core-identity
|
||||
"constantly" core-constantly
|
||||
"complement" core-complement
|
||||
"comp" core-comp
|
||||
"partial" core-partial
|
||||
"juxt" core-juxt
|
||||
"memoize" core-memoize
|
||||
"vector" core-vector
|
||||
"hash-map" core-hash-map
|
||||
"array-map" core-array-map
|
||||
"hash-set" core-hash-set
|
||||
"set" core-set
|
||||
"list" core-list
|
||||
"str" core-str
|
||||
"subs" core-subs
|
||||
"print" core-print
|
||||
"println" core-println
|
||||
"pr" core-pr
|
||||
"prn" core-prn
|
||||
"atom" core-atom
|
||||
"atom?" core-atom?
|
||||
"deref" core-deref
|
||||
"reset!" core-reset!
|
||||
"swap!" core-swap!})
|
||||
|
||||
(def init-core!
|
||||
(fn [& args]
|
||||
(case (length args)
|
||||
1 (let [ctx (args 0)
|
||||
ns (ctx-find-ns ctx "clojure.core")]
|
||||
(loop [[name fn] :pairs core-bindings]
|
||||
(ns-intern ns name fn))
|
||||
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))
|
||||
ns)
|
||||
(error "Wrong number of args passed to: init-core!"))))
|
||||
264
src/jolt/evaluator.janet
Normal file
264
src/jolt/evaluator.janet
Normal file
|
|
@ -0,0 +1,264 @@
|
|||
# Jolt Evaluator
|
||||
# Direct interpreter for Clojure forms on Janet.
|
||||
|
||||
(use ./types)
|
||||
|
||||
(defn- sym-name?
|
||||
[sym-s name-str]
|
||||
(and (struct? sym-s) (= :symbol (sym-s :jolt/type)) (= name-str (sym-s :name))))
|
||||
|
||||
(defn- special-symbol?
|
||||
[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")))
|
||||
|
||||
(var eval-form nil)
|
||||
|
||||
(defn- syntax-quote*
|
||||
[ctx bindings form]
|
||||
(cond
|
||||
(and (array? form) (> (length form) 0) (sym-name? (first form) "unquote"))
|
||||
(eval-form ctx bindings (in form 1))
|
||||
(and (array? form) (> (length form) 0) (sym-name? (first form) "unquote-splicing"))
|
||||
(error "~@ used outside of a list or vector in syntax-quote")
|
||||
(or (number? form) (string? form) (keyword? form) (nil? form) (= true form) (= false form))
|
||||
form
|
||||
(and (struct? form) (= :symbol (form :jolt/type)))
|
||||
(if (nil? (form :ns))
|
||||
(if (special-symbol? (form :name)) form
|
||||
{:jolt/type :symbol :ns (ctx-current-ns ctx) :name (form :name)})
|
||||
form)
|
||||
(tuple? form)
|
||||
(do (var result @[]) (var i 0) (while (< i (length form))
|
||||
(let [item (in form i)]
|
||||
(if (and (array? item) (> (length item) 0) (sym-name? (first item) "unquote-splicing"))
|
||||
(each v (eval-form ctx bindings (in item 1)) (array/push result v))
|
||||
(array/push result (syntax-quote* ctx bindings item))))
|
||||
(++ i)) (tuple ;result))
|
||||
(array? form)
|
||||
(do (var result @[]) (var i 0) (while (< i (length form))
|
||||
(let [item (in form i)]
|
||||
(if (and (array? item) (> (length item) 0) (sym-name? (first item) "unquote-splicing"))
|
||||
(each v (eval-form ctx bindings (in item 1)) (array/push result v))
|
||||
(array/push result (syntax-quote* ctx bindings item))))
|
||||
(++ i)) result)
|
||||
(and (struct? form) (get form :jolt/type)) form
|
||||
(struct? form)
|
||||
(do (var kvs @[]) (each k (keys form)
|
||||
(array/push kvs (syntax-quote* ctx bindings k))
|
||||
(array/push kvs (syntax-quote* ctx bindings (get form k)))) (struct ;kvs))
|
||||
form))
|
||||
|
||||
(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))))))
|
||||
|
||||
(defn- sym-name-str
|
||||
[sym-s]
|
||||
(if (sym-s :ns) (string (sym-s :ns) "/" (sym-s :name)) (sym-s :name)))
|
||||
|
||||
(defn- eval-require
|
||||
[ctx spec]
|
||||
(let [ns-sym (in spec 0)
|
||||
ns-name (sym-name-str ns-sym)]
|
||||
(var alias nil)
|
||||
(var i 1)
|
||||
(let [slen (length spec)]
|
||||
(while (< i slen)
|
||||
(let [item (in spec i)]
|
||||
(if (or (= item :as) (and (struct? item) (= :symbol (item :jolt/type)) (= "as" (item :name))))
|
||||
(do
|
||||
(def alias-sym (in spec (+ i 1)))
|
||||
(set alias (alias-sym :name))
|
||||
(set i slen))
|
||||
(++ i)))))
|
||||
(ctx-find-ns ctx ns-name)
|
||||
(when alias
|
||||
(let [current-ns (ctx-find-ns ctx (ctx-current-ns ctx))]
|
||||
(ns-import current-ns alias ns-name)))
|
||||
nil))
|
||||
|
||||
(defn- resolve-sym
|
||||
[ctx bindings sym-s]
|
||||
(let [name (sym-s :name) ns (sym-s :ns)]
|
||||
(if (not (nil? ns))
|
||||
(let [current-ns (ctx-find-ns ctx (ctx-current-ns ctx)) aliased-ns (ns-import-lookup current-ns ns)]
|
||||
(if aliased-ns
|
||||
(let [target-ns (ctx-find-ns ctx aliased-ns) v (ns-find target-ns name)]
|
||||
(if v (var-get v) (error (string "Unable to resolve symbol: " ns "/" name))))
|
||||
(let [target-ns (ctx-find-ns ctx ns) v (ns-find target-ns name)]
|
||||
(if v (var-get v) (error (string "Unable to resolve symbol: " ns "/" name))))))
|
||||
(let [local (get bindings name)]
|
||||
(if (not (nil? local)) local
|
||||
(let [current-ns (ctx-current-ns ctx) ns (ctx-find-ns ctx current-ns) v (ns-find ns name)]
|
||||
(if v (var-get v)
|
||||
# Check clojure.core as auto-referred fallback
|
||||
(let [core-ns (ctx-find-ns ctx "clojure.core")
|
||||
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)))))))))))))
|
||||
|
||||
# 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))
|
||||
(match name
|
||||
"quote" (in form 1)
|
||||
"syntax-quote" (syntax-quote* ctx bindings (in form 1))
|
||||
"unquote" (error "Unquote not valid outside of syntax-quote")
|
||||
"unquote-splicing" (error "Unquote-splicing not valid outside of syntax-quote")
|
||||
"do" (do
|
||||
(var result nil)
|
||||
(var i 1)
|
||||
(let [len (length form)]
|
||||
(while (< i len)
|
||||
(set result (eval-form ctx bindings (in form i)))
|
||||
(++ i)))
|
||||
result)
|
||||
"if" (let [test-val (eval-form ctx bindings (in form 1))]
|
||||
(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)
|
||||
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))
|
||||
clauses (tuple/slice form 2)]
|
||||
(ctx-set-current-ns ctx ns-name)
|
||||
(ctx-find-ns ctx ns-name)
|
||||
(var result nil)
|
||||
(var i 0)
|
||||
(let [clen (length clauses)]
|
||||
(while (< i clen)
|
||||
(let [clause (in clauses i)]
|
||||
(if (and (array? clause) (> (length clause) 0) (= :require (first clause)))
|
||||
(let [specs (tuple/slice clause 1)
|
||||
slen (length specs)]
|
||||
(var j 0)
|
||||
(while (< j slen)
|
||||
(let [s (in specs j)]
|
||||
(eval-require ctx s))
|
||||
(++ j))
|
||||
(set i (+ i 1)))
|
||||
(do (set result clause) (++ i))))))
|
||||
result)
|
||||
"require" (let [spec (eval-form ctx bindings (in form 1))]
|
||||
(if (and (tuple? spec) (> (length spec) 0))
|
||||
(eval-require ctx spec)
|
||||
(error "require expects a vector spec")))
|
||||
"in-ns" (let [ns-name (sym-name-str (in form 1))]
|
||||
(ctx-set-current-ns ctx ns-name)
|
||||
(ctx-find-ns ctx ns-name)
|
||||
nil)
|
||||
"fn*" (let [args-form (in form 1)
|
||||
body (tuple/slice form 2)
|
||||
arg-names (map |($ :name) args-form)]
|
||||
(var self nil)
|
||||
(set self (fn [& fn-args]
|
||||
(var fn-bindings @{})
|
||||
(table/setproto fn-bindings bindings)
|
||||
(var i 0)
|
||||
(each arg-name arg-names
|
||||
(put fn-bindings arg-name (fn-args i))
|
||||
(++ i))
|
||||
(put fn-bindings :jolt/loop-fn self)
|
||||
(var result nil)
|
||||
(each body-form body
|
||||
(set result (eval-form ctx fn-bindings body-form)))
|
||||
result))
|
||||
self)
|
||||
"let*" (let [bind-vec (in form 1)
|
||||
body (tuple/slice form 2)]
|
||||
(var new-bindings @{})
|
||||
(table/setproto new-bindings bindings)
|
||||
(var i 0)
|
||||
(let [len (length bind-vec)]
|
||||
(while (< i len)
|
||||
(let [sym (bind-vec i)
|
||||
val (eval-form ctx new-bindings (bind-vec (+ i 1)))]
|
||||
(put new-bindings (sym :name) val)
|
||||
(+= i 2))))
|
||||
(var result nil)
|
||||
(each body-form body
|
||||
(set result (eval-form ctx new-bindings body-form)))
|
||||
result)
|
||||
"loop*" (let [bind-vec (in form 1)
|
||||
body (tuple/slice form 2)
|
||||
init-vals @[]
|
||||
sym-names @[]]
|
||||
(var i 0)
|
||||
(while (< i (length bind-vec))
|
||||
(array/push init-vals (eval-form ctx bindings (bind-vec (+ i 1))))
|
||||
(array/push sym-names ((bind-vec i) :name))
|
||||
(+= i 2))
|
||||
(var loop-fn nil)
|
||||
(set loop-fn (fn [& args]
|
||||
(var loop-bindings @{})
|
||||
(table/setproto loop-bindings bindings)
|
||||
(var j 0)
|
||||
(each sn sym-names
|
||||
(put loop-bindings sn (args j))
|
||||
(++ j))
|
||||
(put loop-bindings :jolt/loop-fn loop-fn)
|
||||
(var result nil)
|
||||
(each body-form body
|
||||
(set result (eval-form ctx loop-bindings body-form)))
|
||||
result))
|
||||
(apply loop-fn init-vals))
|
||||
"recur" (let [loop-fn (get bindings :jolt/loop-fn)]
|
||||
(if (nil? loop-fn)
|
||||
(error "recur used outside of loop* or fn*")
|
||||
(let [args (map |(eval-form ctx bindings $) (tuple/slice form 1))]
|
||||
(apply loop-fn args))))
|
||||
# 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)
|
||||
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)))))
|
||||
|
||||
(set eval-form (fn [ctx bindings form]
|
||||
(cond
|
||||
(nil? form) nil
|
||||
(number? form) form
|
||||
(string? form) form
|
||||
(keyword? form) form
|
||||
(bytes? form) form
|
||||
(buffer? form) form
|
||||
(tuple? form) (tuple/slice (map |(eval-form ctx bindings $) form))
|
||||
(struct? form)
|
||||
(if (= :symbol (form :jolt/type))
|
||||
(resolve-sym ctx bindings form)
|
||||
(if (get form :jolt/type)
|
||||
(error (string "Unexpected tagged form: " (form :jolt/type)))
|
||||
form))
|
||||
(array? form)
|
||||
(if (= 0 (length form))
|
||||
@[]
|
||||
(eval-list ctx bindings form))
|
||||
form)))
|
||||
34
src/jolt/main.janet
Normal file
34
src/jolt/main.janet
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
# Jolt REPL
|
||||
# Read-eval-print loop for Clojure expressions.
|
||||
|
||||
(use ./api)
|
||||
(use ./types)
|
||||
|
||||
(def ctx (init))
|
||||
|
||||
(defn read-line [prompt]
|
||||
(prin prompt)
|
||||
(flush)
|
||||
(let [line (file/read stdin :line)]
|
||||
(if line (string/trim line) nil)))
|
||||
|
||||
(defn print-value [v]
|
||||
(if (nil? v)
|
||||
(print "nil")
|
||||
(if (and (table? v) (= :jolt/var (v :jolt/type)))
|
||||
(printf "#'%s/%s" (ctx-current-ns ctx) ((var-name v) :name))
|
||||
(print v))))
|
||||
|
||||
(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))))))))
|
||||
383
src/jolt/reader.janet
Normal file
383
src/jolt/reader.janet
Normal file
|
|
@ -0,0 +1,383 @@
|
|||
# Jolt Clojure Reader
|
||||
# Recursive descent parser for Clojure source text.
|
||||
# Output convention:
|
||||
# Symbols foo, foo/bar → {:jolt/type :symbol :ns "foo" :name "bar"}
|
||||
# Keywords :foo, :foo/bar → Janet keyword :foo, :foo/bar
|
||||
# Lists (a b c) → Janet array @[a b c]
|
||||
# Vectors [a b c] → Janet tuple [a b c]
|
||||
# Maps {:a 1} → Janet struct {:a 1}
|
||||
# Sets #{1 2} → tagged struct {:jolt/type :jolt/set :value [1 2]}
|
||||
|
||||
# Forward declaration for mutual recursion
|
||||
(var read-form nil)
|
||||
|
||||
(def whitespace-chars " \t\n\r,")
|
||||
|
||||
(defn whitespace? [c]
|
||||
(or (= c 32) # space
|
||||
(= c 10) # \n
|
||||
(= c 9) # \t
|
||||
(= c 13) # \r
|
||||
(= c 44))) # comma
|
||||
|
||||
(defn skip-whitespace [s pos]
|
||||
(if (and (< pos (length s))
|
||||
(whitespace? (s pos)))
|
||||
(skip-whitespace s (+ pos 1))
|
||||
pos))
|
||||
|
||||
(defn digit? [c]
|
||||
(and (>= c 48) (<= c 57)))
|
||||
|
||||
(defn hex-digit? [c]
|
||||
(or (and (>= c 48) (<= c 57))
|
||||
(and (>= c 65) (<= c 70))
|
||||
(and (>= c 97) (<= c 102))))
|
||||
|
||||
(defn symbol-start? [c]
|
||||
(or (and (>= c 65) (<= c 90)) # A-Z
|
||||
(and (>= c 97) (<= c 122)) # a-z
|
||||
(= c 42) # *
|
||||
(= c 43) # +
|
||||
(= c 33) # !
|
||||
(= c 95) # _
|
||||
(= c 45) # -
|
||||
(= c 63) # ?
|
||||
(= c 46) # .
|
||||
(= c 60) # <
|
||||
(= c 62) # >
|
||||
(= c 61) # =
|
||||
(= c 38) # &
|
||||
(= c 124) # |
|
||||
(= c 36) # $
|
||||
(= c 37) # %
|
||||
(= c 47))) # /
|
||||
|
||||
(defn symbol-char? [c]
|
||||
(or (symbol-start? c)
|
||||
(digit? c)
|
||||
(= c 35) # #
|
||||
(= c 39) # '
|
||||
(= c 58))) # :
|
||||
|
||||
(defn read-symbol-name [s pos end]
|
||||
(if (and (< end (length s))
|
||||
(symbol-char? (s end)))
|
||||
(read-symbol-name s pos (+ end 1))
|
||||
end))
|
||||
|
||||
(defn make-symbol
|
||||
"Create a Jolt symbol struct."
|
||||
[name]
|
||||
(let [slash (string/find "/" name)]
|
||||
(if slash
|
||||
{:jolt/type :symbol
|
||||
:ns (string/slice name 0 slash)
|
||||
:name (string/slice name (+ slash 1))}
|
||||
{:jolt/type :symbol
|
||||
:ns nil
|
||||
:name name})))
|
||||
|
||||
(defn sym
|
||||
"Convenience to create a symbol during testing."
|
||||
[name]
|
||||
(make-symbol name))
|
||||
|
||||
(defn read-symbol [s pos]
|
||||
(let [end (read-symbol-name s pos pos)]
|
||||
(if (= end pos)
|
||||
(error (string "Unrecognized character at " pos ": " (string/from-bytes (s pos))))
|
||||
(let [name (string/slice s pos end)]
|
||||
(if (= name "nil") [nil end]
|
||||
(if (= name "true") [true end]
|
||||
(if (= name "false") [false end]
|
||||
[(make-symbol name) end])))))))
|
||||
|
||||
(defn read-keyword-name [s pos end]
|
||||
(if (and (< end (length s))
|
||||
(symbol-char? (s end)))
|
||||
(read-keyword-name s pos (+ end 1))
|
||||
end))
|
||||
|
||||
(defn read-keyword [s pos]
|
||||
# pos is at the first colon
|
||||
(if (and (< (+ pos 1) (length s)) (= (s (+ pos 1)) 58))
|
||||
# ::foo/bar — auto-resolved keyword
|
||||
(let [start (+ pos 2)
|
||||
end (read-keyword-name s start start)
|
||||
name (string/slice s start end)]
|
||||
[(keyword name) end])
|
||||
# :foo or :foo/bar
|
||||
(let [start (+ pos 1)
|
||||
end (read-keyword-name s start start)
|
||||
name (string/slice s start end)]
|
||||
[(keyword name) end])))
|
||||
|
||||
(defn escape-char [c]
|
||||
(if (= c 110) "\n"
|
||||
(if (= c 116) "\t"
|
||||
(if (= c 114) "\r"
|
||||
(if (= c 92) "\\"
|
||||
(if (= c 34) "\""
|
||||
(string/from-bytes c)))))))
|
||||
|
||||
(defn read-string-chars [s pos end chars]
|
||||
(if (>= pos end)
|
||||
(error "Unterminated string")
|
||||
(let [c (s pos)]
|
||||
(if (= c 92) # backslash
|
||||
(let [next-pos (+ pos 1)]
|
||||
(if (>= next-pos end)
|
||||
(error "Unterminated escape")
|
||||
(read-string-chars s (+ pos 2) end
|
||||
(array/push chars (escape-char (s next-pos))))))
|
||||
(if (= c 34) # closing quote
|
||||
[pos chars]
|
||||
(read-string-chars s (+ pos 1) end
|
||||
(array/push chars (string/from-bytes c))))))))
|
||||
|
||||
(defn read-string [s pos]
|
||||
# pos is at opening double-quote
|
||||
(let [end (length s)
|
||||
[new-pos chars] (read-string-chars s (+ pos 1) end @[])]
|
||||
[(string/join chars "") (+ new-pos 1)]))
|
||||
|
||||
(defn read-hex-digits [s pos end]
|
||||
(if (and (< end (length s)) (hex-digit? (s end)))
|
||||
(read-hex-digits s pos (+ end 1))
|
||||
end))
|
||||
|
||||
(defn read-digits [s pos end]
|
||||
(if (and (< end (length s)) (digit? (s end)))
|
||||
(read-digits s pos (+ end 1))
|
||||
end))
|
||||
|
||||
(defn read-fractional [s pos end]
|
||||
(if (and (< end (length s)) (digit? (s end)))
|
||||
(read-fractional s pos (+ end 1))
|
||||
end))
|
||||
|
||||
(defn read-number [s pos]
|
||||
(var start pos) # start is mutable for sign handling
|
||||
(var neg false)
|
||||
|
||||
# optional sign
|
||||
(if (and (< pos (length s)) (= (s pos) 45))
|
||||
(do (set start (+ pos 1)) (set neg true)))
|
||||
|
||||
(let [pos start
|
||||
hex? (and (< (+ pos 1) (length s))
|
||||
(= (s pos) 48) (= (s (+ pos 1)) 120))
|
||||
start (if hex? (+ pos 2) pos)
|
||||
end (if hex?
|
||||
(read-hex-digits s start start)
|
||||
(read-digits s start start))]
|
||||
(if (= end start) (error (string "Expected number at " pos)))
|
||||
|
||||
# check for fractional part
|
||||
(if (and (not hex?)
|
||||
(< end (length s))
|
||||
(= (s end) 46))
|
||||
(let [frac-start (+ end 1)
|
||||
frac-end (read-fractional s frac-start frac-start)]
|
||||
(if (= frac-end frac-start) (error "Expected digit after ."))
|
||||
(let [num-str (string/slice s start frac-end)
|
||||
val (scan-number num-str)]
|
||||
[(if neg (- val) val) frac-end]))
|
||||
|
||||
# integer or hex
|
||||
(let [num-str (string/slice s start end)
|
||||
val (if hex?
|
||||
(string/format "0x%s" num-str)
|
||||
num-str)
|
||||
val (scan-number val)]
|
||||
[(if neg (- val) val) end]))))
|
||||
|
||||
(defn read-list [s pos]
|
||||
# pos is at opening paren
|
||||
(defn read-list-items [s pos items]
|
||||
(let [pos (skip-whitespace s pos)]
|
||||
(if (>= pos (length s))
|
||||
(error "Unterminated list"))
|
||||
(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))))))
|
||||
(read-list-items s (+ pos 1) @[]))
|
||||
|
||||
(defn read-vector [s pos]
|
||||
# pos is at opening bracket
|
||||
(defn read-vec-items [s pos items]
|
||||
(let [pos (skip-whitespace s pos)]
|
||||
(if (>= pos (length s))
|
||||
(error "Unterminated vector"))
|
||||
(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))))))
|
||||
(read-vec-items s (+ pos 1) @[]))
|
||||
|
||||
(defn read-map [s pos]
|
||||
# pos is at opening brace
|
||||
(defn read-kvs [s pos kvs]
|
||||
(let [pos (skip-whitespace s pos)]
|
||||
(if (>= pos (length s))
|
||||
(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)))))))
|
||||
(read-kvs s (+ pos 1) @[]))
|
||||
|
||||
(defn read-set [s pos]
|
||||
# pos is at #, next char is {
|
||||
(defn read-set-items [s pos items]
|
||||
(let [pos (skip-whitespace s pos)]
|
||||
(if (>= pos (length s))
|
||||
(error "Unterminated set"))
|
||||
(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))))))
|
||||
(read-set-items s (+ pos 2) @[]))
|
||||
|
||||
(defn read-char-name-end [s pos]
|
||||
(if (and (< pos (length s)) (symbol-char? (s pos)))
|
||||
(read-char-name-end s (+ pos 1))
|
||||
pos))
|
||||
|
||||
(defn read-char [s pos]
|
||||
# pos is at backslash
|
||||
(let [end (read-char-name-end s (+ pos 1))
|
||||
char-name (string/slice s (+ pos 1) end)]
|
||||
[{:jolt/type :char :name char-name} end]))
|
||||
|
||||
(defn read-anon-fn [s pos]
|
||||
# pos is at #, next char is (
|
||||
(let [[form new-pos] (read-form s (+ pos 1))]
|
||||
[(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]))
|
||||
|
||||
(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-dispatch [s pos]
|
||||
# pos is at #
|
||||
(if (>= (+ pos 1) (length s))
|
||||
(error "Unexpected end after #"))
|
||||
(let [c (s (+ pos 1))]
|
||||
(cond
|
||||
(= c 123) (read-set s pos) # #{
|
||||
(= 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))
|
||||
(= c 39) (read-var-quote s pos) # #'
|
||||
# unknown dispatch — tagged literal
|
||||
(let [end (read-symbol-name s pos pos)
|
||||
tag (string/slice s pos end)
|
||||
[form new-pos] (read-form s end)]
|
||||
[{:jolt/type :jolt/tagged :tag (keyword tag) :form form} new-pos]))))
|
||||
|
||||
(defn read-quote [s pos new-pos token-sym]
|
||||
(let [[form final-pos] (read-form s new-pos)]
|
||||
[(array token-sym form) final-pos]))
|
||||
|
||||
(defn read-meta [s pos]
|
||||
# pos is at ^
|
||||
(let [[meta-form new-pos] (read-form s (+ pos 1))
|
||||
[form new-pos2] (read-form s new-pos)]
|
||||
[(array (sym "with-meta") form meta-form) new-pos2]))
|
||||
|
||||
(defn read-until-newline [s pos]
|
||||
(if (or (>= pos (length s)) (= (s pos) 10))
|
||||
pos
|
||||
(read-until-newline s (+ pos 1))))
|
||||
|
||||
(set read-form (fn [s pos]
|
||||
(let [pos (skip-whitespace s pos)]
|
||||
(if (>= pos (length s))
|
||||
[nil pos]
|
||||
(let [c (s pos)]
|
||||
(cond
|
||||
# comment
|
||||
(= c 59)
|
||||
(let [line-end (read-until-newline s pos)]
|
||||
(read-form s line-end))
|
||||
|
||||
# dispatch
|
||||
(= c 35)
|
||||
(read-dispatch s pos)
|
||||
|
||||
# string
|
||||
(= c 34)
|
||||
(read-string s pos)
|
||||
|
||||
# list
|
||||
(= c 40)
|
||||
(read-list s pos)
|
||||
|
||||
# vector
|
||||
(= c 91)
|
||||
(read-vector s pos)
|
||||
|
||||
# map
|
||||
(= c 123)
|
||||
(read-map s pos)
|
||||
|
||||
# keyword
|
||||
(= c 58)
|
||||
(read-keyword s pos)
|
||||
|
||||
# quote
|
||||
(= c 39)
|
||||
(read-quote s pos (+ pos 1) (sym "quote"))
|
||||
|
||||
# syntax-quote / backtick
|
||||
(= c 96)
|
||||
(read-quote s pos (+ pos 1) (sym "syntax-quote"))
|
||||
|
||||
# unquote ~
|
||||
(= c 126)
|
||||
(if (and (< (+ pos 1) (length s)) (= (s (+ pos 1)) 64))
|
||||
(read-quote s pos (+ pos 2) (sym "unquote-splicing"))
|
||||
(read-quote s pos (+ pos 1) (sym "unquote")))
|
||||
|
||||
# deref
|
||||
(= c 64)
|
||||
(read-quote s pos (+ pos 1) (sym "deref"))
|
||||
|
||||
# metadata
|
||||
(= c 94)
|
||||
(read-meta s pos)
|
||||
|
||||
# character
|
||||
(= c 92)
|
||||
(read-char s pos)
|
||||
|
||||
# number or symbol
|
||||
(if (or (digit? c)
|
||||
(and (= c 45) (< (+ pos 1) (length s)) (digit? (s (+ pos 1))))
|
||||
(and (= c 43) (< (+ pos 1) (length s)) (digit? (s (+ pos 1)))))
|
||||
(read-number s pos)
|
||||
(read-symbol s pos))))))))
|
||||
|
||||
(defn parse-string
|
||||
"Parse a Clojure source string and return the first form."
|
||||
[s]
|
||||
(let [[form _] (read-form s 0)]
|
||||
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)]))
|
||||
276
src/jolt/types.janet
Normal file
276
src/jolt/types.janet
Normal file
|
|
@ -0,0 +1,276 @@
|
|||
# Jolt Types
|
||||
# Core types for the Clojure-on-Janet interpreter.
|
||||
#
|
||||
# Types:
|
||||
# JoltVar — mutable container with metadata (like Clojure Var)
|
||||
# JoltNamespace — namespace with symbol→var mappings and imports
|
||||
# JoltContext — evaluation context (env atom, namespaces)
|
||||
#
|
||||
# Symbols are represented as {:jolt/type :symbol :ns <string-or-nil> :name <string>}
|
||||
# as produced by the reader.
|
||||
|
||||
# ============================================================
|
||||
# Symbol helpers
|
||||
# ============================================================
|
||||
|
||||
(defn sym?
|
||||
"Check if x is a Jolt symbol struct."
|
||||
[x]
|
||||
(and (struct? x) (= :symbol (x :jolt/type))))
|
||||
|
||||
# ============================================================
|
||||
# Var
|
||||
# ============================================================
|
||||
|
||||
(def- binding-stack @[]) # stack of {var → value} tables for thread-local bindings
|
||||
|
||||
(defn push-thread-bindings
|
||||
"Push a frame of dynamic var bindings. Takes a struct of var→value."
|
||||
[bindings]
|
||||
(array/push binding-stack bindings))
|
||||
|
||||
(defn pop-thread-bindings
|
||||
"Pop the most recent frame of dynamic var bindings."
|
||||
[]
|
||||
(array/pop binding-stack))
|
||||
|
||||
(defn make-var
|
||||
"Create a new Jolt Var.
|
||||
(make-var name) — unbound var
|
||||
(make-var name init-val) — var with root binding
|
||||
(make-var name init-val meta) — var with root and metadata
|
||||
|
||||
name is a symbol struct {:jolt/type :symbol ...}"
|
||||
[name &opt init-val meta]
|
||||
(default init-val nil)
|
||||
(default meta nil)
|
||||
(let [m (if meta meta {:name name})
|
||||
result @{:jolt/type :jolt/var
|
||||
:name name
|
||||
:root init-val
|
||||
:meta m
|
||||
:dynamic (if meta (get meta :dynamic) false)
|
||||
:macro (if meta (get meta :macro) false)
|
||||
:ns (if meta (get meta :ns) nil)}]
|
||||
result))
|
||||
|
||||
(defn var?
|
||||
"Check if x is a Jolt Var."
|
||||
[x]
|
||||
(and (table? x) (= :jolt/var (x :jolt/type))))
|
||||
|
||||
(defn var-dynamic?
|
||||
"Check if var is marked :dynamic."
|
||||
[v]
|
||||
(v :dynamic))
|
||||
|
||||
(defn var-macro?
|
||||
"Check if var is marked :macro."
|
||||
[v]
|
||||
(v :macro))
|
||||
|
||||
(defn var-name
|
||||
"Return the symbol name of the var."
|
||||
[v]
|
||||
(v :name))
|
||||
|
||||
(defn var-meta
|
||||
"Return the metadata of the var."
|
||||
[v]
|
||||
(v :meta))
|
||||
|
||||
(defn var-ns
|
||||
"Return the namespace of the var."
|
||||
[v]
|
||||
(v :ns))
|
||||
|
||||
(defn var-get
|
||||
"Deref the var. If the var is dynamic and has a thread-local binding, return that.
|
||||
Otherwise return the root binding."
|
||||
[v]
|
||||
# walk binding stack top-down for this var
|
||||
(var result nil)
|
||||
(var i (dec (length binding-stack)))
|
||||
(while (>= i 0)
|
||||
(let [frame (in binding-stack i)
|
||||
val (get frame v)]
|
||||
(if (not (nil? val))
|
||||
(do
|
||||
(set result (if (var? val) (var-get val) val))
|
||||
(set i -1))
|
||||
(-- i))))
|
||||
(if (not (nil? result)) result (v :root)))
|
||||
|
||||
(defn var-set
|
||||
"Set the root binding of a var."
|
||||
[v val]
|
||||
(put v :root val))
|
||||
|
||||
(defn alter-var-root
|
||||
"Atomically alter the root binding of v by applying f to current value plus args."
|
||||
[v f & args]
|
||||
(let [new-val (f (v :root) ;args)]
|
||||
(put v :root new-val)))
|
||||
|
||||
(defn with-meta
|
||||
"Return a new var with updated metadata. The original var is unchanged."
|
||||
[v meta]
|
||||
# build new meta as a table first (to allow adding keys), then convert
|
||||
(let [new-meta-table (merge @{} (v :meta) meta)
|
||||
# convert to struct by extracting all keys
|
||||
new-meta (table/to-struct new-meta-table)]
|
||||
@{:jolt/type :jolt/var
|
||||
:name (v :name)
|
||||
:root (v :root)
|
||||
:meta new-meta
|
||||
:dynamic (v :dynamic)
|
||||
:macro (v :macro)
|
||||
:ns (v :ns)}))
|
||||
|
||||
(defn bind-root
|
||||
"Set the root binding (internal, same as var-set)."
|
||||
[v val]
|
||||
(put v :root val))
|
||||
|
||||
# ============================================================
|
||||
# Namespace
|
||||
# ============================================================
|
||||
|
||||
(defn make-ns
|
||||
"Create a new namespace.
|
||||
(make-ns name) — empty namespace
|
||||
name is a symbol struct {:jolt/type :symbol ...}"
|
||||
[name]
|
||||
(struct
|
||||
:jolt/type :jolt/namespace
|
||||
:name name
|
||||
:mappings @{}
|
||||
:imports @{}
|
||||
:aliases @{}))
|
||||
|
||||
(defn ns?
|
||||
"Check if x is a Jolt Namespace."
|
||||
[x]
|
||||
(and (struct? x) (= :jolt/namespace (x :jolt/type))))
|
||||
|
||||
(defn ns-name
|
||||
"Return the name symbol of a namespace."
|
||||
[ns]
|
||||
(ns :name))
|
||||
|
||||
(defn ns-map
|
||||
"Return the mappings table (symbol → var) for a namespace."
|
||||
[ns]
|
||||
(ns :mappings))
|
||||
|
||||
(defn ns-intern
|
||||
"Find or create a var named by sym in namespace ns, setting root binding to val if given.
|
||||
(ns-intern ns sym) — find or create unbound var
|
||||
(ns-intern ns sym val) — find or create with root binding"
|
||||
[ns sym &opt val]
|
||||
(default val nil)
|
||||
(let [mappings (ns :mappings)
|
||||
existing (get mappings sym)]
|
||||
(if existing
|
||||
(do
|
||||
(when (not (nil? val))
|
||||
(bind-root existing val))
|
||||
existing)
|
||||
(let [v (make-var sym val {:ns ns :name sym})]
|
||||
(put mappings sym v)
|
||||
v))))
|
||||
|
||||
(defn ns-find
|
||||
"Find a var by symbol in the namespace. Returns nil if not found."
|
||||
[ns sym]
|
||||
(get (ns :mappings) sym))
|
||||
|
||||
(defn ns-unmap
|
||||
"Remove a mapping by symbol from the namespace."
|
||||
[ns sym]
|
||||
(put (ns :mappings) sym nil))
|
||||
|
||||
(defn ns-resolve
|
||||
"Resolve a symbol in a namespace. Looks in own mappings first,
|
||||
then aliases. Returns the var or nil."
|
||||
[ns sym]
|
||||
(or (ns-find ns sym)
|
||||
(let [qualified? (sym? sym)]
|
||||
(when qualified?
|
||||
# qualified symbol: look up via alias
|
||||
(let [alias-ns (get (ns :aliases) (sym :ns))]
|
||||
(when alias-ns
|
||||
(ns-find alias-ns (sym :name))))))))
|
||||
|
||||
(defn ns-import
|
||||
"Add an import to the namespace. class-name is local symbol, fq-class-name is the full qualified name."
|
||||
[ns class-name fq-class-name]
|
||||
(put (ns :imports) class-name fq-class-name))
|
||||
|
||||
(defn ns-import-lookup
|
||||
"Look up an import in the namespace. Returns the full qualified name or nil."
|
||||
[ns class-name]
|
||||
(get (ns :imports) class-name))
|
||||
|
||||
(defn ns-add-alias
|
||||
"Add an alias from alias-sym to target-ns."
|
||||
[ns alias-sym target-ns]
|
||||
(put (ns :aliases) alias-sym target-ns))
|
||||
|
||||
# ============================================================
|
||||
# Context
|
||||
# ============================================================
|
||||
|
||||
(defn ctx-find-ns
|
||||
"Find or create a namespace in the context by name symbol."
|
||||
[ctx ns-sym]
|
||||
(let [env (ctx :env)
|
||||
namespaces (env :namespaces)]
|
||||
(or (get namespaces ns-sym)
|
||||
(let [ns (make-ns ns-sym)]
|
||||
(put namespaces ns-sym ns)
|
||||
ns))))
|
||||
|
||||
(defn make-ctx
|
||||
"Create a new evaluation context.
|
||||
(make-ctx) — empty context with 'user namespace
|
||||
(make-ctx opts) — context with initial namespaces from opts
|
||||
|
||||
opts may contain:
|
||||
:namespaces — struct of {ns-symbol → {sym → value, ...}, ...}"
|
||||
[&opt opts]
|
||||
(default opts nil)
|
||||
(let [env @{:namespaces @{}
|
||||
:class->opts @{}
|
||||
:current-ns "user"}
|
||||
# create the user namespace via a partial context
|
||||
_ (ctx-find-ns {:env env} "user")]
|
||||
# initialize from opts
|
||||
(when opts
|
||||
(when-let [ns-opts (get opts :namespaces)]
|
||||
(loop [[ns-sym mappings] :pairs ns-opts]
|
||||
(let [ns (ctx-find-ns {:env env} ns-sym)]
|
||||
(loop [[sym val] :pairs mappings]
|
||||
(ns-intern ns sym val))))))
|
||||
{:jolt/type :jolt/context
|
||||
:env env}))
|
||||
|
||||
(defn ctx?
|
||||
"Check if x is a Jolt Context."
|
||||
[x]
|
||||
(and (struct? x) (= :jolt/context (x :jolt/type))))
|
||||
|
||||
(defn ctx-env
|
||||
"Return the env atom from the context."
|
||||
[ctx]
|
||||
(ctx :env))
|
||||
|
||||
(defn ctx-current-ns
|
||||
"Get the current namespace symbol."
|
||||
[ctx]
|
||||
(get (ctx :env) :current-ns))
|
||||
|
||||
(defn ctx-set-current-ns
|
||||
"Set the current namespace symbol."
|
||||
[ctx ns-sym]
|
||||
(put (ctx :env) :current-ns ns-sym))
|
||||
38
test/api-test.janet
Normal file
38
test/api-test.janet
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
(use ../src/jolt/api)
|
||||
(use ../src/jolt/types)
|
||||
|
||||
(print "1: init creates context...")
|
||||
(let [ctx (init)]
|
||||
(assert (ctx? ctx) "init returns context")
|
||||
(let [ns (ctx-find-ns ctx "clojure.core")]
|
||||
(assert (ns? ns) "clojure.core namespace exists")
|
||||
(assert (ns-find ns "nil?") "nil? is interned")
|
||||
(assert (ns-find ns "+") "+ is interned")))
|
||||
(print " passed")
|
||||
|
||||
(print "2: eval-string basics...")
|
||||
(let [ctx (init)]
|
||||
(assert (= 42 (eval-string ctx "42")) "eval integer")
|
||||
(assert (= true (eval-string ctx "true")) "eval bool")
|
||||
(assert (= 3 (eval-string ctx "(+ 1 2)")) "eval list"))
|
||||
(print " passed")
|
||||
|
||||
(print "3: eval-string with core fns...")
|
||||
(let [ctx (init)]
|
||||
(assert (= true (eval-string ctx "(nil? nil)")) "nil?")
|
||||
(assert (deep= [2 3 4] (eval-string ctx "(map inc [1 2 3])")) "map+inc")
|
||||
(assert (= 6 (eval-string ctx "(reduce + [1 2 3])")) "reduce"))
|
||||
(print " passed")
|
||||
|
||||
(print "4: eval-string with def...")
|
||||
(let [ctx (init)]
|
||||
(eval-string ctx "(def x 42)")
|
||||
(assert (= 42 (eval-string ctx "x")) "def then resolve"))
|
||||
(print " passed")
|
||||
|
||||
(print "5: eval-string* with bindings...")
|
||||
(let [ctx (init)]
|
||||
(assert (= 99 (eval-string* ctx "y" @{"y" 99})) "bound variable"))
|
||||
(print " passed")
|
||||
|
||||
(print "\nAll API tests passed!")
|
||||
110
test/core-test.janet
Normal file
110
test/core-test.janet
Normal file
|
|
@ -0,0 +1,110 @@
|
|||
(use ../src/jolt/types)
|
||||
(use ../src/jolt/reader)
|
||||
(use ../src/jolt/evaluator)
|
||||
(use ../src/jolt/core)
|
||||
|
||||
# Helper: create a fresh bootstrapped context
|
||||
(defn make-boot-ctx []
|
||||
(let [ctx (make-ctx)]
|
||||
(init-core! ctx)
|
||||
ctx))
|
||||
|
||||
# Helper: parse + eval
|
||||
(defn eval-str [ctx s]
|
||||
(let [form (parse-string s)]
|
||||
(eval-form ctx @{} form)))
|
||||
|
||||
(print "1: predicates...")
|
||||
(let [ctx (make-boot-ctx)]
|
||||
(assert (= true (eval-str ctx "(nil? nil)")) "nil?")
|
||||
(assert (= false (eval-str ctx "(nil? 1)")) "nil? false")
|
||||
(assert (= true (eval-str ctx "(string? \"hello\")")) "string?")
|
||||
(assert (= true (eval-str ctx "(number? 42)")) "number?")
|
||||
(assert (= true (eval-str ctx "(fn? inc)")) "fn?")
|
||||
(assert (= true (eval-str ctx "(keyword? :foo)")) "keyword?")
|
||||
(assert (= false (eval-str ctx "(keyword? 1)")) "keyword? false")
|
||||
(assert (= true (eval-str ctx "(zero? 0)")) "zero?")
|
||||
(assert (= true (eval-str ctx "(pos? 1)")) "pos?")
|
||||
(assert (= true (eval-str ctx "(neg? -1)")) "neg?")
|
||||
(assert (= true (eval-str ctx "(even? 2)")) "even?")
|
||||
(assert (= true (eval-str ctx "(odd? 1)")) "odd?")
|
||||
(assert (= true (eval-str ctx "(empty? [])")) "empty? vector")
|
||||
(assert (= false (eval-str ctx "(empty? [1])")) "empty? non-empty"))
|
||||
(print " passed")
|
||||
|
||||
(print "2: math...")
|
||||
(let [ctx (make-boot-ctx)]
|
||||
(assert (= 0 (eval-str ctx "(+)")) "+ 0 args")
|
||||
(assert (= 5 (eval-str ctx "(+ 2 3)")) "+ 2 args")
|
||||
(assert (= 10 (eval-str ctx "(+ 1 2 3 4)")) "+ varargs")
|
||||
(assert (= -5 (eval-str ctx "(- 5)")) "- unary")
|
||||
(assert (= 2 (eval-str ctx "(- 5 3)")) "- binary")
|
||||
(assert (= 6 (eval-str ctx "(* 2 3)")) "*")
|
||||
(assert (= 1 (eval-str ctx "(*)")) "* 0 args")
|
||||
(assert (= 42 (eval-str ctx "(inc 41)")) "inc")
|
||||
(assert (= 40 (eval-str ctx "(dec 41)")) "dec")
|
||||
(assert (= 4 (eval-str ctx "(max 1 4 2)")) "max"))
|
||||
(print " passed")
|
||||
|
||||
(print "3: comparison...")
|
||||
(let [ctx (make-boot-ctx)]
|
||||
(assert (= true (eval-str ctx "(= 1 1)")) "= same")
|
||||
(assert (= false (eval-str ctx "(= 1 2)")) "= diff")
|
||||
(assert (= true (eval-str ctx "(= 1 1 1)")) "= multi same")
|
||||
(assert (= false (eval-str ctx "(= 1 2 1)")) "= multi diff")
|
||||
(assert (= true (eval-str ctx "(not= 1 2)")) "not="))
|
||||
(print " passed")
|
||||
|
||||
(print "4: collections...")
|
||||
(let [ctx (make-boot-ctx)]
|
||||
(assert (= 3 (eval-str ctx "(count [1 2 3])")) "count vector")
|
||||
(assert (= 1 (eval-str ctx "(first [1 2 3])")) "first")
|
||||
(assert (deep= [2 3] (eval-str ctx "(rest [1 2 3])")) "rest")
|
||||
(assert (= nil (eval-str ctx "(next [1])")) "next singleton")
|
||||
(assert (deep= [1 2 3] (eval-str ctx "(conj [1 2] 3)")) "conj vector")
|
||||
(assert (= 1 (eval-str ctx "(get {:a 1} :a)")) "get map")
|
||||
(assert (= 2 (eval-str ctx "(get [1 2 3] 1)")) "get vector")
|
||||
(assert (= :default (eval-str ctx "(get {:a 1} :b :default)")) "get default")
|
||||
(assert (deep= {:a 1 :c 3} (eval-str ctx "(assoc {:a 1} :c 3)")) "assoc")
|
||||
(assert (deep= {:a 1} (eval-str ctx "(dissoc {:a 1 :b 2} :b)")) "dissoc"))
|
||||
(print " passed")
|
||||
|
||||
(print "5: seq ops...")
|
||||
(let [ctx (make-boot-ctx)]
|
||||
(assert (deep= [2 3 4] (eval-str ctx "(map inc [1 2 3])")) "map")
|
||||
(assert (deep= [2 4] (eval-str ctx "(filter even? [1 2 3 4])")) "filter")
|
||||
(assert (= 6 (eval-str ctx "(reduce + [1 2 3])")) "reduce")
|
||||
(assert (= 10 (eval-str ctx "(reduce + 4 [1 2 3])")) "reduce with val")
|
||||
(assert (deep= [1 2] (eval-str ctx "(take 2 [1 2 3 4])")) "take")
|
||||
(assert (deep= [3 4] (eval-str ctx "(drop 2 [1 2 3 4])")) "drop")
|
||||
(assert (deep= [1 2] (eval-str ctx "(take-while (fn* [x] (<= x 2)) [1 2 3 4])")) "take-while"))
|
||||
(print " passed")
|
||||
|
||||
(print "6: range...")
|
||||
(let [ctx (make-boot-ctx)]
|
||||
(assert (deep= [0 1 2 3 4] (eval-str ctx "(range 5)")) "range end")
|
||||
(assert (deep= [2 3 4] (eval-str ctx "(range 2 5)")) "range start end"))
|
||||
(print " passed")
|
||||
|
||||
(print "7: higher-order...")
|
||||
(let [ctx (make-boot-ctx)]
|
||||
(assert (= 42 (eval-str ctx "(identity 42)")) "identity")
|
||||
(assert (= 42 (eval-str ctx "(let* [f (constantly 42)] (f))")) "constantly")
|
||||
(assert (= 3 (eval-str ctx "(let* [f (comp inc inc)] (f 1))")) "comp")
|
||||
(assert (deep= [2 0] (eval-str ctx "(let* [f (juxt inc dec)] (f 1))")) "juxt"))
|
||||
(print " passed")
|
||||
|
||||
(print "8: str...")
|
||||
(let [ctx (make-boot-ctx)]
|
||||
(assert (= "hello" (eval-str ctx "(str \"hello\")")) "str")
|
||||
(assert (= "hello42" (eval-str ctx "(str \"hello\" 42)")) "str concat"))
|
||||
(print " passed")
|
||||
|
||||
(print "9: atom...")
|
||||
(let [ctx (make-boot-ctx)]
|
||||
(assert (= 1 (eval-str ctx "(let* [a (atom 1)] (deref a))")) "atom + deref")
|
||||
(assert (= 42 (eval-str ctx "(let* [a (atom 1)] (reset! a 42) (deref a))")) "reset!")
|
||||
(assert (= 2 (eval-str ctx "(let* [a (atom 1)] (swap! a inc) (deref a))")) "swap!"))
|
||||
(print " passed")
|
||||
|
||||
(print "\nAll core tests passed!")
|
||||
73
test/evaluator-test.janet
Normal file
73
test/evaluator-test.janet
Normal file
|
|
@ -0,0 +1,73 @@
|
|||
(use ../src/jolt/evaluator)
|
||||
(use ../src/jolt/types)
|
||||
(use ../src/jolt/reader)
|
||||
|
||||
# Helper: create a Jolt symbol
|
||||
(defn sym [name]
|
||||
(let [slash (string/find "/" name)]
|
||||
(if slash
|
||||
{:jolt/type :symbol :ns (string/slice name 0 slash)
|
||||
:name (string/slice name (+ slash 1))}
|
||||
{:jolt/type :symbol :ns nil :name name})))
|
||||
|
||||
# Helper: parse and eval
|
||||
(defn eval-str [s]
|
||||
(let [ctx (make-ctx)
|
||||
form (parse-string s)]
|
||||
(eval-form ctx @{} form)))
|
||||
|
||||
(print "1: literals...")
|
||||
(assert (= 42 (eval-str "42")) "integer")
|
||||
(assert (= "hello" (eval-str "\"hello\"")) "string")
|
||||
(assert (= true (eval-str "true")) "true")
|
||||
(assert (= false (eval-str "false")) "false")
|
||||
(assert (= nil (eval-str "nil")) "nil")
|
||||
(print " passed")
|
||||
|
||||
(print "2: quote...")
|
||||
(assert (deep= (sym "x") (eval-str "'x")) "quote returns symbol")
|
||||
(assert (deep= @[1 2 3] (eval-str "'(1 2 3)")) "quote list")
|
||||
(print " passed")
|
||||
|
||||
(print "3: do...")
|
||||
(assert (= 2 (eval-str "(do 1 2)")) "do returns last")
|
||||
(print " passed")
|
||||
|
||||
(print "4: if...")
|
||||
(assert (= 1 (eval-str "(if true 1 2)")) "if true")
|
||||
(assert (= 2 (eval-str "(if false 1 2)")) "if false")
|
||||
(assert (= :b (eval-str "(if nil :a :b)")) "if nil = false")
|
||||
(assert (= nil (eval-str "(if false 1)")) "if with no else")
|
||||
(print " passed")
|
||||
|
||||
(print "5: def...")
|
||||
(assert (= 42 (eval-str "(do (def x 42) x)")) "def in do")
|
||||
(print " passed")
|
||||
|
||||
(print "6: fn*...")
|
||||
(let [f (eval-str "(fn* [x] (inc x))")]
|
||||
(assert (function? f) "fn* returns function")
|
||||
(assert (= 42 (f 41)) "fn* fn works"))
|
||||
# nested function
|
||||
(let [f (eval-str "(fn* [x] (inc (inc x)))")]
|
||||
(assert (= 43 (f 41)) "nested inc"))
|
||||
(print " passed")
|
||||
|
||||
(print "7: let*...")
|
||||
(assert (= 2 (eval-str "(let* [x 1 y 2] y)")) "let* binds")
|
||||
(assert (= 3 (eval-str "(let* [x 1] (inc (inc x)))")) "let* with expr")
|
||||
(print " passed")
|
||||
|
||||
(print "8: loop*/recur...")
|
||||
(assert (= 5 (eval-str "(loop* [x 0] (if (< x 5) (recur (inc x)) x))"))
|
||||
"loop counts up")
|
||||
(assert (= 10 (eval-str "(loop* [i 0 acc 0] (if (< i 5) (recur (inc i) (+ acc i)) acc))"))
|
||||
"loop with multiple bindings")
|
||||
(print " passed")
|
||||
|
||||
(print "9: recur in fn*...")
|
||||
(let [countdown (eval-str "(fn* [n] (if (< n 1) 0 (recur (dec n))))")]
|
||||
(assert (= 0 (countdown 5)) "recur in fn"))
|
||||
(print " passed")
|
||||
|
||||
(print "\nAll evaluator tests passed!")
|
||||
129
test/macro-test.janet
Normal file
129
test/macro-test.janet
Normal file
|
|
@ -0,0 +1,129 @@
|
|||
(use ../src/jolt/reader)
|
||||
(use ../src/jolt/types)
|
||||
(use ../src/jolt/evaluator)
|
||||
|
||||
# Helper: create a Jolt symbol
|
||||
(defn sym [name]
|
||||
(let [slash (string/find "/" name)]
|
||||
(if slash
|
||||
{:jolt/type :symbol :ns (string/slice name 0 slash)
|
||||
:name (string/slice name (+ slash 1))}
|
||||
{:jolt/type :symbol :ns nil :name name})))
|
||||
|
||||
# Helper: parse and eval
|
||||
(defn eval-str [s]
|
||||
(let [ctx (make-ctx)
|
||||
form (parse-string s)]
|
||||
(eval-form ctx @{} form)))
|
||||
|
||||
# ============================================================
|
||||
# 1. syntax-quote — literals pass through
|
||||
# ============================================================
|
||||
(print "1: syntax-quote literals...")
|
||||
(assert (= 42 (eval-str "`42")) "syntax-quote number")
|
||||
(assert (= "hello" (eval-str "`\"hello\"")) "syntax-quote string")
|
||||
(assert (= :foo (eval-str "`:foo")) "syntax-quote keyword")
|
||||
(assert (= nil (eval-str "`nil")) "syntax-quote nil")
|
||||
(assert (= true (eval-str "`true")) "syntax-quote true")
|
||||
(assert (= false (eval-str "`false")) "syntax-quote false")
|
||||
(print " passed")
|
||||
|
||||
# ============================================================
|
||||
# 2. syntax-quote — qualify symbols
|
||||
# ============================================================
|
||||
(print "2: syntax-quote qualifies symbols...")
|
||||
# In the 'user namespace, `x → user/x
|
||||
(let [form (eval-str "`x")]
|
||||
(assert (deep= {:jolt/type :symbol :ns "user" :name "x"} form)
|
||||
"qualifies bare symbol to current ns"))
|
||||
|
||||
# Already qualified symbols stay as-is
|
||||
(let [form (eval-str "`foo/bar")]
|
||||
(assert (deep= {:jolt/type :symbol :ns "foo" :name "bar"} form)
|
||||
"qualified symbol unchanged"))
|
||||
(print " passed")
|
||||
|
||||
# ============================================================
|
||||
# 3. syntax-quote — lists: qualify symbols, literal items as-is
|
||||
# ============================================================
|
||||
(print "3: syntax-quote lists...")
|
||||
# `(+ 1 2) → (user/+ 1 2) — but 1 and 2 are numbers, stay as-is
|
||||
(let [form (eval-str "`(+ 1 2)")]
|
||||
(assert (array? form) "syntax-quote list is array")
|
||||
(assert (= 3 (length form)) "has 3 elements")
|
||||
(assert (deep= {:jolt/type :symbol :ns "user" :name "+"} (in form 0))
|
||||
"operator qualified")
|
||||
(assert (= 1 (in form 1)) "number stays")
|
||||
(assert (= 2 (in form 2)) "number stays"))
|
||||
(print " passed")
|
||||
|
||||
# ============================================================
|
||||
# 4. unquote inside syntax-quote
|
||||
# ============================================================
|
||||
(print "4: unquote...")
|
||||
# `~x inside (let* [x 10] ...) → 10
|
||||
(let [form (eval-str "(let* [x 10] `~x)")]
|
||||
(assert (= 10 form) "unquote evaluates"))
|
||||
# `(~x) produces a list containing x
|
||||
(let [form2 (eval-str "(let* [x 10] `(~x))")]
|
||||
(assert (deep= @[10] form2) "unquote in list"))
|
||||
|
||||
# `(+ ~x ~y) with x=1 y=2 → (+ 1 2)
|
||||
(let [form (eval-str "(let* [x 1 y 2] `(+ ~x ~y))")]
|
||||
(assert (array? form) "result is list")
|
||||
(assert (= 1 (in form 1)) "first unquoted value")
|
||||
(assert (= 2 (in form 2)) "second unquoted value"))
|
||||
(print " passed")
|
||||
|
||||
# ============================================================
|
||||
# 5. unquote-splicing inside syntax-quote
|
||||
# ============================================================
|
||||
(print "5: unquote-splicing...")
|
||||
# `[1 2 ~@xs] with xs = (3 4) → [1 2 3 4]
|
||||
(let [form (eval-str "(let* [xs '(3 4)] `[1 2 ~@xs])")]
|
||||
(assert (tuple? form) "result is vector")
|
||||
(assert (= 4 (length form)) "spliced items merged")
|
||||
(assert (deep= [1 2 3 4] form) "correct items"))
|
||||
|
||||
# `(1 ~@xs) with xs = (2 3) → (1 2 3)
|
||||
(let [form (eval-str "(let* [xs '(2 3)] `(1 ~@xs))")]
|
||||
(assert (array? form) "result is list")
|
||||
(assert (= 3 (length form)) "spliced into list")
|
||||
(assert (deep= @[1 2 3] form) "correct items"))
|
||||
(print " passed")
|
||||
|
||||
# ============================================================
|
||||
# 6. Macro function application
|
||||
# ============================================================
|
||||
(print "6: macro application...")
|
||||
|
||||
# Define a simple macro: (my-when test body) → (if test body nil)
|
||||
(def ctx (make-ctx))
|
||||
(def macro-fn-form (parse-string "(fn* [test body] (if test body nil))"))
|
||||
(def macro-fn (eval-form ctx @{} macro-fn-form))
|
||||
# intern it in user namespace with string key
|
||||
(let [ns (ctx-find-ns ctx "user")]
|
||||
(ns-intern ns "my-when" macro-fn)
|
||||
(put (ns-find ns "my-when") :macro true))
|
||||
|
||||
# (my-when true 42) should expand to (if true 42 nil), evaluating to 42
|
||||
(let [form (parse-string "(my-when true 42)")]
|
||||
(assert (= 42 (eval-form ctx @{} form)) "macro application returns correct value"))
|
||||
|
||||
# (my-when false 99) should expand to (if false 99 nil), evaluating to nil
|
||||
(let [form (parse-string "(my-when false 99)")]
|
||||
(assert (= nil (eval-form ctx @{} form)) "macro returns nil when false"))
|
||||
(print " passed")
|
||||
|
||||
# ============================================================
|
||||
# 7. Nested syntax-quote
|
||||
# ============================================================
|
||||
(print "7: nested syntax-quote...")
|
||||
# ``x → (syntax-quote user/x)
|
||||
(let [form (eval-str "``x")]
|
||||
(assert (array? form) "nested syntax-quote produces list")
|
||||
(assert (deep= {:jolt/type :symbol :ns nil :name "syntax-quote"} (in form 0))
|
||||
"outer is syntax-quote"))
|
||||
(print " passed")
|
||||
|
||||
(print "\nAll macro tests passed!")
|
||||
92
test/namespace-test.janet
Normal file
92
test/namespace-test.janet
Normal file
|
|
@ -0,0 +1,92 @@
|
|||
(use ../src/jolt/reader)
|
||||
(use ../src/jolt/types)
|
||||
(use ../src/jolt/evaluator)
|
||||
|
||||
# Helper: parse and eval in a fresh ctx
|
||||
(defn eval-str [s]
|
||||
(let [ctx (make-ctx)
|
||||
form (parse-string s)]
|
||||
(eval-form ctx @{} form)))
|
||||
|
||||
(print "1: in-ns...")
|
||||
(let [ctx (make-ctx)]
|
||||
(def form (parse-string "(in-ns my.app)"))
|
||||
(eval-form ctx @{} form)
|
||||
(assert (= "my.app" (ctx-current-ns ctx)) "in-ns switches namespace"))
|
||||
(print " passed")
|
||||
|
||||
(print "2: def in different namespace...")
|
||||
(let [ctx (make-ctx)]
|
||||
(eval-form ctx @{} (parse-string "(in-ns my.app)"))
|
||||
(eval-form ctx @{} (parse-string "(def x 42)"))
|
||||
(let [ns (ctx-find-ns ctx "my.app")
|
||||
v (ns-find ns "x")]
|
||||
(assert (= 42 (var-get v)) "def works in new namespace")))
|
||||
(print " passed")
|
||||
|
||||
(print "3: ns form...")
|
||||
(let [ctx (make-ctx)]
|
||||
(eval-form ctx @{} (parse-string "(ns my.lib)"))
|
||||
(assert (= "my.lib" (ctx-current-ns ctx)) "ns sets current namespace"))
|
||||
(print " passed")
|
||||
|
||||
(print "4: ns with require...")
|
||||
(let [ctx (make-ctx)]
|
||||
# Set up a namespace with some vars
|
||||
(let [other-ns (ctx-find-ns ctx "other.lib")]
|
||||
(ns-intern other-ns "f" (fn [x] (inc x))))
|
||||
# Now ns with require
|
||||
(eval-form ctx @{} (parse-string "(ns my.app (:require [other.lib :as o]))"))
|
||||
# current-ns should be my.app
|
||||
(assert (= "my.app" (ctx-current-ns ctx)) "ns with require sets current namespace")
|
||||
# Alias should be registered
|
||||
(let [ns (ctx-find-ns ctx "my.app")
|
||||
aliased (ns-import-lookup ns "o")]
|
||||
(assert (= "other.lib" aliased) "alias o -> other.lib registered")))
|
||||
(print " passed")
|
||||
|
||||
(print "5: require form (standalone)...")
|
||||
(let [ctx (make-ctx)]
|
||||
(eval-form ctx @{} (parse-string "(require '[other.lib :as o])"))
|
||||
(let [ns (ctx-find-ns ctx "user")
|
||||
aliased (ns-import-lookup ns "o")]
|
||||
(assert (= "other.lib" aliased) "standalone require registers alias")))
|
||||
(print " passed")
|
||||
|
||||
(print "6: qualified symbol via alias...")
|
||||
(let [ctx (make-ctx)]
|
||||
# Set up target ns
|
||||
(let [target (ctx-find-ns ctx "other.lib")]
|
||||
(ns-intern target "f" (fn [x] (inc x))))
|
||||
# Register alias
|
||||
(let [ns (ctx-find-ns ctx "user")]
|
||||
(ns-import ns "o" "other.lib"))
|
||||
# Resolve o/f and call it
|
||||
(let [form (parse-string "(o/f 41)")
|
||||
result (eval-form ctx @{} form)]
|
||||
(assert (= 42 result) "qualified call via alias works")))
|
||||
(print " passed")
|
||||
|
||||
(print "7: require then use alias...")
|
||||
(let [ctx (make-ctx)]
|
||||
# Set up target ns
|
||||
(let [target (ctx-find-ns ctx "math.lib")]
|
||||
(ns-intern target "add" (fn [a b] (+ a b))))
|
||||
# require + use
|
||||
(eval-form ctx @{} (parse-string "(require '[math.lib :as m])"))
|
||||
(let [result (eval-form ctx @{} (parse-string "(m/add 1 2)"))]
|
||||
(assert (= 3 result) "require + alias + call chain works")))
|
||||
(print " passed")
|
||||
|
||||
(print "8: ns form requires multiple...")
|
||||
(let [ctx (make-ctx)]
|
||||
(let [ns1 (ctx-find-ns ctx "a.lib")]
|
||||
(ns-intern ns1 "f" (fn [x] (inc x))))
|
||||
(let [ns2 (ctx-find-ns ctx "b.lib")]
|
||||
(ns-intern ns2 "g" (fn [x] (dec x))))
|
||||
(eval-form ctx @{} (parse-string "(ns user (:require [a.lib :as a] [b.lib :as b]))"))
|
||||
(assert (= 43 (eval-form ctx @{} (parse-string "(a/f 42)"))) "alias a works")
|
||||
(assert (= 41 (eval-form ctx @{} (parse-string "(b/g 42)"))) "alias b works"))
|
||||
(print " passed")
|
||||
|
||||
(print "\nAll namespace tests passed!")
|
||||
132
test/reader-test.janet
Normal file
132
test/reader-test.janet
Normal file
|
|
@ -0,0 +1,132 @@
|
|||
(use ../src/jolt/reader)
|
||||
|
||||
# Helper: create a symbol
|
||||
(defn sym [name]
|
||||
(let [slash (string/find "/" name)]
|
||||
(if slash
|
||||
{:jolt/type :symbol
|
||||
:ns (string/slice name 0 slash)
|
||||
:name (string/slice name (+ slash 1))}
|
||||
{:jolt/type :symbol
|
||||
:ns nil
|
||||
:name name})))
|
||||
|
||||
# Symbols
|
||||
(assert (deep= (sym "foo") (parse-string "foo"))
|
||||
"bare symbol")
|
||||
(assert (deep= (sym "foo/bar") (parse-string "foo/bar"))
|
||||
"namespaced symbol")
|
||||
(assert (deep= (sym "+") (parse-string "+"))
|
||||
"operator symbol")
|
||||
(assert (deep= (sym "->foo") (parse-string "->foo"))
|
||||
"arrow symbol")
|
||||
|
||||
# Keywords
|
||||
(assert (= :foo (parse-string ":foo"))
|
||||
"bare keyword")
|
||||
(assert (= :foo/bar (parse-string "::foo/bar"))
|
||||
"auto-resolved keyword")
|
||||
(assert (= :foo/bar (parse-string ":foo/bar"))
|
||||
"namespaced keyword")
|
||||
|
||||
# Numbers
|
||||
(assert (= 1 (parse-string "1"))
|
||||
"integer")
|
||||
(assert (= -42 (parse-string "-42"))
|
||||
"negative integer")
|
||||
(assert (= 3.14 (parse-string "3.14"))
|
||||
"float")
|
||||
|
||||
# Strings
|
||||
(assert (= "hello" (parse-string "\"hello\""))
|
||||
"simple string")
|
||||
|
||||
# Nil, booleans
|
||||
(assert (= nil (parse-string "nil"))
|
||||
"nil")
|
||||
(assert (= true (parse-string "true"))
|
||||
"true")
|
||||
(assert (= false (parse-string "false"))
|
||||
"false")
|
||||
|
||||
# Lists → Janet arrays (to distinguish from vectors)
|
||||
(assert (array? (parse-string "(1 2 3)"))
|
||||
"list produces array")
|
||||
(assert (deep= @[1 2 3] (parse-string "(1 2 3)"))
|
||||
"simple list")
|
||||
|
||||
# Vectors → Janet tuples
|
||||
(assert (tuple? (parse-string "[1 2 3]"))
|
||||
"vector produces tuple")
|
||||
(assert (deep= [1 2 3] (parse-string "[1 2 3]"))
|
||||
"simple vector")
|
||||
|
||||
# Maps → Janet structs
|
||||
(let [m (parse-string "{:a 1 :b 2}")]
|
||||
(assert (struct? m) "map is struct")
|
||||
(assert (= 1 (m :a)) "map key lookup"))
|
||||
|
||||
# Sets → tagged with :jolt/set
|
||||
(let [form (parse-string "#{1 2 3}")]
|
||||
(assert (struct? form) "set is struct")
|
||||
(assert (= :jolt/set (form :jolt/type)) "set type tag"))
|
||||
|
||||
# Quote and shorthand
|
||||
(assert (deep= @[(sym "quote") (sym "x")] (parse-string "'x"))
|
||||
"quote shorthand")
|
||||
(assert (deep= @[(sym "syntax-quote") (sym "x")] (parse-string "`x"))
|
||||
"syntax-quote")
|
||||
(assert (deep= @[(sym "unquote") (sym "x")] (parse-string "~x"))
|
||||
"unquote")
|
||||
(assert (deep= @[(sym "unquote-splicing") (sym "x")] (parse-string "~@x"))
|
||||
"unquote-splicing")
|
||||
(assert (deep= @[(sym "deref") (sym "x")] (parse-string "@x"))
|
||||
"deref shorthand")
|
||||
|
||||
# Metadata
|
||||
(let [form (parse-string "^:meta x")]
|
||||
(assert (array? form) "metadata is array")
|
||||
(assert (deep= @[(sym "with-meta") (sym "x") :meta] form)
|
||||
"metadata form"))
|
||||
|
||||
# Comments (skip to end of line)
|
||||
(assert (= 42 (parse-string "; comment\n42"))
|
||||
"comment then form")
|
||||
|
||||
# Discard #_
|
||||
(assert (= 42 (parse-string "#_ (ignored 1 2) 42"))
|
||||
"discard skips next form")
|
||||
|
||||
# Anonymous function #()
|
||||
(let [form (parse-string "#(+ %1 %2)")]
|
||||
(assert (array? form) "fn form is array")
|
||||
(assert (deep= (sym "fn*") (in form 0)) "first element is fn*"))
|
||||
|
||||
# Nested forms
|
||||
(let [form (parse-string "(+ 1 (* 2 3))")]
|
||||
(assert (array? form) "outer list is array")
|
||||
(assert (deep= (sym "+") (in form 0)) "+ is first")
|
||||
(assert (= 1 (in form 1)) "1 is second")
|
||||
(assert (array? (in form 2)) "nested list is array"))
|
||||
|
||||
# Multiple forms: parse-next
|
||||
(let [[form1 rest-str] (parse-next "(1 2) [3 4]")]
|
||||
(assert (deep= @[1 2] form1) "first form is list")
|
||||
(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"))
|
||||
|
||||
# Characters
|
||||
(let [form (parse-string "\\newline")]
|
||||
(assert (struct? form) "char is struct")
|
||||
(assert (= :char (form :jolt/type)) "char type")
|
||||
(assert (= "newline" (form :name)) "char name"))
|
||||
|
||||
(let [form (parse-string "\\a")]
|
||||
(assert (= "a" (form :name)) "simple char name"))
|
||||
|
||||
(print "All reader tests passed!")
|
||||
118
test/types-test.janet
Normal file
118
test/types-test.janet
Normal file
|
|
@ -0,0 +1,118 @@
|
|||
(use ../src/jolt/types)
|
||||
|
||||
# ============================================================
|
||||
# Var tests
|
||||
# ============================================================
|
||||
|
||||
# make-var
|
||||
(let [v (make-var 'x 42)]
|
||||
(assert (var? v) "var? returns true")
|
||||
(assert (= 42 (var-get v)) "var-get returns root binding")
|
||||
(assert (deep= {:name 'x} (var-meta v)) "var-meta returns metadata")
|
||||
(assert (deep= 'x (var-name v)) "var-name returns name symbol"))
|
||||
|
||||
# var without init value
|
||||
(let [v (make-var 'y)]
|
||||
(assert (var? v) "unbound var is still a var"))
|
||||
|
||||
# dynamic var
|
||||
(let [v (make-var '*dyn* 1 {:dynamic true})]
|
||||
(assert (var-dynamic? v) "var-dynamic? true")
|
||||
(assert (not (var-macro? v)) "var-macro? false for dynamic var"))
|
||||
|
||||
# macro var
|
||||
(let [v (make-var 'when nil {:macro true})]
|
||||
(assert (var-macro? v) "var-macro? true"))
|
||||
|
||||
# var-set — set root binding
|
||||
(let [v (make-var 'x 1)]
|
||||
(var-set v 99)
|
||||
(assert (= 99 (var-get v)) "var-set changes root binding"))
|
||||
|
||||
# alter-var-root
|
||||
(let [v (make-var 'c 0)]
|
||||
(alter-var-root v inc)
|
||||
(assert (= 1 (var-get v)) "alter-var-root applies fn"))
|
||||
|
||||
# with-meta — returns new var with updated meta
|
||||
(let [v (make-var 'x 42)
|
||||
v2 (with-meta v {:private true})]
|
||||
(assert (deep= {:name 'x :private true} (var-meta v2)) "with-meta merges meta")
|
||||
(assert (= 42 (var-get v2)) "with-meta preserves root binding"))
|
||||
|
||||
# var with namespace
|
||||
(let [ns (make-ns 'my.ns)
|
||||
v (make-var 'my.ns/x 1 {:ns ns})]
|
||||
(assert (= ns (var-ns v)) "var-ns returns namespace"))
|
||||
|
||||
# ============================================================
|
||||
# Namespace tests
|
||||
# ============================================================
|
||||
|
||||
(let [ns (make-ns 'foo.bar)]
|
||||
(assert (ns? ns) "ns? returns true")
|
||||
(assert (deep= 'foo.bar (ns-name ns)) "ns-name returns name symbol")
|
||||
(assert (table? (ns-map ns)) "ns-map returns table")
|
||||
(assert (= 0 (length (ns-map ns))) "empty namespace has no mappings"))
|
||||
|
||||
# ns-intern
|
||||
(let [ns (make-ns 'test.ns)
|
||||
v (ns-intern ns 'x 42)]
|
||||
(assert (var? v) "ns-intern returns a var")
|
||||
(assert (= 42 (var-get v)) "ns-intern sets root binding")
|
||||
# check ns-find returns the same var (by reference, not deep=)
|
||||
(assert (= v (ns-find ns 'x)) "ns-find returns interned var"))
|
||||
|
||||
# ns-intern without value
|
||||
(let [ns (make-ns 'test.ns)
|
||||
v (ns-intern ns 'y)]
|
||||
(assert (var? v) "ns-intern without value creates unbound var"))
|
||||
|
||||
# ns-unmap
|
||||
(let [ns (make-ns 'test.ns)
|
||||
_ (ns-intern ns 'x 1)
|
||||
_ (ns-unmap ns 'x)]
|
||||
(assert (nil? (ns-find ns 'x)) "ns-unmap removes mapping"))
|
||||
|
||||
# ns-resolve — own ns
|
||||
(let [ns (make-ns 'test.ns)
|
||||
v (ns-intern ns 'x 10)]
|
||||
(assert (= v (ns-resolve ns 'x)) "ns-resolve finds var in own ns"))
|
||||
|
||||
# ns-import
|
||||
(let [ns (make-ns 'test.ns)]
|
||||
(ns-import ns 'Date 'java.util.Date)
|
||||
(assert (= 'java.util.Date (ns-import-lookup ns 'Date)) "ns-import-lookup returns import"))
|
||||
|
||||
# ============================================================
|
||||
# Context tests
|
||||
# ============================================================
|
||||
|
||||
(let [ctx (make-ctx)]
|
||||
(assert (ctx? ctx) "ctx? returns true"))
|
||||
|
||||
# ctx with initial namespaces
|
||||
(let [ctx (make-ctx {:namespaces {"user" {"x" 1 "y" 2}}})]
|
||||
(let [ns (ctx-find-ns ctx "user")]
|
||||
(assert (ns? ns) "ctx-find-ns returns namespace for user")
|
||||
(let [v (ns-find ns "x")]
|
||||
(assert (var? v) "user/x is a var")
|
||||
(assert (= 1 (var-get v)) "user/x has correct value"))))
|
||||
|
||||
# ctx-find-ns creates ns if not present
|
||||
(let [ctx (make-ctx)
|
||||
ns (ctx-find-ns ctx "foo")]
|
||||
(assert (ns? ns) "ctx-find-ns creates namespace on demand"))
|
||||
|
||||
# ============================================================
|
||||
# Dynamic binding support (thread-local bindings table)
|
||||
# ============================================================
|
||||
|
||||
# push-thread-bindings / pop-thread-bindings
|
||||
(let [v (make-var '*dyn* 0 {:dynamic true})]
|
||||
(push-thread-bindings @{v 100})
|
||||
(assert (= 100 (var-get v)) "push-thread-bindings sets binding")
|
||||
(pop-thread-bindings)
|
||||
(assert (= 0 (var-get v)) "pop-thread-bindings restores root"))
|
||||
|
||||
(print "All types tests passed!")
|
||||
Loading…
Add table
Add a link
Reference in a new issue