luciano/babashka
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Sci: reify core vars, implement repl/doc (#265)

Browse source
This commit is contained in:
Michiel Borkent 2020-02-16 12:54:54 +01:00 committed by GitHub
parent 018371d90c
commit e98a92c283
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
5 changed files with 169 additions and 162 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
sci

@ -1 +1 @@
Subproject commit 0fdb743ad833d74fb86bed1ae2eacaa9d883f652 Subproject commit 57209f08d18ee168dbc1dca26e60b4958add3c0c

6
script/lib_tests/spartan_spec_test
View file

@ -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) export BABASHKA_CLASSPATH=$(clojure -Sdeps '{:deps {spartan.spec {:git/url "https://github.com/borkdude/spartan.spec" :sha "16f7eec4b6589c77c96c9fcf989f78fffcee7c4c"}}}' -Spath)
./bb -e " ./bb -e "
(require '[spartan.spec :as s]) (time (require '[spartan.spec :as s]))
(s/explain (s/cat :i int? :s string?) [1 :foo]) (time (s/explain (s/cat :i int? :s string?) [1 :foo]))
(s/conform (s/cat :i int? :s string?) [1 \"foo\"]) (time (s/conform (s/cat :i int? :s string?) [1 \"foo\"]))
" "

2
src/babashka/impl/repl.clj
View file

@ -31,7 +31,7 @@
(sio/println "Use :repl/quit or :repl/exit to quit the REPL.") (sio/println "Use :repl/quit or :repl/exit to quit the REPL.")
(sio/println "Clojure rocks, Bash reaches.") (sio/println "Clojure rocks, Bash reaches.")
(sio/println) (sio/println)
(eval-form sci-ctx '(require '[clojure.repl :refer [dir]])))) (eval-form sci-ctx '(require '[clojure.repl :refer [dir doc]]))))
:read (or read :read (or read
(fn [_request-prompt request-exit] (fn [_request-prompt request-exit]
;; (prn "PEEK" @sci/in (r/peek-char @sci/in)) ;; (prn "PEEK" @sci/in (r/peek-char @sci/in))

313
src/babashka/main.clj
View file

@ -25,12 +25,14 @@
[sci.core :as sci] [sci.core :as sci]
[sci.impl.interpreter :refer [eval-string*]] [sci.impl.interpreter :refer [eval-string*]]
[sci.impl.opts :as sci-opts] [sci.impl.opts :as sci-opts]
[sci.impl.vars :as vars]) [sci.impl.vars :as vars]
[sci.impl.unrestrict :refer [*unrestricted*]])
(:gen-class)) (:gen-class))
(sci/alter-var-root sci/in (constantly *in*)) (binding [*unrestricted* true]
(sci/alter-var-root sci/out (constantly *out*)) (sci/alter-var-root sci/in (constantly *in*))
(sci/alter-var-root sci/err (constantly *err*)) (sci/alter-var-root sci/out (constantly *out*))
(sci/alter-var-root sci/err (constantly *err*)))
(set! *warn-on-reflection* true) (set! *warn-on-reflection* true)
;; To detect problems when generating the image, run: ;; To detect problems when generating the image, run:
@ -217,10 +219,6 @@ Everything after that is bound to *command-line-args*."))
(defn exit [n] (defn exit [n]
(throw (ex-info "" {:bb/exit-code 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 (def aliases
'{tools.cli 'clojure.tools.cli '{tools.cli 'clojure.tools.cli
edn clojure.edn edn clojure.edn
@ -283,155 +281,156 @@ Everything after that is bound to *command-line-args*."))
(handle-pipe!) (handle-pipe!)
#_(binding [*out* *err*] #_(binding [*out* *err*]
(prn "M" (meta (get bindings 'future)))) (prn "M" (meta (get bindings 'future))))
(sci/with-bindings {reflection-var false (binding [*unrestricted* true]
vars/current-ns (vars/->SciNamespace 'user)} (sci/binding [reflection-var false
(let [t0 (System/currentTimeMillis) vars/current-ns (vars/->SciNamespace 'user)]
{:keys [:version :shell-in :edn-in :shell-out :edn-out (let [t0 (System/currentTimeMillis)
:help? :file :command-line-args {:keys [:version :shell-in :edn-in :shell-out :edn-out
:expressions :stream? :time? :help? :file :command-line-args
:repl :socket-repl :expressions :stream? :time?
:verbose? :classpath :repl :socket-repl
:main :uberscript] :as _opts} :verbose? :classpath
(parse-opts args) :main :uberscript] :as _opts}
read-next (fn [*in*] (parse-opts args)
(if (pipe-signal-received?) read-next (fn [*in*]
::EOF (if (pipe-signal-received?)
(if stream? ::EOF
(if shell-in (or (read-line) ::EOF) (if stream?
(read-edn)) (if shell-in (or (read-line) ::EOF)
(delay (cond shell-in (read-edn))
(shell-seq *in*) (delay (cond shell-in
edn-in (shell-seq *in*)
(edn-seq *in*) edn-in
:else (edn-seq *in*)
(edn/read *in*)))))) :else
uberscript-sources (atom ()) (edn/read *in*))))))
env (atom {}) uberscript-sources (atom ())
classpath (or classpath env (atom {})
(System/getenv "BABASHKA_CLASSPATH")) classpath (or classpath
_ (when classpath (System/getenv "BABASHKA_CLASSPATH"))
(add-classpath* classpath)) _ (when classpath
load-fn (fn [{:keys [:namespace]}] (add-classpath* classpath))
(when-let [{:keys [:loader]} @cp-state] load-fn (fn [{:keys [:namespace]}]
(let [res (cp/source-for-namespace loader namespace nil)] (when-let [{:keys [:loader]} @cp-state]
(when uberscript (swap! uberscript-sources conj (:source res))) (let [res (cp/source-for-namespace loader namespace nil)]
res))) (when uberscript (swap! uberscript-sources conj (:source res)))
_ (when file (vars/bindRoot vars/current-file (.getCanonicalPath (io/file file)))) res)))
ctx {:aliases aliases _ (when file (vars/bindRoot vars/current-file (.getCanonicalPath (io/file file))))
:namespaces (-> namespaces ctx {:aliases aliases
(assoc 'clojure.core :namespaces (-> namespaces
(assoc core-extras (assoc 'clojure.core
'*command-line-args* (assoc core-extras
(sci/new-dynamic-var '*command-line-args* command-line-args) '*command-line-args*
'*warn-on-reflection* reflection-var)) (sci/new-dynamic-var '*command-line-args* command-line-args)
(assoc-in ['clojure.java.io 'resource] '*warn-on-reflection* reflection-var))
#(when-let [{:keys [:loader]} @cp-state] (cp/getResource loader % {:url? true})))) (assoc-in ['clojure.java.io 'resource]
:bindings bindings #(when-let [{:keys [:loader]} @cp-state] (cp/getResource loader % {:url? true}))))
:env env :bindings bindings
:features #{:bb} :env env
:classes classes/class-map :features #{:bb}
:imports '{ArithmeticException java.lang.ArithmeticException :classes classes/class-map
AssertionError java.lang.AssertionError :imports '{ArithmeticException java.lang.ArithmeticException
Boolean java.lang.Boolean AssertionError java.lang.AssertionError
Class java.lang.Class Boolean java.lang.Boolean
Double java.lang.Double Class java.lang.Class
Exception java.lang.Exception Double java.lang.Double
IllegalArgumentException java.lang.IllegalArgumentException Exception java.lang.Exception
Integer java.lang.Integer IllegalArgumentException java.lang.IllegalArgumentException
File java.io.File Integer java.lang.Integer
Long java.lang.Long File java.io.File
Math java.lang.Math Long java.lang.Long
Object java.lang.Object Math java.lang.Math
ProcessBuilder java.lang.ProcessBuilder Object java.lang.Object
String java.lang.String ProcessBuilder java.lang.ProcessBuilder
StringBuilder java.lang.StringBuilder String java.lang.String
System java.lang.System StringBuilder java.lang.StringBuilder
Thread java.lang.Thread System java.lang.System
Throwable java.lang.Throwable} Thread java.lang.Thread
:load-fn load-fn Throwable java.lang.Throwable}
:dry-run uberscript} :load-fn load-fn
ctx (addons/future ctx) :dry-run uberscript}
sci-ctx (sci-opts/init ctx) ctx (addons/future ctx)
_ (vreset! common/ctx sci-ctx) sci-ctx (sci-opts/init ctx)
_ (swap! (:env sci-ctx) _ (vreset! common/ctx sci-ctx)
(fn [env] _ (swap! (:env sci-ctx)
(update-in env [:namespaces 'clojure.core] assoc (fn [env]
'eval #(eval* sci-ctx %) (update-in env [:namespaces 'clojure.core] assoc
'load-file #(load-file* sci-ctx %)))) 'eval #(eval* sci-ctx %)
_ (swap! (:env sci-ctx) 'load-file #(load-file* sci-ctx %))))
(fn [env] _ (swap! (:env sci-ctx)
(assoc-in env [:namespaces 'clojure.main 'repl] (fn [env]
(fn [& opts] (assoc-in env [:namespaces 'clojure.main 'repl]
(let [opts (apply hash-map opts)] (fn [& opts]
(repl/start-repl! sci-ctx opts)))))) (let [opts (apply hash-map opts)]
preloads (some-> (System/getenv "BABASHKA_PRELOADS") (str/trim)) (repl/start-repl! sci-ctx opts))))))
[expressions exit-code] preloads (some-> (System/getenv "BABASHKA_PRELOADS") (str/trim))
(cond expressions [expressions nil] [expressions exit-code]
main [[(format "(ns user (:require [%1$s])) (apply %1$s/-main *command-line-args*)" (cond expressions [expressions nil]
main)] nil] main [[(format "(ns user (:require [%1$s])) (apply %1$s/-main *command-line-args*)"
file (try [[(read-file file)] nil] main)] nil]
(catch Exception e file (try [[(read-file file)] nil]
(error-handler* e verbose?)))) (catch Exception e
expression (str/join " " expressions) ;; this might mess with the locations... (error-handler* e verbose?))))
exit-code expression (str/join " " expressions) ;; this might mess with the locations...
;; handle preloads exit-code
(if exit-code exit-code ;; handle preloads
(do (when preloads (if exit-code exit-code
(try (do (when preloads
(eval-string* sci-ctx preloads) (try
(catch Throwable e (eval-string* sci-ctx preloads)
(error-handler* e verbose?)))) (catch Throwable e
nil)) (error-handler* e verbose?))))
exit-code nil))
(or exit-code exit-code
(second (or exit-code
(cond version (second
[(print-version) 0] (cond version
help? [(print-version) 0]
[(print-help) 0] help?
repl [(repl/start-repl! sci-ctx) 0] [(print-help) 0]
socket-repl [(start-socket-repl! socket-repl sci-ctx) 0] repl [(repl/start-repl! sci-ctx) 0]
(not (str/blank? expression)) socket-repl [(start-socket-repl! socket-repl sci-ctx) 0]
(try (not (str/blank? expression))
(loop [in (read-next *in*)] (try
(let [_ (swap! env update-in [:namespaces 'user] (loop [in (read-next *in*)]
assoc (with-meta '*input* (let [_ (swap! env update-in [:namespaces 'user]
(when-not stream? assoc (with-meta '*input*
{:sci.impl/deref! true})) (when-not stream?
(sci/new-dynamic-var '*input* in))] {:sci.impl/deref! true}))
(if (identical? ::EOF in) (sci/new-dynamic-var '*input* in))]
[nil 0] ;; done streaming (if (identical? ::EOF in)
(let [res [(let [res (eval-string* sci-ctx expression)] [nil 0] ;; done streaming
(when (some? res) (let [res [(let [res (eval-string* sci-ctx expression)]
(if-let [pr-f (cond shell-out println (when (some? res)
edn-out prn)] (if-let [pr-f (cond shell-out println
(if (coll? res) edn-out prn)]
(doseq [l res (if (coll? res)
:while (not (pipe-signal-received?))] (doseq [l res
(pr-f l)) :while (not (pipe-signal-received?))]
(pr-f res)) (pr-f l))
(prn res)))) 0]] (pr-f res))
(if stream? (prn res)))) 0]]
(recur (read-next *in*)) (if stream?
res))))) (recur (read-next *in*))
(catch Throwable e res)))))
(error-handler* e verbose?))) (catch Throwable e
uberscript [nil 0] (error-handler* e verbose?)))
:else [(repl/start-repl! sci-ctx) 0])) uberscript [nil 0]
1) :else [(repl/start-repl! sci-ctx) 0]))
t1 (System/currentTimeMillis)] 1)
(flush) t1 (System/currentTimeMillis)]
(when uberscript (flush)
uberscript (when uberscript
(let [uberscript-out uberscript] uberscript
(spit uberscript-out "") ;; reset file (let [uberscript-out uberscript]
(doseq [s @uberscript-sources] (spit uberscript-out "") ;; reset file
(spit uberscript-out s :append true)) (doseq [s @uberscript-sources]
(spit uberscript-out preloads :append true) (spit uberscript-out s :append true))
(spit uberscript-out expression :append true))) (spit uberscript-out preloads :append true)
(when time? (binding [*out* *err*] (spit uberscript-out expression :append true)))
(println "bb took" (str (- t1 t0) "ms.")))) (when time? (binding [*out* *err*]
exit-code))) (println "bb took" (str (- t1 t0) "ms."))))
exit-code))))
(defn -main (defn -main
[& args] [& args]

8
test/babashka/main_test.clj
View file

@ -342,6 +342,14 @@
(is (empty? (bb nil "--uberscript" (.getPath tmp-file) "-e" "(System/exit 1)"))) (is (empty? (bb nil "--uberscript" (.getPath tmp-file) "-e" "(System/exit 1)")))
(is (= "(System/exit 1)" (slurp tmp-file))))) (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 ;;;; Scratch
(comment (comment