diff options
Diffstat (limited to '')
| -rw-r--r-- | luxc/src/lux/compiler.clj | 2 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/js.clj | 182 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/js/base.clj | 135 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/js/lux.clj | 468 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/js/rt.clj | 994 |
5 files changed, 1780 insertions, 1 deletions
diff --git a/luxc/src/lux/compiler.clj b/luxc/src/lux/compiler.clj index fafb35818..0e78fa766 100644 --- a/luxc/src/lux/compiler.clj +++ b/luxc/src/lux/compiler.clj @@ -7,7 +7,7 @@ [io :as &&io] [parallel :as &¶llel] [jvm :as &&jvm] - ;; [js :as &&js] + [js :as &&js] ))) (defn init! [resources-dirs ^String target-dir] diff --git a/luxc/src/lux/compiler/js.clj b/luxc/src/lux/compiler/js.clj new file mode 100644 index 000000000..6334b1d9a --- /dev/null +++ b/luxc/src/lux/compiler/js.clj @@ -0,0 +1,182 @@ +(ns lux.compiler.js + (:refer-clojure :exclude [compile]) + (:require (clojure [string :as string] + [set :as set] + [template :refer [do-template]]) + clojure.core.match + clojure.core.match.array + (lux [base :as & :refer [|let |do return* return |case]] + [type :as &type] + [reader :as &reader] + [lexer :as &lexer] + [parser :as &parser] + [analyser :as &analyser] + [optimizer :as &optimizer]) + [lux.optimizer :as &o] + [lux.analyser.base :as &a] + [lux.analyser.module :as &a-module] + (lux.compiler [core :as &&core] + [io :as &&io] + [parallel :as &¶llel]) + (lux.compiler.js [base :as &&] + ;; [cache :as &&cache] + [lux :as &&lux] + [rt :as &&rt] + ;; [host :as &&host] + ) + ) + (:import (jdk.nashorn.api.scripting NashornScriptEngineFactory + NashornScriptEngine + ScriptObjectMirror) + (jdk.nashorn.internal.runtime Undefined)) + ) + +;; [Resources] +(defn ^:private compile-expression [syntax] + (|let [[[?type [_file-name _line _]] ?form] syntax] + (|case ?form + (&o/$bool ?value) + (&&lux/compile-bool ?value) + + (&o/$nat ?value) + (&&lux/compile-nat ?value) + + (&o/$int ?value) + (&&lux/compile-int ?value) + + (&o/$deg ?value) + (&&lux/compile-deg ?value) + + (&o/$real ?value) + (&&lux/compile-real ?value) + + (&o/$char ?value) + (&&lux/compile-char ?value) + + (&o/$text ?value) + (&&lux/compile-text ?value) + + (&o/$tuple ?elems) + (&&lux/compile-tuple compile-expression ?elems) + + (&o/$var (&/$Local ?idx)) + (&&lux/compile-local compile-expression ?idx) + + ;; (&o/$captured ?scope ?captured-id ?source) + ;; (&&lux/compile-captured compile-expression ?scope ?captured-id ?source) + + (&o/$var (&/$Global ?module ?name)) + (&&lux/compile-global ?module ?name) + + (&o/$apply ?fn ?args) + (&&lux/compile-apply compile-expression ?fn ?args) + + ;; (&o/$loop _register-offset _inits _body) + ;; (&&lux/compile-loop compile-expression _register-offset _inits _body) + + ;; (&o/$iter _register-offset ?args) + ;; (&&lux/compile-iter compile-expression _register-offset ?args) + + (&o/$variant ?tag ?tail ?members) + (&&lux/compile-variant compile-expression ?tag ?tail ?members) + + (&o/$case ?value [?pm ?bodies]) + (&&lux/compile-case compile-expression ?value ?pm ?bodies) + + (&o/$let _value _register _body) + (&&lux/compile-let compile-expression _value _register _body) + + ;; (&o/$record-get _value _path) + ;; (&&lux/compile-record-get compile-expression _value _path) + + ;; (&o/$if _test _then _else) + ;; (&&lux/compile-if compile-expression _test _then _else) + + (&o/$function _register-offset ?arity ?scope ?env ?body) + (&&lux/compile-function compile-expression ?arity ?scope ?env ?body) + + (&o/$ann ?value-ex ?type-ex) + (compile-expression ?value-ex) + + ;; (&o/$proc [?proc-category ?proc-name] ?args special-args) + ;; (&&host/compile-host compile-expression ?proc-category ?proc-name ?args special-args) + + _ + (assert false (prn-str 'JS=compile-expression| (&/adt->text syntax)))) + )) + +(defn init! + "(-> (List Text) Null)" + [resources-dirs ^String target-dir] + nil) + +(defn eval! [expr] + (&/with-eval + (|do [compiled-expr (compile-expression expr) + js-output (&&/run-js! compiled-expr)] + (return (&&/js-to-lux js-output))))) + +(def all-compilers + (&/T [(partial &&lux/compile-def compile-expression) + (partial &&lux/compile-program compile-expression) + (fn [^ScriptObjectMirror macro] + (fn [args state] + (let [output (.call macro nil (to-array [(&&/wrap-lux-obj args) + (&&/wrap-lux-obj state)]))] + (do (prn 'output output) + (assert false "Got macros?")))))])) + +(defn compile-module [source-dirs name] + (let [file-name (str name ".lux")] + (|do [file-content (&&io/read-file source-dirs file-name) + :let [file-hash (hash file-content) + ;; compile-module!! (&¶llel/parallel-compilation (partial compile-module source-dirs)) + compile-module!! (partial compile-module source-dirs)]] + ;; (&/|eitherL (&&cache/load name)) + (let [compiler-step (&analyser/analyse &optimizer/optimize eval! compile-module!! all-compilers)] + (|do [module-exists? (&a-module/exists? name)] + (if module-exists? + (&/fail-with-loc (str "[Compiler Error] Can't re-define a module: " name)) + (|do [;; _ (&&cache/delete name) + _ (&a-module/create-module name file-hash) + _ (&a-module/flag-active-module name) + _ (if (= "lux" name) + &&rt/compile-LuxRT + (return nil)) + ] + (fn [state] + (|case ((&/exhaust% compiler-step) + ;; (&/with-writer =class + ;; (&/exhaust% compiler-step)) + (&/set$ &/$source (&reader/from name file-content) state)) + (&/$Right ?state _) + (&/run-state (|do [_ (&a-module/flag-compiled-module name) + ;; _ (&&/save-class! &/module-class-name (.toByteArray =class)) + module-descriptor &&core/generate-module-descriptor + _ (&&core/write-module-descriptor! name module-descriptor)] + (return file-hash)) + ?state) + + (&/$Left ?message) + (&/fail* ?message))))))) + ) + )) + +(let [!err! *err*] + (defn compile-program [mode program-module resources-dir source-dirs target-dir] + (do (init! resources-dir target-dir) + (let [m-action (|do [;; _ (&&cache/pre-load-cache! source-dirs) + _ (compile-module source-dirs "lux")] + (compile-module source-dirs program-module))] + (|case (m-action (&/init-state mode (&&/js-host))) + (&/$Right ?state _) + (do (println "Compilation complete!") + ;; (&&cache/clean ?state) + ) + + (&/$Left ?message) + (binding [*out* !err!] + (do (println (str "Compilation failed:\n" ?message)) + ;; (flush) + ;; (System/exit 1) + ))))))) diff --git a/luxc/src/lux/compiler/js/base.clj b/luxc/src/lux/compiler/js/base.clj new file mode 100644 index 000000000..d3746f01c --- /dev/null +++ b/luxc/src/lux/compiler/js/base.clj @@ -0,0 +1,135 @@ +(ns lux.compiler.js.base + (:refer-clojure :exclude [compile]) + (:require (clojure [string :as string] + [set :as set] + [template :refer [do-template]]) + clojure.core.match + clojure.core.match.array + (lux [base :as & :refer [deftuple |let |do return* return |case]] + [host :as &host]) + [lux.compiler.core :as &&] + ) + (:import (jdk.nashorn.api.scripting NashornScriptEngineFactory + NashornScriptEngine + ScriptObjectMirror + JSObject) + (jdk.nashorn.internal.runtime Undefined) + (java.io File + BufferedOutputStream + FileOutputStream)) + ) + +(deftuple + ["interpreter" + "buffer"]) + +(defn js-host [] + (&/T [;; "interpreter" + (.getScriptEngine (new NashornScriptEngineFactory)) + ;; "buffer" + &/$None + ])) + +(defn run-js! [^String js-code] + (fn [compiler-state] + (|let [^NashornScriptEngine interpreter (->> compiler-state (&/get$ &/$host) (&/get$ $interpreter))] + (try (&/$Right (&/T [compiler-state + (.eval interpreter js-code)])) + (catch Exception ex + (&/$Left (str ex))))))) + +(def ^:private lux-obj-class (Class/forName "[Ljava.lang.Object;")) + +(defn ^:private _valueOf_ [value] + (reify JSObject + (isFunction [self] true) + (call [self this args] + value))) + +(defn ^:private _slice_ [wrap-lux-obj value] + (reify JSObject + (isFunction [self] true) + (call [self this args] + (prn '_slice_ (seq args)) + (let [slice (java.util.Arrays/copyOfRange value (aget args 0) (alength value))] + (wrap-lux-obj slice))))) + +(defn ^:private _toString_ [obj] + (reify JSObject + (isFunction [self] true) + (call [self this args] + (&/adt->text obj) + ;; (pr-str this) + ))) + +(defn wrap-lux-obj [obj] + (if (instance? lux-obj-class obj) + (reify JSObject + (isFunction [self] false) + (getSlot [self idx] + (wrap-lux-obj (aget obj idx))) + (getMember [self member] + (condp = member + ;; "valueOf" (_valueOf_ obj) + "toString" (_toString_ obj) + "length" (alength obj) + "slice" (_slice_ wrap-lux-obj obj) + ;; else + (assert false (str "member = " member))))) + obj)) + +(defn js-to-lux [js-object] + (cond (instance? java.lang.Integer js-object) + (long js-object) + + (or (nil? js-object) + (instance? java.lang.Boolean js-object) + (instance? java.lang.String js-object)) + js-object + + ;; (instance? Undefined js-object) + ;; (assert false "UNDEFINED") + + (instance? ScriptObjectMirror js-object) + (let [^ScriptObjectMirror js-object js-object] + (cond (.isArray js-object) + (let [array-vec (loop [num-keys (.size js-object) + idx 0 + array-vec []] + (if (< idx num-keys) + (let [idx-key (str idx)] + (if (.hasMember js-object idx-key) + (recur num-keys + (inc idx) + (conj array-vec (js-to-lux (.getMember js-object idx-key)))) + (recur (inc num-keys) + (inc idx) + (conj array-vec nil)))) + array-vec))] + (&/T array-vec)) + + (.isFunction js-object) + js-object + + :else + (assert false (str "Unknown kind of JS object: " js-object)))) + + :else + (assert false (str "Unknown kind of JS object: " (class js-object) " :: " js-object)))) + +(defn run-js!+ [^String js-code] + (|do [raw (run-js! js-code)] + (return (js-to-lux raw)))) + +(def ^String unit (pr-str &/unit-tag)) + +(defn save-js! [name ^String script] + (|do [_ (run-js! script) + eval? &/get-eval + module &/get-module-name + :let [_ (when (not eval?) + (let [^String module* (&host/->module-class module) + module-dir (str @&&/!output-dir java.io.File/separator (.replace module* "/" java.io.File/separator))] + (do (.mkdirs (File. module-dir)) + (&&/write-file (str module-dir java.io.File/separator name ".js") (.getBytes script)))))]] + (return nil))) diff --git a/luxc/src/lux/compiler/js/lux.clj b/luxc/src/lux/compiler/js/lux.clj new file mode 100644 index 000000000..fe45350b5 --- /dev/null +++ b/luxc/src/lux/compiler/js/lux.clj @@ -0,0 +1,468 @@ +(ns lux.compiler.js.lux + (:require (clojure [string :as string] + [set :as set] + [template :refer [do-template]]) + clojure.core.match + clojure.core.match.array + (lux [base :as & :refer [|do return* return |let |case]] + [type :as &type] + [lexer :as &lexer] + [parser :as &parser] + [analyser :as &analyser] + [host :as &host] + [optimizer :as &o]) + (lux.analyser [base :as &a] + [module :as &a-module] + [meta :as &a-meta]) + (lux.compiler.js [base :as &&] + [rt :as &&rt]) + )) + +;; [Utils] +(defn ^:private js-var-name [module name] + (str (string/replace module "/" "$") "$" (&host/def-name name))) + +(defn ^:private register-name [register] + (str "_" register)) + +;; [Exports] +(defn compile-bool [?value] + (return (str ?value))) + +(do-template [<name>] + (defn <name> [value] + (return (str value "|0"))) + + compile-nat + compile-int + compile-deg + ) + +(defn compile-real [value] + (return (str value))) + +(defn compile-char [value] + (return (str "\"" value "\""))) + +(defn compile-text [?value] + (return (pr-str ?value))) + +(defn compile-tuple [compile ?elems] + (|do [:let [num-elems (&/|length ?elems)]] + (|case num-elems + 0 + (return &&/unit) + + 1 + (compile (&/|head ?elems)) + + _ + (|do [=elems (&/map% compile ?elems)] + (return (str "[" (->> =elems (&/|interpose ",") (&/fold str "")) "]")))))) + +(defn compile-variant [compile tag tail? value] + (|do [value-expr (compile value)] + (return (str "[" tag + "," (if tail? "\"\"" "null") + "," value-expr + "]")))) + +(defn compile-local [compile register] + (return (register-name register))) + +;; (defn compile-captured [compile ?scope ?captured-id ?source] +;; (|do [:let [??scope (&/|reverse ?scope)] +;; ^MethodVisitor *writer* &/get-writer +;; :let [_ (doto *writer* +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitFieldInsn Opcodes/GETFIELD +;; (str (&host/->module-class (&/|head ??scope)) "/" (&host/location (&/|tail ??scope))) +;; (str &&/closure-prefix ?captured-id) +;; "Ljava/lang/Object;"))]] +;; (return nil))) + +(defn compile-global [module name] + (return (js-var-name module name))) + +(defn compile-apply [compile ?fn ?args] + (|do [=fn (compile ?fn) + =args (&/map% compile ?args)] + (return (str =fn "(" (->> =args (&/|interpose ",") (&/fold str "")) ")")))) + +;; (defn compile-loop [compile-expression register-offset inits body] +;; (|do [^MethodVisitor *writer* &/get-writer +;; :let [idxs+inits (&/zip2 (&/|range* 0 (dec (&/|length inits))) +;; inits)] +;; _ (&/map% (fn [idx+_init] +;; (|do [:let [[idx _init] idx+_init +;; idx+ (+ register-offset idx)] +;; _ (compile-expression nil _init) +;; :let [_ (.visitVarInsn *writer* Opcodes/ASTORE idx+)]] +;; (return nil))) +;; idxs+inits) +;; :let [$begin (new Label) +;; _ (.visitLabel *writer* $begin)]] +;; (compile-expression $begin body) +;; )) + +;; (defn compile-iter [compile $begin register-offset ?args] +;; (|do [^MethodVisitor *writer* &/get-writer +;; :let [idxs+args (&/zip2 (&/|range* 0 (dec (&/|length ?args))) +;; ?args)] +;; _ (&/map% (fn [idx+?arg] +;; (|do [:let [[idx ?arg] idx+?arg +;; idx+ (+ register-offset idx) +;; already-set? (|case ?arg +;; [_ (&o/$var (&/$Local l-idx))] +;; (= idx+ l-idx) + +;; _ +;; false)]] +;; (if already-set? +;; (return nil) +;; (compile ?arg)))) +;; idxs+args) +;; _ (&/map% (fn [idx+?arg] +;; (|do [:let [[idx ?arg] idx+?arg +;; idx+ (+ register-offset idx) +;; already-set? (|case ?arg +;; [_ (&o/$var (&/$Local l-idx))] +;; (= idx+ l-idx) + +;; _ +;; false)] +;; :let [_ (when (not already-set?) +;; (.visitVarInsn *writer* Opcodes/ASTORE idx+))]] +;; (return nil))) +;; (&/|reverse idxs+args)) +;; :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $begin)]] +;; (return nil))) + +(defn compile-let [compile _value _register _body] + (|do [=value (compile _value) + =body (compile _body)] + (return (str "(function() {" + "var " (register-name _register) " = " =value ";" + " return " =body + ";})()")))) + +;; (defn compile-record-get [compile _value _path] +;; (|do [^MethodVisitor *writer* &/get-writer +;; _ (compile _value) +;; :let [_ (&/|map (fn [step] +;; (|let [[idx tail?] step] +;; (doto *writer* +;; (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") +;; (.visitLdcInsn (int idx)) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" +;; (if tail? "product_getRight" "product_getLeft") +;; "([Ljava/lang/Object;I)Ljava/lang/Object;")))) +;; _path)]] +;; (return nil))) + +;; (defn compile-if [compile _test _then _else] +;; (|do [^MethodVisitor *writer* &/get-writer +;; _ (compile _test) +;; :let [$else (new Label) +;; $end (new Label) +;; _ (doto *writer* +;; &&/unwrap-boolean +;; (.visitJumpInsn Opcodes/IFEQ $else))] +;; _ (compile _then) +;; :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)] +;; :let [_ (.visitLabel *writer* $else)] +;; _ (compile _else) +;; :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end) +;; _ (.visitLabel *writer* $end)]] +;; (return nil))) + +(def ^:private original "pm_stack_original") +(def ^:private stack "pm_stack") +(defn ^:private stack-push [value] + (str stack ".push(" value ");")) +(def ^:private stack-init (str stack " = " original ".slice();")) +(def ^:private stack-peek (str stack "[" stack ".length - 1]")) +(def ^:private stack-pop (str stack ".pop();")) +(def ^:private pm-error (.intern (pr-str (str (char 0) "PM-ERROR" (char 0))))) +(def ^:private pm-fail (str "throw " pm-error ";")) + +(defn ^:private compile-pm* [compile pm bodies] + "(-> Case-Pattern (List Analysis) (Lux JS))" + (|case pm + (&o/$ExecPM _body-idx) + (|case (&/|at _body-idx bodies) + (&/$Some body) + (|do [=body (compile body)] + (return (str "return " =body ";"))) + + (&/$None) + (assert false)) + + (&o/$PopPM) + (return stack-pop) + + (&o/$BindPM _register) + (return (str "var " (register-name _register) " = " stack-peek ";" + stack-pop)) + + (&o/$BoolPM _value) + (return (str "if(" stack-peek "!== " _value ") { " pm-fail " }")) + + (&o/$NatPM _value) + (return (str "if(" stack-peek "!== " _value ") { " pm-fail " }")) + + (&o/$IntPM _value) + (return (str "if(" stack-peek "!== " _value ") { " pm-fail " }")) + + (&o/$DegPM _value) + (return (str "if(" stack-peek "!== " _value ") { " pm-fail " }")) + + (&o/$RealPM _value) + (return (str "if(" stack-peek "!== " _value ") { " pm-fail " }")) + + (&o/$CharPM _value) + (return (str "if(" stack-peek "!== \"" _value "\") { " pm-fail " }")) + + (&o/$TextPM _value) + (return (str "if(" stack-peek "!== \"" _value "\") { " pm-fail " }")) + + (&o/$TuplePM _idx+) + (|let [[_idx is-tail?] (|case _idx+ + (&/$Left _idx) + (&/T [_idx false]) + + (&/$Right _idx) + (&/T [_idx true])) + getter (if is-tail? "product_getRight" "product_getLeft")] + (return (str (stack-push (str &&rt/LuxRT "." getter "(" stack-peek "," _idx ")"))))) + + (&o/$VariantPM _idx+) + (|let [[_idx is-last] (|case _idx+ + (&/$Left _idx) + (&/T [_idx false]) + + (&/$Right _idx) + (&/T [_idx true])) + temp-assignment (str "temp = " &&rt/LuxRT "." "sum_get(" stack-peek "," _idx "," (if is-last "\"\"" "null") ");")] + (return (str temp-assignment + (str "if(temp) {" + (stack-push "temp") + "}" + "else {" + pm-fail + "}")))) + + (&o/$SeqPM _left-pm _right-pm) + (|do [=left (compile-pm* compile _left-pm bodies) + =right (compile-pm* compile _right-pm bodies)] + (return (str =left =right))) + + (&o/$AltPM _left-pm _right-pm) + (|do [=left (compile-pm* compile _left-pm bodies) + =right (compile-pm* compile _right-pm bodies)] + (return (str "try {" =left "}" + "catch(ex) {" + "if(ex === " pm-error ") {" + stack-init + =right + "}" + "else {" + "throw ex;" + "}" + "}"))) + )) + +(defn ^:private compile-pm [compile pm bodies] + (|do [raw (compile-pm* compile pm bodies)] + (return (str "try {" raw "}" + "catch(ex) {" + "if(ex === " pm-error ") {" + "throw \"Invalid expression for pattern-matching.\";" + "}" + "else {" + "throw ex;" + "}" + "}")))) + +;; [Resources] +(defn compile-case [compile ?value ?pm ?bodies] + (|do [=value (compile ?value) + =pm (compile-pm compile ?pm ?bodies)] + (return (str "(function() {" + "\"use strict\";" + "var temp;" + "var " original " = [" =value "];" + "var " stack-init + =pm + "})()")))) + +(defn compile-function [compile arity ?scope ?env ?body] + (|do [:let [??scope (&/|reverse ?scope) + function-name (str (&host/->module-class (&/|head ??scope)) + "$" (&host/location (&/|tail ??scope))) + func-args (->> (&/|range* 0 (dec arity)) + (&/|map (fn [register] (str "var " (register-name (inc register)) " = arguments[" register "];"))) + (&/fold str ""))] + =body (compile ?body)] + (return (str "(function " function-name "() {" + "\"use strict\";" + "var num_args = arguments.length;" + "if(num_args == " arity ") {" + "var " (register-name 0) " = " function-name ";" + func-args + "return " =body ";" + "}" + "else if(num_args > " arity ") {" + "return " function-name ".apply(null, [].slice.call(arguments,0," arity "))" + ".apply(null, [].slice.call(arguments," arity "));" + "}" + ;; Less than arity + "else {" + "var curried = [].slice.call(arguments);" + "return function() { " + "return " function-name ".apply(null, curried.concat([].slice.call(arguments)));" + " };" + "}" + "})")))) + +(defn compile-def [compile ?name ?body def-meta] + (|do [module-name &/get-module-name + class-loader &/loader + :let [var-name (js-var-name module-name ?name)]] + (|case (&a-meta/meta-get &a-meta/alias-tag def-meta) + (&/$Some (&/$IdentA [r-module r-name])) + (if (= 1 (&/|length def-meta)) + (|do [def-value (&&/run-js! var-name) + def-type (&a-module/def-type r-module r-name) + _ (&/without-repl-closure + (&a-module/define module-name ?name def-type def-meta def-value))] + (return nil)) + (&/fail-with-loc (str "[Compilation Error] Aliases cannot contain meta-data: " module-name ";" ?name))) + + (&/$Some _) + (&/fail-with-loc "[Compilation Error] Invalid syntax for lux;alias meta-data. Must be an Ident.") + + _ + (|do [=body (compile ?body) + :let [def-js (str "var " var-name " = " =body ";") + is-type? (|case (&a-meta/meta-get &a-meta/type?-tag def-meta) + (&/$Some (&/$BoolA true)) + true + + _ + false) + def-type (&a/expr-type* ?body) + _ (&/|log! (str "def-js >>\n" + (string/replace def-js " + _ (&&/run-js! def-js) + def-value (&&/run-js!+ var-name) + _ (&/without-repl-closure + (&a-module/define module-name ?name def-type def-meta def-value)) + _ (|case (&/T [is-type? (&a-meta/meta-get &a-meta/tags-tag def-meta)]) + [true (&/$Some (&/$ListA tags*))] + (|do [:let [was-exported? (|case (&a-meta/meta-get &a-meta/export?-tag def-meta) + (&/$Some _) + true + + _ + false)] + tags (&/map% (fn [tag*] + (|case tag* + (&/$TextA tag) + (return tag) + + _ + (&/fail-with-loc "[Compiler Error] Incorrect format for tags."))) + tags*) + _ (&a-module/declare-tags module-name tags was-exported? def-value)] + (return nil)) + + [false (&/$Some _)] + (&/fail-with-loc "[Compiler Error] Can't define tags for non-type.") + + [true (&/$Some _)] + (&/fail-with-loc "[Compiler Error] Incorrect format for tags.") + + [_ (&/$None)] + (return nil)) + :let [_ (println 'DEF (str module-name ";" ?name))]] + (return nil)) + )) + ) + +(defn compile-program [compile ?body] + (assert false "compile-program") + ;; (|do [module-name &/get-module-name + ;; ^ClassWriter *writer* &/get-writer] + ;; (&/with-writer (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "main" "([Ljava/lang/String;)V" nil nil) + ;; (.visitCode)) + ;; (|do [^MethodVisitor main-writer &/get-writer + ;; :let [$loop (new Label) + ;; $end (new Label) + ;; _ (doto main-writer + ;; ;; Tail: Begin + ;; (.visitLdcInsn (->> #'&/$Nil meta ::&/idx int)) ;; I + ;; (.visitInsn Opcodes/ACONST_NULL) ;; I? + ;; (.visitLdcInsn &/unit-tag) ;; I?U + ;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") ;; V + ;; ;; Tail: End + ;; ;; Size: Begin + ;; (.visitVarInsn Opcodes/ALOAD 0) ;; VA + ;; (.visitInsn Opcodes/ARRAYLENGTH) ;; VI + ;; ;; Size: End + ;; ;; Loop: Begin + ;; (.visitLabel $loop) + ;; (.visitLdcInsn (int 1)) ;; VII + ;; (.visitInsn Opcodes/ISUB) ;; VI + ;; (.visitInsn Opcodes/DUP) ;; VII + ;; (.visitJumpInsn Opcodes/IFLT $end) ;; VI + ;; ;; Head: Begin + ;; (.visitInsn Opcodes/DUP) ;; VII + ;; (.visitVarInsn Opcodes/ALOAD 0) ;; VIIA + ;; (.visitInsn Opcodes/SWAP) ;; VIAI + ;; (.visitInsn Opcodes/AALOAD) ;; VIO + ;; (.visitInsn Opcodes/SWAP) ;; VOI + ;; (.visitInsn Opcodes/DUP_X2) ;; IVOI + ;; (.visitInsn Opcodes/POP) ;; IVO + ;; ;; Head: End + ;; ;; Tuple: Begin + ;; (.visitLdcInsn (int 2)) ;; IVOS + ;; (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") ;; IVO2 + ;; (.visitInsn Opcodes/DUP_X1) ;; IV2O2 + ;; (.visitInsn Opcodes/SWAP) ;; IV22O + ;; (.visitLdcInsn (int 0)) ;; IV22OI + ;; (.visitInsn Opcodes/SWAP) ;; IV22IO + ;; (.visitInsn Opcodes/AASTORE) ;; IV2 + ;; (.visitInsn Opcodes/DUP_X1) ;; I2V2 + ;; (.visitInsn Opcodes/SWAP) ;; I22V + ;; (.visitLdcInsn (int 1)) ;; I22VI + ;; (.visitInsn Opcodes/SWAP) ;; I22IV + ;; (.visitInsn Opcodes/AASTORE) ;; I2 + ;; ;; Tuple: End + ;; ;; Cons: Begin + ;; (.visitLdcInsn (->> #'&/$Cons meta ::&/idx int)) ;; I2I + ;; (.visitLdcInsn "") ;; I2I? + ;; (.visitInsn Opcodes/DUP2_X1) ;; II?2I? + ;; (.visitInsn Opcodes/POP2) ;; II?2 + ;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") ;; IV + ;; ;; Cons: End + ;; (.visitInsn Opcodes/SWAP) ;; VI + ;; (.visitJumpInsn Opcodes/GOTO $loop) + ;; ;; Loop: End + ;; (.visitLabel $end) ;; VI + ;; (.visitInsn Opcodes/POP) ;; V + ;; (.visitVarInsn Opcodes/ASTORE (int 0)) ;; + ;; ) + ;; ] + ;; _ (compile ?body) + ;; :let [_ (doto main-writer + ;; (.visitTypeInsn Opcodes/CHECKCAST &&/function-class) + ;; (.visitInsn Opcodes/ACONST_NULL) + ;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1)))] + ;; :let [_ (doto main-writer + ;; (.visitInsn Opcodes/POP) + ;; (.visitInsn Opcodes/RETURN) + ;; (.visitMaxs 0 0) + ;; (.visitEnd))]] + ;; (return nil)))) + ) diff --git a/luxc/src/lux/compiler/js/rt.clj b/luxc/src/lux/compiler/js/rt.clj new file mode 100644 index 000000000..c54c9debf --- /dev/null +++ b/luxc/src/lux/compiler/js/rt.clj @@ -0,0 +1,994 @@ +(ns lux.compiler.js.rt + (:require (clojure [string :as string] + [set :as set] + [template :refer [do-template]]) + clojure.core.match + clojure.core.match.array + (lux [base :as & :refer [|do return* return |let |case]] + [type :as &type] + [lexer :as &lexer] + [parser :as &parser] + [analyser :as &analyser] + [optimizer :as &o] + [host :as &host]) + [lux.analyser.base :as &a] + [lux.compiler.js.base :as &&])) + +;; (defn ^:private low-4b [^MethodVisitor =method] +;; (doto =method +;; ;; Assume there is a long at the top of the stack... +;; ;; Add mask corresponding to -1 (FFFF...), on the low 32 bits. +;; (.visitLdcInsn (int -1)) +;; (.visitInsn Opcodes/I2L) +;; ;; Then do a bitwise and. +;; (.visitInsn Opcodes/LAND) +;; )) + +;; (defn ^:private high-4b [^MethodVisitor =method] +;; (doto =method +;; ;; Assume there is a long at the top of the stack... +;; (.visitLdcInsn (int 32)) +;; (.visitInsn Opcodes/LUSHR) +;; )) + +;; (defn ^:private swap2 [^MethodVisitor =method] +;; (doto =method +;; ;; X2, Y2 +;; (.visitInsn Opcodes/DUP2_X2) ;; Y2, X2, Y2 +;; (.visitInsn Opcodes/POP2) ;; Y2, X2 +;; )) + +;; (defn ^:private swap2x1 [^MethodVisitor =method] +;; (doto =method +;; ;; X1, Y2 +;; (.visitInsn Opcodes/DUP2_X1) ;; Y2, X1, Y2 +;; (.visitInsn Opcodes/POP2) ;; Y2, X1 +;; )) + +;; (defn ^:private bit-set-64? [^MethodVisitor =method] +;; (doto =method +;; ;; L, I +;; (.visitLdcInsn (long 1)) ;; L, I, L +;; (.visitInsn Opcodes/DUP2_X1) ;; L, L, I, L +;; (.visitInsn Opcodes/POP2) ;; L, L, I +;; (.visitInsn Opcodes/LSHL) ;; L, L +;; (.visitInsn Opcodes/LAND) ;; L +;; (.visitLdcInsn (long 0)) ;; L, L +;; (.visitInsn Opcodes/LCMP) ;; I +;; )) + +;; (defn ^:private compile-LuxRT-deg-methods [^ClassWriter =class] +;; (|let [deg-bits 64 +;; _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "mul_deg" "(JJ)J" nil nil) +;; ;; Based on: http://stackoverflow.com/a/31629280/6823464 +;; (.visitCode) +;; ;; Bottom part +;; (.visitVarInsn Opcodes/LLOAD 0) low-4b +;; (.visitVarInsn Opcodes/LLOAD 2) low-4b +;; (.visitInsn Opcodes/LMUL) +;; (.visitLdcInsn (int 32)) +;; (.visitInsn Opcodes/LUSHR) +;; ;; Middle part +;; (.visitVarInsn Opcodes/LLOAD 0) high-4b +;; (.visitVarInsn Opcodes/LLOAD 2) low-4b +;; (.visitInsn Opcodes/LMUL) +;; (.visitVarInsn Opcodes/LLOAD 0) low-4b +;; (.visitVarInsn Opcodes/LLOAD 2) high-4b +;; (.visitInsn Opcodes/LMUL) +;; (.visitInsn Opcodes/LADD) +;; ;; Join middle and bottom +;; (.visitInsn Opcodes/LADD) +;; (.visitLdcInsn (int 32)) +;; (.visitInsn Opcodes/LUSHR) +;; ;; Top part +;; (.visitVarInsn Opcodes/LLOAD 0) high-4b +;; (.visitVarInsn Opcodes/LLOAD 2) high-4b +;; (.visitInsn Opcodes/LMUL) +;; ;; Join top with rest +;; (.visitInsn Opcodes/LADD) +;; ;; Return +;; (.visitInsn Opcodes/LRETURN) +;; (.visitMaxs 0 0) +;; (.visitEnd)) +;; _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "div_deg" "(JJ)J" nil nil) +;; (.visitCode) +;; ;; Based on: http://stackoverflow.com/a/8510587/6823464 +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitVarInsn Opcodes/LLOAD 2) high-4b +;; (.visitInsn Opcodes/LDIV) +;; (.visitLdcInsn (int 32)) +;; (.visitInsn Opcodes/LSHL) +;; (.visitInsn Opcodes/LRETURN) +;; (.visitMaxs 0 0) +;; (.visitEnd)) +;; _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "deg-to-real" "(J)D" nil nil) +;; (.visitCode) +;; ;; Translate high bytes +;; (.visitVarInsn Opcodes/LLOAD 0) high-4b +;; (.visitInsn Opcodes/L2D) +;; (.visitLdcInsn (double (Math/pow 2 32))) +;; (.visitInsn Opcodes/DDIV) +;; ;; Translate low bytes +;; (.visitVarInsn Opcodes/LLOAD 0) low-4b +;; (.visitInsn Opcodes/L2D) +;; (.visitLdcInsn (double (Math/pow 2 32))) +;; (.visitInsn Opcodes/DDIV) +;; (.visitLdcInsn (double (Math/pow 2 32))) +;; (.visitInsn Opcodes/DDIV) +;; ;; Combine and return +;; (.visitInsn Opcodes/DADD) +;; (.visitInsn Opcodes/DRETURN) +;; (.visitMaxs 0 0) +;; (.visitEnd)) +;; _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "real-to-deg" "(D)J" nil nil) +;; (.visitCode) +;; ;; Drop any excess +;; (.visitVarInsn Opcodes/DLOAD 0) +;; (.visitLdcInsn (double 1.0)) +;; (.visitInsn Opcodes/DREM) +;; ;; Shift upper half, but retain remaining decimals +;; (.visitLdcInsn (double (Math/pow 2 32))) +;; (.visitInsn Opcodes/DMUL) +;; ;; Make a copy, so the lower half can be extracted +;; (.visitInsn Opcodes/DUP2) +;; ;; Get that lower half +;; (.visitLdcInsn (double 1.0)) +;; (.visitInsn Opcodes/DREM) +;; (.visitLdcInsn (double (Math/pow 2 32))) +;; (.visitInsn Opcodes/DMUL) +;; ;; Turn it into a deg +;; (.visitInsn Opcodes/D2L) +;; ;; Turn the upper half into deg too +;; swap2 +;; (.visitInsn Opcodes/D2L) +;; ;; Combine both pieces +;; (.visitInsn Opcodes/LADD) +;; ;; FINISH +;; (.visitInsn Opcodes/LRETURN) +;; (.visitMaxs 0 0) +;; (.visitEnd)) +;; _ (let [$loop-start (new Label) +;; $do-a-round (new Label)] +;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "times5" "(I[B)[B" nil nil) +;; (.visitCode) +;; (.visitLdcInsn (int 0)) ;; {carry} +;; (.visitLabel $loop-start) +;; (.visitVarInsn Opcodes/ILOAD 0) +;; (.visitJumpInsn Opcodes/IFGE $do-a-round) +;; (.visitVarInsn Opcodes/ALOAD 1) +;; (.visitInsn Opcodes/ARETURN) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;; {carry} +;; (.visitLabel $do-a-round) +;; (.visitVarInsn Opcodes/ALOAD 1) +;; (.visitVarInsn Opcodes/ILOAD 0) +;; (.visitInsn Opcodes/BALOAD) ;; {carry, current-digit} +;; (.visitLdcInsn (int 5)) +;; (.visitInsn Opcodes/IMUL) +;; (.visitInsn Opcodes/IADD) ;; {next-raw-digit} +;; (.visitInsn Opcodes/DUP) +;; (.visitLdcInsn (int 10)) +;; (.visitInsn Opcodes/IREM) ;; {next-raw-digit, next-digit} +;; (.visitVarInsn Opcodes/ALOAD 1) +;; (.visitVarInsn Opcodes/ILOAD 0) +;; swap2x1 +;; (.visitInsn Opcodes/BASTORE) ;; {next-raw-digit} +;; (.visitLdcInsn (int 10)) +;; (.visitInsn Opcodes/IDIV) ;; {next-carry} +;; ;; Decrement index +;; (.visitVarInsn Opcodes/ILOAD 0) +;; (.visitLdcInsn (int 1)) +;; (.visitInsn Opcodes/ISUB) +;; (.visitVarInsn Opcodes/ISTORE 0) +;; ;; Iterate +;; (.visitJumpInsn Opcodes/GOTO $loop-start) +;; (.visitMaxs 0 0) +;; (.visitEnd))) +;; _ (let [$loop-start (new Label) +;; $do-a-round (new Label)] +;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "deg_digit_power" "(I)[B" nil nil) +;; (.visitCode) +;; ;; Initialize digits array. +;; (.visitLdcInsn (int deg-bits)) +;; (.visitIntInsn Opcodes/NEWARRAY Opcodes/T_BYTE) ;; {digits} +;; (.visitInsn Opcodes/DUP) +;; (.visitVarInsn Opcodes/ILOAD 0) +;; (.visitLdcInsn (int 1)) +;; (.visitInsn Opcodes/BASTORE) ;; digits = 5^0 +;; (.visitVarInsn Opcodes/ASTORE 1) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitVarInsn Opcodes/ILOAD 0) ;; {times} +;; (.visitLabel $loop-start) +;; (.visitInsn Opcodes/DUP) +;; (.visitJumpInsn Opcodes/IFGE $do-a-round) +;; (.visitVarInsn Opcodes/ALOAD 1) +;; (.visitInsn Opcodes/ARETURN) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $do-a-round) +;; ;; {times} +;; (.visitVarInsn Opcodes/ILOAD 0) +;; (.visitVarInsn Opcodes/ALOAD 1) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "times5" "(I[B)[B") ;; {digits*5, times} +;; (.visitVarInsn Opcodes/ASTORE 1) ;; {times} +;; ;; Decrement index +;; (.visitLdcInsn (int 1)) +;; (.visitInsn Opcodes/ISUB) +;; ;; {times-1} +;; (.visitJumpInsn Opcodes/GOTO $loop-start) +;; (.visitMaxs 0 0) +;; (.visitEnd))) +;; _ (let [$loop-start (new Label) +;; $do-a-round (new Label)] +;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "add_deg_digit_powers" "([B[B)[B" nil nil) +;; (.visitCode) +;; (.visitLdcInsn (int (dec deg-bits))) +;; (.visitVarInsn Opcodes/ISTORE 2) ;; Index +;; (.visitLdcInsn (int deg-bits)) +;; (.visitIntInsn Opcodes/NEWARRAY Opcodes/T_BYTE) +;; (.visitVarInsn Opcodes/ASTORE 3) ;; added_digits +;; (.visitLdcInsn (int 0)) ;; {carry} +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;; {carry} +;; (.visitLabel $loop-start) +;; (.visitVarInsn Opcodes/ILOAD 2) +;; (.visitJumpInsn Opcodes/IFGE $do-a-round) +;; ;; {carry} +;; (.visitVarInsn Opcodes/ALOAD 3) +;; (.visitInsn Opcodes/ARETURN) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;; {carry} +;; (.visitLabel $do-a-round) +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitVarInsn Opcodes/ILOAD 2) +;; (.visitInsn Opcodes/BALOAD) ;; {carry, dL} +;; (.visitVarInsn Opcodes/ALOAD 1) +;; (.visitVarInsn Opcodes/ILOAD 2) +;; (.visitInsn Opcodes/BALOAD) ;; {carry, dL, dR} +;; (.visitInsn Opcodes/IADD) +;; (.visitInsn Opcodes/IADD) ;; {raw-next-digit} +;; (.visitInsn Opcodes/DUP) +;; (.visitLdcInsn (int 10)) +;; (.visitInsn Opcodes/IREM) ;; {raw-next-digit, next-digit} +;; (.visitVarInsn Opcodes/ALOAD 3) +;; (.visitVarInsn Opcodes/ILOAD 2) +;; swap2x1 +;; (.visitInsn Opcodes/BASTORE) ;; {raw-next-digit} +;; (.visitLdcInsn (int 10)) +;; (.visitInsn Opcodes/IDIV) ;; {next-carry} +;; ;; Decrement index +;; (.visitVarInsn Opcodes/ILOAD 2) +;; (.visitLdcInsn (int 1)) +;; (.visitInsn Opcodes/ISUB) +;; (.visitVarInsn Opcodes/ISTORE 2) +;; ;; Iterate +;; (.visitJumpInsn Opcodes/GOTO $loop-start) +;; (.visitMaxs 0 0) +;; (.visitEnd))) +;; _ (let [$loop-start (new Label) +;; $do-a-round (new Label)] +;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "deg_digits_to_text" "([B)Ljava/lang/String;" nil nil) +;; (.visitCode) +;; (.visitLdcInsn (int (dec deg-bits))) +;; (.visitVarInsn Opcodes/ISTORE 1) ;; Index +;; (.visitLdcInsn "") ;; {text} +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $loop-start) +;; (.visitVarInsn Opcodes/ILOAD 1) +;; (.visitJumpInsn Opcodes/IFGE $do-a-round) +;; (.visitInsn Opcodes/ARETURN) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $do-a-round) +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitVarInsn Opcodes/ILOAD 1) +;; (.visitInsn Opcodes/BALOAD) ;; {text, digit} +;; (.visitLdcInsn (int 10)) ;; {text, digit, radix} +;; (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Character" "forDigit" "(II)C") ;; {text, digit-char} +;; (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Character" "toString" "(C)Ljava/lang/String;") ;; {text, digit-char-text} +;; (.visitInsn Opcodes/SWAP) +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;") +;; ;; Decrement index +;; (.visitVarInsn Opcodes/ILOAD 1) +;; (.visitLdcInsn (int 1)) +;; (.visitInsn Opcodes/ISUB) +;; (.visitVarInsn Opcodes/ISTORE 1) +;; ;; Iterate +;; (.visitJumpInsn Opcodes/GOTO $loop-start) +;; (.visitMaxs 0 0) +;; (.visitEnd))) +;; _ (let [$loop-start (new Label) +;; $do-a-round (new Label) +;; $not-set (new Label) +;; $next-iteration (new Label) +;; $normal-path (new Label)] +;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "encode_deg" "(J)Ljava/lang/String;" nil nil) +;; (.visitCode) +;; ;; A quick corner-case to handle. +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitLdcInsn (long 0)) +;; (.visitInsn Opcodes/LCMP) +;; (.visitJumpInsn Opcodes/IFNE $normal-path) +;; (.visitLdcInsn ".0") +;; (.visitInsn Opcodes/ARETURN) +;; (.visitLabel $normal-path) +;; ;; Normal case +;; (.visitLdcInsn (int (dec deg-bits))) +;; (.visitVarInsn Opcodes/ISTORE 2) ;; Index +;; (.visitLdcInsn (int deg-bits)) +;; (.visitIntInsn Opcodes/NEWARRAY Opcodes/T_BYTE) +;; (.visitVarInsn Opcodes/ASTORE 3) ;; digits +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $loop-start) +;; (.visitVarInsn Opcodes/ILOAD 2) +;; (.visitJumpInsn Opcodes/IFGE $do-a-round) +;; ;; Prepare text to return. +;; (.visitVarInsn Opcodes/ALOAD 3) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "deg_digits_to_text" "([B)Ljava/lang/String;") +;; (.visitLdcInsn ".") +;; (.visitInsn Opcodes/SWAP) +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;") +;; ;; Trim unnecessary 0s at the end... +;; (.visitLdcInsn "0*$") +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "split" "(Ljava/lang/String;)[Ljava/lang/String;") +;; (.visitLdcInsn (int 0)) +;; (.visitInsn Opcodes/AALOAD) +;; (.visitInsn Opcodes/ARETURN) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $do-a-round) +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitVarInsn Opcodes/ILOAD 2) +;; bit-set-64? +;; (.visitJumpInsn Opcodes/IFEQ $next-iteration) +;; (.visitLdcInsn (int (dec deg-bits))) +;; (.visitVarInsn Opcodes/ILOAD 2) +;; (.visitInsn Opcodes/ISUB) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "deg_digit_power" "(I)[B") +;; (.visitVarInsn Opcodes/ALOAD 3) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "add_deg_digit_powers" "([B[B)[B") +;; (.visitVarInsn Opcodes/ASTORE 3) +;; (.visitJumpInsn Opcodes/GOTO $next-iteration) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $next-iteration) +;; ;; Decrement index +;; (.visitVarInsn Opcodes/ILOAD 2) +;; (.visitLdcInsn (int 1)) +;; (.visitInsn Opcodes/ISUB) +;; (.visitVarInsn Opcodes/ISTORE 2) +;; ;; Iterate +;; (.visitJumpInsn Opcodes/GOTO $loop-start) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitMaxs 0 0) +;; (.visitEnd))) +;; _ (let [$loop-start (new Label) +;; $do-a-round (new Label) +;; $not-set (new Label) +;; $next-iteration (new Label)] +;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "deg_text_to_digits" "(Ljava/lang/String;)[B" nil nil) +;; (.visitCode) +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "length" "()I") +;; (.visitLdcInsn (int 1)) +;; (.visitInsn Opcodes/ISUB) +;; (.visitVarInsn Opcodes/ISTORE 1) ;; Index +;; (.visitLdcInsn (int deg-bits)) +;; (.visitIntInsn Opcodes/NEWARRAY Opcodes/T_BYTE) +;; (.visitVarInsn Opcodes/ASTORE 2) ;; digits +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $loop-start) +;; (.visitVarInsn Opcodes/ILOAD 1) +;; (.visitJumpInsn Opcodes/IFGE $do-a-round) +;; (.visitVarInsn Opcodes/ALOAD 2) +;; (.visitInsn Opcodes/ARETURN) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $do-a-round) +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitVarInsn Opcodes/ILOAD 1) +;; (.visitVarInsn Opcodes/ILOAD 1) +;; (.visitLdcInsn (int 1)) +;; (.visitInsn Opcodes/IADD) +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;") +;; (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Byte" "parseByte" "(Ljava/lang/String;)B") +;; ;; Set digit +;; (.visitVarInsn Opcodes/ALOAD 2) +;; (.visitVarInsn Opcodes/ILOAD 1) +;; swap2x1 +;; (.visitInsn Opcodes/BASTORE) +;; ;; Decrement index +;; (.visitVarInsn Opcodes/ILOAD 1) +;; (.visitLdcInsn (int 1)) +;; (.visitInsn Opcodes/ISUB) +;; (.visitVarInsn Opcodes/ISTORE 1) +;; ;; Iterate +;; (.visitJumpInsn Opcodes/GOTO $loop-start) +;; (.visitMaxs 0 0) +;; (.visitEnd))) +;; _ (let [$loop-start (new Label) +;; $do-a-round (new Label) +;; $is-less-than (new Label) +;; $is-equal (new Label)] +;; ;; [B0 <= [B1 +;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "deg_digits_lt" "([B[B)Z" nil nil) +;; (.visitCode) +;; (.visitLdcInsn (int 0)) +;; (.visitVarInsn Opcodes/ISTORE 2) ;; Index +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $loop-start) +;; (.visitVarInsn Opcodes/ILOAD 2) +;; (.visitLdcInsn (int deg-bits)) +;; (.visitJumpInsn Opcodes/IF_ICMPLT $do-a-round) +;; (.visitLdcInsn false) +;; (.visitInsn Opcodes/IRETURN) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $do-a-round) +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitVarInsn Opcodes/ILOAD 2) +;; (.visitInsn Opcodes/BALOAD) ;; {D0} +;; (.visitVarInsn Opcodes/ALOAD 1) +;; (.visitVarInsn Opcodes/ILOAD 2) +;; (.visitInsn Opcodes/BALOAD) ;; {D0, D1} +;; (.visitInsn Opcodes/DUP2) +;; (.visitJumpInsn Opcodes/IF_ICMPLT $is-less-than) +;; (.visitJumpInsn Opcodes/IF_ICMPEQ $is-equal) +;; ;; Is greater than... +;; (.visitLdcInsn false) +;; (.visitInsn Opcodes/IRETURN) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $is-less-than) +;; (.visitInsn Opcodes/POP2) +;; (.visitLdcInsn true) +;; (.visitInsn Opcodes/IRETURN) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $is-equal) +;; ;; Increment index +;; (.visitVarInsn Opcodes/ILOAD 2) +;; (.visitLdcInsn (int 1)) +;; (.visitInsn Opcodes/IADD) +;; (.visitVarInsn Opcodes/ISTORE 2) +;; ;; Iterate +;; (.visitJumpInsn Opcodes/GOTO $loop-start) +;; (.visitMaxs 0 0) +;; (.visitEnd))) +;; _ (let [$loop-start (new Label) +;; $do-a-round (new Label) +;; $simple-sub (new Label)] +;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "deg_digits_sub_once" "([BBI)[B" nil nil) +;; (.visitCode) +;; (.visitLabel $loop-start) +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitVarInsn Opcodes/ILOAD 2) ;; {target-digit} +;; (.visitInsn Opcodes/BALOAD) +;; (.visitVarInsn Opcodes/ILOAD 1) ;; {target-digit, param-digit} +;; (.visitInsn Opcodes/DUP2) +;; (.visitJumpInsn Opcodes/IF_ICMPGE $simple-sub) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;; Since $0 < $1 +;; (.visitInsn Opcodes/SWAP) +;; (.visitInsn Opcodes/ISUB) ;; $1 - $0 +;; (.visitLdcInsn (byte 10)) +;; (.visitInsn Opcodes/SWAP) +;; (.visitInsn Opcodes/ISUB) ;; 10 - ($1 - $0) +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitVarInsn Opcodes/ILOAD 2) +;; swap2x1 +;; (.visitInsn Opcodes/BASTORE) +;; ;; Prepare to iterate... +;; ;; Decrement index +;; (.visitVarInsn Opcodes/ILOAD 2) +;; (.visitLdcInsn (int 1)) +;; (.visitInsn Opcodes/ISUB) +;; (.visitVarInsn Opcodes/ISTORE 2) +;; ;; Subtract 1 from next digit +;; (.visitLdcInsn (int 1)) +;; (.visitVarInsn Opcodes/ISTORE 1) +;; ;; Iterate +;; (.visitJumpInsn Opcodes/GOTO $loop-start) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $simple-sub) +;; (.visitInsn Opcodes/ISUB) +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitVarInsn Opcodes/ILOAD 2) +;; swap2x1 +;; (.visitInsn Opcodes/BASTORE) +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitInsn Opcodes/ARETURN) +;; (.visitMaxs 0 0) +;; (.visitEnd))) +;; _ (let [$loop-start (new Label) +;; $do-a-round (new Label)] +;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "deg_digits_sub" "([B[B)[B" nil nil) +;; (.visitCode) +;; (.visitLdcInsn (int (dec deg-bits))) +;; (.visitVarInsn Opcodes/ISTORE 2) ;; Index +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $loop-start) +;; (.visitVarInsn Opcodes/ILOAD 2) +;; (.visitJumpInsn Opcodes/IFGE $do-a-round) +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitInsn Opcodes/ARETURN) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $do-a-round) +;; (.visitVarInsn Opcodes/ALOAD 0) ;; {target-digits} +;; (.visitVarInsn Opcodes/ALOAD 1) +;; (.visitVarInsn Opcodes/ILOAD 2) +;; (.visitInsn Opcodes/BALOAD) ;; {target-digits, param-digit} +;; (.visitVarInsn Opcodes/ILOAD 2) ;; {target-digits, param-digit, idx} +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "deg_digits_sub_once" "([BBI)[B") +;; (.visitVarInsn Opcodes/ASTORE 0) ;; Update target digits +;; ;; Decrement index +;; (.visitVarInsn Opcodes/ILOAD 2) +;; (.visitLdcInsn (int 1)) +;; (.visitInsn Opcodes/ISUB) +;; (.visitVarInsn Opcodes/ISTORE 2) +;; ;; Iterate +;; (.visitJumpInsn Opcodes/GOTO $loop-start) +;; (.visitMaxs 0 0) +;; (.visitEnd))) +;; _ (let [$from (new Label) +;; $to (new Label) +;; $handler (new Label) +;; $loop-start (new Label) +;; $do-a-round (new Label) +;; $skip-power (new Label) +;; $iterate (new Label) +;; $bad-format (new Label)] +;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "decode_deg" "(Ljava/lang/String;)Ljava/lang/Object;" nil nil) +;; (.visitCode) +;; ;; Check prefix +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitLdcInsn ".") +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "startsWith" "(Ljava/lang/String;)Z") +;; (.visitJumpInsn Opcodes/IFEQ $bad-format) +;; ;; Check if size is valid +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "length" "()I") +;; (.visitLdcInsn (int (inc deg-bits))) ;; It's increased, to account for the prefix . +;; (.visitJumpInsn Opcodes/IF_ICMPGT $bad-format) +;; ;; Initialization +;; (.visitTryCatchBlock $from $to $handler "java/lang/Exception") +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitLdcInsn (int 1)) +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(I)Ljava/lang/String;") +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "clean_separators" "(Ljava/lang/String;)Ljava/lang/String;") +;; (.visitLabel $from) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "deg_text_to_digits" "(Ljava/lang/String;)[B") +;; (.visitLabel $to) +;; (.visitVarInsn Opcodes/ASTORE 0) ;; From test to digits... +;; (.visitLdcInsn (int 0)) +;; (.visitVarInsn Opcodes/ISTORE 1) ;; Index +;; (.visitLdcInsn (long 0)) +;; (.visitVarInsn Opcodes/LSTORE 2) ;; Output +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $loop-start) +;; (.visitVarInsn Opcodes/ILOAD 1) +;; (.visitLdcInsn (int deg-bits)) +;; (.visitJumpInsn Opcodes/IF_ICMPLT $do-a-round) +;; (.visitVarInsn Opcodes/LLOAD 2) +;; &&/wrap-long +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)Ljava/lang/Object;") +;; (.visitInsn Opcodes/ARETURN) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $do-a-round) +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitVarInsn Opcodes/ILOAD 1) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "deg_digit_power" "(I)[B") +;; (.visitInsn Opcodes/DUP2) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "deg_digits_lt" "([B[B)Z") +;; (.visitJumpInsn Opcodes/IFNE $skip-power) +;; ;; Subtract power +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "deg_digits_sub" "([B[B)[B") +;; (.visitVarInsn Opcodes/ASTORE 0) +;; ;; Set bit on output +;; (.visitVarInsn Opcodes/LLOAD 2) +;; (.visitLdcInsn (long 1)) +;; (.visitVarInsn Opcodes/ILOAD 1) +;; (.visitLdcInsn (int (dec deg-bits))) +;; (.visitInsn Opcodes/SWAP) +;; (.visitInsn Opcodes/ISUB) +;; (.visitInsn Opcodes/LSHL) +;; (.visitInsn Opcodes/LOR) +;; (.visitVarInsn Opcodes/LSTORE 2) +;; (.visitJumpInsn Opcodes/GOTO $iterate) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $skip-power) +;; (.visitInsn Opcodes/POP2) +;; ;; (.visitJumpInsn Opcodes/GOTO $iterate) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $iterate) +;; (.visitVarInsn Opcodes/ILOAD 1) +;; (.visitLdcInsn (int 1)) +;; (.visitInsn Opcodes/IADD) +;; (.visitVarInsn Opcodes/ISTORE 1) +;; ;; Iterate +;; (.visitJumpInsn Opcodes/GOTO $loop-start) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $handler) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;") +;; (.visitInsn Opcodes/ARETURN) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitLabel $bad-format) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;") +;; (.visitInsn Opcodes/ARETURN) +;; (.visitMaxs 0 0) +;; (.visitEnd)))] +;; nil)) + +;; (let [+wrapper-class+ (&host-generics/->bytecode-class-name "java.lang.Long")] +;; (defn ^:private compile-LuxRT-nat-methods [^ClassWriter =class] +;; (|let [;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#677 +;; _ (let [$from (new Label) +;; $to (new Label) +;; $handler (new Label) + +;; $good-start (new Label) +;; $short-enough (new Label) +;; $bad-digit (new Label) +;; $out-of-bounds (new Label)] +;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "decode_nat" "(Ljava/lang/String;)Ljava/lang/Object;" nil nil) +;; (.visitCode) +;; (.visitTryCatchBlock $from $to $handler "java/lang/Exception") +;; (.visitLabel $from) +;; ;; Remove the + at the beginning... +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitLdcInsn (int 0)) +;; (.visitLdcInsn (int 1)) +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;") +;; (.visitLdcInsn "+") +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Object" "equals" "(Ljava/lang/Object;)Z") +;; (.visitJumpInsn Opcodes/IFNE $good-start) +;; ;; Doesn't start with + +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;") +;; (.visitInsn Opcodes/ARETURN) +;; ;; Starts with + +;; (.visitLabel $good-start) +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitLdcInsn (int 1)) +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "length" "()I") +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;") +;; (.visitVarInsn Opcodes/ASTORE 0) ;; Removed the + prefix... +;; ;; Begin parsing processs +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "length" "()I") +;; (.visitLdcInsn (int 18)) +;; (.visitJumpInsn Opcodes/IF_ICMPLE $short-enough) +;; ;; Too long +;; ;; Get prefix... +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitLdcInsn (int 0)) +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "length" "()I") +;; (.visitLdcInsn (int 1)) +;; (.visitInsn Opcodes/ISUB) +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;") +;; (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "parseLong" "(Ljava/lang/String;)J") +;; (.visitInsn Opcodes/DUP2) ;; Clone prefix, for later... +;; ;; Get last digit... +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "length" "()I") +;; (.visitLdcInsn (int 1)) +;; (.visitInsn Opcodes/ISUB) +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "charAt" "(I)C") +;; (.visitLdcInsn (int 10)) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Character" "digit" "(CI)I") +;; ;; Test last digit... +;; (.visitInsn Opcodes/DUP) +;; (.visitJumpInsn Opcodes/IFLT $bad-digit) +;; ;; Good digit... +;; ;; Stack: prefix::L, prefix::L, last-digit::I +;; (.visitInsn Opcodes/I2L) +;; ;; Build the result... +;; swap2 +;; (.visitLdcInsn (long 10)) +;; (.visitInsn Opcodes/LMUL) +;; (.visitInsn Opcodes/LADD) ;; Stack: prefix::L, result::L +;; (.visitInsn Opcodes/DUP2_X2) ;; Stack: result::L, prefix::L, result::L +;; swap2 ;; Stack: result::L, result::L, prefix::L +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_compareUnsigned" "(JJ)I") +;; (.visitJumpInsn Opcodes/IFLT $out-of-bounds) +;; ;; Within bounds +;; ;; Stack: result::L +;; &&/wrap-long +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)Ljava/lang/Object;") +;; (.visitInsn Opcodes/ARETURN) +;; ;; Out of bounds +;; (.visitLabel $out-of-bounds) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;") +;; (.visitInsn Opcodes/ARETURN) +;; ;; Bad digit... +;; (.visitLabel $bad-digit) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;") +;; (.visitInsn Opcodes/ARETURN) +;; ;; 18 chars or less +;; (.visitLabel $short-enough) +;; (.visitVarInsn Opcodes/ALOAD 0) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "parseLong" "(Ljava/lang/String;)J") +;; &&/wrap-long +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)Ljava/lang/Object;") +;; (.visitInsn Opcodes/ARETURN) +;; (.visitLabel $to) +;; (.visitLabel $handler) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;") +;; (.visitInsn Opcodes/ARETURN) +;; (.visitMaxs 0 0) +;; (.visitEnd))) +;; ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#172 +;; _ (let [$too-big (new Label)] +;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "encode_nat" "(J)Ljava/lang/String;" nil nil) +;; (.visitCode) +;; (.visitLdcInsn "+") +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitLdcInsn (long 0)) +;; (.visitInsn Opcodes/LCMP) +;; (.visitJumpInsn Opcodes/IFLT $too-big) +;; ;; then +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "toString" "(J)Ljava/lang/String;") +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;") +;; (.visitInsn Opcodes/ARETURN) +;; ;; else +;; (.visitLabel $too-big) +;; ;; Set up parts of the number string... +;; ;; First digits +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitLdcInsn (int 1)) +;; (.visitInsn Opcodes/LUSHR) +;; (.visitLdcInsn (long 5)) +;; (.visitInsn Opcodes/LDIV) ;; quot +;; ;; Last digit +;; (.visitInsn Opcodes/DUP2) +;; (.visitLdcInsn (long 10)) +;; (.visitInsn Opcodes/LMUL) +;; (.visitVarInsn Opcodes/LLOAD 0) +;; swap2 +;; (.visitInsn Opcodes/LSUB) ;; quot, rem +;; ;; Conversion to string... +;; (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "toString" "(J)Ljava/lang/String;") ;; quot, rem* +;; (.visitInsn Opcodes/DUP_X2);; rem*, quot, rem* +;; (.visitInsn Opcodes/POP) ;; rem*, quot +;; (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "toString" "(J)Ljava/lang/String;") ;; rem*, quot* +;; (.visitInsn Opcodes/SWAP) ;; quot*, rem* +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;") +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;") +;; (.visitInsn Opcodes/ARETURN) +;; (.visitMaxs 0 0) +;; (.visitEnd))) +;; ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#215 +;; _ (let [$simple-case (new Label)] +;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;" nil nil) +;; (.visitCode) +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitLdcInsn (long 0)) +;; (.visitInsn Opcodes/LCMP) +;; (.visitJumpInsn Opcodes/IFGE $simple-case) +;; ;; else +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitLdcInsn (int 32)) +;; (.visitInsn Opcodes/LUSHR) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "java/math/BigInteger" "valueOf" "(J)Ljava/math/BigInteger;") +;; (.visitLdcInsn (int 32)) +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "shiftLeft" "(I)Ljava/math/BigInteger;") +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitLdcInsn (int 32)) +;; (.visitInsn Opcodes/LSHL) +;; (.visitLdcInsn (int 32)) +;; (.visitInsn Opcodes/LUSHR) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "java/math/BigInteger" "valueOf" "(J)Ljava/math/BigInteger;") +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "add" "(Ljava/math/BigInteger;)Ljava/math/BigInteger;") +;; (.visitInsn Opcodes/ARETURN) +;; ;; then +;; (.visitLabel $simple-case) +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "java/math/BigInteger" "valueOf" "(J)Ljava/math/BigInteger;") +;; (.visitInsn Opcodes/ARETURN) +;; (.visitMaxs 0 0) +;; (.visitEnd))) +;; ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java?av=f#1267 +;; _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "_compareUnsigned" "(JJ)I" nil nil) +;; (.visitCode) +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitFieldInsn Opcodes/GETSTATIC "java/lang/Long" "MIN_VALUE" "J") +;; (.visitInsn Opcodes/LADD) +;; (.visitVarInsn Opcodes/LLOAD 2) +;; (.visitFieldInsn Opcodes/GETSTATIC "java/lang/Long" "MIN_VALUE" "J") +;; (.visitInsn Opcodes/LADD) +;; (.visitInsn Opcodes/LCMP) +;; (.visitInsn Opcodes/IRETURN) +;; (.visitMaxs 0 0) +;; (.visitEnd)) +;; ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#1290 +;; _ (let [$case-1 (new Label) +;; $0 (new Label) +;; $case-2 (new Label)] +;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "div_nat" "(JJ)J" nil nil) +;; (.visitCode) +;; ;; Test #1 +;; (.visitVarInsn Opcodes/LLOAD 2) +;; (.visitLdcInsn (long 0)) +;; (.visitInsn Opcodes/LCMP) +;; (.visitJumpInsn Opcodes/IFLT $case-1) +;; ;; Test #2 +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitLdcInsn (long 0)) +;; (.visitInsn Opcodes/LCMP) +;; (.visitJumpInsn Opcodes/IFGT $case-2) +;; ;; Case #3 +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;") +;; (.visitVarInsn Opcodes/LLOAD 2) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;") +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "divide" "(Ljava/math/BigInteger;)Ljava/math/BigInteger;") +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "longValue" "()J") +;; (.visitInsn Opcodes/LRETURN) +;; ;; Case #2 +;; (.visitLabel $case-2) +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitVarInsn Opcodes/LLOAD 2) +;; (.visitInsn Opcodes/LDIV) +;; (.visitInsn Opcodes/LRETURN) +;; ;; Case #1 +;; (.visitLabel $case-1) +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitVarInsn Opcodes/LLOAD 2) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_compareUnsigned" "(JJ)I") +;; (.visitJumpInsn Opcodes/IFLT $0) +;; ;; 1 +;; (.visitLdcInsn (long 1)) +;; (.visitInsn Opcodes/LRETURN) +;; ;; 0 +;; (.visitLabel $0) +;; (.visitLdcInsn (long 0)) +;; (.visitInsn Opcodes/LRETURN) +;; (.visitMaxs 0 0) +;; (.visitEnd))) +;; ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#1323 +;; _ (let [$test-2 (new Label) +;; $case-2 (new Label)] +;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "rem_nat" "(JJ)J" nil nil) +;; (.visitCode) +;; ;; Test #1 +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitLdcInsn (long 0)) +;; (.visitInsn Opcodes/LCMP) +;; (.visitJumpInsn Opcodes/IFLE $test-2) +;; (.visitVarInsn Opcodes/LLOAD 2) +;; (.visitLdcInsn (long 0)) +;; (.visitInsn Opcodes/LCMP) +;; (.visitJumpInsn Opcodes/IFLE $test-2) +;; ;; Case #1 +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitVarInsn Opcodes/LLOAD 2) +;; (.visitInsn Opcodes/LREM) +;; (.visitInsn Opcodes/LRETURN) +;; ;; Test #2 +;; (.visitLabel $test-2) +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitVarInsn Opcodes/LLOAD 2) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_compareUnsigned" "(JJ)I") +;; (.visitJumpInsn Opcodes/IFLT $case-2) +;; ;; Case #3 +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;") +;; (.visitVarInsn Opcodes/LLOAD 2) +;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;") +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "remainder" "(Ljava/math/BigInteger;)Ljava/math/BigInteger;") +;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "longValue" "()J") +;; (.visitInsn Opcodes/LRETURN) +;; ;; Case #2 +;; (.visitLabel $case-2) +;; (.visitVarInsn Opcodes/LLOAD 0) +;; (.visitInsn Opcodes/LRETURN) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; (.visitMaxs 0 0) +;; (.visitEnd)))] +;; nil))) + +(def ^:private adt-methods + {:product_getLeft (str "(function product_getLeft(product,index) {" + "var index_min_length = (index+1);" + "if(product.length > index_min_length) {" + ;; No need for recursion + "return product[index];" + "}" + "else {" + ;; Needs recursion + "return product_getLeft(product[product.length - 1], (index_min_length - product.length));" + "}" + "})") + :product_getRight (str "(function product_getRight(product,index) {" + "var index_min_length = (index+1);" + "if(product.length === index_min_length) {" + ;; Last element. + "return product[index];" + "}" + "else if(product.length < index_min_length) {" + ;; Needs recursion + "return product_getRight(product[product.length - 1], (index_min_length - product.length));" + "}" + "else {" + ;; Must slice + "return product.slice(index);" + "}" + "})") + :sum_get (str "(function sum_get(sum,wantedTag,wantsLast) {" + "if(sum[0] === wantedTag && sum[1] === wantsLast) {" + ;; Exact match. + "return sum[2];" + "}" + "else if(sum[0] < wantedTag || sum[1] !== wantsLast) {" + "if(sum[1]) {" + ;; Must recurse. + "return sum_get(sum[2], (wantedTag - sum[0]), wantsLast);" + "}" + ;; Not match. + "else { return null; }" + "}" + ;; Not match. + "else { return null; }" + "})")}) + +(def LuxRT "LuxRT") + +(def compile-LuxRT + (|do [_ (return nil) + :let [rt-object (str "{" (->> adt-methods + (map (fn [[key val]] + (str (name key) ":" val))) + (interpose ",") + (reduce str "")) + "}")]] + (&&/save-js! LuxRT + (str "var " LuxRT " = " rt-object ";")))) |