Merge pull request #24 from jolt-lang/stage2-tier6-ns-fns
Stage 2 tier 6b: ns-introspection fns compile as ordinary invokes
This commit is contained in:
Dmitri Sotnikov
GitHub
commit
b49cb5c934
5 changed files with 84 additions and 27 deletions
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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\"))"]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue