Skip to content

Commit

Permalink
[#520] Fix ns-publics: don't include referred
Browse files Browse the repository at this point in the history
  • Loading branch information
@borkdude
borkdude authored Feb 2, 2021
1 parent 4fd2a47 commit f8f4268
Show file tree
Hide file tree
Showing 7 changed files with 110 additions and 97 deletions.
1 change: 1 addition & 0 deletions .gitignore
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,3 +27,4 @@ sci.exp
sci.lib
sci.pdb
sci.stripped.pdb
/.lsp
59 changes: 27 additions & 32 deletions src/sci/impl/analyzer.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -562,38 +562,33 @@
{:sci.impl/op :try})))

(defn expand-declare [ctx [_declare & names :as expr]]
(swap! (:env ctx)
(fn [env]
(let [cnn (vars/current-ns-name)]
(update-in env [:namespaces cnn]
(fn [current-ns]
(reduce (fn [acc name]
(if-let [x (.get ^java.util.Map acc name)]
(if-let [prev-ns (some-> x meta :ns)]
(let [current-ns-name (vars/current-ns-name)]
(if-not (= (vars/getName prev-ns)
current-ns-name)
(throw-error-with-location
(str name " already refers to "
x " in namespace "
current-ns-name)
expr)
;; when the previous bound thing
;; didn't have an ns, just assume
;; things are ok to redefine
acc))
;; declare does not override an existing var
acc)
(assoc acc name
(doto (vars/->SciVar nil (symbol (str cnn)
(str name))
{:name name
:ns @vars/current-ns
:file @vars/current-file}
false)
(vars/unbind)))))
current-ns
names))))))
(let [cnn (vars/current-ns-name)
env (:env ctx)
the-current-ns (get-in @env [:namespaces cnn])
refers (:refers the-current-ns)
the-current-ns (reduce (fn [acc name]
(if-let [x (and refers (.get ^java.util.Map refers name))]
(throw-error-with-location
(str name " already refers to "
x " in namespace "
cnn)
expr)
(if-not #?(:clj (.containsKey ^java.util.Map the-current-ns name)
:cljs (get the-current-ns name))
(assoc acc name
(doto (vars/->SciVar nil (symbol (str cnn)
(str name))
{:name name
:ns @vars/current-ns
:file @vars/current-file}
false)
(vars/unbind)))
the-current-ns)))
the-current-ns
names)]
(swap! env
(fn [env]
(update env :namespaces assoc cnn the-current-ns))))
nil)

;;;; Interop
Expand Down
119 changes: 61 additions & 58 deletions src/sci/impl/evaluator.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,8 +12,7 @@
[sci.impl.utils :as utils :refer [throw-error-with-location
rethrow-with-location-of-node
set-namespace!
kw-identical?
]]
kw-identical?]]
[sci.impl.vars :as vars])
#?(:cljs (:require-macros [sci.impl.evaluator :refer [def-fn-call resolve-symbol]])))

Expand Down Expand Up @@ -116,15 +115,17 @@
(declare eval-string*)

(defn handle-refer-all [the-current-ns the-loaded-ns include-sym? rename-sym only]
(let [only (when only (set only))]
(reduce (fn [ns [k v]]
(if (and (symbol? k) (include-sym? k)
(or (not only)
(contains? only k)))
(assoc ns (rename-sym k) v)
ns))
the-current-ns
the-loaded-ns)))
(let [referred (:refers the-current-ns)
only (when only (set only))
referred (reduce (fn [ns [k v]]
(if (and (symbol? k) (include-sym? k)
(or (not only)
(contains? only k)))
(assoc ns (rename-sym k) v)
ns))
referred
the-loaded-ns)]
(assoc the-current-ns :refers referred)))

(defn handle-require-libspec-env
[ctx env current-ns the-loaded-ns lib-name
Expand All @@ -145,17 +146,19 @@
use)
(handle-refer-all the-current-ns the-loaded-ns include-sym? rename-sym nil)
(sequential? refer)
(reduce (fn [ns sym]
(if (include-sym? sym)
(assoc ns (rename-sym sym)
(if-let [[_k v] (find the-loaded-ns sym)]
v
(when-not (:uberscript ctx)
(throw (new #?(:clj Exception :cljs js/Error)
(str sym " does not exist"))))))
ns))
the-current-ns
refer)
(let [referred (:refers the-current-ns)
referred (reduce (fn [ns sym]
(if (include-sym? sym)
(assoc ns (rename-sym sym)
(if-let [[_k v] (find the-loaded-ns sym)]
v
(when-not (:uberscript ctx)
(throw (new #?(:clj Exception :cljs js/Error)
(str sym " does not exist"))))))
ns))
referred
refer)]
(assoc the-current-ns :refers referred))
:else (throw (new #?(:clj Exception :cljs js/Error)
(str ":refer value must be a sequential collection of symbols"))))
use (handle-refer-all the-current-ns the-loaded-ns include-sym? rename-sym only)
Expand Down Expand Up @@ -288,17 +291,17 @@
(eval ctx body))
(catch #?(:clj Throwable :cljs js/Error) e
(if-let
[[_ r]
(reduce (fn [_ c]
(let [clazz (:class c)]
(when (instance? clazz e)
(reduced
[::try-result
(eval (assoc-in ctx [:bindings (:binding c)]
e)
(:body c))]))))
nil
catches)]
[[_ r]
(reduce (fn [_ c]
(let [clazz (:class c)]
(when (instance? clazz e)
(reduced
[::try-result
(eval (assoc-in ctx [:bindings (:binding c)]
e)
(:body c))]))))
nil
catches)]
r
(rethrow-with-location-of-node ctx e body)))
(finally
Expand Down Expand Up @@ -575,37 +578,37 @@
op (when m (get-2 m :sci.impl/op))
ret
(if
(not op) expr
(not op) expr
;; TODO: moving this up increased performance for #246. We can
;; probably optimize it further by not using separate keywords for
;; one :sci.impl/op keyword on which we can use a case expression
(case op
:call (eval-call ctx expr)
:try (eval-try ctx expr)
:fn (let [fn-meta (:sci.impl/fn-meta expr)
the-fn (fns/eval-fn ctx eval expr)
fn-meta (when fn-meta (handle-meta ctx fn-meta))]
(if fn-meta
(vary-meta the-fn merge fn-meta)
the-fn))
:static-access (interop/get-static-field expr)
:deref! (let [v (first expr)
v (if (vars/var? v) @v v)
v (force v)]
v)
:resolve-sym (resolve-symbol ctx expr)
(case op
:call (eval-call ctx expr)
:try (eval-try ctx expr)
:fn (let [fn-meta (:sci.impl/fn-meta expr)
the-fn (fns/eval-fn ctx eval expr)
fn-meta (when fn-meta (handle-meta ctx fn-meta))]
(if fn-meta
(vary-meta the-fn merge fn-meta)
the-fn))
:static-access (interop/get-static-field expr)
:deref! (let [v (first expr)
v (if (vars/var? v) @v v)
v (force v)]
v)
:resolve-sym (resolve-symbol ctx expr)
;; needed for when a needs-ctx fn is passed as hof
needs-ctx (if (identical? op utils/needs-ctx)
(partial expr ctx)
needs-ctx (if (identical? op utils/needs-ctx)
(partial expr ctx)
;; this should never happen, or if it does, it's
;; someone trying to hack
(throw (new #?(:clj Exception :cljs js/Error)
(str "unexpected: " expr ", type: " (type expr), ", meta:" (meta expr)))))
(cond (map? expr) (with-meta (zipmap (map #(eval ctx %) (keys expr))
(map #(eval ctx %) (vals expr)))
(handle-meta ctx m))
:else (throw (new #?(:clj Exception :cljs js/Error)
(str "unexpected: " expr ", type: " (type expr), ", meta:" (meta expr)))))))]
(throw (new #?(:clj Exception :cljs js/Error)
(str "unexpected: " expr ", type: " (type expr), ", meta:" (meta expr)))))
(cond (map? expr) (with-meta (zipmap (map #(eval ctx %) (keys expr))
(map #(eval ctx %) (vals expr)))
(handle-meta ctx m))
:else (throw (new #?(:clj Exception :cljs js/Error)
(str "unexpected: " expr ", type: " (type expr), ", meta:" (meta expr)))))))]
;; for debugging:
;; (prn :eval expr (meta expr) '-> ret (meta ret))
ret))
Expand Down
12 changes: 6 additions & 6 deletions src/sci/impl/namespaces.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -400,14 +400,14 @@
(let [sci-ns (sci-the-ns ctx sci-ns)
name (sci-ns-name sci-ns)
m (get-in @(:env ctx) [:namespaces name])
m (dissoc m :aliases :imports :obj)]
m (dissoc m :aliases :imports :obj :refers)]
m))

(defn sci-ns-publics [ctx sci-ns]
(let [sci-ns (sci-the-ns ctx sci-ns)
name (sci-ns-name sci-ns)
m (get-in @(:env ctx) [:namespaces name])
m (dissoc m :aliases :imports :obj)]
m (dissoc m :aliases :imports :obj :refers)]
(into {} (keep (fn [[k v]]
(when-not (:private (meta v))
[k v]))
Expand All @@ -424,15 +424,15 @@
all-imports (concat (vals global-imports) (vals namespace-imports))]
(zipmap all-aliased (map (comp :class #(get class-opts %)) all-imports))))

;; TODO, FIX
(defn sci-ns-refers [ctx sci-ns]
(let [sci-ns (sci-the-ns ctx sci-ns)
name (sci-ns-name sci-ns)
env @(:env ctx)
the-ns (get-in env [:namespaces name])
the-ns (dissoc the-ns :aliases :imports :obj)
refers (get-in env [:namespaces name :refers])
clojure-core (get-in env [:namespaces 'clojure.core])
clojure-core (dissoc clojure-core :aliases :imports :obj)]
(merge the-ns clojure-core)))
clojure-core (dissoc clojure-core :aliases :imports :obj :refers)]
(merge clojure-core refers)))

(defn sci-ns-map [ctx sci-ns]
(merge (sci-ns-interns ctx sci-ns)
Expand Down
7 changes: 7 additions & 0 deletions src/sci/impl/parser.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -62,6 +62,13 @@
(contains? sym ))))
(contains? utils/ana-macros sym))
(symbol "clojure.core" sym-name-str))
(when-let [v (get (:refers the-current-ns) sym)]
;; TODO: pull out to common function, see above
(when-let [m (meta v)]
(when-let [var-name (:name m)]
(when-let [ns (:ns m)]
(symbol (str (vars/getName ns))
(str var-name))))))
(interop/fully-qualify-class ctx sym)
;; all unresolvable symbols all resolved in the current namespace
(symbol current-ns-str sym-name-str))
Expand Down
2 changes: 2 additions & 0 deletions src/sci/impl/resolve.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -71,6 +71,8 @@
:exclude
(contains? sym-name))
kv))
;; TODO: we can unify clojure core and refers into one thing
(find (:refers the-current-ns) sym-name)
(when (when call? (get ana-macros sym))
[sym sym])
(when-let [c (interop/resolve-class ctx sym)]
Expand Down
7 changes: 6 additions & 1 deletion test/sci/namespaces_test.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -56,9 +56,14 @@
(is (eval* "
(import clojure.lang.ExceptionInfo) (some? (get (ns-imports *ns*) 'ExceptionInfo))"))]))

(deftest ns-publics-test
(testing "See issue 520"
(is (eval* "(require '[clojure.string :refer [includes?]]) (nil? (get (ns-publics *ns*) 'refer))"))))

(deftest ns-refers-test
(is (eval* "(some? (get (ns-refers *ns*) 'inc))"))
(is (eval* "(def x 1) (some? (get (ns-refers *ns*) 'x))")))
(is (eval* "(def x 1) (nil? (get (ns-refers *ns*) 'x))"))
(is (eval* "(require '[clojure.string :refer [includes?]]) (some? (get (ns-refers *ns*) 'includes?))")))

(deftest ns-map-test
(is (eval* "(some? (get (ns-map *ns*) 'inc))"))
Expand Down

0 comments on commit f8f4268

Please sign in to comment.