feat: SCI submodule, gensym, doto, defrecord, multi-arity defn

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)
This commit is contained in:
Yogthos 2026-06-02 01:41:44 -04:00
parent 6e0b95aaae
commit 7ecd781fe6
4 changed files with 169 additions and 54 deletions

3
.gitmodules vendored Normal file
View file

@ -0,0 +1,3 @@
[submodule "vendor/sci"]
path = vendor/sci
url = https://github.com/borkdude/sci.git

View file

@ -534,6 +534,14 @@
(array/push result (if (string? x) x (string x))))) (array/push result (if (string? x) x (string x)))))
(string/join result "")))) (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 (def core-subs
(fn [& args] (fn [& args]
(case (length args) (case (length args)
@ -601,6 +609,16 @@
# Initialization — intern everything into a context's namespace # 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 (defn core-when
"Macro: (when test & body) -> (if test (do body...))" "Macro: (when test & body) -> (if test (do body...))"
[test & body] [test & body]
@ -663,16 +681,38 @@
@[{:jolt/type :symbol :ns nil :name "some?"} form-sym] @[{:jolt/type :symbol :ns nil :name "some?"} form-sym]
;body]]) ;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 (defn core-defn
"Macro: (defn name [args] body) -> (def name (fn* [args] body))" "Macro: (defn name [args] body) or (defn name ([args] body)...)
[fn-name args-form & body] -> (def name (fn* ...) )"
(def fn-form @[]) [fn-name & rest]
(array/push fn-form {:jolt/type :symbol :ns nil :name "fn*"}) # Multi-arity if rest starts with list of [args] pairs
(array/push fn-form args-form) (if (and (> (length rest) 0) (array? (first rest)) (indexed? (first (first rest))))
(each b body (array/push fn-form b)) (let [pairs rest]
@[{:jolt/type :symbol :ns nil :name "def"} (def fn-form @[])
fn-name (array/push fn-form {:jolt/type :symbol :ns nil :name "fn*"})
fn-form]) (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- stub — expands to defn
(defn core-defn- [& args] @[{:jolt/type :symbol :ns nil :name "do"}]) (defn core-defn- [& args] @[{:jolt/type :symbol :ns nil :name "do"}])
@ -712,6 +752,22 @@
(defn core-comment [& body] (defn core-comment [& body]
nil) 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 <ctor-fn>))
@[{: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 # prefer-method stub — multimethod preference ordering
(defn core-prefer-method [multifn dispatch-val & dispatch-vals] (defn core-prefer-method [multifn dispatch-val & dispatch-vals]
nil) nil)
@ -873,6 +929,7 @@
"set" core-set "set" core-set
"list" core-list "list" core-list
"str" core-str "str" core-str
"name" core-name
"subs" core-subs "subs" core-subs
"print" core-print "print" core-print
"println" core-println "println" core-println
@ -890,6 +947,7 @@
"when-let" core-when-let "when-let" core-when-let
"if-some" core-if-some "if-some" core-if-some
"when-some" core-when-some "when-some" core-when-some
"doto" core-doto
"defn" core-defn "defn" core-defn
"defn-" core-defn- "defn-" core-defn-
"derive" core-derive "derive" core-derive
@ -917,6 +975,7 @@
"ThreadLocal" core-ThreadLocal "ThreadLocal" core-ThreadLocal
"IllegalStateException" core-IllegalStateException "IllegalStateException" core-IllegalStateException
"definterface" core-definterface "definterface" core-definterface
"defrecord" core-defrecord
"comment" core-comment "comment" core-comment
"prefer-method" core-prefer-method "prefer-method" core-prefer-method
"resolve" core-resolve "resolve" core-resolve
@ -940,7 +999,7 @@
(defn core-macro-names (defn core-macro-names
"Set of core binding names that are macros." "Set of core binding names that are macros."
[] []
@{"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! (def init-core!
(fn [& args] (fn [& args]

View file

@ -5,7 +5,7 @@
(def ctx (init)) (def ctx (init))
(defn load-file [ctx path] (defn load-file [ctx path &opt quiet]
(var s (slurp path)) (var s (slurp path))
(var count 0) (var count 0)
(var ok 0) (var ok 0)
@ -17,39 +17,94 @@
(++ count) (++ count)
(if (not (nil? form)) (if (not (nil? form))
(do (do
(printf "eval form %d..." count) (when (not quiet) (printf "eval form %d..." count) (flush))
(flush)
(if (try (if (try
(do (eval-form ctx @{} form) true) (do (eval-form ctx @{} form) true)
([err] ([err]
(printf " FAIL: %q\n" err) (when (not quiet) (printf " FAIL: %q\n" err))
(array/push failures {:form-number count :error (string err) :form (string form)}) (array/push failures {:form-number count :error (string err)})
false)) false))
(do (do (when (not quiet) (printf " OK\n")) (++ ok))
(printf " OK\n")
(++ ok))
(++ fail))))) (++ fail)))))
{:ok ok :fail fail :total count :failures failures}) {: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] # Phase 1: Core SCI files (known-good)
["impl/protocols.cljc" nil] # ============================================================
["impl/types.cljc" nil] (def core-order @[
["impl/unrestrict.cljc" nil] "impl/macros.cljc"
["impl/vars.cljc" nil] "impl/protocols.cljc"
["lang.cljc" nil] "impl/types.cljc"
["impl/utils.cljc" nil] "impl/unrestrict.cljc"
["impl/namespaces.cljc" nil] "impl/vars.cljc"
["core.cljc" nil] "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-ok 0)
(var total-fail 0) (var total-fail 0)
(var all-failures @[]) (var all-failures @[])
(each [file expected-ns] load-order # Phase 1: core
(each file core-order
(def path (string sci-base "/" file)) (def path (string sci-base "/" file))
(printf "\n=== Loading %s ===\n" file) (printf "\n=== Loading %s ===\n" file)
(def result (load-file ctx path)) (def result (load-file ctx path))
@ -57,33 +112,30 @@
(+= total-ok (result :ok)) (+= total-ok (result :ok))
(+= total-fail (result :fail)) (+= total-fail (result :fail))
(each f (result :failures) (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 "\n==============================\n")
(printf "TOTAL: %d ok, %d fail, %d total\n" total-ok total-fail (+ total-ok total-fail)) (printf "TOTAL: %d ok, %d fail, %d total\n" total-ok total-fail (+ total-ok total-fail))
(printf "==============================\n") (printf "==============================\n")
# After loading, replace sci.core/eval-string with Jolt-native implementation # Check namespace binding counts
(def core-ns (ctx-find-ns ctx "sci.core")) (printf "\n--- Namespace bindings ---\n")
(each nsn ["sci.impl.interop" "sci.impl.opts" "sci.impl.parser" "sci.impl.analyzer" "sci.impl.interpreter"]
# Replace eval-string with native Jolt version (def ns (ctx-find-ns ctx nsn))
(defn jolt-eval-string (printf "%s: %d bindings\n" nsn (if ns (length (keys (ns-map ns))) 0)))
[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)
(when (> (length all-failures) 0) (when (> (length all-failures) 0)
(printf "\n=== FAILURES ===\n") (printf "\n=== FAILURES ===\n")
(each f all-failures (each f all-failures
(printf "[%s:%d] %s\n" (f :file) (f :form-number) (f :error)) (printf "[%s:%d] %s\n" (f :file) (f :form-number) (f :error))))
(printf " form: %s\n" (f :form))))

1
vendor/sci vendored Submodule

@ -0,0 +1 @@
Subproject commit ebd5cfacda272eabf91f3168d56d08b64f770a80