Sci: reify core vars, implement repl/doc (#265)
This commit is contained in:
Michiel Borkent
GitHub
parent
018371d90c
commit
e98a92c283
5 changed files with 169 additions and 162 deletions
2
sci
2
sci
|
|
@ -1 +1 @@
|
|||
Subproject commit 0fdb743ad833d74fb86bed1ae2eacaa9d883f652
|
||||
Subproject commit 57209f08d18ee168dbc1dca26e60b4958add3c0c
|
||||
|
|
@ -5,7 +5,7 @@ set -eo pipefail
|
|||
export BABASHKA_CLASSPATH=$(clojure -Sdeps '{:deps {spartan.spec {:git/url "https://github.com/borkdude/spartan.spec" :sha "16f7eec4b6589c77c96c9fcf989f78fffcee7c4c"}}}' -Spath)
|
||||
|
||||
./bb -e "
|
||||
(require '[spartan.spec :as s])
|
||||
(s/explain (s/cat :i int? :s string?) [1 :foo])
|
||||
(s/conform (s/cat :i int? :s string?) [1 \"foo\"])
|
||||
(time (require '[spartan.spec :as s]))
|
||||
(time (s/explain (s/cat :i int? :s string?) [1 :foo]))
|
||||
(time (s/conform (s/cat :i int? :s string?) [1 \"foo\"]))
|
||||
"
|
||||
|
|
|
|||
|
|
@ -31,7 +31,7 @@
|
|||
(sio/println "Use :repl/quit or :repl/exit to quit the REPL.")
|
||||
(sio/println "Clojure rocks, Bash reaches.")
|
||||
(sio/println)
|
||||
(eval-form sci-ctx '(require '[clojure.repl :refer [dir]]))))
|
||||
(eval-form sci-ctx '(require '[clojure.repl :refer [dir doc]]))))
|
||||
:read (or read
|
||||
(fn [_request-prompt request-exit]
|
||||
;; (prn "PEEK" @sci/in (r/peek-char @sci/in))
|
||||
|
|
|
|||
|
|
@ -25,12 +25,14 @@
|
|||
[sci.core :as sci]
|
||||
[sci.impl.interpreter :refer [eval-string*]]
|
||||
[sci.impl.opts :as sci-opts]
|
||||
[sci.impl.vars :as vars])
|
||||
[sci.impl.vars :as vars]
|
||||
[sci.impl.unrestrict :refer [*unrestricted*]])
|
||||
(:gen-class))
|
||||
|
||||
(sci/alter-var-root sci/in (constantly *in*))
|
||||
(sci/alter-var-root sci/out (constantly *out*))
|
||||
(sci/alter-var-root sci/err (constantly *err*))
|
||||
(binding [*unrestricted* true]
|
||||
(sci/alter-var-root sci/in (constantly *in*))
|
||||
(sci/alter-var-root sci/out (constantly *out*))
|
||||
(sci/alter-var-root sci/err (constantly *err*)))
|
||||
|
||||
(set! *warn-on-reflection* true)
|
||||
;; To detect problems when generating the image, run:
|
||||
|
|
@ -217,10 +219,6 @@ Everything after that is bound to *command-line-args*."))
|
|||
(defn exit [n]
|
||||
(throw (ex-info "" {:bb/exit-code n})))
|
||||
|
||||
;; (sci/set-var-root! sci/*in* *in*)
|
||||
;; (sci/set-var-root! sci/*out* *out*)
|
||||
;; (sci/set-var-root! sci/*err* *err*)
|
||||
|
||||
(def aliases
|
||||
'{tools.cli 'clojure.tools.cli
|
||||
edn clojure.edn
|
||||
|
|
@ -283,155 +281,156 @@ Everything after that is bound to *command-line-args*."))
|
|||
(handle-pipe!)
|
||||
#_(binding [*out* *err*]
|
||||
(prn "M" (meta (get bindings 'future))))
|
||||
(sci/with-bindings {reflection-var false
|
||||
vars/current-ns (vars/->SciNamespace 'user)}
|
||||
(let [t0 (System/currentTimeMillis)
|
||||
{:keys [:version :shell-in :edn-in :shell-out :edn-out
|
||||
:help? :file :command-line-args
|
||||
:expressions :stream? :time?
|
||||
:repl :socket-repl
|
||||
:verbose? :classpath
|
||||
:main :uberscript] :as _opts}
|
||||
(parse-opts args)
|
||||
read-next (fn [*in*]
|
||||
(if (pipe-signal-received?)
|
||||
::EOF
|
||||
(if stream?
|
||||
(if shell-in (or (read-line) ::EOF)
|
||||
(read-edn))
|
||||
(delay (cond shell-in
|
||||
(shell-seq *in*)
|
||||
edn-in
|
||||
(edn-seq *in*)
|
||||
:else
|
||||
(edn/read *in*))))))
|
||||
uberscript-sources (atom ())
|
||||
env (atom {})
|
||||
classpath (or classpath
|
||||
(System/getenv "BABASHKA_CLASSPATH"))
|
||||
_ (when classpath
|
||||
(add-classpath* classpath))
|
||||
load-fn (fn [{:keys [:namespace]}]
|
||||
(when-let [{:keys [:loader]} @cp-state]
|
||||
(let [res (cp/source-for-namespace loader namespace nil)]
|
||||
(when uberscript (swap! uberscript-sources conj (:source res)))
|
||||
res)))
|
||||
_ (when file (vars/bindRoot vars/current-file (.getCanonicalPath (io/file file))))
|
||||
ctx {:aliases aliases
|
||||
:namespaces (-> namespaces
|
||||
(assoc 'clojure.core
|
||||
(assoc core-extras
|
||||
'*command-line-args*
|
||||
(sci/new-dynamic-var '*command-line-args* command-line-args)
|
||||
'*warn-on-reflection* reflection-var))
|
||||
(assoc-in ['clojure.java.io 'resource]
|
||||
#(when-let [{:keys [:loader]} @cp-state] (cp/getResource loader % {:url? true}))))
|
||||
:bindings bindings
|
||||
:env env
|
||||
:features #{:bb}
|
||||
:classes classes/class-map
|
||||
:imports '{ArithmeticException java.lang.ArithmeticException
|
||||
AssertionError java.lang.AssertionError
|
||||
Boolean java.lang.Boolean
|
||||
Class java.lang.Class
|
||||
Double java.lang.Double
|
||||
Exception java.lang.Exception
|
||||
IllegalArgumentException java.lang.IllegalArgumentException
|
||||
Integer java.lang.Integer
|
||||
File java.io.File
|
||||
Long java.lang.Long
|
||||
Math java.lang.Math
|
||||
Object java.lang.Object
|
||||
ProcessBuilder java.lang.ProcessBuilder
|
||||
String java.lang.String
|
||||
StringBuilder java.lang.StringBuilder
|
||||
System java.lang.System
|
||||
Thread java.lang.Thread
|
||||
Throwable java.lang.Throwable}
|
||||
:load-fn load-fn
|
||||
:dry-run uberscript}
|
||||
ctx (addons/future ctx)
|
||||
sci-ctx (sci-opts/init ctx)
|
||||
_ (vreset! common/ctx sci-ctx)
|
||||
_ (swap! (:env sci-ctx)
|
||||
(fn [env]
|
||||
(update-in env [:namespaces 'clojure.core] assoc
|
||||
'eval #(eval* sci-ctx %)
|
||||
'load-file #(load-file* sci-ctx %))))
|
||||
_ (swap! (:env sci-ctx)
|
||||
(fn [env]
|
||||
(assoc-in env [:namespaces 'clojure.main 'repl]
|
||||
(fn [& opts]
|
||||
(let [opts (apply hash-map opts)]
|
||||
(repl/start-repl! sci-ctx opts))))))
|
||||
preloads (some-> (System/getenv "BABASHKA_PRELOADS") (str/trim))
|
||||
[expressions exit-code]
|
||||
(cond expressions [expressions nil]
|
||||
main [[(format "(ns user (:require [%1$s])) (apply %1$s/-main *command-line-args*)"
|
||||
main)] nil]
|
||||
file (try [[(read-file file)] nil]
|
||||
(catch Exception e
|
||||
(error-handler* e verbose?))))
|
||||
expression (str/join " " expressions) ;; this might mess with the locations...
|
||||
exit-code
|
||||
;; handle preloads
|
||||
(if exit-code exit-code
|
||||
(do (when preloads
|
||||
(try
|
||||
(eval-string* sci-ctx preloads)
|
||||
(catch Throwable e
|
||||
(error-handler* e verbose?))))
|
||||
nil))
|
||||
exit-code
|
||||
(or exit-code
|
||||
(second
|
||||
(cond version
|
||||
[(print-version) 0]
|
||||
help?
|
||||
[(print-help) 0]
|
||||
repl [(repl/start-repl! sci-ctx) 0]
|
||||
socket-repl [(start-socket-repl! socket-repl sci-ctx) 0]
|
||||
(not (str/blank? expression))
|
||||
(try
|
||||
(loop [in (read-next *in*)]
|
||||
(let [_ (swap! env update-in [:namespaces 'user]
|
||||
assoc (with-meta '*input*
|
||||
(when-not stream?
|
||||
{:sci.impl/deref! true}))
|
||||
(sci/new-dynamic-var '*input* in))]
|
||||
(if (identical? ::EOF in)
|
||||
[nil 0] ;; done streaming
|
||||
(let [res [(let [res (eval-string* sci-ctx expression)]
|
||||
(when (some? res)
|
||||
(if-let [pr-f (cond shell-out println
|
||||
edn-out prn)]
|
||||
(if (coll? res)
|
||||
(doseq [l res
|
||||
:while (not (pipe-signal-received?))]
|
||||
(pr-f l))
|
||||
(pr-f res))
|
||||
(prn res)))) 0]]
|
||||
(if stream?
|
||||
(recur (read-next *in*))
|
||||
res)))))
|
||||
(catch Throwable e
|
||||
(error-handler* e verbose?)))
|
||||
uberscript [nil 0]
|
||||
:else [(repl/start-repl! sci-ctx) 0]))
|
||||
1)
|
||||
t1 (System/currentTimeMillis)]
|
||||
(flush)
|
||||
(when uberscript
|
||||
uberscript
|
||||
(let [uberscript-out uberscript]
|
||||
(spit uberscript-out "") ;; reset file
|
||||
(doseq [s @uberscript-sources]
|
||||
(spit uberscript-out s :append true))
|
||||
(spit uberscript-out preloads :append true)
|
||||
(spit uberscript-out expression :append true)))
|
||||
(when time? (binding [*out* *err*]
|
||||
(println "bb took" (str (- t1 t0) "ms."))))
|
||||
exit-code)))
|
||||
(binding [*unrestricted* true]
|
||||
(sci/binding [reflection-var false
|
||||
vars/current-ns (vars/->SciNamespace 'user)]
|
||||
(let [t0 (System/currentTimeMillis)
|
||||
{:keys [:version :shell-in :edn-in :shell-out :edn-out
|
||||
:help? :file :command-line-args
|
||||
:expressions :stream? :time?
|
||||
:repl :socket-repl
|
||||
:verbose? :classpath
|
||||
:main :uberscript] :as _opts}
|
||||
(parse-opts args)
|
||||
read-next (fn [*in*]
|
||||
(if (pipe-signal-received?)
|
||||
::EOF
|
||||
(if stream?
|
||||
(if shell-in (or (read-line) ::EOF)
|
||||
(read-edn))
|
||||
(delay (cond shell-in
|
||||
(shell-seq *in*)
|
||||
edn-in
|
||||
(edn-seq *in*)
|
||||
:else
|
||||
(edn/read *in*))))))
|
||||
uberscript-sources (atom ())
|
||||
env (atom {})
|
||||
classpath (or classpath
|
||||
(System/getenv "BABASHKA_CLASSPATH"))
|
||||
_ (when classpath
|
||||
(add-classpath* classpath))
|
||||
load-fn (fn [{:keys [:namespace]}]
|
||||
(when-let [{:keys [:loader]} @cp-state]
|
||||
(let [res (cp/source-for-namespace loader namespace nil)]
|
||||
(when uberscript (swap! uberscript-sources conj (:source res)))
|
||||
res)))
|
||||
_ (when file (vars/bindRoot vars/current-file (.getCanonicalPath (io/file file))))
|
||||
ctx {:aliases aliases
|
||||
:namespaces (-> namespaces
|
||||
(assoc 'clojure.core
|
||||
(assoc core-extras
|
||||
'*command-line-args*
|
||||
(sci/new-dynamic-var '*command-line-args* command-line-args)
|
||||
'*warn-on-reflection* reflection-var))
|
||||
(assoc-in ['clojure.java.io 'resource]
|
||||
#(when-let [{:keys [:loader]} @cp-state] (cp/getResource loader % {:url? true}))))
|
||||
:bindings bindings
|
||||
:env env
|
||||
:features #{:bb}
|
||||
:classes classes/class-map
|
||||
:imports '{ArithmeticException java.lang.ArithmeticException
|
||||
AssertionError java.lang.AssertionError
|
||||
Boolean java.lang.Boolean
|
||||
Class java.lang.Class
|
||||
Double java.lang.Double
|
||||
Exception java.lang.Exception
|
||||
IllegalArgumentException java.lang.IllegalArgumentException
|
||||
Integer java.lang.Integer
|
||||
File java.io.File
|
||||
Long java.lang.Long
|
||||
Math java.lang.Math
|
||||
Object java.lang.Object
|
||||
ProcessBuilder java.lang.ProcessBuilder
|
||||
String java.lang.String
|
||||
StringBuilder java.lang.StringBuilder
|
||||
System java.lang.System
|
||||
Thread java.lang.Thread
|
||||
Throwable java.lang.Throwable}
|
||||
:load-fn load-fn
|
||||
:dry-run uberscript}
|
||||
ctx (addons/future ctx)
|
||||
sci-ctx (sci-opts/init ctx)
|
||||
_ (vreset! common/ctx sci-ctx)
|
||||
_ (swap! (:env sci-ctx)
|
||||
(fn [env]
|
||||
(update-in env [:namespaces 'clojure.core] assoc
|
||||
'eval #(eval* sci-ctx %)
|
||||
'load-file #(load-file* sci-ctx %))))
|
||||
_ (swap! (:env sci-ctx)
|
||||
(fn [env]
|
||||
(assoc-in env [:namespaces 'clojure.main 'repl]
|
||||
(fn [& opts]
|
||||
(let [opts (apply hash-map opts)]
|
||||
(repl/start-repl! sci-ctx opts))))))
|
||||
preloads (some-> (System/getenv "BABASHKA_PRELOADS") (str/trim))
|
||||
[expressions exit-code]
|
||||
(cond expressions [expressions nil]
|
||||
main [[(format "(ns user (:require [%1$s])) (apply %1$s/-main *command-line-args*)"
|
||||
main)] nil]
|
||||
file (try [[(read-file file)] nil]
|
||||
(catch Exception e
|
||||
(error-handler* e verbose?))))
|
||||
expression (str/join " " expressions) ;; this might mess with the locations...
|
||||
exit-code
|
||||
;; handle preloads
|
||||
(if exit-code exit-code
|
||||
(do (when preloads
|
||||
(try
|
||||
(eval-string* sci-ctx preloads)
|
||||
(catch Throwable e
|
||||
(error-handler* e verbose?))))
|
||||
nil))
|
||||
exit-code
|
||||
(or exit-code
|
||||
(second
|
||||
(cond version
|
||||
[(print-version) 0]
|
||||
help?
|
||||
[(print-help) 0]
|
||||
repl [(repl/start-repl! sci-ctx) 0]
|
||||
socket-repl [(start-socket-repl! socket-repl sci-ctx) 0]
|
||||
(not (str/blank? expression))
|
||||
(try
|
||||
(loop [in (read-next *in*)]
|
||||
(let [_ (swap! env update-in [:namespaces 'user]
|
||||
assoc (with-meta '*input*
|
||||
(when-not stream?
|
||||
{:sci.impl/deref! true}))
|
||||
(sci/new-dynamic-var '*input* in))]
|
||||
(if (identical? ::EOF in)
|
||||
[nil 0] ;; done streaming
|
||||
(let [res [(let [res (eval-string* sci-ctx expression)]
|
||||
(when (some? res)
|
||||
(if-let [pr-f (cond shell-out println
|
||||
edn-out prn)]
|
||||
(if (coll? res)
|
||||
(doseq [l res
|
||||
:while (not (pipe-signal-received?))]
|
||||
(pr-f l))
|
||||
(pr-f res))
|
||||
(prn res)))) 0]]
|
||||
(if stream?
|
||||
(recur (read-next *in*))
|
||||
res)))))
|
||||
(catch Throwable e
|
||||
(error-handler* e verbose?)))
|
||||
uberscript [nil 0]
|
||||
:else [(repl/start-repl! sci-ctx) 0]))
|
||||
1)
|
||||
t1 (System/currentTimeMillis)]
|
||||
(flush)
|
||||
(when uberscript
|
||||
uberscript
|
||||
(let [uberscript-out uberscript]
|
||||
(spit uberscript-out "") ;; reset file
|
||||
(doseq [s @uberscript-sources]
|
||||
(spit uberscript-out s :append true))
|
||||
(spit uberscript-out preloads :append true)
|
||||
(spit uberscript-out expression :append true)))
|
||||
(when time? (binding [*out* *err*]
|
||||
(println "bb took" (str (- t1 t0) "ms."))))
|
||||
exit-code))))
|
||||
|
||||
(defn -main
|
||||
[& args]
|
||||
|
|
|
|||
|
|
@ -342,6 +342,14 @@
|
|||
(is (empty? (bb nil "--uberscript" (.getPath tmp-file) "-e" "(System/exit 1)")))
|
||||
(is (= "(System/exit 1)" (slurp tmp-file)))))
|
||||
|
||||
(deftest unrestricted-access
|
||||
(testing "babashka is allowed to mess with built-in vars"
|
||||
(is (= 1 (bb nil "
|
||||
(def inc2 inc) (alter-var-root #'clojure.core/inc (constantly dec))
|
||||
(let [res (inc 2)]
|
||||
(alter-var-root #'clojure.core/inc (constantly inc2))
|
||||
res)")))))
|
||||
|
||||
;;;; Scratch
|
||||
|
||||
(comment
|
||||
|
|
|
|||
Loading…
Reference in a new issue