Phase 3: Compile-aware loader, :compile? flag, compile-and-eval
- loader.janet: load-ns with compile? dispatch, compiled-cache, compiled?, clear-compiled-cache - compiler.janet: compile-ast (Janet data structures for direct eval), compile-and-eval - api.janet: compile-string, compile-file, eval-string dispatches to compile-and-eval when :compile? is true - types.janet: :compile? flag and :compiled-cache table in context env - Stateful forms (def, defmacro, ns, deftype, defmulti, defmethod) fall back to interpreter - All 317 tests pass + 16 new Phase 3 tests
This commit is contained in:
parent
dfa98746ee
commit
ab7ff85816
9 changed files with 326 additions and 176 deletions
|
|
@ -5,10 +5,11 @@
|
|||
(use ./reader)
|
||||
(use ./evaluator)
|
||||
(use ./core)
|
||||
(use ./compiler)
|
||||
(use ./loader)
|
||||
|
||||
(defn- load-persistent-structures
|
||||
"Load immutable persistent data structures and swap clojure.core bindings.
|
||||
Replaces vec, vector, hash-map, hash-set, set with Jolt's persistent versions."
|
||||
"Load immutable persistent data structures and swap clojure.core bindings."
|
||||
[ctx]
|
||||
(def source (slurp "src/jolt/clojure/lang/persistent_vector.clj"))
|
||||
(var cur source)
|
||||
|
|
@ -24,15 +25,11 @@
|
|||
(ns-intern core-ns "vector?" (var-get (ns-find pv-ns "vector?")))))
|
||||
|
||||
(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
|
||||
|
||||
Persistent immutable data structures are loaded by default.
|
||||
|
||||
"Create a new Jolt evaluation context.
|
||||
opts may contain:
|
||||
:namespaces — map of {ns-name → {sym → value, ...}, ...}
|
||||
:mutable? — if true, use Janet mutable data structures instead"
|
||||
:mutable? — use Janet mutable data structures instead of persistent
|
||||
:compile? — enable compilation of Clojure forms to Janet"
|
||||
[&opt opts]
|
||||
(default opts {})
|
||||
(let [ctx (make-ctx opts)
|
||||
|
|
@ -45,17 +42,40 @@
|
|||
|
||||
(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."
|
||||
When :compile? is enabled, compiles to Janet source and evaluates via Janet.
|
||||
Stateful forms (def, defmacro, ns, deftype) always use the interpreter."
|
||||
[ctx s]
|
||||
(let [form (parse-string s)]
|
||||
(eval-form ctx @{} form)))
|
||||
(let [compile? (get (ctx :env) :compile?)
|
||||
form (parse-string s)]
|
||||
(if (and compile? (array? form))
|
||||
# Check if this is a stateful form that needs the interpreter
|
||||
(let [first-form (first form)
|
||||
head-name (if (and (struct? first-form) (= :symbol (first-form :jolt/type)))
|
||||
(first-form :name)
|
||||
nil)]
|
||||
(if (or (= head-name "def") (= head-name "defmacro") (= head-name "ns")
|
||||
(= head-name "deftype") (= head-name "defmulti") (= head-name "defmethod")
|
||||
(= head-name "require") (= head-name "in-ns"))
|
||||
(eval-form ctx @{} form)
|
||||
(compile-and-eval form)))
|
||||
(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"
|
||||
"Evaluate a Clojure source string with explicit bindings."
|
||||
[ctx s bindings]
|
||||
(let [form (parse-string s)]
|
||||
(eval-form ctx bindings form)))
|
||||
|
||||
(defn compile-string
|
||||
"Compile a Clojure source string to Janet source.
|
||||
Returns the Janet source string."
|
||||
[s]
|
||||
(let [form (parse-string s)]
|
||||
(compile-form form)))
|
||||
|
||||
(defn compile-file
|
||||
"Compile a .clj file to Janet source and optionally eval it.
|
||||
When ctx has :compile? enabled, also evaluates the compiled forms.
|
||||
Returns the namespace name."
|
||||
[ctx filepath]
|
||||
(load-ns ctx filepath))
|
||||
|
|
|
|||
|
|
@ -2,8 +2,6 @@
|
|||
# Source-to-source: Clojure forms → Janet source
|
||||
# Two-phase: analyze-form (classify) → emit-ast (generate)
|
||||
|
||||
# Mapping from Clojure core names to Janet function names.
|
||||
# Populated at init time from the core-bindings map.
|
||||
(def- core-renames
|
||||
@{"+" "core-+"
|
||||
"-" "core--"
|
||||
|
|
@ -89,15 +87,10 @@
|
|||
"mod" "core-mod"})
|
||||
|
||||
(defn- literal?
|
||||
"Check if a form is a self-evaluating literal (not a symbol)."
|
||||
[form]
|
||||
(or (nil? form) (= true form) (= false form)
|
||||
(number? form) (string? form) (keyword? form) (bytes? form) (buffer? form)))
|
||||
|
||||
(defn- sym-name-str
|
||||
[sym-s]
|
||||
(if (sym-s :ns) (string (sym-s :ns) "/" (sym-s :name)) (sym-s :name)))
|
||||
|
||||
(defn- special-form?
|
||||
[name]
|
||||
(or (= name "quote") (= name "syntax-quote") (= name "do")
|
||||
|
|
@ -108,33 +101,26 @@
|
|||
(= name "defmulti") (= name "defmethod") (= name "locking")))
|
||||
|
||||
# ============================================================
|
||||
# Analyzer — Clojure form → annotated AST node {:op ...}
|
||||
# Analyzer
|
||||
# ============================================================
|
||||
|
||||
(defn analyze-form
|
||||
"Analyze a Clojure form and return an AST node with :op key.
|
||||
Takes bindings (table) for local symbol classification.
|
||||
Recursively analyzes sub-expressions."
|
||||
[form bindings]
|
||||
(cond
|
||||
# Literals
|
||||
(literal? form)
|
||||
{:op :const :val form}
|
||||
|
||||
# Symbols
|
||||
(and (struct? form) (= :symbol (form :jolt/type)))
|
||||
(let [name (form :name)
|
||||
ns (form :ns)]
|
||||
(if ns
|
||||
{:op :qualified-symbol :ns ns :name name}
|
||||
# Check local bindings first (let vars, fn params)
|
||||
(if (get bindings name)
|
||||
{:op :local :name name}
|
||||
(if (and (not (special-form? name)) (get core-renames name))
|
||||
{:op :core-symbol :name name :janet-name (get core-renames name)}
|
||||
{:op :symbol :name name}))))
|
||||
|
||||
# Lists/arrays
|
||||
(array? form)
|
||||
(let [first-form (first form)
|
||||
head-name (if (and (struct? first-form) (= :symbol (first-form :jolt/type)))
|
||||
|
|
@ -159,7 +145,6 @@
|
|||
:name (in form 1)
|
||||
:init (analyze-form (in form 2) bindings)}
|
||||
"fn*" (let [params (in form 1)
|
||||
# Augment bindings with param names so body refs are :local
|
||||
body-bindings (do
|
||||
(var bb @{})
|
||||
(loop [[k v] :pairs bindings] (put bb k v))
|
||||
|
|
@ -177,20 +162,18 @@
|
|||
(first analyzed-body))})
|
||||
"let*" (let [bind-vec (in form 1)
|
||||
body-exprs (tuple/slice form 2)
|
||||
# Analyze binding init values with outer bindings
|
||||
n-binding-slots (length bind-vec)
|
||||
binding-pairs (do
|
||||
(var pairs @[])
|
||||
(var i 0)
|
||||
(while (< i n-binding-slots)
|
||||
(let [sym-s (in bind-vec i)
|
||||
name (if (struct? sym-s) (sym-s :name) sym-s)
|
||||
val-form (if (< (+ i 1) n-binding-slots) (in bind-vec (+ i 1)) nil)
|
||||
val-ast (if val-form (analyze-form val-form bindings) {:op :const :val nil})]
|
||||
(array/push pairs {:name name :init val-ast})
|
||||
(+= i 2)))
|
||||
(let [n (length bind-vec)]
|
||||
(while (< i n)
|
||||
(let [sym-s (in bind-vec i)
|
||||
name (if (struct? sym-s) (sym-s :name) sym-s)
|
||||
val-form (if (< (+ i 1) n) (in bind-vec (+ i 1)) nil)
|
||||
val-ast (if val-form (analyze-form val-form bindings) {:op :const :val nil})]
|
||||
(array/push pairs {:name name :init val-ast})
|
||||
(+= i 2))))
|
||||
pairs)
|
||||
# Augment bindings with let-bound names for body analysis
|
||||
body-bindings (do
|
||||
(var bb @{})
|
||||
(loop [[k v] :pairs bindings] (put bb k v))
|
||||
|
|
@ -206,33 +189,29 @@
|
|||
:statements (array/slice analyzed-body 0 (- n-body 1))
|
||||
:ret (last analyzed-body)}
|
||||
(first analyzed-body))})
|
||||
# Default: function invocation
|
||||
(let [f-ast (analyze-form first-form bindings)
|
||||
args (map |(analyze-form $ bindings) (tuple/slice form 1))]
|
||||
{:op :invoke :fn f-ast :args args}))
|
||||
# Non-symbol head: function invocation
|
||||
(let [f-ast (analyze-form first-form bindings)
|
||||
args (map |(analyze-form $ bindings) (tuple/slice form 1))]
|
||||
{:op :invoke :fn f-ast :args args})))
|
||||
|
||||
# Tuples (vectors)
|
||||
(tuple? form)
|
||||
(let [items (map |(analyze-form $ bindings) form)]
|
||||
{:op :vector :items items})
|
||||
|
||||
# Structs (maps)
|
||||
(struct? form)
|
||||
{:op :map :form form}
|
||||
|
||||
# Fallback
|
||||
{:op :const :val form}))
|
||||
|
||||
# ============================================================
|
||||
# Emitter — AST node → Janet source string
|
||||
# Emitter — AST → Janet source string
|
||||
# ============================================================
|
||||
|
||||
(defn- emit-const
|
||||
"Emit a literal constant value."
|
||||
(var emit-ast nil)
|
||||
|
||||
(defn- emit-const-str
|
||||
[val buf]
|
||||
(cond
|
||||
(nil? val) (buffer/push buf "nil")
|
||||
|
|
@ -242,11 +221,7 @@
|
|||
(keyword? val) (do (buffer/push buf ":") (buffer/push buf (string val)))
|
||||
(buffer/push buf (string val))))
|
||||
|
||||
# Forward declaration for mutual recursion
|
||||
(var emit-ast nil)
|
||||
|
||||
(defn- emit-do
|
||||
[statements ret buf]
|
||||
(defn- emit-do-str [statements ret buf]
|
||||
(buffer/push buf "(do ")
|
||||
(var i 0)
|
||||
(let [n (length statements)]
|
||||
|
|
@ -254,91 +229,57 @@
|
|||
(emit-ast (in statements i) buf)
|
||||
(buffer/push buf " ")
|
||||
(++ i)))
|
||||
(when ret
|
||||
(emit-ast ret buf))
|
||||
(when ret (emit-ast ret buf))
|
||||
(buffer/push buf ")"))
|
||||
|
||||
(defn- emit-if
|
||||
[test then else buf]
|
||||
(defn- emit-if-str [test then else buf]
|
||||
(buffer/push buf "(if ")
|
||||
(emit-ast test buf)
|
||||
(buffer/push buf " ")
|
||||
(emit-ast test buf) (buffer/push buf " ")
|
||||
(emit-ast then buf)
|
||||
(when else
|
||||
(buffer/push buf " ")
|
||||
(emit-ast else buf))
|
||||
(when else (buffer/push buf " ") (emit-ast else buf))
|
||||
(buffer/push buf ")"))
|
||||
|
||||
(defn- emit-def
|
||||
[name-sym init buf]
|
||||
(buffer/push buf "(def ")
|
||||
(buffer/push buf (name-sym :name))
|
||||
(buffer/push buf " ")
|
||||
(emit-ast init buf)
|
||||
(buffer/push buf ")"))
|
||||
(defn- emit-def-str [name-sym init buf]
|
||||
(buffer/push buf "(def ") (buffer/push buf (name-sym :name))
|
||||
(buffer/push buf " ") (emit-ast init buf) (buffer/push buf ")"))
|
||||
|
||||
(defn- emit-fn
|
||||
[params body buf]
|
||||
(defn- emit-fn-str [params body buf]
|
||||
(buffer/push buf "(fn [")
|
||||
(var i 0)
|
||||
(let [n (length params)]
|
||||
(while (< i n)
|
||||
(let [p (in params i)]
|
||||
(buffer/push buf (if (struct? p) (p :name) (string p))))
|
||||
(when (< (+ i 1) n)
|
||||
(buffer/push buf " "))
|
||||
(when (< (+ i 1) n) (buffer/push buf " "))
|
||||
(++ i)))
|
||||
(buffer/push buf "] ")
|
||||
(emit-ast body buf)
|
||||
(buffer/push buf ")"))
|
||||
(buffer/push buf "] ") (emit-ast body buf) (buffer/push buf ")"))
|
||||
|
||||
(defn- emit-let
|
||||
[binding-pairs body buf]
|
||||
(defn- emit-let-str [binding-pairs body buf]
|
||||
(buffer/push buf "(let [")
|
||||
(var i 0)
|
||||
(let [n (length binding-pairs)]
|
||||
(while (< i n)
|
||||
(let [bp (in binding-pairs i)]
|
||||
(buffer/push buf (bp :name))
|
||||
(buffer/push buf " ")
|
||||
(buffer/push buf (bp :name)) (buffer/push buf " ")
|
||||
(emit-ast (bp :init) buf)
|
||||
(when (< (+ i 1) n) (buffer/push buf " ")))
|
||||
(++ i)))
|
||||
(buffer/push buf "] ")
|
||||
(emit-ast body buf)
|
||||
(buffer/push buf "] ") (emit-ast body buf) (buffer/push buf ")"))
|
||||
|
||||
(defn- emit-invoke-str [f-ast args buf]
|
||||
(buffer/push buf "(") (emit-ast f-ast buf)
|
||||
(each arg args (buffer/push buf " ") (emit-ast arg buf))
|
||||
(buffer/push buf ")"))
|
||||
|
||||
(defn- emit-invoke
|
||||
[f-ast args buf]
|
||||
(buffer/push buf "(")
|
||||
(emit-ast f-ast buf)
|
||||
(each arg args
|
||||
(buffer/push buf " ")
|
||||
(emit-ast arg buf))
|
||||
(buffer/push buf ")"))
|
||||
(defn- emit-symbol-str [name buf] (buffer/push buf name))
|
||||
(defn- emit-local-str [name buf] (buffer/push buf name))
|
||||
(defn- emit-core-symbol-str [janet-name buf] (buffer/push buf janet-name))
|
||||
|
||||
(defn- emit-symbol
|
||||
[name buf]
|
||||
(buffer/push buf name))
|
||||
(defn- emit-qualified-symbol-str [ns name buf]
|
||||
(buffer/push buf "(ns-get \"") (buffer/push buf ns)
|
||||
(buffer/push buf "\" \"") (buffer/push buf name) (buffer/push buf "\")"))
|
||||
|
||||
(defn- emit-local
|
||||
[name buf]
|
||||
(buffer/push buf name))
|
||||
|
||||
(defn- emit-core-symbol
|
||||
[janet-name buf]
|
||||
(buffer/push buf janet-name))
|
||||
|
||||
(defn- emit-qualified-symbol
|
||||
[ns name buf]
|
||||
(buffer/push buf "(ns-get \"")
|
||||
(buffer/push buf ns)
|
||||
(buffer/push buf "\" \"")
|
||||
(buffer/push buf name)
|
||||
(buffer/push buf "\")"))
|
||||
|
||||
(defn- emit-vector
|
||||
[items buf]
|
||||
(defn- emit-vector-str [items buf]
|
||||
(buffer/push buf "[")
|
||||
(var i 0)
|
||||
(let [n (length items)]
|
||||
|
|
@ -348,35 +289,34 @@
|
|||
(++ i)))
|
||||
(buffer/push buf "]"))
|
||||
|
||||
(defn- emit-map
|
||||
[form buf]
|
||||
(buffer/push buf (string form)))
|
||||
(defn- emit-map-str [form buf] (buffer/push buf (string form)))
|
||||
|
||||
(defn- emit-quote
|
||||
[expr buf]
|
||||
(buffer/push buf "'")
|
||||
(emit-ast (analyze-form expr @{}) buf))
|
||||
(defn- emit-quote-str [expr buf]
|
||||
(buffer/push buf "'") (emit-ast (analyze-form expr @{}) buf))
|
||||
|
||||
(set emit-ast
|
||||
(fn [ast buf]
|
||||
(match (ast :op)
|
||||
:const (emit-const (ast :val) buf)
|
||||
:symbol (emit-symbol (ast :name) buf)
|
||||
:local (emit-local (ast :name) buf)
|
||||
:core-symbol (emit-core-symbol (ast :janet-name) buf)
|
||||
:qualified-symbol (emit-qualified-symbol (ast :ns) (ast :name) buf)
|
||||
:do (emit-do (ast :statements) (ast :ret) buf)
|
||||
:if (emit-if (ast :test) (ast :then) (ast :else) buf)
|
||||
:def (emit-def (ast :name) (ast :init) buf)
|
||||
:fn (emit-fn (ast :params) (ast :body) buf)
|
||||
:let (emit-let (ast :binding-pairs) (ast :body) buf)
|
||||
:invoke (emit-invoke (ast :fn) (ast :args) buf)
|
||||
:vector (emit-vector (ast :items) buf)
|
||||
:map (emit-map (ast :form) buf)
|
||||
:quote (emit-quote (ast :expr) buf)
|
||||
# Fallback for unknown ops
|
||||
:const (emit-const-str (ast :val) buf)
|
||||
:symbol (emit-symbol-str (ast :name) buf)
|
||||
:local (emit-local-str (ast :name) buf)
|
||||
:core-symbol (emit-core-symbol-str (ast :janet-name) buf)
|
||||
:qualified-symbol (emit-qualified-symbol-str (ast :ns) (ast :name) buf)
|
||||
:do (emit-do-str (ast :statements) (ast :ret) buf)
|
||||
:if (emit-if-str (ast :test) (ast :then) (ast :else) buf)
|
||||
:def (emit-def-str (ast :name) (ast :init) buf)
|
||||
:fn (emit-fn-str (ast :params) (ast :body) buf)
|
||||
:let (emit-let-str (ast :binding-pairs) (ast :body) buf)
|
||||
:invoke (emit-invoke-str (ast :fn) (ast :args) buf)
|
||||
:vector (emit-vector-str (ast :items) buf)
|
||||
:map (emit-map-str (ast :form) buf)
|
||||
:quote (emit-quote-str (ast :expr) buf)
|
||||
(buffer/push buf (string "/* unhandled op: " (ast :op) " */")))))
|
||||
|
||||
# ============================================================
|
||||
# Public API
|
||||
# ============================================================
|
||||
|
||||
(defn compile-form
|
||||
"Compile a Clojure form to a Janet source string."
|
||||
[form]
|
||||
|
|
@ -384,3 +324,19 @@
|
|||
buf @""]
|
||||
(emit-ast ast buf)
|
||||
(string buf)))
|
||||
|
||||
(defn eval-janet-source
|
||||
"Parse and evaluate a Janet source string.
|
||||
Uses the proper parser→produce→eval pipeline so special forms work."
|
||||
[source]
|
||||
(def p (parser/new))
|
||||
(parser/consume p source)
|
||||
(parser/eof p)
|
||||
(def form (parser/produce p))
|
||||
(eval form))
|
||||
|
||||
(defn compile-and-eval
|
||||
"Compile a Clojure form to Janet source and evaluate it.
|
||||
Returns the result value."
|
||||
[form]
|
||||
(eval-janet-source (compile-form form)))
|
||||
|
|
|
|||
80
src/jolt/loader.janet
Normal file
80
src/jolt/loader.janet
Normal file
|
|
@ -0,0 +1,80 @@
|
|||
# Jolt Loader
|
||||
# Namespace loading with optional compilation.
|
||||
# Supports in-memory bytecode caching when :compile? is enabled.
|
||||
|
||||
(use ./reader)
|
||||
(use ./compiler)
|
||||
(use ./evaluator)
|
||||
|
||||
(defn load-ns
|
||||
"Load a Clojure namespace from a .clj file.
|
||||
When ctx has :compile? enabled, forms are compiled to Janet source,
|
||||
evaluated via Janet's evaluator, and cached.
|
||||
|
||||
(load-ns ctx filepath) → namespace symbol string"
|
||||
[ctx filepath]
|
||||
(let [env (ctx :env)
|
||||
compile? (get env :compile?)
|
||||
cache (get env :compiled-cache)]
|
||||
|
||||
(def source (slurp filepath))
|
||||
(var ns-name nil)
|
||||
(var remaining source)
|
||||
(var forms @[])
|
||||
|
||||
# Parse all forms
|
||||
(while (> (length (string/trim remaining)) 0)
|
||||
(def [form rest] (parse-next remaining))
|
||||
(set remaining rest)
|
||||
(when (not (nil? form))
|
||||
(array/push forms form)
|
||||
# Extract ns name from the first ns form
|
||||
(when (and (nil? ns-name)
|
||||
(array? form)
|
||||
(> (length form) 0)
|
||||
(and (struct? (first form))
|
||||
(= :symbol ((first form) :jolt/type))
|
||||
(= "ns" ((first form) :name))))
|
||||
(let [name-form (in form 1)]
|
||||
(set ns-name (if (struct? name-form) (name-form :name) (string name-form)))))))
|
||||
|
||||
(when (nil? ns-name)
|
||||
(error (string "No ns form found in " filepath)))
|
||||
|
||||
(if compile?
|
||||
(do
|
||||
# Compile each form and eval as Janet
|
||||
(var cached (get cache ns-name))
|
||||
(when (nil? cached)
|
||||
(set cached @[])
|
||||
(put cache ns-name cached))
|
||||
|
||||
(each form forms
|
||||
(let [janet-src (compile-form form)]
|
||||
(array/push cached janet-src)
|
||||
(eval-janet-source janet-src)))
|
||||
ns-name)
|
||||
# Interpreter path
|
||||
(do
|
||||
(each form forms
|
||||
(eval-form ctx @{} form))
|
||||
ns-name))))
|
||||
|
||||
(defn compiled?
|
||||
"Check if a namespace has been compiled and cached."
|
||||
[ctx ns-name]
|
||||
(let [cache (get (ctx :env) :compiled-cache)]
|
||||
(not (nil? (get cache ns-name)))))
|
||||
|
||||
(defn get-compiled-forms
|
||||
"Get the compiled Janet source forms for a namespace."
|
||||
[ctx ns-name]
|
||||
(get (ctx :env) :compiled-cache ns-name))
|
||||
|
||||
(defn clear-compiled-cache
|
||||
"Clear the compiled form cache for a namespace or all namespaces."
|
||||
[ctx &opt ns-name]
|
||||
(let [cache (get (ctx :env) :compiled-cache)]
|
||||
(if ns-name
|
||||
(put cache ns-name nil)
|
||||
(loop [[k] :pairs cache] (put cache k nil)))))
|
||||
|
|
@ -240,9 +240,12 @@
|
|||
:namespaces — struct of {ns-symbol → {sym → value, ...}, ...}"
|
||||
[&opt opts]
|
||||
(default opts nil)
|
||||
(let [env @{:namespaces @{}
|
||||
(let [compile? (if opts (get opts :compile?) false)
|
||||
env @{:namespaces @{}
|
||||
:class->opts @{}
|
||||
:current-ns "user"}
|
||||
:current-ns "user"
|
||||
:compile? compile?
|
||||
:compiled-cache @{}}
|
||||
# create the user namespace via a partial context
|
||||
_ (ctx-find-ns {:env env} "user")]
|
||||
# initialize from opts
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue