- Added support for the new common procedures to the JVM backend.

- Fixed some bugs.

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>)