commit cdcf569506556a06ae50617d0638dd470355591f Author: Yogthos Date: Mon Jun 1 16:48:56 2026 -0400 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 diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..4a729a7 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 index 0000000..9b50edb --- /dev/null +++ b/README.md @@ -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) diff --git a/project.janet b/project.janet new file mode 100644 index 0000000..886889b --- /dev/null +++ b/project.janet @@ -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") diff --git a/src/jolt/api.janet b/src/jolt/api.janet new file mode 100644 index 0000000..cc502ff --- /dev/null +++ b/src/jolt/api.janet @@ -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))) diff --git a/src/jolt/core.janet b/src/jolt/core.janet new file mode 100644 index 0000000..e1faded --- /dev/null +++ b/src/jolt/core.janet @@ -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!")))) diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet new file mode 100644 index 0000000..a5464de --- /dev/null +++ b/src/jolt/evaluator.janet @@ -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))) diff --git a/src/jolt/main.janet b/src/jolt/main.janet new file mode 100644 index 0000000..4b1aad8 --- /dev/null +++ b/src/jolt/main.janet @@ -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)))))))) diff --git a/src/jolt/reader.janet b/src/jolt/reader.janet new file mode 100644 index 0000000..6a126da --- /dev/null +++ b/src/jolt/reader.janet @@ -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)])) diff --git a/src/jolt/types.janet b/src/jolt/types.janet new file mode 100644 index 0000000..dcaa9c9 --- /dev/null +++ b/src/jolt/types.janet @@ -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 :name } +# 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)) diff --git a/test/api-test.janet b/test/api-test.janet new file mode 100644 index 0000000..ff699e0 --- /dev/null +++ b/test/api-test.janet @@ -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!") diff --git a/test/core-test.janet b/test/core-test.janet new file mode 100644 index 0000000..b773184 --- /dev/null +++ b/test/core-test.janet @@ -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!") diff --git a/test/evaluator-test.janet b/test/evaluator-test.janet new file mode 100644 index 0000000..5082ab6 --- /dev/null +++ b/test/evaluator-test.janet @@ -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!") diff --git a/test/macro-test.janet b/test/macro-test.janet new file mode 100644 index 0000000..5eb6b66 --- /dev/null +++ b/test/macro-test.janet @@ -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!") diff --git a/test/namespace-test.janet b/test/namespace-test.janet new file mode 100644 index 0000000..3c78ea7 --- /dev/null +++ b/test/namespace-test.janet @@ -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!") diff --git a/test/reader-test.janet b/test/reader-test.janet new file mode 100644 index 0000000..a9d28fd --- /dev/null +++ b/test/reader-test.janet @@ -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!") diff --git a/test/types-test.janet b/test/types-test.janet new file mode 100644 index 0000000..674b636 --- /dev/null +++ b/test/types-test.janet @@ -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!")