diff options
author | Eduardo Julian | 2017-02-16 20:09:52 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-02-16 20:09:52 -0400 |
commit | b0114f4871a6a2654fa2edc667a635a97ae76b19 (patch) | |
tree | 9e501a76cfb77a1b523384660e0020a2a15ffe44 /luxc/src/lux/compiler | |
parent | 47ddcadd07234f32d6d4f1411548ccf9665e60c3 (diff) |
- Implemented several new procedures.
- Improved Lux-to-JS interactions.
- Parallel compilation works for the JS backend.
- Added more primitive functionality to the JS runtime.
- More common procedures.
Diffstat (limited to '')
-rw-r--r-- | luxc/src/lux/compiler/js.clj | 3 | ||||
-rw-r--r-- | luxc/src/lux/compiler/js/base.clj | 54 | ||||
-rw-r--r-- | luxc/src/lux/compiler/js/lux.clj | 22 | ||||
-rw-r--r-- | luxc/src/lux/compiler/js/proc/common.clj | 192 | ||||
-rw-r--r-- | luxc/src/lux/compiler/js/rt.clj | 108 | ||||
-rw-r--r-- | luxc/src/lux/compiler/jvm/proc/common.clj | 144 | ||||
-rw-r--r-- | luxc/src/lux/compiler/jvm/rt.clj | 30 |
7 files changed, 447 insertions, 106 deletions
diff --git a/luxc/src/lux/compiler/js.clj b/luxc/src/lux/compiler/js.clj index a60afbc23..2e7d01d44 100644 --- a/luxc/src/lux/compiler/js.clj +++ b/luxc/src/lux/compiler/js.clj @@ -130,8 +130,7 @@ (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)]] + compile-module!! (&¶llel/parallel-compilation (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)] diff --git a/luxc/src/lux/compiler/js/base.clj b/luxc/src/lux/compiler/js/base.clj index 62d440d6d..044a4f099 100644 --- a/luxc/src/lux/compiler/js/base.clj +++ b/luxc/src/lux/compiler/js/base.clj @@ -54,15 +54,31 @@ (&/adt->text obj) ))) +(defn ^:private _toString_simple [^String obj] + (reify JSObject + (isFunction [self] true) + (call [self this args] + obj + ))) + (def ^:private i64-mask (dec (bit-shift-left 1 32))) -(defn ^:private to-i64 [value] +(deftype I64 [value] + JSObject + (getMember [self member] + (condp = member + "H" (-> value (unsigned-bit-shift-right 32) (bit-and i64-mask) int) + "L" (-> value (bit-and i64-mask) int) + ;; else + (assert false (str "I64#getMember = " member))))) + +(defn ^:private encode-char [value] (reify JSObject (getMember [self member] (condp = member - "H" (-> value (unsigned-bit-shift-right 32) (bit-and i64-mask) int) - "L" (-> value (bit-and i64-mask) int) + "C" value + ;; "toString" (_toString_simple value) ;; else - (assert false (str "to-i64#getMember = " member)))))) + (assert false (str "encode-char#getMember = " member)))))) (deftype LuxJsObject [obj] JSObject @@ -73,7 +89,10 @@ (new LuxJsObject value) (instance? java.lang.Long value) - (to-i64 value) + (new I64 value) + + (instance? java.lang.Character value) + (encode-char (str value)) :else value))) @@ -81,15 +100,7 @@ (condp = member "toString" (_toString_ obj) "length" (alength obj) - "slice" (let [wrap-lux-obj #(cond (instance? lux-obj-class %) - (new LuxJsObject %) - - (instance? java.lang.Long %) - (to-i64 %) - - :else - %)] - (_slice_ wrap-lux-obj obj)) + "slice" (_slice_ #(new LuxJsObject %) obj) ;; else (assert false (str "wrap-lux-obj#getMember = " member))))) @@ -102,6 +113,13 @@ (and (.hasMember js-object "H") (.hasMember js-object "L"))) +(defn ^:private encoded-char? [^ScriptObjectMirror js-object] + (.hasMember js-object "C")) + +(defn ^:private decode-char [^ScriptObjectMirror js-object] + (-> (.getMember js-object "C") + (.charAt 0))) + (defn ^:private parse-int64 [^ScriptObjectMirror js-object] (+ (-> (.getMember js-object "H") long @@ -122,6 +140,9 @@ (instance? LuxJsObject js-object) (.-obj ^LuxJsObject js-object) + (instance? I64 js-object) + (.-value ^I64 js-object) + ;; (instance? Undefined js-object) ;; (assert false "UNDEFINED") @@ -149,6 +170,9 @@ (int64? js-object) (parse-int64 js-object) + (encoded-char? js-object) + (decode-char js-object) + :else (assert false (str "Unknown kind of JS object: " js-object)))) @@ -169,5 +193,5 @@ (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)))))]] + (&&/write-file (str module-dir java.io.File/separator (&host/def-name name) ".js") (.getBytes script)))))]] (return nil))) diff --git a/luxc/src/lux/compiler/js/lux.clj b/luxc/src/lux/compiler/js/lux.clj index 61f21bf55..f0ad777c6 100644 --- a/luxc/src/lux/compiler/js/lux.clj +++ b/luxc/src/lux/compiler/js/lux.clj @@ -19,8 +19,11 @@ )) ;; [Utils] +(defn ^:private js-module [module] + (string/replace module "/" "$")) + (defn ^:private js-var-name [module name] - (str (string/replace module "/" "$") "$" (&host/def-name name))) + (str (js-module module) "$" (&host/def-name name))) (defn ^:private captured-name [register] (str "$" register)) @@ -49,7 +52,7 @@ (return (str value))) (defn compile-char [value] - (return (str "\"" value "\""))) + (return (str "{C:\"" value "\"}"))) (defn compile-text [?value] (return (pr-str ?value))) @@ -279,7 +282,7 @@ (defn compile-function [compile arity ?scope ?env ?body] (|do [:let [??scope (&/|reverse ?scope) - function-name (str (&host/->module-class (&/|head ??scope)) + function-name (str (js-module (&/|head ??scope)) "$" (&host/location (&/|tail ??scope))) func-args (->> (&/|range* 0 (dec arity)) (&/|map (fn [register] (str "var " (register-name (inc register)) " = arguments[" register "];"))) @@ -323,12 +326,11 @@ (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)]] + class-loader &/loader] (|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) + (|do [def-value (&&/run-js! (js-var-name r-module r-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))] @@ -339,7 +341,8 @@ (&/fail-with-loc "[Compilation Error] Invalid syntax for lux;alias meta-data. Must be an Ident.") _ - (|do [=body (compile ?body) + (|do [:let [var-name (js-var-name module-name ?name)] + =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)) @@ -348,8 +351,9 @@ _ false) def-type (&a/expr-type* ?body) - _ (&/|log! (string/replace def-js " - _ (&&/run-js! def-js) + ;; _ (&/|log! (string/replace def-js " + ] + _ (&&/save-js! ?name def-js) def-value (&&/run-js!+ var-name) _ (&/without-repl-closure (&a-module/define module-name ?name def-type def-meta def-value)) diff --git a/luxc/src/lux/compiler/js/proc/common.clj b/luxc/src/lux/compiler/js/proc/common.clj index 385761dbe..23454914e 100644 --- a/luxc/src/lux/compiler/js/proc/common.clj +++ b/luxc/src/lux/compiler/js/proc/common.clj @@ -10,7 +10,8 @@ [optimizer :as &o]) [lux.analyser.base :as &a] (lux.compiler.js [base :as &&] - [rt :as &&rt]))) + [rt :as &&rt] + [lux :as &&lux]))) ;; [Resources] ;; (do-template [<name> <op>] @@ -62,22 +63,11 @@ ;; ^:private compile-bit-unsigned-shift-right Opcodes/LUSHR ;; ) -;; (defn ^:private compile-lux-== [compile ?values special-args] -;; (|do [:let [(&/$Cons ?left (&/$Cons ?right (&/$Nil))) ?values] -;; ^MethodVisitor *writer* &/get-writer -;; _ (compile ?left) -;; _ (compile ?right) -;; :let [$then (new Label) -;; $end (new Label) -;; _ (doto *writer* -;; (.visitJumpInsn Opcodes/IF_ACMPEQ $then) -;; ;; else -;; (.visitFieldInsn Opcodes/GETSTATIC "java/lang/Boolean" "FALSE" "Ljava/lang/Boolean;") -;; (.visitJumpInsn Opcodes/GOTO $end) -;; (.visitLabel $then) -;; (.visitFieldInsn Opcodes/GETSTATIC "java/lang/Boolean" "TRUE" "Ljava/lang/Boolean;") -;; (.visitLabel $end))]] -;; (return nil))) +(defn ^:private compile-lux-is [compile ?values special-args] + (|do [:let [(&/$Cons ?left (&/$Cons ?right (&/$Nil))) ?values] + =left (compile ?left) + =right (compile ?right)] + (return (str "(" =left " === " =right ")")))) (do-template [<name> <method>] (defn <name> [compile ?values special-args] @@ -132,11 +122,42 @@ (defn <name> [compile ?values special-args] (|do [:let [(&/$Cons ?x (&/$Nil)) ?values] =x (compile ?x)] - (return (str &&rt/LuxRT "." <method> "(" =x ")")))) + (return (str &&rt/LuxRT "." <method> "(" =x ")")) + )) ^:private compile-int-encode "encodeI64" ^:private compile-nat-encode "encodeN64" ^:private compile-deg-encode "encodeD64" + + ^:private compile-int-decode "decodeI64" + ^:private compile-nat-decode "decodeN64" + ^:private compile-deg-decode "decodeD64" + + ^:private compile-real-decode "decodeReal" + + ^:private compile-real-hash "hashReal" + ) + +(do-template [<name> <compiler> <value>] + (defn <name> [compile ?values special-args] + (|do [:let [(&/$Nil) ?values]] + (<compiler> <value>))) + + ^:private compile-nat-min-value &&lux/compile-nat 0 + ^:private compile-nat-max-value &&lux/compile-nat -1 + + ^:private compile-int-min-value &&lux/compile-int Long/MIN_VALUE + ^:private compile-int-max-value &&lux/compile-int Long/MAX_VALUE + + ^:private compile-deg-min-value &&lux/compile-deg 0 + ^:private compile-deg-max-value &&lux/compile-deg -1 + + ^:private compile-real-min-value &&lux/compile-real (* -1.0 Double/MAX_VALUE) + ^:private compile-real-max-value &&lux/compile-real Double/MAX_VALUE + + ^:private compile-real-not-a-number &&lux/compile-real "NaN" + ^:private compile-real-positive-infinity &&lux/compile-real "Infinity" + ^:private compile-real-negative-infinity &&lux/compile-real "-Infinity" ) (defn ^:private compile-real-encode [compile ?values special-args] @@ -166,22 +187,6 @@ ;; (.visitLabel $end))]] ;; (return nil))) -;; (do-template [<name> <instr> <wrapper>] -;; (defn <name> [compile ?values special-args] -;; (|do [:let [(&/$Nil) ?values] -;; ^MethodVisitor *writer* &/get-writer -;; :let [_ (doto *writer* -;; <instr> -;; <wrapper>)]] -;; (return nil))) - -;; ^:private compile-nat-min-value (.visitLdcInsn 0) &&/wrap-long -;; ^:private compile-nat-max-value (.visitLdcInsn -1) &&/wrap-long - -;; ^:private compile-deg-min-value (.visitLdcInsn 0) &&/wrap-long -;; ^:private compile-deg-max-value (.visitLdcInsn -1) &&/wrap-long -;; ) - ;; (do-template [<name> <method>] ;; (defn <name> [compile ?values special-args] ;; (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values] @@ -248,6 +253,26 @@ ^:private compile-int-to-nat ) +(defn ^:private compile-int-to-real [compile ?values special-args] + (|do [:let [(&/$Cons ?x (&/$Nil)) ?values] + =x (compile ?x)] + (return (str "LuxRT.toNumberI64(" =x ")")))) + +(defn ^:private compile-real-to-int [compile ?values special-args] + (|do [:let [(&/$Cons ?x (&/$Nil)) ?values] + =x (compile ?x)] + (return (str "LuxRT.fromNumberI64(" =x ")")))) + +(defn ^:private compile-deg-to-real [compile ?values special-args] + (|do [:let [(&/$Cons ?x (&/$Nil)) ?values] + =x (compile ?x)] + (return (str "LuxRT.degToReal(" =x ")")))) + +(defn ^:private compile-real-to-deg [compile ?values special-args] + (|do [:let [(&/$Cons ?x (&/$Nil)) ?values] + =x (compile ?x)] + (return (str "LuxRT.realToDeg(" =x ")")))) + (defn ^:private compile-text-eq [compile ?values special-args] (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values] =x (compile ?x) @@ -260,29 +285,78 @@ =y (compile ?y)] (return (str =x ".concat(" =y ")")))) +(do-template [<name> <method>] + (defn <name> [compile ?values special-args] + (|do [:let [(&/$Cons ?text (&/$Cons ?part (&/$Nil))) ?values] + =text (compile ?text) + =part (compile ?part)] + (return (str "LuxRT" "." <method> "(" =text "," =part ")")))) + + ^:private compile-text-last-index "lastIndex" + ^:private compile-text-index "index" + ) + +(defn ^:private compile-text-clip [compile ?values special-args] + (|do [:let [(&/$Cons ?text (&/$Cons ?from (&/$Cons ?to (&/$Nil)))) ?values] + =text (compile ?text) + =from (compile ?from) + =to (compile ?to)] + (return (str "LuxRT.clip(" (str =text "," =from "," =to) ")")))) + +(defn ^:private compile-text-replace-all [compile ?values special-args] + (|do [:let [(&/$Cons ?text (&/$Cons ?to-find (&/$Cons ?replace-with (&/$Nil)))) ?values] + =text (compile ?text) + =to-find (compile ?to-find) + =replace-with (compile ?replace-with)] + (return (str "LuxRT.replaceAll(" (str =text "," =to-find "," =replace-with) ")")))) + +(defn ^:private compile-text-trim [compile ?values special-args] + (|do [:let [(&/$Cons ?text (&/$Nil)) ?values] + =text (compile ?text)] + (return (str "(" =text ").trim()")))) + +(defn ^:private compile-text-size [compile ?values special-args] + (|do [:let [(&/$Cons ?text (&/$Nil)) ?values] + =text (compile ?text)] + (return (str "LuxRT.fromNumberI64(" =text ".length" ")")))) + (defn ^:private compile-char-to-text [compile ?values special-args] - (|do [:let [(&/$Cons ?x (&/$Nil)) ?values]] - (compile ?x))) + (|do [:let [(&/$Cons ?x (&/$Nil)) ?values] + =x (compile ?x)] + (return (str "(" =x ").C")))) -(defn ^:private compile-lux-log! [compile ?values special-args] +(defn ^:private compile-lux-log [compile ?values special-args] (|do [:let [(&/$Cons ?message (&/$Nil)) ?values] =message (compile ?message)] (return (str "LuxRT.log(" =message ")")))) +(defn ^:private compile-lux-error [compile ?values special-args] + (|do [:let [(&/$Cons ?message (&/$Nil)) ?values] + =message (compile ?message)] + (return (str "LuxRT.error(" =message ")")))) + (defn compile-proc [compile proc-category proc-name ?values special-args] (case proc-category - ;; "lux" - ;; (case proc-name - ;; "==" (compile-lux-== compile ?values special-args)) + "lux" + (case proc-name + "is" (compile-lux-is compile ?values special-args)) "io" (case proc-name - "log!" (compile-lux-log! compile ?values special-args)) + "log" (compile-lux-log compile ?values special-args) + "error" (compile-lux-error compile ?values special-args)) "text" (case proc-name "=" (compile-text-eq compile ?values special-args) - "append" (compile-text-append compile ?values special-args)) + "append" (compile-text-append compile ?values special-args) + "clip" (compile-text-clip compile ?values special-args) + "index" (compile-text-index compile ?values special-args) + "last-index" (compile-text-last-index compile ?values special-args) + "size" (compile-text-size compile ?values special-args) + "replace-all" (compile-text-replace-all compile ?values special-args) + "trim" (compile-text-trim compile ?values special-args) + ) ;; "bit" ;; (case proc-name @@ -308,9 +382,9 @@ "=" (compile-nat-eq compile ?values special-args) "<" (compile-nat-lt compile ?values special-args) "encode" (compile-nat-encode compile ?values special-args) - ;; "decode" (compile-nat-decode compile ?values special-args) - ;; "max-value" (compile-nat-max-value compile ?values special-args) - ;; "min-value" (compile-nat-min-value compile ?values special-args) + "decode" (compile-nat-decode compile ?values special-args) + "max-value" (compile-nat-max-value compile ?values special-args) + "min-value" (compile-nat-min-value compile ?values special-args) "to-int" (compile-nat-to-int compile ?values special-args) ;; "to-char" (compile-nat-to-char compile ?values special-args) ) @@ -325,10 +399,11 @@ "=" (compile-int-eq compile ?values special-args) "<" (compile-int-lt compile ?values special-args) "encode" (compile-int-encode compile ?values special-args) - ;; "decode" (compile-int-decode compile ?values special-args) - ;; "max-value" (compile-int-max-value compile ?values special-args) - ;; "min-value" (compile-int-min-value compile ?values special-args) + "decode" (compile-int-decode compile ?values special-args) + "max-value" (compile-int-max-value compile ?values special-args) + "min-value" (compile-int-min-value compile ?values special-args) "to-nat" (compile-int-to-nat compile ?values special-args) + "to-real" (compile-int-to-real compile ?values special-args) ) "deg" @@ -341,10 +416,10 @@ "=" (compile-deg-eq compile ?values special-args) "<" (compile-deg-lt compile ?values special-args) "encode" (compile-deg-encode compile ?values special-args) - ;; "decode" (compile-deg-decode compile ?values special-args) - ;; "max-value" (compile-deg-max-value compile ?values special-args) - ;; "min-value" (compile-deg-min-value compile ?values special-args) - ;; "to-real" (compile-deg-to-real compile ?values special-args) + "decode" (compile-deg-decode compile ?values special-args) + "max-value" (compile-deg-max-value compile ?values special-args) + "min-value" (compile-deg-min-value compile ?values special-args) + "to-real" (compile-deg-to-real compile ?values special-args) "scale" (compile-deg-scale compile ?values special-args) ) @@ -358,10 +433,15 @@ "=" (compile-real-eq compile ?values special-args) "<" (compile-real-lt compile ?values special-args) "encode" (compile-real-encode compile ?values special-args) - ;; "decode" (compile-real-decode compile ?values special-args) - ;; "max-value" (compile-real-max-value compile ?values special-args) - ;; "min-value" (compile-real-min-value compile ?values special-args) - ;; "to-deg" (compile-real-to-deg compile ?values special-args) + "decode" (compile-real-decode compile ?values special-args) + "max-value" (compile-real-max-value compile ?values special-args) + "min-value" (compile-real-min-value compile ?values special-args) + "not-a-number" (compile-real-not-a-number compile ?values special-args) + "positive-infinity" (compile-real-positive-infinity compile ?values special-args) + "negative-infinity" (compile-real-negative-infinity compile ?values special-args) + "to-deg" (compile-real-to-deg compile ?values special-args) + "to-int" (compile-real-to-int compile ?values special-args) + "hash" (compile-real-hash compile ?values special-args) ) "char" diff --git a/luxc/src/lux/compiler/js/rt.clj b/luxc/src/lux/compiler/js/rt.clj index ce5bf5d16..1cb4a6150 100644 --- a/luxc/src/lux/compiler/js/rt.clj +++ b/luxc/src/lux/compiler/js/rt.clj @@ -941,16 +941,50 @@ }) (def ^:private i64-methods - {"makeI64" (str "(function makeI64(high,low) {" + {"TWO_PWR_16" "(1 << 16)" + "TWO_PWR_32" "((1 << 16) * (1 << 16))" + "TWO_PWR_64" "(((1 << 16) * (1 << 16)) * ((1 << 16) * (1 << 16)))" + "TWO_PWR_63" "((((1 << 16) * (1 << 16)) * ((1 << 16) * (1 << 16))) / 2)" + "getLowBitsUnsigned" (str "(function getLowBitsUnsigned(i64) {" + "return (i64.L >= 0) ? i64.L : (LuxRT.TWO_PWR_32 + i64.L);" + "})") + "toNumberI64" (str "(function toNumberI64(i64) {" + "return (i64.H * LuxRT.TWO_PWR_32) + LuxRT.getLowBitsUnsigned(i64);" + "})") + "fromNumberI64" (str "(function fromNumberI64(num) {" + (str "if (isNaN(num)) {" + "return LuxRT.ZERO;" + "}") + (str "else if (num <= -LuxRT.TWO_PWR_63) {" + "return LuxRT.MIN_VALUE_I64;" + "}") + (str "else if ((num + 1) >= LuxRT.TWO_PWR_63) {" + "return LuxRT.MAX_VALUE_I64;" + "}") + (str "else if (num < 0) {" + "return LuxRT.negateI64(LuxRT.fromNumberI64(-num));" + "}") + (str "else {" + "return LuxRT.makeI64((num / LuxRT.TWO_PWR_32), (num % LuxRT.TWO_PWR_32));" + "}") + "})") + "makeI64" (str "(function makeI64(high,low) {" "return { H: (high|0), L: (low|0)};" "})") - "MIN_VALUE" "{ H: 0x80000000, L: 0}" - "ONE" "{ H: 0, L: 1}" + "MIN_VALUE_I64" "{ H: (0x80000000|0), L: (0|0)}" + "MAX_VALUE_I64" "{ H: (0x7FFFFFFF|0), L: (0xFFFFFFFF|0)}" + "ONE" "{ H: (0|0), L: (1|0)}" + "ZERO" "{ H: (0|0), L: (0|0)}" "notI64" (str "(function notI64(i64) {" "return LuxRT.makeI64(~i64.H,~i64.L);" "})") "negateI64" (str "(function negateI64(i64) {" - "return LuxRT.addI64(LuxRT.notI64(i64),LuxRT.makeI64(0,1));" + (str "if(LuxRT.eqI64(LuxRT.MIN_VALUE_I64,i64)) {" + "return LuxRT.MIN_VALUE_I64;" + "}") + (str "else {" + "return LuxRT.addI64(LuxRT.notI64(i64),LuxRT.ONE);" + "}") "})") "eqI64" (str "(function eqI64(l,r) {" "return (l.H === r.H) && (l.L === r.L);" @@ -1045,14 +1079,14 @@ ;; Special case: L = 0 "return l;" "}") - (str "if(LuxRT.eqI64(l,LuxRT.MIN_VALUE)) {" + (str "if(LuxRT.eqI64(l,LuxRT.MIN_VALUE_I64)) {" ;; Special case: L = MIN (str "if(LuxRT.eqI64(r,LuxRT.ONE) || LuxRT.eqI64(r,LuxRT.negateI64(LuxRT.ONE))) {" ;; Special case: L = MIN, R = 1|-1 - "return LuxRT.MIN_VALUE;" + "return LuxRT.MIN_VALUE_I64;" "}" ;; Special case: L = R = MIN - "else if(LuxRT.eqI64(r,LuxRT.MIN_VALUE)) {" + "else if(LuxRT.eqI64(r,LuxRT.MIN_VALUE_I64)) {" "return LuxRT.ONE;" "}" ;; Special case: L = MIN @@ -1073,7 +1107,7 @@ "}") "}") "}" - "else if(LuxRT.eqI64(r,LuxRT.MIN_VALUE)) {" + "else if(LuxRT.eqI64(r,LuxRT.MIN_VALUE_I64)) {" ;; Special case: R = MIN "return LuxRT.makeI64(0,0);" "}") @@ -1093,7 +1127,7 @@ "return LuxRT.negateI64(LuxRT.divI64(l,LuxRT.negateI64(r)));" "}") ;; Common case - (str "var res = { H: 0, L: 0};" + (str "var res = LuxRT.ZERO;" "var rem = l;" (str "while(LuxRT.ltI64(r,rem) || LuxRT.eqI64(r,rem)) {" "var approx = Math.max(1, Math.floor(LuxRT.toNumberI64(rem) / LuxRT.toNumberI64(r)));" @@ -1124,16 +1158,16 @@ "}") ;; If input < 0 (str "if(input.H < 0) {" - (str "if(LuxRT.eqI64(input,LuxRT.MIN_VALUE)) {" + (str "if(LuxRT.eqI64(input,LuxRT.MIN_VALUE_I64)) {" "var radix = LuxRT.makeI64(0,10);" "var div = LuxRT.divI64(input,radix);" "var rem = LuxRT.subI64(LuxRT.mulI64(div,radix),input);" "return LuxRT.encodeI64(div).concat(rem.L+'');" "}") "}" - "else {" - "return '-'.concat(LuxRT.encodeI64(LuxRT.negateI64(input)));" - "}") + (str "else {" + "return '-'.concat(LuxRT.encodeI64(LuxRT.negateI64(input)));" + "}")) ;; If input > 0 (str "var chunker = LuxRT.makeI64(0,1000000);" "var rem = input;" @@ -1176,6 +1210,11 @@ "return '+'.concat(LuxRT.encodeI64(input));" "}") "})") + "ltN64" (str "(function ltN64(l,r) {" + "var li = LuxRT.addI64(l,LuxRT.MIN_VALUE_I64);" + "var ri = LuxRT.addI64(r,LuxRT.MIN_VALUE_I64);" + "return LuxRT.ltI64(li,ri);" + "})") }) (def ^:private io-methods @@ -1183,6 +1222,48 @@ "console.log(message);" (str "return " &&/unit ";") "})") + "error" (str "(function error(message) {" + "throw new Error(message);" + (str "return null;") + "})") + }) + +(def ^:private const-none (str "[0,null," &&/unit "]")) +(defn ^:private make-some [value] + (str "[1,''," value "]")) + +(def ^:private text-methods + {"index" (str "(function index(text,part) {" + "var idx = text.indexOf(part);" + (str (str "if(idx === -1) {" + "return " const-none ";" + "}") + (str "else {" + (str "return " (make-some "LuxRT.fromNumberI64(idx)") ";") + "}")) + "})") + "lastIndex" (str "(function lastIndex(text,part) {" + "var idx = text.lastIndexOf(part);" + (str (str "if(idx === -1) {" + "return " const-none ";" + "}") + (str "else {" + (str "return " (make-some "LuxRT.fromNumberI64(idx)") ";") + "}")) + "})") + "clip" (str "(function clip(text,from,to) {" + "var clip = text.substring(from.L,to.L);" + (str (str "if(clip === '') {" + "return " const-none ";" + "}") + (str "else {" + "return " (make-some "clip") ";" + "}")) + "})") + "replaceAll" (str "(function replaceAll(text,toFind,replaceWith) {" + "var reEscaped = toFind.replace(/[.*+?^${}()|[\\]\\\\]/g, '\\\\$&');" + "return text.replace(new RegExp(reEscaped, 'g'), replaceWith);" + "})") }) (def LuxRT "LuxRT") @@ -1192,6 +1273,7 @@ :let [rt-object (str "{" (->> (merge adt-methods i64-methods n64-methods + text-methods io-methods) (map (fn [[key val]] (str key ":" val))) diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index 4ed8134fd..c48403e52 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -162,7 +162,7 @@ ^:private compile-bit-unsigned-shift-right Opcodes/LUSHR ) -(defn ^:private compile-lux-== [compile ?values special-args] +(defn ^:private compile-lux-is [compile ?values special-args] (|do [:let [(&/$Cons ?left (&/$Cons ?right (&/$Nil))) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?left) @@ -209,11 +209,11 @@ ^:private compile-deg-rem Opcodes/LSUB &&/unwrap-long &&/wrap-long ^:private compile-deg-scale Opcodes/LMUL &&/unwrap-long &&/wrap-long - ^:private compile-real-add Opcodes/DADD &&/unwrap-double &&/wrap-double - ^:private compile-real-sub Opcodes/DSUB &&/unwrap-double &&/wrap-double - ^:private compile-real-mul Opcodes/DMUL &&/unwrap-double &&/wrap-double - ^:private compile-real-div Opcodes/DDIV &&/unwrap-double &&/wrap-double - ^:private compile-real-rem Opcodes/DREM &&/unwrap-double &&/wrap-double + ^:private compile-real-add Opcodes/DADD &&/unwrap-double &&/wrap-double + ^:private compile-real-sub Opcodes/DSUB &&/unwrap-double &&/wrap-double + ^:private compile-real-mul Opcodes/DMUL &&/unwrap-double &&/wrap-double + ^:private compile-real-div Opcodes/DDIV &&/unwrap-double &&/wrap-double + ^:private compile-real-rem Opcodes/DREM &&/unwrap-double &&/wrap-double ) (do-template [<name> <comp-method>] @@ -450,6 +450,21 @@ ^:private compile-int-to-nat ) +(do-template [<name> <unwrap> <op> <wrap>] + (defn <name> [compile ?values special-args] + (|do [:let [(&/$Cons ?input (&/$Nil)) ?values] + ^MethodVisitor *writer* &/get-writer + _ (compile ?input) + :let [_ (doto *writer* + <unwrap> + (.visitInsn <op>) + <wrap>)]] + (return nil))) + + ^:private compile-real-to-int &&/unwrap-double Opcodes/D2L &&/wrap-long + ^:private compile-int-to-real &&/unwrap-long Opcodes/L2D &&/wrap-double + ) + (defn compile-text-eq [compile ?values special-args] (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values] ^MethodVisitor *writer* &/get-writer @@ -473,7 +488,93 @@ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;"))]] (return nil))) -(defn compile-io-log! [compile ?values special-args] +(defn compile-text-clip [compile ?values special-args] + (|do [:let [(&/$Cons ?text (&/$Cons ?from (&/$Cons ?to (&/$Nil)))) ?values] + ^MethodVisitor *writer* &/get-writer + _ (compile ?text) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String"))] + _ (compile ?from) + :let [_ (doto *writer* + &&/unwrap-long + (.visitInsn Opcodes/L2I))] + _ (compile ?to) + :let [_ (doto *writer* + &&/unwrap-long + (.visitInsn Opcodes/L2I))] + :let [_ (doto *writer* + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "text_clip" "(Ljava/lang/String;II)[Ljava/lang/Object;"))]] + (return nil))) + +(do-template [<name> <method>] + (defn <name> [compile ?values special-args] + (|do [:let [(&/$Cons ?text (&/$Cons ?part (&/$Nil))) ?values] + ^MethodVisitor *writer* &/get-writer + _ (compile ?text) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String"))] + _ (compile ?part) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String"))] + :let [_ (doto *writer* + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" <method> "(Ljava/lang/String;)I"))] + :let [$not-found (new Label) + $end (new Label) + _ (doto *writer* + (.visitInsn Opcodes/DUP) + (.visitLdcInsn (int -1)) + (.visitJumpInsn Opcodes/IF_ICMPEQ $not-found) + (.visitInsn Opcodes/I2L) + &&/wrap-long + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)Ljava/lang/Object;") + (.visitJumpInsn Opcodes/GOTO $end) + (.visitLabel $not-found) + (.visitInsn Opcodes/POP) + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;") + (.visitLabel $end))]] + (return nil))) + + ^:private compile-text-index "indexOf" + ^:private compile-text-last-index "lastIndexOf" + ) + +(defn ^:private compile-text-size [compile ?values special-args] + (|do [:let [(&/$Cons ?text (&/$Nil)) ?values] + ^MethodVisitor *writer* &/get-writer + _ (compile ?text) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String") + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "length" "()I") + (.visitInsn Opcodes/I2L) + &&/wrap-long)]] + (return nil))) + +(defn ^:private compile-text-replace-all [compile ?values special-args] + (|do [:let [(&/$Cons ?text (&/$Cons ?pattern (&/$Cons ?replacement (&/$Nil)))) ?values] + ^MethodVisitor *writer* &/get-writer + _ (compile ?text) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String"))] + _ (compile ?pattern) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String"))] + _ (compile ?replacement) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String"))] + :let [_ (doto *writer* + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "replace" "(Ljava/lang/CharSequence;Ljava/lang/CharSequence;)Ljava/lang/String;"))]] + (return nil))) + +(defn ^:private compile-text-trim [compile ?values special-args] + (|do [:let [(&/$Cons ?text (&/$Nil)) ?values] + ^MethodVisitor *writer* &/get-writer + _ (compile ?text) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String") + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "trim" "()Ljava/lang/String;"))]] + (return nil))) + +(defn compile-io-log [compile ?values special-args] (|do [:let [(&/$Cons ?x (&/$Nil)) ?values] ^MethodVisitor *writer* &/get-writer :let [_ (doto *writer* @@ -485,20 +586,41 @@ (.visitLdcInsn &/unit-tag))]] (return nil))) +(defn compile-io-error [compile ?values special-args] + (|do [:let [(&/$Cons ?message (&/$Nil)) ?values] + ^MethodVisitor *writer* &/get-writer + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/NEW "java/lang/Error") + (.visitInsn Opcodes/DUP))] + _ (compile ?message) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String") + (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Error" "<init>" "(Ljava/lang/String;)V") + (.visitInsn Opcodes/ATHROW))]] + (return nil))) + (defn compile-proc [compile proc-category proc-name ?values special-args] (case proc-category "lux" (case proc-name - "==" (compile-lux-== compile ?values special-args)) + "is" (compile-lux-is compile ?values special-args)) "io" (case proc-name - "log!" (compile-io-log! compile ?values special-args)) + "log" (compile-io-log compile ?values special-args) + "error" (compile-io-error compile ?values special-args)) "text" (case proc-name "=" (compile-text-eq compile ?values special-args) - "append" (compile-text-append compile ?values special-args)) + "append" (compile-text-append compile ?values special-args) + "clip" (compile-text-clip compile ?values special-args) + "index" (compile-text-index compile ?values special-args) + "last-index" (compile-text-last-index compile ?values special-args) + "size" (compile-text-size compile ?values special-args) + "replace-all" (compile-text-replace-all compile ?values special-args) + "trim" (compile-text-trim compile ?values special-args) + ) "bit" (case proc-name @@ -562,6 +684,7 @@ "=" (compile-int-eq compile ?values special-args) "<" (compile-int-lt compile ?values special-args) "to-nat" (compile-int-to-nat compile ?values special-args) + "to-real" (compile-int-to-real compile ?values special-args) "encode" (compile-int-encode compile ?values special-args) ) @@ -575,6 +698,7 @@ "=" (compile-real-eq compile ?values special-args) "<" (compile-real-lt compile ?values special-args) "encode" (compile-real-encode compile ?values special-args) + "to-int" (compile-real-to-int compile ?values special-args) "to-deg" (compile-real-to-deg compile ?values special-args) ) diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj index 1beb9aa21..303d9ae0a 100644 --- a/luxc/src/lux/compiler/jvm/rt.clj +++ b/luxc/src/lux/compiler/jvm/rt.clj @@ -1204,6 +1204,33 @@ (.visitEnd))] nil)) +(defn ^:private compile-LuxRT-text-methods [^ClassWriter =class] + (|do [:let [_ (let [$from (new Label) + $to (new Label) + $handler (new Label) + $end (new Label)] + (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "text_clip" "(Ljava/lang/String;II)[Ljava/lang/Object;" nil nil) + (.visitCode) + (.visitTryCatchBlock $from $to $handler "java/lang/IndexOutOfBoundsException") + (.visitLabel $from) + (.visitVarInsn Opcodes/ALOAD 0) + (.visitVarInsn Opcodes/ILOAD 1) + (.visitVarInsn Opcodes/ILOAD 2) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;") + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)Ljava/lang/Object;") + (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") + (.visitJumpInsn Opcodes/GOTO $end) + (.visitLabel $to) + (.visitLabel $handler) + (.visitInsn Opcodes/POP) + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;") + (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") + (.visitLabel $end) + (.visitInsn Opcodes/ARETURN) + (.visitMaxs 0 0) + (.visitEnd)))]] + (return nil))) + (def compile-LuxRT-class (|do [_ (return nil) :let [full-name &&/lux-utils-class @@ -1264,6 +1291,7 @@ (compile-LuxRT-pm-methods) (compile-LuxRT-adt-methods) (compile-LuxRT-nat-methods) - (compile-LuxRT-deg-methods))]] + (compile-LuxRT-deg-methods) + (compile-LuxRT-text-methods))]] (&&/save-class! (second (string/split &&/lux-utils-class #"/")) (.toByteArray (doto =class .visitEnd))))) |