aboutsummaryrefslogtreecommitdiff
path: root/luxc
diff options
context:
space:
mode:
Diffstat (limited to 'luxc')
-rw-r--r--luxc/src/lux/analyser/proc/common.clj125
-rw-r--r--luxc/src/lux/compiler/js.clj3
-rw-r--r--luxc/src/lux/compiler/js/base.clj54
-rw-r--r--luxc/src/lux/compiler/js/lux.clj22
-rw-r--r--luxc/src/lux/compiler/js/proc/common.clj192
-rw-r--r--luxc/src/lux/compiler/js/rt.clj108
-rw-r--r--luxc/src/lux/compiler/jvm/proc/common.clj144
-rw-r--r--luxc/src/lux/compiler/jvm/rt.clj30
8 files changed, 551 insertions, 127 deletions
diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj
index 3bbc47e88..4a4048c1c 100644
--- a/luxc/src/lux/analyser/proc/common.clj
+++ b/luxc/src/lux/analyser/proc/common.clj
@@ -6,7 +6,7 @@
[type :as &type])
(lux.analyser [base :as &&])))
-(defn ^:private analyse-lux-== [analyse exo-type ?values]
+(defn ^:private analyse-lux-is [analyse exo-type ?values]
(&type/with-var
(fn [$var]
(|do [:let [(&/$Cons left (&/$Cons right (&/$Nil))) ?values]
@@ -15,7 +15,7 @@
_ (&type/check exo-type &type/Bool)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&&/$proc (&/T ["lux" "=="]) (&/|list =left =right) (&/|list)))))))))
+ (&&/$proc (&/T ["lux" "is"]) (&/|list =left =right) (&/|list)))))))))
(do-template [<name> <proc> <input-type> <output-type>]
(defn <name> [analyse exo-type ?values]
@@ -31,6 +31,66 @@
^:private analyse-text-append ["text" "append"] &type/Text &type/Text
)
+(do-template [<name> <proc-name>]
+ (defn <name> [analyse exo-type ?values]
+ (|do [:let [(&/$Cons text (&/$Cons part (&/$Nil))) ?values]
+ =text (&&/analyse-1 analyse &type/Text text)
+ =part (&&/analyse-1 analyse &type/Text part)
+ _ (&type/check exo-type (&/$AppT &type/Maybe &type/Nat))
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta &type/Text _cursor
+ (&&/$proc (&/T ["text" <proc-name>])
+ (&/|list =text =part)
+ (&/|list)))))))
+
+ ^:private analyse-text-index "index"
+ ^:private analyse-text-last-index "last-index"
+ )
+
+(defn ^:private analyse-text-clip [analyse exo-type ?values]
+ (|do [:let [(&/$Cons text (&/$Cons from (&/$Cons to (&/$Nil)))) ?values]
+ =text (&&/analyse-1 analyse &type/Text text)
+ =from (&&/analyse-1 analyse &type/Nat from)
+ =to (&&/analyse-1 analyse &type/Nat to)
+ _ (&type/check exo-type (&/$AppT &type/Maybe &type/Text))
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$proc (&/T ["text" "clip"])
+ (&/|list =text =from =to)
+ (&/|list)))))))
+
+(defn ^:private analyse-text-replace-all [analyse exo-type ?values]
+ (|do [:let [(&/$Cons text (&/$Cons to-find (&/$Cons replace-with (&/$Nil)))) ?values]
+ =text (&&/analyse-1 analyse &type/Text text)
+ =to-find (&&/analyse-1 analyse &type/Text to-find)
+ =replace-with (&&/analyse-1 analyse &type/Text replace-with)
+ _ (&type/check exo-type &type/Text)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$proc (&/T ["text" "replace-all"])
+ (&/|list =text =to-find =replace-with)
+ (&/|list)))))))
+
+(defn ^:private analyse-text-trim [analyse exo-type ?values]
+ (|do [:let [(&/$Cons text (&/$Nil)) ?values]
+ =text (&&/analyse-1 analyse &type/Text text)
+ _ (&type/check exo-type &type/Text)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$proc (&/T ["text" "trim"])
+ (&/|list =text)
+ (&/|list)))))))
+
+(defn ^:private analyse-text-size [analyse exo-type ?values]
+ (|do [:let [(&/$Cons text (&/$Nil)) ?values]
+ =text (&&/analyse-1 analyse &type/Text text)
+ _ (&type/check exo-type &type/Nat)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta &type/Text _cursor
+ (&&/$proc (&/T ["text" "size"])
+ (&/|list =text)
+ (&/|list)))))))
+
(do-template [<name> <op>]
(defn <name> [analyse exo-type ?values]
(|do [:let [(&/$Cons input (&/$Cons mask (&/$Nil))) ?values]
@@ -153,17 +213,20 @@
(return (&/|list (&&/|meta <type> _cursor
(&&/$proc (&/T <op>) (&/|list) (&/|list)))))))
- ^:private analyse-nat-min-value &type/Nat ["nat" "min-value"]
- ^:private analyse-nat-max-value &type/Nat ["nat" "max-value"]
+ ^:private analyse-nat-min-value &type/Nat ["nat" "min-value"]
+ ^:private analyse-nat-max-value &type/Nat ["nat" "max-value"]
- ^:private analyse-int-min-value &type/Int ["int" "min-value"]
- ^:private analyse-int-max-value &type/Int ["int" "max-value"]
+ ^:private analyse-int-min-value &type/Int ["int" "min-value"]
+ ^:private analyse-int-max-value &type/Int ["int" "max-value"]
- ^:private analyse-deg-min-value &type/Deg ["deg" "min-value"]
- ^:private analyse-deg-max-value &type/Deg ["deg" "max-value"]
+ ^:private analyse-deg-min-value &type/Deg ["deg" "min-value"]
+ ^:private analyse-deg-max-value &type/Deg ["deg" "max-value"]
- ^:private analyse-real-min-value &type/Real ["real" "min-value"]
- ^:private analyse-real-max-value &type/Real ["real" "max-value"]
+ ^:private analyse-real-min-value &type/Real ["real" "min-value"]
+ ^:private analyse-real-max-value &type/Real ["real" "max-value"]
+ ^:private analyse-real-not-a-number &type/Real ["real" "not-a-number"]
+ ^:private analyse-real-positive-infinity &type/Real ["real" "positive-infinity"]
+ ^:private analyse-real-negative-infinity &type/Real ["real" "negative-infinity"]
)
(do-template [<name> <from-type> <to-type> <op>]
@@ -175,16 +238,23 @@
(return (&/|list (&&/|meta <to-type> _cursor
(&&/$proc (&/T <op>) (&/|list =x) (&/|list)))))))
- ^:private analyse-nat-to-int &type/Nat &type/Int ["nat" "to-int"]
- ^:private analyse-nat-to-char &type/Nat &type/Char ["nat" "to-char"]
- ^:private analyse-int-to-nat &type/Int &type/Nat ["int" "to-nat"]
- ^:private analyse-char-to-nat &type/Char &type/Nat ["char" "to-nat"]
- ^:private analyse-char-to-text &type/Char &type/Text ["char" "to-text"]
+ ^:private analyse-nat-to-int &type/Nat &type/Int ["nat" "to-int"]
+ ^:private analyse-int-to-nat &type/Int &type/Nat ["int" "to-nat"]
+
+ ^:private analyse-nat-to-char &type/Nat &type/Char ["nat" "to-char"]
+ ^:private analyse-char-to-nat &type/Char &type/Nat ["char" "to-nat"]
+
+ ^:private analyse-int-to-real &type/Int &type/Real ["int" "to-real"]
+ ^:private analyse-real-to-int &type/Real &type/Int ["real" "to-int"]
+ ^:private analyse-real-hash &type/Real &type/Nat ["real" "hash"]
+
+ ^:private analyse-char-to-text &type/Char &type/Text ["char" "to-text"]
- ^:private analyse-deg-to-real &type/Deg &type/Real ["deg" "to-real"]
- ^:private analyse-real-to-deg &type/Real &type/Deg ["real" "to-deg"]
+ ^:private analyse-deg-to-real &type/Deg &type/Real ["deg" "to-real"]
+ ^:private analyse-real-to-deg &type/Real &type/Deg ["real" "to-deg"]
- ^:private analyse-lux-log! &type/Text &/$UnitT ["io" "log!"]
+ ^:private analyse-lux-log &type/Text &/$UnitT ["io" "log"]
+ ^:private analyse-lux-error &type/Text &type/Bottom ["io" "error"]
)
(defn ^:private analyse-array-new [analyse exo-type ?values]
@@ -245,16 +315,23 @@
(case category
"lux"
(case proc
- "==" (analyse-lux-== analyse exo-type ?values))
+ "is" (analyse-lux-is analyse exo-type ?values))
"io"
(case proc
- "log!" (analyse-lux-log! analyse exo-type ?values))
+ "log" (analyse-lux-log analyse exo-type ?values)
+ "error" (analyse-lux-error analyse exo-type ?values))
"text"
(case proc
"=" (analyse-text-eq analyse exo-type ?values)
- "append" (analyse-text-append analyse exo-type ?values))
+ "append" (analyse-text-append analyse exo-type ?values)
+ "clip" (analyse-text-clip analyse exo-type ?values)
+ "index" (analyse-text-index analyse exo-type ?values)
+ "last-index" (analyse-text-last-index analyse exo-type ?values)
+ "size" (analyse-text-size analyse exo-type ?values)
+ "replace-all" (analyse-text-replace-all analyse exo-type ?values)
+ "trim" (analyse-text-trim analyse exo-type ?values))
"bit"
(case proc
@@ -305,6 +382,7 @@
"min-value" (analyse-int-min-value analyse exo-type ?values)
"max-value" (analyse-int-max-value analyse exo-type ?values)
"to-nat" (analyse-int-to-nat analyse exo-type ?values)
+ "to-real" (analyse-int-to-real analyse exo-type ?values)
)
"deg"
@@ -337,7 +415,12 @@
"decode" (analyse-real-decode analyse exo-type ?values)
"min-value" (analyse-real-min-value analyse exo-type ?values)
"max-value" (analyse-real-max-value analyse exo-type ?values)
+ "not-a-number" (analyse-real-not-a-number analyse exo-type ?values)
+ "positive-infinity" (analyse-real-positive-infinity analyse exo-type ?values)
+ "negative-infinity" (analyse-real-negative-infinity analyse exo-type ?values)
"to-deg" (analyse-real-to-deg analyse exo-type ?values)
+ "to-int" (analyse-real-to-int analyse exo-type ?values)
+ "hash" (analyse-real-hash analyse exo-type ?values)
)
"char"
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!! (&&parallel/parallel-compilation (partial compile-module source-dirs))
- compile-module!! (partial compile-module source-dirs)]]
+ compile-module!! (&&parallel/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)))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 07:55:13 +0000