aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--luxc/src/lux/compiler/jvm/proc/common.clj105
-rw-r--r--luxc/src/lux/compiler/jvm/rt.clj102
-rw-r--r--stdlib/source/lux/data/number.lux4
-rw-r--r--stdlib/source/lux/data/text.lux30
4 files changed, 177 insertions, 64 deletions
diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj
index c48403e52..01048fd98 100644
--- a/luxc/src/lux/compiler/jvm/proc/common.clj
+++ b/luxc/src/lux/compiler/jvm/proc/common.clj
@@ -265,6 +265,16 @@
^:private compile-real-lt Opcodes/DCMPG -1 &&/unwrap-double
)
+(defn ^:private compile-real-hash [compile ?values special-args]
+ (|do [:let [(&/$Cons ?input (&/$Nil)) ?values]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?input)
+ :let [_ (doto *writer*
+ &&/unwrap-double
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Double" "doubleToRawLongBits" "(D)J")
+ &&/wrap-long)]]
+ (return nil)))
+
(do-template [<name> <cmp-output>]
(defn <name> [compile ?values special-args]
(|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
@@ -328,8 +338,18 @@
^:private compile-nat-min-value (.visitLdcInsn 0) &&/wrap-long
^:private compile-nat-max-value (.visitLdcInsn -1) &&/wrap-long
+ ^:private compile-int-min-value (.visitLdcInsn Long/MIN_VALUE) &&/wrap-long
+ ^:private compile-int-max-value (.visitLdcInsn Long/MAX_VALUE) &&/wrap-long
+
^:private compile-deg-min-value (.visitLdcInsn 0) &&/wrap-long
^:private compile-deg-max-value (.visitLdcInsn -1) &&/wrap-long
+
+ ^:private compile-real-min-value (.visitLdcInsn (* -1.0 Double/MAX_VALUE)) &&/wrap-double
+ ^:private compile-real-max-value (.visitLdcInsn Double/MAX_VALUE) &&/wrap-double
+
+ ^:private compile-real-not-a-number (.visitLdcInsn Double/NaN) &&/wrap-double
+ ^:private compile-real-positive-infinity (.visitLdcInsn Double/POSITIVE_INFINITY) &&/wrap-double
+ ^:private compile-real-negative-infinity (.visitLdcInsn Double/NEGATIVE_INFINITY) &&/wrap-double
)
(do-template [<encode-name> <encode-method> <decode-name> <decode-method>]
@@ -356,23 +376,34 @@
^:private compile-deg-encode "encode_deg" ^:private compile-deg-decode "decode_deg"
)
-(defn ^:private compile-int-encode [compile ?values special-args]
- (|do [:let [(&/$Cons ?x (&/$Nil)) ?values]
- ^MethodVisitor *writer* &/get-writer
- _ (compile ?x)
- :let [_ (doto *writer*
- &&/unwrap-long
- (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "toString" "(J)Ljava/lang/String;"))]]
- (return nil)))
+(do-template [<name> <class> <signature> <unwrap>]
+ (defn <name> [compile ?values special-args]
+ (|do [:let [(&/$Cons ?input (&/$Nil)) ?values]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?input)
+ :let [_ (doto *writer*
+ <unwrap>
+ (.visitMethodInsn Opcodes/INVOKESTATIC <class> "toString" <signature>))]]
+ (return nil)))
+
+ ^:private compile-int-encode "java/lang/Long" "(J)Ljava/lang/String;" &&/unwrap-long
+ ^:private compile-real-encode "java/lang/Double" "(D)Ljava/lang/String;" &&/unwrap-double
+ )
-(defn ^:private compile-real-encode [compile ?values special-args]
- (|do [:let [(&/$Cons ?x (&/$Nil)) ?values]
- ^MethodVisitor *writer* &/get-writer
- _ (compile ?x)
- :let [_ (doto *writer*
- &&/unwrap-double
- (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Double" "toString" "(D)Ljava/lang/String;"))]]
- (return nil)))
+
+(do-template [<name> <method>]
+ (defn <name> [compile ?values special-args]
+ (|do [:let [(&/$Cons ?input (&/$Nil)) ?values]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?input)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String")
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" <method> "(Ljava/lang/String;)[Ljava/lang/Object;"))]]
+ (return nil)))
+
+ ^:private compile-int-decode "decode_int"
+ ^:private compile-real-decode "decode_real"
+ )
(do-template [<name> <method>]
(defn <name> [compile ?values special-args]
@@ -565,13 +596,32 @@
(.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]
+(do-template [<name> <method>]
+ (defn <name> [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" <method> "()Ljava/lang/String;"))]]
+ (return nil)))
+
+ ^:private compile-text-trim "trim"
+ ^:private compile-text-upper-case "toUpperCase"
+ ^:private compile-text-lower-case "toLowerCase"
+ )
+
+(defn ^:private compile-text-char [compile ?values special-args]
+ (|do [:let [(&/$Cons ?text (&/$Cons ?idx (&/$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;"))]]
+ (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String"))]
+ _ (compile ?idx)
+ :let [_ (doto *writer*
+ &&/unwrap-long
+ (.visitInsn Opcodes/L2I)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "text_char" "(Ljava/lang/String;I)[Ljava/lang/Object;"))]]
(return nil)))
(defn compile-io-log [compile ?values special-args]
@@ -620,6 +670,9 @@
"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)
+ "upper-case" (compile-text-upper-case compile ?values special-args)
+ "lower-case" (compile-text-lower-case compile ?values special-args)
+ "char" (compile-text-char compile ?values special-args)
)
"bit"
@@ -683,9 +736,12 @@
"%" (compile-int-rem compile ?values special-args)
"=" (compile-int-eq compile ?values special-args)
"<" (compile-int-lt 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)
"encode" (compile-int-encode compile ?values special-args)
+ "decode" (compile-int-decode compile ?values special-args)
)
"real"
@@ -697,9 +753,16 @@
"%" (compile-real-rem compile ?values special-args)
"=" (compile-real-eq compile ?values special-args)
"<" (compile-real-lt compile ?values special-args)
- "encode" (compile-real-encode compile ?values special-args)
+ "hash" (compile-real-hash 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-int" (compile-real-to-int compile ?values special-args)
"to-deg" (compile-real-to-deg compile ?values special-args)
+ "encode" (compile-real-encode compile ?values special-args)
+ "decode" (compile-real-decode compile ?values special-args)
)
"char"
diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj
index 303d9ae0a..7f193a1cd 100644
--- a/luxc/src/lux/compiler/jvm/rt.clj
+++ b/luxc/src/lux/compiler/jvm/rt.clj
@@ -1160,6 +1160,34 @@
(.visitEnd)))]
nil)))
+(do-template [<name> <method> <class> <parse-method> <signature> <wrapper>]
+ (defn <name> [^ClassWriter =class]
+ (do (let [$from (new Label)
+ $to (new Label)
+ $handler (new Label)]
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) <method> "(Ljava/lang/String;)[Ljava/lang/Object;" nil nil)
+ (.visitCode)
+ (.visitTryCatchBlock $from $to $handler "java/lang/Exception")
+ (.visitLabel $from)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitMethodInsn Opcodes/INVOKESTATIC <class> <parse-method> <signature>)
+ <wrapper>
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)Ljava/lang/Object;")
+ (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+ (.visitInsn Opcodes/ARETURN)
+ (.visitLabel $to)
+ (.visitLabel $handler)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;")
+ (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
+ nil))
+
+ ^:private compile-LuxRT-int-methods "decode_int" "java/lang/Long" "parseLong" "(Ljava/lang/String;)J" &&/wrap-long
+ ^:private compile-LuxRT-real-methods "decode_real" "java/lang/Double" "parseDouble" "(Ljava/lang/String;)D" &&/wrap-double
+ )
+
(defn ^:private compile-LuxRT-pm-methods [^ClassWriter =class]
(|let [_ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "pm_fail" "()V" nil nil)
(.visitCode)
@@ -1205,31 +1233,53 @@
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)))
+ (do (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)))
+ (let [$from (new Label)
+ $to (new Label)
+ $handler (new Label)]
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "text_char" "(Ljava/lang/String;I)[Ljava/lang/Object;" nil nil)
+ (.visitCode)
+ (.visitTryCatchBlock $from $to $handler "java/lang/IndexOutOfBoundsException")
+ (.visitLabel $from)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitVarInsn Opcodes/ILOAD 1)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "charAt" "(I)C")
+ &&/wrap-char
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)Ljava/lang/Object;")
+ (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+ (.visitInsn Opcodes/ARETURN)
+ (.visitLabel $to)
+ (.visitLabel $handler)
+ (.visitInsn Opcodes/POP)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;")
+ (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
+ nil))
(def compile-LuxRT-class
(|do [_ (return nil)
@@ -1291,7 +1341,9 @@
(compile-LuxRT-pm-methods)
(compile-LuxRT-adt-methods)
(compile-LuxRT-nat-methods)
+ (compile-LuxRT-int-methods)
(compile-LuxRT-deg-methods)
+ (compile-LuxRT-real-methods)
(compile-LuxRT-text-methods))]]
(&&/save-class! (second (string/split &&/lux-utils-class #"/"))
(.toByteArray (doto =class .visitEnd)))))
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index cad152f2b..0c52653af 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -201,14 +201,14 @@
(if (n.< input-size idx)
(let [digit (assume (_lux_proc ["text" "char"] [input idx]))]
(case (_lux_proc ["text" "index"]
- [input
+ [<char-set>
(_lux_proc ["char" "to-text"] [digit])])
#;None
(#;Left <error>)
(#;Some index)
(recur (n.inc idx)
- (|> output (n.* <base>) (n.* index)))))
+ (|> output (n.* <base>) (n.+ index)))))
(#;Right output))))))))
(macro: #export (<macro> tokens state)
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index 9375d6876..bc350cc3a 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -12,40 +12,38 @@
## [Functions]
(def: #export (size x)
(-> Text Nat)
- (int-to-nat (_lux_proc ["jvm" "i2l"] [(_lux_proc ["jvm" "invokevirtual:java.lang.String:length:"] [x])])))
+ [(_lux_proc ["text" "size"] [x])])
-(def: #export (nth idx x)
+(def: #export (nth idx input)
(-> Nat Text (Maybe Char))
- (if (n.< (size x) idx)
- (#;Some (_lux_proc ["jvm" "invokevirtual:java.lang.String:charAt:int"] [x (_lux_proc ["jvm" "l2i"] [(nat-to-int idx)])]))
- #;None))
+ (_lux_proc ["text" "char"] [input idx]))
(def: #export (contains? sub text)
(-> Text Text Bool)
(_lux_proc ["jvm" "invokevirtual:java.lang.String:contains:java.lang.CharSequence"] [text sub]))
(do-template [<name> <proc>]
- [(def: #export (<name> x)
+ [(def: #export (<name> input)
(-> Text Text)
- (_lux_proc ["jvm" <proc>] [x]))]
- [lower-case "invokevirtual:java.lang.String:toLowerCase:"]
- [upper-case "invokevirtual:java.lang.String:toUpperCase:"]
- [trim "invokevirtual:java.lang.String:trim:"]
+ (_lux_proc ["text" <proc>] [input]))]
+ [lower-case "lower-case"]
+ [upper-case "upper-case"]
+ [trim "trim"]
)
-(def: #export (clip from to x)
+(def: #export (clip from to input)
(-> Nat Nat Text (Maybe Text))
(if (and (n.< to from)
- (n.<= (size x) to))
+ (n.<= (size input) to))
(#;Some (_lux_proc ["jvm" "invokevirtual:java.lang.String:substring:int,int"]
- [x
+ [input
(_lux_proc ["jvm" "l2i"] [(nat-to-int from)])
(_lux_proc ["jvm" "l2i"] [(nat-to-int to)])]))
#;None))
-(def: #export (clip' from x)
+(def: #export (clip' from input)
(-> Nat Text (Maybe Text))
- (clip from (size x) x))
+ (clip from (size input) input))
(def: #export (replace pattern value template)
(-> Text Text Text Text)
@@ -120,7 +118,7 @@
## [Structures]
(struct: #export _ (Eq Text)
(def: (= test subject)
- (_lux_proc ["jvm" "invokevirtual:java.lang.Object:equals:java.lang.Object"] [subject test])))
+ (_lux_proc ["text" "="] [subject test])))
(struct: #export _ (ord;Ord Text)
(def: eq Eq<Text>)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 07:29:21 +0000