From a3b9b19231047ec6da8decfc7d45db0598622651 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 14 Nov 2017 20:39:03 -0400
Subject: - Made "lux text clip" work like it used to.
---
luxc/src/lux/analyser/proc/common.clj | 4 +-
luxc/src/lux/compiler/jvm/proc/common.clj | 4 +-
luxc/src/lux/compiler/jvm/rt.clj | 31 +++++++---
.../source/luxc/lang/analysis/procedure/common.lux | 2 +-
.../luxc/lang/translation/procedure/common.jvm.lux | 2 +-
.../source/luxc/lang/translation/runtime.jvm.lux | 64 ++++++++++-----------
stdlib/source/lux.lux | 10 +---
stdlib/source/lux/data/number.lux | 66 ++++++++++++----------
stdlib/source/lux/data/text.lux | 7 +--
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)
--
cgit v1.2.3