Compare commits
2 commits
main
...
stage2-tas
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
0626b66987 | ||
|
|
8e98a16e25 |
8 changed files with 90 additions and 69 deletions
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -772,6 +772,50 @@
|
|||
(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 a [ns & opts]
|
||||
vector (a pvec/tuple, not a Janet array — coerce, then take the head as the ns)."
|
||||
[ctx & specs]
|
||||
(def target-ns (ctx-find-ns ctx (ctx-current-ns ctx)))
|
||||
(each s specs
|
||||
(let [spec (if (pvec? s) (pv->array s) s)
|
||||
ns-sym (if (indexed? spec) (in spec 0) spec)
|
||||
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 +833,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 +979,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)
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -135,6 +135,8 @@
|
|||
|
||||
### ---- 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\"))"]
|
||||
["ns :use refers" "42" "(do (ns src.u) (def helper 42) (ns dst.u (:use [src.u])) helper)"]
|
||||
|
||||
### ---- MED: missing core fns ----
|
||||
["peek vec" "3" "(peek [1 2 3])"]
|
||||
|
|
|
|||
|
|
@ -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 @[])
|
||||
|
|
|
|||
|
|
@ -16,6 +16,11 @@
|
|||
|
||||
(defspec "namespaces / ns operations"
|
||||
["in-ns switches" "true" "(do (in-ns 'my.ns) (symbol? 'x))"]
|
||||
# ns is a macro over in-ns/require/use/import (Stage 2 jolt-eaa): the form sets
|
||||
# the current ns and processes its clauses.
|
||||
["ns form + alias" "\"HI\"" "(do (ns my.app (:require [clojure.string :as s])) (s/upper-case \"hi\"))"]
|
||||
["ns :use refers all" "9" "(do (ns src.lib) (def helper 9) (ns dst.app (:use [src.lib])) helper)"]
|
||||
["standalone use" "7" "(do (ns src.l2) (def k 7) (in-ns 'dst.a2) (use '[src.l2]) k)"]
|
||||
["ns-name" "true" "(do (require (quote [clojure.string])) (= 'clojure.string (ns-name (find-ns 'clojure.string))))"]
|
||||
["find-ns existing" "true" "(some? (find-ns 'clojure.core))"]
|
||||
["find-ns missing" "nil" "(find-ns 'does.not.exist)"]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue