diff --git a/jolt-core/clojure/core/00-syntax.clj b/jolt-core/clojure/core/00-syntax.clj index 1b3131c..00ae85d 100644 --- a/jolt-core/clojure/core/00-syntax.clj +++ b/jolt-core/clojure/core/00-syntax.clj @@ -36,6 +36,31 @@ nil `(if ~(first clauses) ~(nth clauses 1) (cond ~@(drop 2 clauses))))) +;; ns is sugar over the namespace-op fns (in-ns/require/use/import/refer-clojure, +;; all ctx-capturing clojure.core fns) — matching Clojure, where require is a fn and +;; the ns macro expands its clauses into require calls. Each spec is quoted +;; individually and passed as data; non-list clauses (docstring, attr-map, +;; :gen-class, …) are ignored. So ns compiles to a plain (do …) of invokes. +;; MUST live in this first tier: the self-hosted analyzer build (triggered while +;; 10-seq loads) processes jolt.analyzer's own (ns …) form, so ns has to exist by +;; then. Its body resolves fn/map/reduce/cond at EXPANSION time, by which point all +;; of 00-syntax has loaded, so using them here is fine. +(defmacro ns [nm & clauses] + (let [calls (reduce + (fn [acc clause] + (if (seq? clause) + (let [head (first clause) args (rest clause)] + (cond + (= head :require) (conj acc `(require ~@(map (fn [s] `(quote ~s)) args))) + (= head :use) (conj acc `(use ~@(map (fn [s] `(quote ~s)) args))) + (= head :import) (conj acc `(import ~@(map (fn [s] `(quote ~s)) args))) + (= head :refer-clojure) + (conj acc `(refer-clojure ~@(map (fn [s] `(quote ~s)) args))) + :else acc)) + acc)) + [] clauses)] + `(do (in-ns (quote ~nm)) ~@calls))) + ;; Threading: a list form threads x in as the first (->) or last (->>) arg; a bare ;; symbol becomes (form x). Recursive; the expand-once cache makes that free. (defmacro -> [x & forms] diff --git a/src/jolt/compiler.janet b/src/jolt/compiler.janet index 7dac091..eba953e 100644 --- a/src/jolt/compiler.janet +++ b/src/jolt/compiler.janet @@ -159,7 +159,7 @@ "defmethod" "prefer-method" "remove-method" "remove-all-methods" "get-method" "methods" "satisfies?" "instance?" "set!" "var" "var-get" - "var-set" "var?" "ns" "create-ns" "remove-ns" + "var-set" "var?" "ns" "in-ns" "require" "create-ns" "remove-ns" "find-ns" "all-ns" "the-ns" "find-var" "intern" "resolve" "ns-resolve" "ns-aliases" "ns-imports" "ns-interns" "alter-var-root" "alter-meta!" "reset-meta!" "locking" "new" diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index 1c9f3d3..206444d 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -772,6 +772,48 @@ (ctx-set-current-ns ctx ns-name) nil) +(defn use-impl + "(use '[ns ...] ...) — refer ALL public vars of each used ns into the CURRENT ns. + A fn; quoted specs arrive evaluated. Each spec is a ns symbol or [ns & opts]." + [ctx & specs] + (def target-ns (ctx-find-ns ctx (ctx-current-ns ctx))) + (each s specs + (let [ns-sym (if (array? s) (in s 0) s) + src-name (sym-name-str ns-sym)] + (maybe-require-ns ctx src-name) + (let [source-ns (ctx-find-ns ctx src-name)] + (loop [[sym v] :pairs (source-ns :mappings)] + (let [nv (ns-intern target-ns sym (var-get v))] + (when (get v :macro) (put nv :macro true))))))) + nil) + +(defn import-impl + "(import 'pkg.Class ...) — register the short class name as an alias of the fully + qualified name in the current ns. A fn; quoted class symbols arrive evaluated." + [ctx & class-specs] + (def ns (ctx-find-ns ctx (ctx-current-ns ctx))) + (each class-spec class-specs + (let [class-name (if (and (struct? class-spec) (= :symbol (class-spec :jolt/type))) + (class-spec :name) (string class-spec)) + last-dot (do (var idx -1) (var pos 0) + (while (< pos (length class-name)) + (when (= (class-name pos) 46) (set idx pos)) (++ pos)) + idx) + short-name (if (>= last-dot 0) (string/slice class-name (+ last-dot 1)) class-name)] + (ns-import ns short-name class-name))) + nil) + +(defn refer-clojure-impl + "(refer-clojure :exclude [a b]) — currently only :exclude is honored: unmap the + excluded names from the current ns. A fn; quoted args arrive evaluated." + [ctx & args] + (when (and (>= (length args) 2) (= (in args 0) :exclude)) + (let [ns (ctx-find-ns ctx (ctx-current-ns ctx)) + excl (in args 1)] + (each sym excl + (ns-unmap ns (if (and (struct? sym) (= :symbol (sym :jolt/type))) (sym :name) (string sym)))))) + nil) + (defn install-stateful-fns! "Intern ctx-capturing closures for the stateful primitives into clojure.core, so both the interpreter and the compiler reach them as ordinary fns. Called by @@ -789,6 +831,9 @@ (fn [proto-name methods-map] (make-reified-impl ctx proto-name methods-map))) (ns-intern core "require" (fn [& specs] (require-impl ctx ;specs))) (ns-intern core "in-ns" (fn [sym] (in-ns-impl ctx sym))) + (ns-intern core "use" (fn [& specs] (use-impl ctx ;specs))) + (ns-intern core "import" (fn [& specs] (import-impl ctx ;specs))) + (ns-intern core "refer-clojure" (fn [& args] (refer-clojure-impl ctx ;args))) core) # Dispatch a special form by its string name. @@ -932,69 +977,9 @@ # A (re)defined macro invalidates any cached expansions. (table/clear macro-cache) (var-get v))) - "ns" (let [raw-name (in form 1) - name-sym (unwrap-meta-name raw-name) - ns-name (sym-name-str name-sym) - clauses (tuple/slice form 2)] - (ctx-set-current-ns ctx ns-name) - (ctx-find-ns ctx ns-name) - (var result nil) - (var i 0) - (let [clen (length clauses)] - (while (< i clen) - (let [clause (in clauses i) - head (if (and (array? clause) (> (length clause) 0)) (first clause) nil)] - (if (nil? head) - (do (set result clause) (++ i)) - (match head - :require (let [specs (tuple/slice clause 1) - slen (length specs)] - (var j 0) - (while (< j slen) - (let [s (in specs j)] - (when s (eval-require ctx s))) - (++ j)) - (set i (+ i 1))) - :use (let [specs (tuple/slice clause 1) - slen (length specs)] - (var j 0) - (while (< j slen) - (let [s (in specs j) - ns-sym (if (array? s) (in s 0) s) - ns-name (sym-name-str ns-sym) - source-ns (ctx-find-ns ctx ns-name) - target-ns (ctx-find-ns ctx ns-name)] - (loop [[sym v] :pairs (source-ns :mappings)] - (ns-intern target-ns sym (var-get v)))) - (++ j)) - (set i (+ i 1))) - :refer-clojure (let [spec (in clause 1)] - (when (and (array? spec) (= (first spec) :exclude)) - (let [ns (ctx-find-ns ctx ns-name)] - (each sym (tuple/slice spec 1) - (ns-unmap ns (if (struct? sym) (sym :name) sym))))) - (set i (+ i 1))) - :import (let [specs (tuple/slice clause 1) - slen (length specs)] - (var j 0) - (while (< j slen) - (let [class-spec (in specs j) - class-name (if (struct? class-spec) (class-spec :name) (string class-spec)) - last-dot (do - (var idx -1) - (var pos 0) - (while (< pos (length class-name)) - (if (= (class-name pos) 46) (set idx pos)) - (++ pos)) - idx) - short-name (if (>= last-dot 0) - (string/slice class-name (+ last-dot 1)) - class-name)] - (ns-import (ctx-find-ns ctx ns-name) short-name class-name)) - (++ j)) - (set i (+ i 1))) - (do (set result clause) (++ i))))))) - result) + # ns is now a macro (clojure.core, 30-macros) expanding to in-ns + require/use/ + # import/refer-clojure calls — all ctx-capturing fns — so it compiles. No + # 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) diff --git a/src/jolt/host_iface.janet b/src/jolt/host_iface.janet index 802a720..13a0780 100644 --- a/src/jolt/host_iface.janet +++ b/src/jolt/host_iface.janet @@ -82,9 +82,10 @@ # 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" - # require/in-ns are now clojure.core fns (compile as plain invokes). - "read-string" "macroexpand-1" "defonce" "ns" - "import" "use" "refer" "defrecord" + # ns/require/in-ns/use/import/refer-clojure are now clojure.core + # fns/macros (compile as plain invokes / expand to them). + "read-string" "macroexpand-1" "defonce" + "refer" "defrecord" # defprotocol/extend-type/extend-protocol/reify now expand to plain # def + protocol-dispatch/register-method/make-reified invokes. "gen-class" diff --git a/src/jolt/loader.janet b/src/jolt/loader.janet index d5e4103..c1223ec 100644 --- a/src/jolt/loader.janet +++ b/src/jolt/loader.janet @@ -13,7 +13,7 @@ # host-coupled set (Stage 2 jolt-eaa): forms move off this list as they gain a # compile path; syntax-quote already compiles via the analyzer's `handled` set. (defn- stateful-head? [head-name] - (or (= head-name "defmacro") (= head-name "ns") + (or (= head-name "defmacro") (= head-name "deftype") (= head-name "defmulti") (= head-name "defmethod") (= head-name "set!") (= head-name ".") (= head-name "new") diff --git a/test/integration/fallback-zero-test.janet b/test/integration/fallback-zero-test.janet index 30529ce..3e1364f 100644 --- a/test/integration/fallback-zero-test.janet +++ b/test/integration/fallback-zero-test.janet @@ -47,6 +47,7 @@ # compiles over an INTERNED var; the built-in dynamic vars aren't interned yet, # so it's exercised end-to-end in the state spec instead.) "(require (quote [clojure.string :as s]))" "(in-ns (quote foo.bar))" + "(ns foo.bar (:require [clojure.string :as s]))" "(defprotocol P (m [x]))" "(extend-type Long P (m [x] x))" "(reify P (m [this] 1))" "(var map)"]) @@ -55,7 +56,7 @@ # (require/in-ns/protocols/binding now compile). The remaining frozen/uncompiled # set keeps the harness honest in the punt direction. (def must-punt - ["(ns foo.bar)" "(defmacro m [x] x)" "(deftype T [a])" + ["(defmacro m [x] x)" "(deftype T [a])" "(set! *warn-on-reflection* true)" "(letfn [(f [n] (g n)) (g [n] (f n))] (f 1))"]) (var fails @[])