diff --git a/src/jolt/compiler.janet b/src/jolt/compiler.janet index 4f2f0d1..33dd213 100644 --- a/src/jolt/compiler.janet +++ b/src/jolt/compiler.janet @@ -161,16 +161,20 @@ # var-get/var-set/var?/alter-var-root/alter-meta!/reset-meta!/ # find-var/intern are plain clojure.core fns now (core-bindings + # install-stateful-fns!) — ordinary invokes, no punt (Stage 2 tier 6). + # create-ns/remove-ns/find-ns/all-ns/the-ns/resolve/ns-resolve/ + # ns-aliases/ns-imports/ns-interns are ctx-capturing core fns now + # (tier 6b) — ordinary invokes, no punt. "satisfies?" "instance?" "set!" "var" - "ns" "in-ns" "require" "create-ns" "remove-ns" - "find-ns" "all-ns" "the-ns" "resolve" - "ns-resolve" "ns-aliases" "ns-imports" "ns-interns" + "ns" "in-ns" "require" "locking" "new" # Definitional/host macros that mutate context or build runtime # values the emitter doesn't model. "defrecord" "defprotocol" "definterface" "reify" "proxy" "extend-type" "extend-protocol" "extend" "gen-class" "import" - "use" "refer" "monitor-enter" "monitor-exit" "binding" "." + # refer is a ctx-capturing core fn now (tier 6b); use stays — the + # bootstrap compiles analyzer.clj/ir.clj, whose ns/use forms must + # fall back to the interpreter that expands the ns macro. + "use" "monitor-enter" "monitor-exit" "binding" "." # letfn needs all its fns in scope simultaneously (mutual # recursion); the sequential let* the compiler would build can't # express that, so interpret it. diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index 6bcc0a3..1cdc448 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -957,6 +957,55 @@ (fn [ns-name sym-name &opt val] (def ns (ctx-find-ns ctx (if (struct? ns-name) (ns-name :name) ns-name))) (ns-intern ns (if (struct? sym-name) (sym-name :name) sym-name) val))) + # --- ns introspection (Stage 2 tier 6b) — evaluated-arg Clojure semantics. + # A namespace designator is an ns object (passes through) or a symbol/string + # naming one. find-ns is a pure lookup (nil when absent); create-ns creates + # (ctx-find-ns is create-on-demand). The optional-arg forms default to the + # current ns, preserving the prior 0-arg interpreter behavior. + (def ns-name-of (fn [x] + (cond + (and (struct? x) (= :symbol (x :jolt/type))) (x :name) + (string? x) x + (keyword? x) (string x) + nil))) + (def ns-of (fn [x] + (if (and (table? x) (not (nil? (x :mappings)))) + x + (let [nm (ns-name-of x)] + (if nm (get (get (ctx :env) :namespaces) nm) nil))))) + (def ns-or-current (fn [x] + (if (nil? x) + (ctx-find-ns ctx (ctx-current-ns ctx)) + (or (ns-of x) (error (string "No namespace: " (ns-name-of x))))))) + (ns-intern core "find-ns" (fn [x] (ns-of x))) + (ns-intern core "create-ns" (fn [x] (ctx-find-ns ctx (ns-name-of x)))) + (ns-intern core "remove-ns" (fn [x] (remove-ns ctx (ns-name-of x)))) + (ns-intern core "all-ns" (fn [] (all-ns ctx))) + (ns-intern core "the-ns" (fn [&opt x] (ns-or-current x))) + (ns-intern core "ns-interns" (fn [&opt x] ((ns-or-current x) :mappings))) + (ns-intern core "ns-aliases" (fn [&opt x] ((ns-or-current x) :aliases))) + (ns-intern core "ns-imports" (fn [&opt x] ((ns-or-current x) :imports))) + # (ns-resolve ns sym) -> the var or nil. Unqualified syms look in ns's own + # mappings; ns-qualified syms resolve through ns's aliases. (types/ns-resolve + # keys ns-find with the symbol struct instead of its name string, so it never + # finds anything — do the lookup here.) + (ns-intern core "ns-resolve" + (fn [ns-d sym] + (def ns (ns-or-current ns-d)) + (def nm (if (struct? sym) (sym :name) (string sym))) + (def nsp (if (struct? sym) (sym :ns) nil)) + (if nsp + (let [alias-ns (get (ns :aliases) nsp)] + (when alias-ns (ns-find alias-ns nm))) + (ns-find ns nm)))) + (ns-intern core "resolve" + (fn [sym] + (when (and (struct? sym) (= :symbol (sym :jolt/type))) + (def r (protect (resolve-var ctx @{} sym))) + (if (r 0) (r 1) nil)))) + # refer: bring another ns's public vars into the current ns. Reuses use-impl's + # refer-all behavior; the :only/:exclude/:rename filters are not yet honored. + (ns-intern core "refer" (fn [ns-sym & filters] (use-impl ctx ns-sym))) core) # Dispatch a special form by its string name. @@ -1105,22 +1154,11 @@ # special-form arm; an (ns ...) head falls through to the macro-expansion path. # require / in-ns are now ordinary clojure.core fns (install-stateful-fns!) — # no special-form arm; they compile + interpret as plain invokes. - "all-ns" (all-ns ctx) - "the-ns" (the-ns ctx) - "create-ns" (create-ns ctx (sym-name-str (in form 1))) - "remove-ns" (remove-ns ctx (sym-name-str (in form 1))) - "ns-interns" (let [ns (ctx-find-ns ctx (ctx-current-ns ctx))] (ns :mappings)) - "ns-aliases" (let [ns (ctx-find-ns ctx (ctx-current-ns ctx))] (ns :aliases)) - "ns-imports" (let [ns (ctx-find-ns ctx (ctx-current-ns ctx))] (ns :imports)) - "ns-resolve" (ns-resolve (ctx-find-ns ctx (ctx-current-ns ctx)) (in form 1)) - "resolve" (let [sym (eval-form ctx bindings (in form 1))] - (if (and (struct? sym) (= :symbol (sym :jolt/type))) - (let [r (protect (resolve-var ctx bindings sym))] - (if (= (r 0) true) (r 1) nil)) - nil)) - "find-ns" (let [sym (eval-form ctx bindings (in form 1)) - nm (if (and (struct? sym) (= :symbol (sym :jolt/type))) (sym :name) (string sym))] - (get (get (ctx :env) :namespaces) nm)) + # all-ns/the-ns/create-ns/remove-ns/ns-interns/ns-aliases/ns-imports/ + # ns-resolve/resolve/find-ns/refer are ctx-capturing clojure.core fns now + # (install-stateful-fns!) with evaluated-arg Clojure semantics — they fall + # through to the function-call default and compile as plain invokes + # (Stage 2 tier 6b). "fn*" (let [# optional name: (fn* name [args] ...) / (fn* name ([args] ...)...) named? (and (struct? (in form 1)) (= :symbol ((in form 1) :jolt/type))) fn-name (if named? ((in form 1) :name) nil) diff --git a/src/jolt/host_iface.janet b/src/jolt/host_iface.janet index cdad206..c303996 100644 --- a/src/jolt/host_iface.janet +++ b/src/jolt/host_iface.janet @@ -82,13 +82,11 @@ # fns (compile as plain invokes). "prefer-method" "remove-method" "remove-all-methods" "get-method" "methods" - # ns-management forms dispatched by the interpreter (not core vars) - "create-ns" "remove-ns" "find-ns" "all-ns" "the-ns" "resolve" - "ns-resolve" "ns-aliases" "ns-imports" "ns-interns" - # ns/require/in-ns/use/import/refer-clojure are now clojure.core - # fns/macros (compile as plain invokes / expand to them). + # create-ns/remove-ns/find-ns/all-ns/the-ns/resolve/ns-resolve/ + # ns-aliases/ns-imports/ns-interns/refer are ctx-capturing + # clojure.core fns now (compile as plain invokes — tier 6b), like + # ns/require/in-ns/use/import/refer-clojure before them. "read-string" "macroexpand-1" "defonce" - "refer" # defprotocol/extend-type/extend-protocol/reify/defrecord now expand to # plain def + protocol-dispatch/register-method/make-reified/deftype. "gen-class" diff --git a/test/integration/conformance-test.janet b/test/integration/conformance-test.janet index a561942..2855169 100644 --- a/test/integration/conformance-test.janet +++ b/test/integration/conformance-test.janet @@ -146,6 +146,16 @@ ["alter-var-root rest args" "11" "(do (def avr 1) (alter-var-root (var avr) + 4 6) avr)"] ["alter-meta! + meta" "7" "(do (def amv 1) (alter-meta! (var amv) assoc :k 7) (:k (meta (var amv))))"] + ### ---- ns introspection fns as ordinary invokes (Stage 2 tier 6b) ---- + ["find-ns + ns-name" "(quote clojure.core)" "(ns-name (find-ns (quote clojure.core)))"] + ["find-ns absent" "nil" "(find-ns (quote no.such.ns))"] + ["create-ns + find" "true" "(do (create-ns (quote made.ns)) (some? (find-ns (quote made.ns))))"] + ["remove-ns" "nil" "(do (create-ns (quote gone.ns)) (remove-ns (quote gone.ns)) (find-ns (quote gone.ns)))"] + ["the-ns of symbol" "(quote user)" "(ns-name (the-ns (quote user)))"] + ["ns-resolve + call" "3" "((var-get (ns-resolve (quote clojure.core) (quote inc))) 2)"] + ["resolve + call" "3" "((var-get (resolve (quote inc))) 2)"] + ["resolve absent" "nil" "(resolve (quote no-such-sym-xyz))"] + ### ---- HIGH: aliased namespace calls ---- ["require :as alias" "\"1,2,3\"" "(do (require (quote [clojure.string :as s])) (s/join \",\" [1 2 3]))"] ["ns form + alias" "\"HI\"" "(do (ns my.a (:require [clojure.string :as s])) (s/upper-case \"hi\"))"] diff --git a/test/integration/fallback-zero-test.janet b/test/integration/fallback-zero-test.janet index 9962342..ea346f3 100644 --- a/test/integration/fallback-zero-test.janet +++ b/test/integration/fallback-zero-test.janet @@ -57,7 +57,14 @@ "(var-get (var map))" "(var? (var map))" "(var-set (var map) map)" "(alter-var-root (var map) identity)" "(find-var (quote clojure.core/map))" "(intern (quote user) (quote tier6-sym) 42)" - "(alter-meta! (var map) assoc :k 1)" "(reset-meta! (var map) {})"]) + "(alter-meta! (var map) assoc :k 1)" "(reset-meta! (var map) {})" + # Stage 2 tier 6b: ns-introspection fns are ordinary invokes now + "(find-ns (quote clojure.core))" "(create-ns (quote t6.created))" + "(remove-ns (quote t6.created))" "(count (all-ns))" + "(the-ns (quote clojure.core))" "(ns-interns (quote clojure.core))" + "(ns-aliases (quote user))" "(ns-imports (quote user))" + "(ns-resolve (quote clojure.core) (quote map))" "(resolve (quote map))" + "(refer (quote clojure.string))"]) # --- Intentional fallback (sanity sample): these SHOULD punt to the interpreter. # The remaining frozen/uncompiled set keeps the harness honest in the punt