- Made "lux text clip" work like it used to.

9 files changed, 97 insertions, 93 deletions

diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj
index a1758f845..0c38132a4 100644
--- a/luxc/src/lux/analyser/proc/common.clj
+++ b/luxc/src/lux/analyser/proc/common.clj
@@ -76,7 +76,7 @@
         =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 &type/Text)
+        _ (&type/check exo-type (&/$Apply &type/Text &type/Maybe))
         _cursor &/cursor]
     (return (&/|list (&&/|meta exo-type _cursor
                                (&&/$proc (&/T ["text" "clip"])
@@ -121,7 +121,6 @@
                                            (&/|list =text)
                                            (&/|list)))))))
 
-  ^:private analyse-text-trim "trim"
   ^:private analyse-text-upper-case "upper-case"
   ^:private analyse-text-lower-case "lower-case"
   )
@@ -491,7 +490,6 @@
          "lux text size"                 (analyse-text-size analyse exo-type ?values)
          "lux text hash"                 (analyse-text-hash analyse exo-type ?values)
          "lux text replace-all"          (analyse-text-replace-all analyse exo-type ?values)
-         "lux text trim"                 (analyse-text-trim analyse exo-type ?values)
          "lux text char"                 (analyse-text-char analyse exo-type ?values)
          "lux text upper-case"           (analyse-text-upper-case analyse exo-type ?values)
          "lux text lower-case"           (analyse-text-lower-case analyse exo-type ?values)
diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj
index e925c7fc0..16774a479 100644
--- a/luxc/src/lux/compiler/jvm/proc/common.clj
+++ b/luxc/src/lux/compiler/jvm/proc/common.clj
@@ -512,7 +512,7 @@
                   &&/unwrap-long
                   (.visitInsn Opcodes/L2I))]
         :let [_ (doto *writer*
-                  (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "text_clip" "(Ljava/lang/String;II)Ljava/lang/String;"))]]
+                  (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "text_clip" "(Ljava/lang/String;II)[Ljava/lang/Object;"))]]
     (return nil)))
 
 (do-template [<name> <method>]
@@ -606,7 +606,6 @@
                     (.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"
   )
@@ -830,7 +829,6 @@
       "size"                 (compile-text-size compile ?values special-args)
       "hash"                 (compile-text-hash compile ?values special-args)
       "replace-all"          (compile-text-replace-all compile ?values special-args)
-      "trim"                 (compile-text-trim compile ?values special-args)
       "char"                 (compile-text-char compile ?values special-args)
       "upper-case"           (compile-text-upper-case compile ?values special-args)
       "lower-case"           (compile-text-lower-case compile ?values special-args)
diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj
index c26265f87..83f02af3e 100644
--- a/luxc/src/lux/compiler/jvm/rt.clj
+++ b/luxc/src/lux/compiler/jvm/rt.clj
@@ -667,15 +667,28 @@
     nil))
 
 (defn ^:private compile-LuxRT-text-methods [^ClassWriter =class]
-  (do (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "text_clip" "(Ljava/lang/String;II)Ljava/lang/String;" nil nil)
-        (.visitCode)
-        (.visitVarInsn Opcodes/ALOAD 0)
-        (.visitVarInsn Opcodes/ILOAD 1)
-        (.visitVarInsn Opcodes/ILOAD 2)
-        (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;")
-        (.visitInsn Opcodes/ARETURN)
-        (.visitMaxs 0 0)
-        (.visitEnd))
+  (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;")
+          (.visitJumpInsn Opcodes/GOTO $end)
+          (.visitLabel $to)
+          (.visitLabel $handler)
+          (.visitInsn Opcodes/POP)
+          (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()[Ljava/lang/Object;")
+          (.visitLabel $end)
+          (.visitInsn Opcodes/ARETURN)
+          (.visitMaxs 0 0)
+          (.visitEnd)))
     (let [$from (new Label)
           $to (new Label)
           $handler (new Label)]
diff --git a/new-luxc/source/luxc/lang/analysis/procedure/common.lux b/new-luxc/source/luxc/lang/analysis/procedure/common.lux
index 3688f990e..f5756f35b 100644
--- a/new-luxc/source/luxc/lang/analysis/procedure/common.lux
+++ b/new-luxc/source/luxc/lang/analysis/procedure/common.lux
@@ -272,7 +272,7 @@
           (install "replace-once" (trinary Text Text Text Text))
           (install "replace-all" (trinary Text Text Text Text))
           (install "char" (binary Text Nat (type (Maybe Nat))))
-          (install "clip" (trinary Text Nat Nat Text))
+          (install "clip" (trinary Text Nat Nat (type (Maybe Text))))
           )))
 
 (def: (array-get proc)
diff --git a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
index 9fd2df62f..9a01622ae 100644
--- a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
@@ -423,7 +423,7 @@
 
   [text//clip ($i;CHECKCAST "java.lang.String") jvm-intI jvm-intI
    ($i;INVOKESTATIC hostL;runtime-class "text_clip"
-                    ($t;method (list $String $t;int $t;int) (#;Some $Object-Array) (list)) false)]
+                    ($t;method (list $String $t;int $t;int) (#;Some $Variant) (list)) false)]
   [text//replace-once ($i;CHECKCAST "java.lang.String")
    (<| ($i;INVOKESTATIC "java.util.regex.Pattern" "quote" ($t;method (list $String) (#;Some $String) (list)) false)
        ($i;CHECKCAST "java.lang.String"))
diff --git a/new-luxc/source/luxc/lang/translation/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/runtime.jvm.lux
index cc17014e1..70450be91 100644
--- a/new-luxc/source/luxc/lang/translation/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/runtime.jvm.lux
@@ -91,6 +91,21 @@
        ($i;string hostL;unit)
        variantI))
 
+(def: (try-methodI unsafeI)
+  (-> $;Inst $;Inst)
+  (<| $i;with-label (function [@from])
+      $i;with-label (function [@to])
+      $i;with-label (function [@handler])
+      (|>. ($i;try @from @to @handler "java.lang.Exception")
+           ($i;label @from)
+           unsafeI
+           someI
+           $i;ARETURN
+           ($i;label @to)
+           ($i;label @handler)
+           noneI
+           $i;ARETURN)))
+
 (def: #export string-concatI
   $;Inst
   ($i;INVOKEVIRTUAL "java.lang.String" "concat" ($t;method (list $String) (#;Some $String) (list)) false))
@@ -271,20 +286,10 @@
 (def: frac-methods
   $;Def
   (|>. ($d;method #$;Public $;staticM "decode_frac" ($t;method (list $String) (#;Some $Object-Array) (list))
-                  (<| $i;with-label (function [@from])
-                      $i;with-label (function [@to])
-                      $i;with-label (function [@handler])
-                      (|>. ($i;try @from @to @handler "java.lang.Exception")
-                           ($i;label @from)
-                           ($i;ALOAD +0)
-                           ($i;INVOKESTATIC "java.lang.Double" "parseDouble" ($t;method (list $String) (#;Some $t;double) (list)) false)
-                           ($i;wrap #$;Double)
-                           someI
-                           $i;ARETURN
-                           ($i;label @to)
-                           ($i;label @handler)
-                           noneI
-                           $i;ARETURN)))
+                  (try-methodI
+                   (|>. ($i;ALOAD +0)
+                        ($i;INVOKESTATIC "java.lang.Double" "parseDouble" ($t;method (list $String) (#;Some $t;double) (list)) false)
+                        ($i;wrap #$;Double))))
        ($d;method #$;Public $;staticM "frac_to_deg" ($t;method (list $t;double) (#;Some $t;long) (list))
                   (let [swap2 (|>. $i;DUP2_X2 $i;POP2)
                         drop-excessI (|>. ($i;double 1.0) $i;DREM)
@@ -388,24 +393,19 @@
 
 (def: text-methods
   $;Def
-  (|>. ($d;method #$;Public $;staticM "text_char" ($t;method (list $String $t;int) (#;Some $Variant) (list))
-                  (let [get-charI (|>. ($i;ALOAD +0)
-                                       ($i;ILOAD +1)
-                                       ($i;INVOKEVIRTUAL "java.lang.String" "codePointAt" ($t;method (list $t;int) (#;Some $t;int) (list)) false)
-                                       $i;I2L
-                                       ($i;wrap #$;Long))]
-                    (<| $i;with-label (function [@from])
-                        $i;with-label (function [@to])
-                        $i;with-label (function [@handler])
-                        (|>. ($i;try @from @to @handler "java.lang.Exception")
-                             ($i;label @from)
-                             get-charI
-                             someI
-                             $i;ARETURN
-                             ($i;label @to)
-                             ($i;label @handler)
-                             noneI
-                             $i;ARETURN))))
+  (|>. ($d;method #$;Public $;staticM "text_clip" ($t;method (list $String $t;int $t;int) (#;Some $Variant) (list))
+                  (try-methodI
+                   (|>. ($i;ALOAD +0)
+                        ($i;ILOAD +1)
+                        ($i;ILOAD +2)
+                        ($i;INVOKEVIRTUAL "java.lang.String" "substring" ($t;method (list $t;int $t;int) (#;Some $String) (list)) false))))
+       ($d;method #$;Public $;staticM "text_char" ($t;method (list $String $t;int) (#;Some $Variant) (list))
+                  (try-methodI
+                   (|>. ($i;ALOAD +0)
+                        ($i;ILOAD +1)
+                        ($i;INVOKEVIRTUAL "java.lang.String" "codePointAt" ($t;method (list $t;int) (#;Some $t;int) (list)) false)
+                        $i;I2L
+                        ($i;wrap #$;Long))))
        ))
 
 (def: pm-methods
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 0da0a628a..d70318f83 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -3395,17 +3395,11 @@
 
 (def: (clip1 from text)
   (-> Nat Text (Maybe Text))
-  (let [to ("lux text size" text)]
-    (if (n.<= to from)
-      (#;Some ("lux text clip" text from to))
-      #;None)))
+  ("lux text clip" text from ("lux text size" text)))
 
 (def: (clip2 from to text)
   (-> Nat Nat Text (Maybe Text))
-  (if (and (n.<= ("lux text size" text) to)
-           (n.<= to from))
-    (#;Some ("lux text clip" text from to))
-    #;None))
+  ("lux text clip" text from to))
 
 (def: #export (error! message)
   {#;doc "## Causes an error, with the given error message.
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index 06a8809e1..e9009102b 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -172,8 +172,8 @@
   )
 
 ## [Values & Syntax]
-(def: (get-char idx full)
-  (-> Nat Text Text)
+(def: (get-char full idx)
+  (-> Text Nat (Maybe Text))
   ("lux text clip" full idx (n.inc idx)))
 
 (do-template [<struct> <base> <char-set> <error>]
@@ -181,7 +181,7 @@
      (def: (encode value)
        (loop [input value
               output ""]
-         (let [digit (get-char (n.% <base> input) <char-set>)
+         (let [digit (maybe;assume (get-char <char-set> (n.% <base> input)))
                output' ("lux text concat" digit output)
                input' (n./ <base> input)]
            (if (n.= +0 input')
@@ -197,7 +197,7 @@
                (loop [idx +1
                       output +0]
                  (if (n.< input-size idx)
-                   (let [digit (get-char idx input)]
+                   (let [digit (maybe;assume (get-char input idx))]
                      (case ("lux text index" <char-set> digit +0)
                        #;None
                        (#E;Error ("lux text concat" <error> repr))
@@ -226,19 +226,20 @@
                       "-"
                       "")]
            (loop [input (|> value (i./ <base>) (:: Number<Int> abs))
-                  output (get-char (|> value (i.% <base>) (:: Number<Int> abs) int-to-nat)
-                                   <char-set>)]
+                  output (|> value (i.% <base>) (:: Number<Int> abs) int-to-nat
+                             (get-char <char-set>)
+                             maybe;assume)]
              (if (i.= 0 input)
                ("lux text concat" sign output)
-               (let [digit (get-char (int-to-nat (i.% <base> input)) <char-set>)]
+               (let [digit (maybe;assume (get-char <char-set> (int-to-nat (i.% <base> input))))]
                  (recur (i./ <base> input)
                         ("lux text concat" digit output))))))))
 
      (def: (decode repr)
        (let [input-size ("lux text size" repr)]
          (if (n.>= +1 input-size)
-           (let [sign (case (get-char +0 repr)
-                        "-"
+           (let [sign (case (get-char repr +0)
+                        (^ (#;Some "-"))
                         -1
 
                         _
@@ -247,7 +248,7 @@
              (loop [idx (if (i.= -1 sign) +1 +0)
                     output 0]
                (if (n.< input-size idx)
-                 (let [digit (get-char idx input)]
+                 (let [digit (maybe;assume (get-char input idx))]
                    (case ("lux text index" <char-set> digit +0)
                      #;None
                      (#E;Error <error>)
@@ -266,7 +267,7 @@
 
 (def: (de-prefix input)
   (-> Text Text)
-  ("lux text clip" input +1 ("lux text size" input)))
+  (maybe;assume ("lux text clip" input +1 ("lux text size" input))))
 
 (do-template [<struct> <nat> <char-bit-size> <error>]
   [(struct: #export <struct> (Codec Text Deg)
@@ -314,8 +315,8 @@
                               (if (f.= 0.0 dec-left)
                                 ("lux text concat" "." output)
                                 (let [shifted (f.* <base> dec-left)
-                                      digit (get-char (|> shifted (f.% <base>) frac-to-int int-to-nat)
-                                                      <char-set>)]
+                                      digit (|> shifted (f.% <base>) frac-to-int int-to-nat
+                                                (get-char <char-set>) maybe;assume)]
                                   (recur (f.% 1.0 shifted)
                                          ("lux text concat" output digit))))))]
          ("lux text concat" whole-part decimal-part)))
@@ -323,8 +324,8 @@
      (def: (decode repr)
        (case ("lux text index" repr "." +0)
          (#;Some split-index)
-         (let [whole-part ("lux text clip" repr +0 split-index)
-               decimal-part ("lux text clip" repr (n.inc split-index) ("lux text size" repr))]
+         (let [whole-part (maybe;assume ("lux text clip" repr +0 split-index))
+               decimal-part (maybe;assume ("lux text clip" repr (n.inc split-index) ("lux text size" repr)))]
            (case [(:: <int> decode whole-part)
                   (:: <int> decode decimal-part)]
              (^multi [(#;Some whole) (#;Some decimal)]
@@ -368,8 +369,8 @@
       (if (n.<= chunk-size num-digits)
         (list digits)
         (let [boundary (n.- chunk-size num-digits)
-              chunk ("lux text clip" digits boundary num-digits)
-              remaining ("lux text clip" digits +0 boundary)]
+              chunk (maybe;assume ("lux text clip" digits boundary num-digits))
+              remaining (maybe;assume ("lux text clip" digits +0 boundary))]
           (list& chunk (segment-digits chunk-size remaining)))))))
 
 (def: (bin-segment-to-hex input)
@@ -498,10 +499,10 @@
        (let [sign (:: Number<Frac> signum value)
              raw-bin (:: Binary@Codec<Text,Frac> encode value)
              dot-idx (maybe;assume ("lux text index" raw-bin "." +0))
-             whole-part ("lux text clip" raw-bin
-                         (if (f.= -1.0 sign) +1 +0)
-                         dot-idx)
-             decimal-part ("lux text clip" raw-bin (n.inc dot-idx) ("lux text size" raw-bin))
+             whole-part (maybe;assume ("lux text clip" raw-bin
+                                       (if (f.= -1.0 sign) +1 +0)
+                                       dot-idx))
+             decimal-part (maybe;assume ("lux text clip" raw-bin (n.inc dot-idx) ("lux text size" raw-bin)))
              hex-output (|> (<from> false decimal-part)
                             ("lux text concat" ".")
                             ("lux text concat" (<from> true whole-part))
@@ -517,8 +518,8 @@
                     1.0)]
          (case ("lux text index" repr "." +0)
            (#;Some split-index)
-           (let [whole-part ("lux text clip" repr (if (f.= -1.0 sign) +1 +0) split-index)
-                 decimal-part ("lux text clip" repr (n.inc split-index) ("lux text size" repr))
+           (let [whole-part (maybe;assume ("lux text clip" repr (if (f.= -1.0 sign) +1 +0) split-index))
+                 decimal-part (maybe;assume ("lux text clip" repr (n.inc split-index) ("lux text size" repr)))
                  as-binary (|> (<to> decimal-part)
                                ("lux text concat" ".")
                                ("lux text concat" (<to> whole-part))
@@ -671,13 +672,14 @@
       (loop [idx +0
              output (make-digits [])]
         (if (n.< length idx)
-          (case ("lux text index" "0123456789" (get-char idx input) +0)
-            #;None
-            #;None
-
-            (#;Some digit)
-            (recur (n.inc idx)
-                   (digits-put idx digit output)))
+          (let [char (maybe;assume (get-char input idx))]
+            (case ("lux text index" "0123456789" char +0)
+              #;None
+              #;None
+
+              (#;Some digit)
+              (recur (n.inc idx)
+                     (digits-put idx digit output))))
           (#;Some output)))
       #;None)))
 
@@ -741,7 +743,9 @@
                     false)]
       (if (and dotted?
                (n.<= (n.inc bit;width) length))
-        (case (text-to-digits ("lux text clip" input +1 length))
+        (case (|> ("lux text clip" input +1 length)
+                  maybe;assume
+                  text-to-digits)
           (#;Some digits)
           (loop [digits digits
                  idx +0
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index 21a170003..d0f1e6f15 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -33,14 +33,11 @@
 
 (def: #export (clip from to input)
   (-> Nat Nat Text (Maybe Text))
-  (if (and (n.<= ("lux text size" input) to)
-           (n.<= to from))
-    (#;Some ("lux text clip" input from to))
-    #;None))
+  ("lux text clip" input from to))
 
 (def: #export (clip' from input)
   (-> Nat Text (Maybe Text))
-  (clip from (size input) input))
+  ("lux text clip" input from (size input)))
 
 (def: #export (replace-all pattern value template)
   (-> Text Text Text Text)