From 7ecd781fe64ea19a637e16f467dec4ea1fe376f7 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Tue, 2 Jun 2026 01:41:44 -0400 Subject: [PATCH] feat: SCI submodule, gensym, doto, defrecord, multi-arity defn MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Phase 2: load internal SCI namespaces - Add SCI as git submodule at vendor/sci - gensym: symbol generation with prefix+counter - doto macro: (doto obj (method args)...) - defrecord macro: emits positional constructor ->TypeName - name: Clojure core function for keyword/symbol name - Fix multi-arity defn: indexed? check for vector patterns (tuples) - Edamame stubs for parser.cljc deps Internal namespace loading results: interop: 14 bindings (all OK) opts: 16 bindings (all OK — defrecord fixed) parser: 2 bindings (6 failures: utils/new-var, edamame/normalize-opts) analyzer/interpreter: pending (15+ deps each) --- .gitmodules | 3 + src/jolt/core.janet | 79 +++++++++++++++++++--- test/test-load-sci.janet | 140 +++++++++++++++++++++++++++------------ vendor/sci | 1 + 4 files changed, 169 insertions(+), 54 deletions(-) create mode 100644 .gitmodules create mode 160000 vendor/sci diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..b878f26 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "vendor/sci"] + path = vendor/sci + url = https://github.com/borkdude/sci.git diff --git a/src/jolt/core.janet b/src/jolt/core.janet index 8e7700b..6bdd6c3 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -534,6 +534,14 @@ (array/push result (if (string? x) x (string x))))) (string/join result "")))) +(defn core-name + "Returns the name string of a keyword, symbol, or string." + [x] + (if (keyword? x) (string x) + (if (and (struct? x) (= :symbol (x :jolt/type))) (x :name) + (if (string? x) x + "")))) + (def core-subs (fn [& args] (case (length args) @@ -601,6 +609,16 @@ # Initialization — intern everything into a context's namespace # ============================================================ +(def gensym_counter @{:val 0}) + +(defn gensym + "Returns a new symbol with a unique name." + [&opt prefix-string] + (default prefix-string "G__") + (def n (get gensym_counter :val)) + (put gensym_counter :val (+ n 1)) + {:jolt/type :symbol :ns nil :name (string prefix-string n)}) + (defn core-when "Macro: (when test & body) -> (if test (do body...))" [test & body] @@ -663,16 +681,38 @@ @[{:jolt/type :symbol :ns nil :name "some?"} form-sym] ;body]]) +(defn core-doto + "Macro: (doto obj (method args)...) → let obj, call methods, return obj" + [obj & forms] + (def sym (gensym "doto")) + (def result @[{:jolt/type :symbol :ns nil :name "let*"} + @[sym obj]]) + (each f forms + (if (array? f) + (array/push result @[{:jolt/type :symbol :ns nil :name "."} sym (first f) ;(tuple/slice f 1)]) + (array/push result @[{:jolt/type :symbol :ns nil :name "."} sym f]))) + (array/push result sym) + result) + (defn core-defn - "Macro: (defn name [args] body) -> (def name (fn* [args] body))" - [fn-name args-form & body] - (def fn-form @[]) - (array/push fn-form {:jolt/type :symbol :ns nil :name "fn*"}) - (array/push fn-form args-form) - (each b body (array/push fn-form b)) - @[{:jolt/type :symbol :ns nil :name "def"} - fn-name - fn-form]) + "Macro: (defn name [args] body) or (defn name ([args] body)...) + -> (def name (fn* ...) )" + [fn-name & rest] + # Multi-arity if rest starts with list of [args] pairs + (if (and (> (length rest) 0) (array? (first rest)) (indexed? (first (first rest)))) + (let [pairs rest] + (def fn-form @[]) + (array/push fn-form {:jolt/type :symbol :ns nil :name "fn*"}) + (each pair pairs (array/push fn-form pair)) + @[{:jolt/type :symbol :ns nil :name "def"} fn-name fn-form]) + # Single-arity: (defn name [args] body...) + (let [args-form (first rest) + body (tuple/slice rest 1)] + (def fn-form @[]) + (array/push fn-form {:jolt/type :symbol :ns nil :name "fn*"}) + (array/push fn-form args-form) + (each b body (array/push fn-form b)) + @[{:jolt/type :symbol :ns nil :name "def"} fn-name fn-form]))) # defn- stub — expands to defn (defn core-defn- [& args] @[{:jolt/type :symbol :ns nil :name "do"}]) @@ -712,6 +752,22 @@ (defn core-comment [& body] nil) +# defrecord stub — emits constructor and factory functions +(defn core-defrecord [name-sym fields-vec & body] + (def ctor-name-str (string "->" (name-sym :name))) + (def ctor-name-sym {:jolt/type :symbol :ns nil :name ctor-name-str}) + (def fnames (map |(keyword ($ :name)) fields-vec)) + (def ctor-body + @[{:jolt/type :symbol :ns nil :name "fn*"} + @[fields-vec] + @[{:jolt/type :symbol :ns nil :name "let*"} + @[{:jolt/type :symbol :ns nil :name "m"} @[{:jolt/type :symbol :ns nil :name "hash-map"} ;(interleave fnames fields-vec)]] + {:jolt/type :symbol :ns nil :name "m"}]]) + # Emit (do (def TypeName )) + @[{:jolt/type :symbol :ns nil :name "do"} + @[{:jolt/type :symbol :ns nil :name "def"} name-sym ctor-body] + @[{:jolt/type :symbol :ns nil :name "def"} ctor-name-sym ctor-body]]) + # prefer-method stub — multimethod preference ordering (defn core-prefer-method [multifn dispatch-val & dispatch-vals] nil) @@ -873,6 +929,7 @@ "set" core-set "list" core-list "str" core-str + "name" core-name "subs" core-subs "print" core-print "println" core-println @@ -890,6 +947,7 @@ "when-let" core-when-let "if-some" core-if-some "when-some" core-when-some + "doto" core-doto "defn" core-defn "defn-" core-defn- "derive" core-derive @@ -917,6 +975,7 @@ "ThreadLocal" core-ThreadLocal "IllegalStateException" core-IllegalStateException "definterface" core-definterface + "defrecord" core-defrecord "comment" core-comment "prefer-method" core-prefer-method "resolve" core-resolve @@ -940,7 +999,7 @@ (defn core-macro-names "Set of core binding names that are macros." [] - @{"when" true "when-not" true "if-let" true "when-let" true "if-some" true "when-some" true "defn" true "defn-" true "declare" true "fn" true "let" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "proxy" true "definterface" true "comment" true}) + @{"when" true "when-not" true "if-let" true "when-let" true "if-some" true "when-some" true "doto" true "defn" true "defn-" true "declare" true "fn" true "let" true "defrecord" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "proxy" true "definterface" true "comment" true}) (def init-core! (fn [& args] diff --git a/test/test-load-sci.janet b/test/test-load-sci.janet index fba223d..a757d03 100644 --- a/test/test-load-sci.janet +++ b/test/test-load-sci.janet @@ -5,7 +5,7 @@ (def ctx (init)) -(defn load-file [ctx path] +(defn load-file [ctx path &opt quiet] (var s (slurp path)) (var count 0) (var ok 0) @@ -17,39 +17,94 @@ (++ count) (if (not (nil? form)) (do - (printf "eval form %d..." count) - (flush) + (when (not quiet) (printf "eval form %d..." count) (flush)) (if (try - (do (eval-form ctx @{} form) true) - ([err] - (printf " FAIL: %q\n" err) - (array/push failures {:form-number count :error (string err) :form (string form)}) - false)) - (do - (printf " OK\n") - (++ ok)) + (do (eval-form ctx @{} form) true) + ([err] + (when (not quiet) (printf " FAIL: %q\n" err)) + (array/push failures {:form-number count :error (string err)}) + false)) + (do (when (not quiet) (printf " OK\n")) (++ ok)) (++ fail))))) {:ok ok :fail fail :total count :failures failures}) -(def sci-base "/Users/yogthos/src/sci/src/sci") +(def sci-base "vendor/sci/src/sci") -(def load-order @[ - ["impl/macros.cljc" nil] - ["impl/protocols.cljc" nil] - ["impl/types.cljc" nil] - ["impl/unrestrict.cljc" nil] - ["impl/vars.cljc" nil] - ["lang.cljc" nil] - ["impl/utils.cljc" nil] - ["impl/namespaces.cljc" nil] - ["core.cljc" nil] +# ============================================================ +# Phase 1: Core SCI files (known-good) +# ============================================================ +(def core-order @[ + "impl/macros.cljc" + "impl/protocols.cljc" + "impl/types.cljc" + "impl/unrestrict.cljc" + "impl/vars.cljc" + "lang.cljc" + "impl/utils.cljc" + "impl/namespaces.cljc" + "core.cljc" +]) + +# ============================================================ +# Phase 2: Internal namespaces — interop, parser, opts, analyzer, interpreter +# These need edamame stubs first +# ============================================================ + +# Create minimal edamame.core namespace for parser/interpreter +(def edn-ns (ctx-find-ns ctx "edamame.core")) +(defn edn-eof [] :edamame/eof) +(defn edn-reader [x] @{:s x :pos 0 :line 1 :col 1}) +(defn edn-parse-string [s & opts] (parse-string s)) + +(def edn-parse-next (fn [& args] + (def reader (args 0)) + (def s (reader :s)) + (def pos (reader :pos)) + (if (>= pos (length s)) (edn-eof) + (let [[form new-pos] (read-form s pos)] + (put reader :pos new-pos) + (var lp pos) + (while (< lp new-pos) + (if (= (s lp) 10) + (do (put reader :line (+ 1 (reader :line))) (put reader :col 1)) + (put reader :col (+ 1 (reader :col)))) + (++ lp)) + form)))) + +(ns-intern edn-ns "eof" edn-eof) +(ns-intern edn-ns "normalize-opts" (fn [opts] (if (= true opts) {:all true} (or opts {})))) +(ns-intern edn-ns "reader" edn-reader) +(ns-intern edn-ns "parse-string" edn-parse-string) +(ns-intern edn-ns "parse-string-all" (fn [s & opts] @[(edn-parse-string s)])) +(ns-intern edn-ns "parse-next" edn-parse-next) +(ns-intern edn-ns "continue" :edamame/continue) + +# Create minimal tools.reader namespace +(def rt-ns (ctx-find-ns ctx "clojure.tools.reader.reader-types")) +(ns-intern rt-ns "indexing-push-back-reader" (fn [rdr] rdr)) +(ns-intern rt-ns "string-push-back-reader" edn-reader) +(ns-intern rt-ns "source-logging-reader?" (fn [rdr] false)) +(ns-intern rt-ns "get-line-number" (fn [rdr] (rdr :line))) +(ns-intern rt-ns "get-column-number" (fn [rdr] (rdr :col))) + +# ============================================================ +# Phase 3: Load internal SCI namespaces in dependency order +# ============================================================ +(def internal-order @[ + # interop needs: types, utils, reflector(clj) + "impl/interop.cljc" + # opts needs: namespaces, types + "impl/opts.cljc" + # parser needs: edamame, tools.reader, interop, types, utils + "impl/parser.cljc" ]) (var total-ok 0) (var total-fail 0) (var all-failures @[]) -(each [file expected-ns] load-order +# Phase 1: core +(each file core-order (def path (string sci-base "/" file)) (printf "\n=== Loading %s ===\n" file) (def result (load-file ctx path)) @@ -57,33 +112,30 @@ (+= total-ok (result :ok)) (+= total-fail (result :fail)) (each f (result :failures) - (array/push all-failures {:file file :form-number (f :form-number) :error (f :error) :form (f :form)}))) + (array/push all-failures {:file file :form-number (f :form-number) :error (f :error)}))) + +# Phase 2: internal +(each file internal-order + (def path (string sci-base "/" file)) + (printf "\n=== Loading %s (internal) ===\n" file) + (def result (load-file ctx path)) + (printf " Result: %d ok, %d fail, %d total\n" (result :ok) (result :fail) (result :total)) + (+= total-ok (result :ok)) + (+= total-fail (result :fail)) + (each f (result :failures) + (array/push all-failures {:file file :form-number (f :form-number) :error (f :error)}))) (printf "\n==============================\n") (printf "TOTAL: %d ok, %d fail, %d total\n" total-ok total-fail (+ total-ok total-fail)) (printf "==============================\n") -# After loading, replace sci.core/eval-string with Jolt-native implementation -(def core-ns (ctx-find-ns ctx "sci.core")) - -# Replace eval-string with native Jolt version -(defn jolt-eval-string - [s &opt opts] - (def forms (parse-string s)) - (eval-form ctx @{} @[{:jolt/type :symbol :ns nil :name "do"} forms])) - -(def ev-var (ns-find core-ns "eval-string")) -(var-set ev-var jolt-eval-string) - -(printf "\n--- Testing sci.core/eval-string (Jolt-native) ---\n") -(def result (try (jolt-eval-string "(+ 1 2 3)") ([err] (string "ERROR: " err)))) -(printf "eval-string result: %q\n" result) - -(def result2 (try (jolt-eval-string "(def x 42) x") ([err] (string "ERROR: " err)))) -(printf "eval-string def+ref: %q\n" result2) +# Check namespace binding counts +(printf "\n--- Namespace bindings ---\n") +(each nsn ["sci.impl.interop" "sci.impl.opts" "sci.impl.parser" "sci.impl.analyzer" "sci.impl.interpreter"] + (def ns (ctx-find-ns ctx nsn)) + (printf "%s: %d bindings\n" nsn (if ns (length (keys (ns-map ns))) 0))) (when (> (length all-failures) 0) (printf "\n=== FAILURES ===\n") (each f all-failures - (printf "[%s:%d] %s\n" (f :file) (f :form-number) (f :error)) - (printf " form: %s\n" (f :form)))) + (printf "[%s:%d] %s\n" (f :file) (f :form-number) (f :error)))) diff --git a/vendor/sci b/vendor/sci new file mode 160000 index 0000000..ebd5cfa --- /dev/null +++ b/vendor/sci @@ -0,0 +1 @@ +Subproject commit ebd5cfacda272eabf91f3168d56d08b64f770a80