diff options
| -rw-r--r-- | luxc/src/lux/analyser/proc/common.clj | 4 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/jvm/proc/common.clj | 4 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/jvm/rt.clj | 31 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/procedure/common.lux | 2 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux | 2 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/runtime.jvm.lux | 64 | ||||
| -rw-r--r-- | stdlib/source/lux.lux | 10 | ||||
| -rw-r--r-- | stdlib/source/lux/data/number.lux | 66 | ||||
| -rw-r--r-- | 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) |