diff options
| -rw-r--r-- | luxc/src/lux/analyser/proc/common.clj | 2 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/jvm/proc/common.clj | 2 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/jvm/rt.clj | 64 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux | 9 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux | 10 | ||||
| -rw-r--r-- | stdlib/source/lux.lux | 36 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/default/syntax.lux | 56 | ||||
| -rw-r--r-- | stdlib/source/lux/data/number.lux | 84 | ||||
| -rw-r--r-- | stdlib/source/lux/data/text.lux | 10 | ||||
| -rw-r--r-- | stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux | 2 | ||||
| -rw-r--r-- | stdlib/test/test/lux/compiler/default/syntax.lux | 20 |
12 files changed, 130 insertions, 167 deletions
diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 8c6bd9d88..b52589460 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -65,7 +65,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 (&/$Apply &type/Text &type/Maybe)) + _ (&type/check exo-type &type/Text) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["text" "clip"]) diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index 36f23263d..90f7b6bcf 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -263,7 +263,7 @@ &&/unwrap-long (.visitInsn Opcodes/L2I))] :let [_ (doto *writer* - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "text_clip" "(Ljava/lang/String;II)[Ljava/lang/Object;"))]] + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;"))]] (return nil))) (defn ^:private compile-text-index [compile ?values special-args] diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj index 6b9aeb680..97b767863 100644 --- a/luxc/src/lux/compiler/jvm/rt.clj +++ b/luxc/src/lux/compiler/jvm/rt.clj @@ -340,49 +340,27 @@ nil)) (defn ^:private compile-LuxRT-text-methods [^ClassWriter =class] - (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)] - (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" "codePointAt" "(I)I") - (.visitInsn Opcodes/I2L) - &&/wrap-long - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)[Ljava/lang/Object;") - (.visitInsn Opcodes/ARETURN) - (.visitLabel $to) - (.visitLabel $handler) - (.visitInsn Opcodes/POP) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()[Ljava/lang/Object;") - (.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") + (.visitInsn Opcodes/I2L) + &&/wrap-long + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)[Ljava/lang/Object;") + (.visitInsn Opcodes/ARETURN) + (.visitLabel $to) + (.visitLabel $handler) + (.visitInsn Opcodes/POP) + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()[Ljava/lang/Object;") + (.visitInsn Opcodes/ARETURN) + (.visitMaxs 0 0) + (.visitEnd)) nil)) (def compile-LuxRT-class diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux index 1b784ee76..a0a34d9ad 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux @@ -223,7 +223,7 @@ paramI <pre-param> <op> <post>))] - [text::= id id + [text::= (<|) (<|) (_.INVOKEVIRTUAL "java.lang.Object" "equals" (_t.method (list ///.$Object) (#.Some _t.boolean) (list)) #0) (_.wrap #$.Boolean)] [text::< ..check-stringI ..check-stringI @@ -231,10 +231,10 @@ (predicateI _.IFLT)] [text::concat ..check-stringI ..check-stringI (_.INVOKEVIRTUAL "java.lang.String" "concat" (_t.method (list $String) (#.Some $String) (list)) #0) - id] + (<|)] [text::char ..check-stringI jvm-intI (_.INVOKESTATIC ///.runtime-class "text_char" (_t.method (list $String _t.int) (#.Some ///.$Variant) (list)) #0) - id] + (<|)] ) (do-template [<name> <pre-subject> <pre-param> <pre-extra> <op>] @@ -246,8 +246,7 @@ <op>))] [text::clip ..check-stringI jvm-intI jvm-intI - (_.INVOKESTATIC ///.runtime-class "text_clip" - (_t.method (list $String _t.int _t.int) (#.Some ///.$Variant) (list)) #0)] + (_.INVOKEVIRTUAL "java.lang.String" "substring" (_t.method (list _t.int _t.int) (#.Some $String) (list)) #0)] ) (def: index-method Method (_t.method (list $String _t.int) (#.Some _t.int) (list))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux index 20c31bd5d..3c8563d75 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux @@ -133,17 +133,11 @@ (def: text-methods Def - (|>> ($d.method #$.Public $.staticM "text_clip" ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list)) + (|>> ($d.method #$.Public $.staticM "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list)) (try-methodI (|>> (_.ALOAD 0) (_.ILOAD 1) - (_.ILOAD 2) - (_.INVOKEVIRTUAL "java.lang.String" "substring" ($t.method (list $t.int $t.int) (#.Some $String) (list)) #0)))) - ($d.method #$.Public $.staticM "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list)) - (try-methodI - (|>> (_.ALOAD 0) - (_.ILOAD 1) - (_.INVOKEVIRTUAL "java.lang.String" "codePointAt" ($t.method (list $t.int) (#.Some $t.int) (list)) #0) + (_.INVOKEVIRTUAL "java.lang.String" "charAt" ($t.method (list $t.int) (#.Some $t.char) (list)) #0) _.I2L (_.wrap #$.Long)))) )) diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index bfbfe0678..5abcab3dc 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1,23 +1,17 @@ ("lux def" double-quote - ("lux check" (0 "#Text" (0)) - ("lux int char" +34)) + ("lux int char" +34) [["" 0 0] (10 (0))]) ("lux def" new-line - ("lux check" (0 "#Text" (0)) - ("lux int char" +10)) + ("lux int char" +10) [["" 0 0] (10 (0))]) ("lux def" __paragraph - ("lux check" (0 "#Text" (0)) - ("lux text concat" new-line new-line)) + ("lux text concat" new-line new-line) [["" 0 0] (10 (0))]) ("lux def" dummy-cursor - ("lux check" (2 (0 "#Text" (0)) - (2 (0 "#I64" (1 (0 "#Nat" (0)) (0))) - (0 "#I64" (1 (0 "#Nat" (0)) (0))))) - ["" 0 0]) + ["" 0 0] [["" 0 0] (10 (1 [[["" 0 0] (7 ["lux" "export?"])] [["" 0 0] (0 #1)]] @@ -3606,13 +3600,19 @@ #None #None)) -(def: (clip1 from text) +(def: (clip/1 from text) (-> Nat Text (Maybe Text)) - ("lux text clip" text from ("lux text size" text))) + (let [size ("lux text size" text)] + (if (n/<= size from) + (#.Some ("lux text clip" text from size)) + #.None))) -(def: (clip2 from to text) +(def: (clip/2 from to text) (-> Nat Nat Text (Maybe Text)) - ("lux text clip" text from to)) + (if (and (n/<= to from) + (n/<= ("lux text size" text) to)) + (#.Some ("lux text clip" text from to)) + #.None)) (def: #export (error! message) {#.doc (text$ ($_ "lux text concat" @@ -3651,10 +3651,10 @@ (#Some idx) (list& (default (error! "UNDEFINED") - (clip2 0 idx input)) + (clip/2 0 idx input)) (text/split splitter (default (error! "UNDEFINED") - (clip1 (n/+ 1 idx) input)))))) + (clip/1 (n/+ 1 idx) input)))))) (def: (nth idx xs) (All [a] @@ -4146,7 +4146,7 @@ (def: (split at x) (-> Nat Text (Maybe [Text Text])) - (case [(..clip2 0 at x) (..clip1 at x)] + (case [(..clip/2 0 at x) (..clip/1 at x)] [(#.Some pre) (#.Some post)] (#.Some [pre post]) @@ -4213,7 +4213,7 @@ list/reverse (interpose "/") text/join) - clean (|> module (clip1 ups) (default (error! "UNDEFINED"))) + clean ("lux text clip" module ups ("lux text size" module)) output (case ("lux text size" clean) 0 prefix _ ($_ text/compose prefix "/" clean))] diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux index 690a4accb..c654d9a00 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux @@ -202,7 +202,7 @@ (bundle.install "index" (trinary Text Text Nat (type (Maybe Nat)))) (bundle.install "size" (unary Text Nat)) (bundle.install "char" (binary Text Nat (type (Maybe Nat)))) - (bundle.install "clip" (trinary Text Nat Nat (type (Maybe Text)))) + (bundle.install "clip" (trinary Text Nat Nat Text)) ))) (def: #export (bundle eval) diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index 7dc992471..69d214371 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -33,7 +33,6 @@ [data ["." error (#+ Error)] ["." number] - ["." maybe] ["." text ["l" lexer (#+ Offset Lexer)] format] @@ -135,11 +134,8 @@ (..frac where) ))) -(type: (Simple a) - (-> Source (Error [Source a]))) - -(type: (Parser a) - (-> Text Aliases (Simple a))) +(type: Parser + (-> Source (Error [Source Code]))) (do-template [<name> <extension> <diff>] [(template: (<name> value) @@ -152,7 +148,7 @@ (do-template [<name> <close> <tag>] [(def: (<name> parse source) - (-> (Simple Code) (Simple Code)) + (-> Parser Parser) (loop [source source stack (: (List Code) #.Nil)] (case (parse source) @@ -184,7 +180,7 @@ ) (def: (parse-record parse source) - (-> (Simple Code) (Simple Code)) + (-> Parser Parser) (loop [source source stack (: (List [Code Code]) #.Nil)] (case (parse source) @@ -214,8 +210,7 @@ (#error.Error error)))) (template: (!clip from to text) - ## TODO: Optimize-away "maybe.assume" - (maybe.assume ("lux text clip" text from to))) + ("lux text clip" text from to)) (template: (!i/< reference subject) ("lux int <" subject reference)) @@ -237,7 +232,7 @@ body)) (def: (read-text [where offset source-code]) - (Simple Code) + Parser (case ("lux text index" source-code (static ..text-delimiter) offset) (#.Some end) (let [content (!clip offset end source-code)] @@ -300,7 +295,7 @@ (#error.Error error))) (def: (parse-nat start [where offset source-code]) - (-> Offset (Simple Code)) + (-> Offset Parser) (loop [end offset] (case ("lux text char" source-code end) (#.Some char) @@ -312,7 +307,7 @@ (!discrete-output number.Codec<Text,Nat> #.Nat)))) (def: (parse-int start [where offset source-code]) - (-> Offset (Simple Code)) + (-> Offset Parser) (loop [end offset] (case ("lux text char" source-code end) (#.Some char) @@ -324,7 +319,7 @@ (!discrete-output number.Codec<Text,Int> #.Int)))) (def: (parse-rev start [where offset source-code]) - (-> Offset (Simple Code)) + (-> Offset Parser) (loop [end offset] (case ("lux text char" source-code end) (#.Some char) @@ -360,17 +355,14 @@ _ <output>)))) -(template: (!leap-bit value) - ("lux i64 +" value 2)) - (template: (!new-line where) (let [[where::file where::line where::column] where] [where::file (!inc where::line) 0])) (with-expansions [<end> (ex.throw end-of-file current-module) <failure> (ex.throw unrecognized-input where) - <consume-1> (as-is [where (!inc offset) source-code]) - <consume-2> (as-is [where (!inc/2 offset) source-code])] + <consume-1> (as-is [where (!inc offset/0) source-code]) + <consume-2> (as-is [where (!inc/2 offset/0) source-code])] (template: (!with-char @source-code @offset @char @body) (case ("lux text char" @source-code @offset) @@ -451,20 +443,20 @@ (def: #export (parse current-module aliases source) (-> Text Aliases Source (Error [Source Code])) (let [parse' (parse current-module aliases)] - (loop [[where offset source-code] source] - (<| (!with-char source-code offset char/0) + (loop [[where offset/0 source-code] source] + (<| (!with-char source-code offset/0 char/0) (`` (case char/0 ## White-space (^template [<char> <direction>] (^ (char <char>)) (recur [(update@ <direction> inc where) - (!inc offset) + (!inc offset/0) source-code])) ([(~~ (static ..space)) #.column] [(~~ (static text.carriage-return)) #.column]) (^ (char (~~ (static text.new-line)))) - (recur [(!new-line where) (!inc offset) source-code]) + (recur [(!new-line where) (!inc offset/0) source-code]) ## Form (^ (char (~~ (static ..open-form)))) @@ -484,13 +476,13 @@ ## Special code (^ (char (~~ (static ..sigil)))) - (let [offset/1 (!inc offset)] + (let [offset/1 (!inc offset/0)] (<| (!with-char source-code offset/1 char/1) (case char/1 (^template [<char> <bit>] (^ (char <char>)) - (#error.Success [[(update@ #.column (|>> !leap-bit) where) - (!leap-bit offset) + (#error.Success [[(update@ #.column (|>> !inc/2) where) + (!inc offset/1) source-code] [where (#.Bit <bit>)]])) (["0" #0] @@ -510,31 +502,31 @@ _ (cond (!name-char?|head char/1) ## Tag - (!parse-full-name offset <consume-2> where #.Tag) + (!parse-full-name offset/1 <consume-2> where #.Tag) ## else <failure>)))) (^ (char (~~ (static ..name-separator)))) - (let [offset/1 (!inc offset)] + (let [offset/1 (!inc offset/0)] (<| (!with-char source-code offset/1 char/1) (if (!digit? char/1) - (parse-rev offset [where (!inc offset/1) source-code]) + (parse-rev offset/0 [where (!inc offset/1) source-code]) (!parse-short-name current-module <consume-1> where #.Identifier)))) (^template [<sign>] (^ (char <sign>)) - (!parse-int offset where source-code)) + (!parse-int offset/0 where source-code)) ([(~~ (static ..positive-sign))] [(~~ (static ..negative-sign))]) _ (cond (!digit? char/0) ## Natural number - (parse-nat offset <consume-1>) + (parse-nat offset/0 <consume-1>) ## Identifier (!name-char?|head char/0) - (!parse-full-name offset <consume-1> where #.Identifier) + (!parse-full-name offset/0 <consume-1> where #.Identifier) ## else <failure>)))))))) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index e45c4ff1c..f2845f48c 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -178,9 +178,9 @@ ) ## [Values & Syntax] -(def: (get-char full idx) - (-> Text Nat (Maybe Text)) - ("lux text clip" full idx (inc idx))) +(def: (get-char! full idx) + (-> Text Nat Text) + ("lux text clip" full idx ("lux i64 +" 1 idx))) (def: (binary-character value) (-> Nat (Maybe Text)) @@ -312,14 +312,13 @@ (loop [idx 0 output 0] (if (n/< input-size idx) - (let [digit (maybe.assume (get-char repr idx))] - (case (<to-value> digit) - #.None - (#error.Error ("lux text concat" <error> repr)) - - (#.Some digit-value) - (recur (inc idx) - (|> output (n/* <base>) (n/+ digit-value))))) + (case (<to-value> (get-char! repr idx)) + #.None + (#error.Error ("lux text concat" <error> repr)) + + (#.Some digit-value) + (recur (inc idx) + (|> output (n/* <base>) (n/+ digit-value)))) (#error.Success output))) (#error.Error ("lux text concat" <error> repr))))))] @@ -337,11 +336,11 @@ (def: (int/sign?? representation) (-> Text (Maybe Int)) - (case (get-char representation 0) - (^ (#.Some "-")) + (case (get-char! representation 0) + "-" (#.Some -1) - (^ (#.Some "+")) + "+" (#.Some +1) _ @@ -352,14 +351,13 @@ (loop [idx 1 output +0] (if (n/< input-size idx) - (let [digit (maybe.assume (get-char repr idx))] - (case (<to-value> digit) - #.None - (#error.Error <error>) + (case (<to-value> (get-char! repr idx)) + #.None + (#error.Error <error>) - (#.Some digit-value) - (recur (inc idx) - (|> output (i/* <base>) (i/+ (.int digit-value)))))) + (#.Some digit-value) + (recur (inc idx) + (|> output (i/* <base>) (i/+ (.int digit-value))))) (#error.Success (i/* sign output))))) (do-template [<struct> <base> <to-character> <to-value> <error>] @@ -396,7 +394,7 @@ (def: (de-prefix input) (-> Text Text) - (maybe.assume ("lux text clip" input 1 ("lux text size" input)))) + ("lux text clip" input 1 ("lux text size" input))) (do-template [<struct> <nat> <char-bit-size> <error>] [(structure: #export <struct> (Codec Text Rev) @@ -444,8 +442,7 @@ (if (f/= +0.0 dec-left) ("lux text concat" "." output) (let [shifted (f/* <base> dec-left) - digit (|> shifted (f/% <base>) frac-to-int .nat - (get-char <char-set>) maybe.assume)] + digit (|> shifted (f/% <base>) frac-to-int .nat (get-char! <char-set>))] (recur (f/% +1.0 shifted) ("lux text concat" output digit))))))] ("lux text concat" whole-part decimal-part))) @@ -453,8 +450,8 @@ (def: (decode repr) (case ("lux text index" repr "." 0) (#.Some split-index) - (let [whole-part (maybe.assume ("lux text clip" repr 0 split-index)) - decimal-part (maybe.assume ("lux text clip" repr (inc split-index) ("lux text size" repr)))] + (let [whole-part ("lux text clip" repr 0 split-index) + decimal-part ("lux text clip" repr (inc split-index) ("lux text size" repr))] (case [(:: <int> decode whole-part) (:: <int> decode decimal-part)] (^multi [(#error.Success whole) (#error.Success decimal)] @@ -498,8 +495,8 @@ (if (n/<= chunk-size num-digits) (list digits) (let [boundary (n/- chunk-size num-digits) - chunk (maybe.assume ("lux text clip" digits boundary num-digits)) - remaining (maybe.assume ("lux text clip" digits 0 boundary))] + chunk ("lux text clip" digits boundary num-digits) + remaining ("lux text clip" digits 0 boundary)] (list& chunk (segment-digits chunk-size remaining))))))) (def: (bin-segment-to-hex input) @@ -627,10 +624,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 (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 (inc dot-idx) ("lux text size" raw-bin))) + whole-part ("lux text clip" raw-bin + (if (f/= -1.0 sign) 1 0) + dot-idx) + decimal-part ("lux text clip" raw-bin (inc dot-idx) ("lux text size" raw-bin)) hex-output (|> (<from> #0 decimal-part) ("lux text concat" ".") ("lux text concat" (<from> #1 whole-part)) @@ -646,8 +643,8 @@ +1.0)] (case ("lux text index" repr "." 0) (#.Some split-index) - (let [whole-part (maybe.assume ("lux text clip" repr 1 split-index)) - decimal-part (maybe.assume ("lux text clip" repr (inc split-index) ("lux text size" repr))) + (let [whole-part ("lux text clip" repr 1 split-index) + decimal-part ("lux text clip" repr (inc split-index) ("lux text size" repr)) as-binary (|> (<to> decimal-part) ("lux text concat" ".") ("lux text concat" (<to> whole-part)) @@ -829,14 +826,13 @@ (loop [idx 0 output (make-digits [])] (if (n/< length idx) - (let [char (maybe.assume (get-char input idx))] - (case ("lux text index" "+0123456789" char 0) - #.None - #.None - - (#.Some digit) - (recur (inc idx) - (digits-put idx digit output)))) + (case ("lux text index" "+0123456789" (get-char! input idx) 0) + #.None + #.None + + (#.Some digit) + (recur (inc idx) + (digits-put idx digit output))) (#.Some output))) #.None))) @@ -900,9 +896,7 @@ #0)] (if (and dotted? (n/<= (inc i64.width) length)) - (case (|> ("lux text clip" input 1 length) - maybe.assume - text-to-digits) + (case (text-to-digits ("lux text clip" input 1 length)) (#.Some digits) (loop [digits digits idx 0 diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 3807275c1..c33ab03a3 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -105,11 +105,17 @@ (def: #export (clip from to input) (-> Nat Nat Text (Maybe Text)) - ("lux text clip" input from to)) + (if (and (n/<= to from) + (n/<= ("lux text size" input) to)) + (#.Some ("lux text clip" input from to)) + #.None)) (def: #export (clip' from input) (-> Nat Text (Maybe Text)) - ("lux text clip" input from (size input))) + (let [size ("lux text size" input)] + (if (n/<= size from) + (#.Some ("lux text clip" input from size)) + #.None))) (def: #export (split at x) (-> Nat Text (Maybe [Text Text])) diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux index fc082155a..cfc164df9 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux @@ -167,7 +167,7 @@ (test "Can obtain the character code of a text at a given index." (check-success+ "lux text char" (list subjectC fromC) (type (Maybe Nat)))) (test "Can clip a piece of text between 2 indices." - (check-success+ "lux text clip" (list subjectC fromC toC) (type (Maybe Text)))) + (check-success+ "lux text clip" (list subjectC fromC toC) Text)) )))) (context: "IO procedures" diff --git a/stdlib/test/test/lux/compiler/default/syntax.lux b/stdlib/test/test/lux/compiler/default/syntax.lux index 829199aa8..887765cbd 100644 --- a/stdlib/test/test/lux/compiler/default/syntax.lux +++ b/stdlib/test/test/lux/compiler/default/syntax.lux @@ -87,23 +87,23 @@ other code^] ($_ seq (test "Can parse Lux code." - (case (&.read "" (dict.new text.Hash<Text>) - [default-cursor 0 (code.to-text sample)]) + (case (&.parse "" (dict.new text.Hash<Text>) + [default-cursor 0 (code.to-text sample)]) (#e.Error error) #0 (#e.Success [_ parsed]) (:: code.Equivalence<Code> = parsed sample))) (test "Can parse Lux multiple code nodes." - (case (&.read "" (dict.new text.Hash<Text>) - [default-cursor 0 (format (code.to-text sample) " " - (code.to-text other))]) + (case (&.parse "" (dict.new text.Hash<Text>) + [default-cursor 0 (format (code.to-text sample) " " + (code.to-text other))]) (#e.Error error) #0 (#e.Success [remaining =sample]) - (case (&.read "" (dict.new text.Hash<Text>) - remaining) + (case (&.parse "" (dict.new text.Hash<Text>) + remaining) (#e.Error error) #0 @@ -133,9 +133,9 @@ comment comment^] ($_ seq (test "Can handle comments." - (case (&.read "" (dict.new text.Hash<Text>) - [default-cursor 0 - (format comment (code.to-text sample))]) + (case (&.parse "" (dict.new text.Hash<Text>) + [default-cursor 0 + (format comment (code.to-text sample))]) (#e.Error error) #0 |