|
| 1 | +;; Copyright (c) Rich Hickey. All rights reserved. |
| 2 | +;; The use and distribution terms for this software are covered by the |
| 3 | +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) |
| 4 | +;; which can be found in the file epl-v10.html at the root of this distribution. |
| 5 | +;; By using this software in any fashion, you are agreeing to be bound by |
| 6 | +;; the terms of this license. |
| 7 | +;; You must not remove this notice, or any other, from this software. |
| 8 | + |
| 9 | +(ns cljs.repl.graaljs |
| 10 | + (:require [clojure.java.io :as io] |
| 11 | + [clojure.string :as string] |
| 12 | + [clojure.stacktrace] |
| 13 | + [clojure.data.json :as json] |
| 14 | + [cljs.analyzer :as ana] |
| 15 | + [cljs.env :as env] |
| 16 | + [cljs.util :as util] |
| 17 | + [cljs.repl :as repl] |
| 18 | + [cljs.cli :as cli] |
| 19 | + [cljs.compiler :as comp] |
| 20 | + [cljs.closure :as closure] |
| 21 | + [cljs.stacktrace :as st]) |
| 22 | + (:import [javax.script ScriptEngine ScriptException])) |
| 23 | + |
| 24 | +(defn create-engine [] |
| 25 | + ;; In order to support AOT compilation by JVMs that don't have |
| 26 | + ;; GraalVM available, we load and execute engine creation code |
| 27 | + ;; here at runtime. |
| 28 | + (import '(com.oracle.truffle.js.scriptengine GraalJSScriptEngine)) |
| 29 | + (import '(org.graalvm.polyglot Context)) |
| 30 | + (let [engine (eval '(GraalJSScriptEngine/create nil |
| 31 | + (-> (Context/newBuilder (make-array String 0)) |
| 32 | + (.allowHostAccess true) |
| 33 | + (.allowCreateThread true) |
| 34 | + (.allowNativeAccess true)))) |
| 35 | + context (.getContext engine)] |
| 36 | + (.setWriter context *out*) |
| 37 | + (.setErrorWriter context *err*) |
| 38 | + engine)) |
| 39 | + |
| 40 | +(defn eval-str [^ScriptEngine engine ^String s] |
| 41 | + (.eval engine s)) |
| 42 | + |
| 43 | +(defn eval-resource |
| 44 | + "Evaluate a file on the classpath in the engine." |
| 45 | + [engine path debug] |
| 46 | + (let [r (io/resource path)] |
| 47 | + (eval-str engine (slurp r)) |
| 48 | + (when debug (println "loaded: " path)))) |
| 49 | + |
| 50 | +(defn init-engine [engine {:keys [output-dir] :as opts} debug] |
| 51 | + (eval-str engine (format "var CLJS_DEBUG = %s;" (boolean debug))) |
| 52 | + (eval-str engine (format "var CLJS_OUTPUT_DIR = \"%s\";" output-dir)) |
| 53 | + (eval-resource engine "goog/base.js" debug) |
| 54 | + (eval-resource engine "goog/deps.js" debug) |
| 55 | + (eval-resource engine "cljs/bootstrap_graaljs.js" debug) |
| 56 | + (eval-str engine |
| 57 | + (format "goog.global.CLOSURE_UNCOMPILED_DEFINES = %s;" |
| 58 | + (json/write-str (:closure-defines opts)))) |
| 59 | + engine) |
| 60 | + |
| 61 | +(defn tear-down-engine [engine] |
| 62 | + (eval-str engine "graaljs_tear_down();")) |
| 63 | + |
| 64 | +(defn load-js-file [engine file] |
| 65 | + (eval-str engine (format "graaljs_load(\"%s\");" file))) |
| 66 | + |
| 67 | +;; Create a minimal build of ClojureScript from the core library. |
| 68 | +;; Copied from clj.cljs.repl.node. |
| 69 | +(defn bootstrap-repl [engine output-dir opts] |
| 70 | + (env/ensure |
| 71 | + (let [deps-file ".graaljs_repl_deps.js" |
| 72 | + core (io/resource "cljs/core.cljs") |
| 73 | + core-js (closure/compile core |
| 74 | + (assoc opts :output-file |
| 75 | + (closure/src-file->target-file |
| 76 | + core (dissoc opts :output-dir)))) |
| 77 | + deps (closure/add-dependencies opts core-js)] |
| 78 | + ;; output unoptimized code and the deps file |
| 79 | + ;; for all compiled namespaces |
| 80 | + (apply closure/output-unoptimized |
| 81 | + (assoc opts :output-to (.getPath (io/file output-dir deps-file))) |
| 82 | + deps) |
| 83 | + ;; load the deps file so we can goog.require cljs.core etc. |
| 84 | + (load-js-file engine deps-file)))) |
| 85 | + |
| 86 | +(defn load-ns [engine ns] |
| 87 | + (eval-str engine |
| 88 | + (format "goog.require(\"%s\");" (comp/munge (first ns))))) |
| 89 | + |
| 90 | +(def repl-filename "<cljs repl>") |
| 91 | + |
| 92 | +(def ^:private skip-types #{"com.oracle.truffle.api.interop.java.TruffleMap" |
| 93 | + "com.oracle.truffle.api.interop.java.TruffleMap$FunctionTruffleMap"}) |
| 94 | + |
| 95 | +(defn- safe-to-string |
| 96 | + "A safe version that avoids calling .toString on types known to cause stack overflow. |
| 97 | + Also has a guard to return an unreadable containing the type if this is encountered." |
| 98 | + [x] |
| 99 | + (let [type-str (pr-str (type x))] |
| 100 | + (try |
| 101 | + (if (contains? skip-types type-str) |
| 102 | + (str #"<" type-str ">") |
| 103 | + (.toString x)) |
| 104 | + (catch StackOverflowError _ |
| 105 | + (str "#<stackoverflow " type-str ">"))))) |
| 106 | + |
| 107 | +(defrecord GraalJSEnv [engine debug] |
| 108 | + repl/IReplEnvOptions |
| 109 | + (-repl-options [this] |
| 110 | + {:output-dir ".cljs_graaljs_repl" |
| 111 | + :target :graaljs}) |
| 112 | + repl/IJavaScriptEnv |
| 113 | + (-setup [this {:keys [output-dir bootstrap output-to] :as opts}] |
| 114 | + (init-engine engine opts debug) |
| 115 | + (let [env (ana/empty-env)] |
| 116 | + (if output-to |
| 117 | + (load-js-file engine output-to) |
| 118 | + (bootstrap-repl engine output-dir opts)) |
| 119 | + (repl/evaluate-form this env repl-filename |
| 120 | + '(.require js/goog "cljs.core")) |
| 121 | + ;; monkey-patch goog.isProvided_ to suppress useless errors |
| 122 | + (repl/evaluate-form this env repl-filename |
| 123 | + '(set! js/goog.isProvided_ (fn [ns] false))) |
| 124 | + ;; monkey-patch goog.require to be more sensible |
| 125 | + (repl/evaluate-form this env repl-filename |
| 126 | + '(do |
| 127 | + (set! *loaded-libs* #{"cljs.core"}) |
| 128 | + (set! (.-require js/goog) |
| 129 | + (fn [name reload] |
| 130 | + (when (or (not (contains? *loaded-libs* name)) reload) |
| 131 | + (set! *loaded-libs* (conj (or *loaded-libs* #{}) name)) |
| 132 | + (js/CLOSURE_IMPORT_SCRIPT |
| 133 | + (if (some? goog/debugLoader_) |
| 134 | + (.getPathFromDeps_ goog/debugLoader_ name) |
| 135 | + (goog.object/get (.. js/goog -dependencies_ -nameToPath) name)))))))))) |
| 136 | + (-evaluate [{engine :engine :as this} filename line js] |
| 137 | + (when debug (println "Evaluating: " js)) |
| 138 | + (try |
| 139 | + {:status :success |
| 140 | + :value (if-let [r (eval-str engine js)] (safe-to-string r) "")} |
| 141 | + (catch ScriptException e |
| 142 | + (let [^Throwable root-cause (clojure.stacktrace/root-cause e)] |
| 143 | + {:status :exception |
| 144 | + :value (.getMessage root-cause) |
| 145 | + :stacktrace |
| 146 | + (apply str |
| 147 | + (interpose "\n" |
| 148 | + (map #(subs % 5) |
| 149 | + (filter #(clojure.string/starts-with? % "<js>.") |
| 150 | + (map str |
| 151 | + (.getStackTrace root-cause))))))})) |
| 152 | + (catch Throwable e |
| 153 | + (let [^Throwable root-cause (clojure.stacktrace/root-cause e)] |
| 154 | + {:status :exception |
| 155 | + :value (.getMessage root-cause) |
| 156 | + :stacktrace |
| 157 | + (apply str |
| 158 | + (interpose "\n" |
| 159 | + (map str |
| 160 | + (.getStackTrace root-cause))))})))) |
| 161 | + (-load [{engine :engine :as this} ns url] |
| 162 | + (load-ns engine ns)) |
| 163 | + (-tear-down [this] |
| 164 | + (tear-down-engine engine)) |
| 165 | + repl/IParseStacktrace |
| 166 | + (-parse-stacktrace [this frames-str ret opts] |
| 167 | + (st/parse-stacktrace this frames-str |
| 168 | + (assoc ret :ua-product :graaljs) opts)) |
| 169 | + repl/IParseError |
| 170 | + (-parse-error [_ err _] |
| 171 | + (update-in err [:stacktrace] |
| 172 | + (fn [st] |
| 173 | + (string/join "\n" (drop 1 (string/split st #"\n"))))))) |
| 174 | + |
| 175 | +(defn repl-env* [{:keys [debug] :as opts}] |
| 176 | + (let [engine (create-engine)] |
| 177 | + (merge |
| 178 | + (GraalJSEnv. engine debug) |
| 179 | + opts))) |
| 180 | + |
| 181 | +(defn repl-env |
| 182 | + "Create a Graal.JS repl-env for use with the repl/repl* method in ClojureScript." |
| 183 | + [& {:as opts}] |
| 184 | + (repl-env* opts)) |
| 185 | + |
| 186 | +;; ------------------------------------------------------------------------- |
| 187 | +;; Command Line Support |
| 188 | + |
| 189 | +(defn -main [& args] |
| 190 | + (apply cli/main repl-env args)) |
0 commit comments