diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/source/lux.lux | 25 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/default/syntax.lux | 197 | ||||
| -rw-r--r-- | stdlib/source/lux/data/number.lux | 154 | ||||
| -rw-r--r-- | stdlib/source/lux/data/text.lux | 15 | ||||
| -rw-r--r-- | stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux | 2 |
5 files changed, 177 insertions, 216 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 5abcab3dc..916b77797 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -3650,11 +3650,9 @@ (list input) (#Some idx) - (list& (default (error! "UNDEFINED") - (clip/2 0 idx input)) + (list& ("lux text clip" input 0 idx) (text/split splitter - (default (error! "UNDEFINED") - (clip/1 (n/+ 1 idx) input)))))) + ("lux text clip" input (n/+ 1 idx) ("lux text size" input)))))) (def: (nth idx xs) (All [a] @@ -4144,23 +4142,17 @@ _ (return [#.Nil parts]))) -(def: (split at x) - (-> Nat Text (Maybe [Text Text])) - (case [(..clip/2 0 at x) (..clip/1 at x)] - [(#.Some pre) (#.Some post)] - (#.Some [pre post]) - - _ - #.None)) +(def: (split! at x) + (-> Nat Text [Text Text]) + [("lux text clip" x 0 at) + ("lux text clip" x at ("lux text size" x))]) (def: (split-with token sample) (-> Text Text (Maybe [Text Text])) (do ..Monad<Maybe> [index (..index-of token sample) - pre+post' (split index sample) - #let [[pre post'] pre+post'] - _+post (split ("lux text size" token) post') - #let [[_ post] _+post]] + #let [[pre post'] (split! index sample) + [_ post] (split! ("lux text size" token) post')]] (wrap [pre post]))) (def: (replace-all pattern value template) @@ -5961,7 +5953,6 @@ (^multi (^ (list [_ (#Text input)])) (n/= 1 ("lux text size" input))) (|> ("lux text char" input 0) - (default (undefined)) nat$ list [compiler] #Right) diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index 69d214371..af7c7ae90 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -146,6 +146,29 @@ [!dec "lux i64 -" 1] ) +(template: (!clip from to text) + ("lux text clip" text from to)) + +(template: (!i/< reference subject) + ("lux int <" subject reference)) + +(do-template [<name> <extension>] + [(template: (<name> param subject) + (<extension> subject param))] + + [!n/+ "lux i64 +"] + [!n/- "lux i64 -"] + ) + +(template: (!with-char @source-code @offset @char @else @body) + (if (!i/< (:coerce Int ("lux text size" @source-code)) + ## TODO: Get rid of the above "lux text size" call. + ## The size should be calculated only once and re-used constantly. + (:coerce Int @offset)) + (let [@char ("lux text char" @source-code @offset)] + @body) + @else)) + (do-template [<name> <close> <tag>] [(def: (<name> parse source) (-> Parser Parser) @@ -157,20 +180,16 @@ (#error.Error error) (let [[where offset source-code] source] - (case ("lux text char" source-code offset) - (#.Some char) - (`` (case char - (^ (char (~~ (static <close>)))) - (#error.Success [[(update@ #.column inc where) - (!inc offset) - source-code] - [where (<tag> (list.reverse stack))]]) - - _ - (ex.throw unrecognized-input where))) - - _ - (#error.Error error))))))] + (<| (!with-char source-code offset char (#error.Error error)) + (`` (case char + (^ (char (~~ (static <close>)))) + (#error.Success [[(update@ #.column inc where) + (!inc offset) + source-code] + [where (<tag> (list.reverse stack))]]) + + _ + (ex.throw unrecognized-input where))))))))] ## Form and tuple syntax is mostly the same, differing only in the ## delimiters involved. @@ -191,38 +210,20 @@ (#error.Error error) (let [[where offset source-code] source] - (case ("lux text char" source-code offset) - (#.Some char) - (`` (case char - (^ (char (~~ (static ..close-record)))) - (#error.Success [[(update@ #.column inc where) - (!inc offset) - source-code] - [where (#.Record (list.reverse stack))]]) + (<| (!with-char source-code offset char (#error.Error error)) + (`` (case char + (^ (char (~~ (static ..close-record)))) + (#error.Success [[(update@ #.column inc where) + (!inc offset) + source-code] + [where (#.Record (list.reverse stack))]]) - _ - (ex.throw unrecognized-input where))) - - _ - (#error.Error error)))) + _ + (ex.throw unrecognized-input where)))))) (#error.Error error) (#error.Error error)))) -(template: (!clip from to text) - ("lux text clip" text from to)) - -(template: (!i/< reference subject) - ("lux int <" subject reference)) - -(do-template [<name> <extension>] - [(template: (<name> param subject) - (<extension> subject param))] - - [!n/+ "lux i64 +"] - [!n/- "lux i64 -"] - ) - (template: (!guarantee-no-new-lines content body) (case ("lux text index" content (static text.new-line) 0) (#.Some g!_) @@ -294,45 +295,23 @@ (#error.Error error) (#error.Error error))) -(def: (parse-nat start [where offset source-code]) - (-> Offset Parser) - (loop [end offset] - (case ("lux text char" source-code end) - (#.Some char) - (if (!digit?+ char) - (recur (!inc end)) - (!discrete-output number.Codec<Text,Nat> #.Nat)) - - _ - (!discrete-output number.Codec<Text,Nat> #.Nat)))) - -(def: (parse-int start [where offset source-code]) - (-> Offset Parser) - (loop [end offset] - (case ("lux text char" source-code end) - (#.Some char) - (if (!digit?+ char) - (recur (!inc end)) - (!discrete-output number.Codec<Text,Int> #.Int)) - - _ - (!discrete-output number.Codec<Text,Int> #.Int)))) - -(def: (parse-rev start [where offset source-code]) - (-> Offset Parser) - (loop [end offset] - (case ("lux text char" source-code end) - (#.Some char) - (if (!digit?+ char) - (recur (!inc end)) - (!discrete-output number.Codec<Text,Rev> #.Rev)) - - _ - (!discrete-output number.Codec<Text,Rev> #.Rev)))) +(do-template [<name> <codec> <tag>] + [(def: (<name> start [where offset source-code]) + (-> Offset Parser) + (loop [end offset] + (<| (!with-char source-code end char (!discrete-output <codec> <tag>)) + (if (!digit?+ char) + (recur (!inc end)) + (!discrete-output <codec> <tag>)))))] + + [parse-nat number.Codec<Text,Nat> #.Nat] + [parse-int number.Codec<Text,Int> #.Int] + [parse-rev number.Codec<Text,Rev> #.Rev] + ) -(template: (!parse-int offset where source-code) +(template: (!parse-int offset where source-code @end) (let [g!offset/1 (!inc offset)] - (<| (!with-char source-code g!offset/1 g!char/1) + (<| (!with-char source-code g!offset/1 g!char/1 @end) (if (!digit? g!char/1) (parse-int offset [where (!inc/2 offset) source-code]) (!parse-full-name offset [where (!inc offset) source-code] where #.Identifier))))) @@ -344,16 +323,12 @@ (def: (parse-name-part start [where offset source-code]) (-> Offset Source (Error [Source Text])) (loop [end offset] - (case ("lux text char" source-code end) - (#.Some char) - (cond (!name-char? char) - (recur (!inc end)) + (<| (!with-char source-code end char <output>) + (cond (!name-char? char) + (recur (!inc end)) - ## else - <output>) - - _ - <output>)))) + ## else + <output>))))) (template: (!new-line where) (let [[where::file where::line where::column] where] @@ -364,14 +339,6 @@ <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) - (#.Some @char) - @body - - _ - <end>)) - (template: (!parse-half-name @offset//pre @offset//post @char @module) (let [@offset//post (!inc @offset//pre)] (cond (!name-char?|head @char) @@ -387,11 +354,11 @@ (`` (def: (parse-short-name current-module [where offset/0 source-code]) (-> Text Source (Error [Source Name])) - (<| (!with-char source-code offset/0 char/0) + (<| (!with-char source-code offset/0 char/0 <end>) (case char/0 (^ (char (~~ (static ..name-separator)))) (let [offset/1 (!inc offset/0)] - (<| (!with-char source-code offset/1 char/1) + (<| (!with-char source-code offset/1 char/1 <end>) (!parse-half-name offset/1 offset/2 char/1 current-module))) _ @@ -411,23 +378,19 @@ (case (..parse-name-part start source) (#error.Success [source' simple]) (let [[where' offset' source-code'] source'] - (case ("lux text char" source-code' offset') - (#.Some char/separator) - (case char/separator - (^ (char (~~ (static ..name-separator)))) - (let [offset'' (!inc offset')] - (case (..parse-name-part offset'' [where' offset'' source-code']) - (#error.Success [source'' complex]) - (#error.Success [source'' [simple complex]]) - - (#error.Error error) - (#error.Error error))) + (<| (!with-char source-code' offset' char/separator <simple>) + (case char/separator + (^ (char (~~ (static ..name-separator)))) + (let [offset'' (!inc offset')] + (case (..parse-name-part offset'' [where' offset'' source-code']) + (#error.Success [source'' complex]) + (#error.Success [source'' [simple complex]]) + + (#error.Error error) + (#error.Error error))) - _ - <simple>) - - _ - <simple>)) + _ + <simple>))) (#error.Error error) (#error.Error error))))) @@ -444,7 +407,7 @@ (-> Text Aliases Source (Error [Source Code])) (let [parse' (parse current-module aliases)] (loop [[where offset/0 source-code] source] - (<| (!with-char source-code offset/0 char/0) + (<| (!with-char source-code offset/0 char/0 <end>) (`` (case char/0 ## White-space (^template [<char> <direction>] @@ -477,7 +440,7 @@ ## Special code (^ (char (~~ (static ..sigil)))) (let [offset/1 (!inc offset/0)] - (<| (!with-char source-code offset/1 char/1) + (<| (!with-char source-code offset/1 char/1 <end>) (case char/1 (^template [<char> <bit>] (^ (char <char>)) @@ -509,14 +472,14 @@ (^ (char (~~ (static ..name-separator)))) (let [offset/1 (!inc offset/0)] - (<| (!with-char source-code offset/1 char/1) + (<| (!with-char source-code offset/1 char/1 <end>) (if (!digit? char/1) (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/0 where source-code)) + (!parse-int offset/0 where source-code <end>)) ([(~~ (static ..positive-sign))] [(~~ (static ..negative-sign))]) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index f2845f48c..efd965d1b 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -178,9 +178,11 @@ ) ## [Values & Syntax] +(type: Char Nat) + (def: (get-char! full idx) - (-> Text Nat Text) - ("lux text clip" full idx ("lux i64 +" 1 idx))) + (-> Text Nat Char) + ("lux text char" full idx)) (def: (binary-character value) (-> Nat (Maybe Text)) @@ -190,10 +192,10 @@ _ #.None)) (def: (binary-value digit) - (-> Text (Maybe Nat)) + (-> Char (Maybe Nat)) (case digit - "0" (#.Some 0) - "1" (#.Some 1) + (^ (char "0")) (#.Some 0) + (^ (char "1")) (#.Some 1) _ #.None)) (def: (octal-character value) @@ -210,16 +212,16 @@ _ #.None)) (def: (octal-value digit) - (-> Text (Maybe Nat)) + (-> Char (Maybe Nat)) (case digit - "0" (#.Some 0) - "1" (#.Some 1) - "2" (#.Some 2) - "3" (#.Some 3) - "4" (#.Some 4) - "5" (#.Some 5) - "6" (#.Some 6) - "7" (#.Some 7) + (^ (char "0")) (#.Some 0) + (^ (char "1")) (#.Some 1) + (^ (char "2")) (#.Some 2) + (^ (char "3")) (#.Some 3) + (^ (char "4")) (#.Some 4) + (^ (char "5")) (#.Some 5) + (^ (char "6")) (#.Some 6) + (^ (char "7")) (#.Some 7) _ #.None)) (def: (decimal-character value) @@ -238,18 +240,18 @@ _ #.None)) (def: (decimal-value digit) - (-> Text (Maybe Nat)) + (-> Char (Maybe Nat)) (case digit - "0" (#.Some 0) - "1" (#.Some 1) - "2" (#.Some 2) - "3" (#.Some 3) - "4" (#.Some 4) - "5" (#.Some 5) - "6" (#.Some 6) - "7" (#.Some 7) - "8" (#.Some 8) - "9" (#.Some 9) + (^ (char "0")) (#.Some 0) + (^ (char "1")) (#.Some 1) + (^ (char "2")) (#.Some 2) + (^ (char "3")) (#.Some 3) + (^ (char "4")) (#.Some 4) + (^ (char "5")) (#.Some 5) + (^ (char "6")) (#.Some 6) + (^ (char "7")) (#.Some 7) + (^ (char "8")) (#.Some 8) + (^ (char "9")) (#.Some 9) _ #.None)) (def: (hexadecimal-character value) @@ -274,24 +276,24 @@ _ #.None)) (def: (hexadecimal-value digit) - (-> Text (Maybe Nat)) + (-> Char (Maybe Nat)) (case digit - "0" (#.Some 0) - "1" (#.Some 1) - "2" (#.Some 2) - "3" (#.Some 3) - "4" (#.Some 4) - "5" (#.Some 5) - "6" (#.Some 6) - "7" (#.Some 7) - "8" (#.Some 8) - "9" (#.Some 9) - (^or "a" "A") (#.Some 10) - (^or "b" "B") (#.Some 11) - (^or "c" "C") (#.Some 12) - (^or "d" "D") (#.Some 13) - (^or "e" "E") (#.Some 14) - (^or "f" "F") (#.Some 15) + (^ (char "0")) (#.Some 0) + (^ (char "1")) (#.Some 1) + (^ (char "2")) (#.Some 2) + (^ (char "3")) (#.Some 3) + (^ (char "4")) (#.Some 4) + (^ (char "5")) (#.Some 5) + (^ (char "6")) (#.Some 6) + (^ (char "7")) (#.Some 7) + (^ (char "8")) (#.Some 8) + (^ (char "9")) (#.Some 9) + (^or (^ (char "a")) (^ (char "A"))) (#.Some 10) + (^or (^ (char "b")) (^ (char "B"))) (#.Some 11) + (^or (^ (char "c")) (^ (char "C"))) (#.Some 12) + (^or (^ (char "d")) (^ (char "D"))) (#.Some 13) + (^or (^ (char "e")) (^ (char "E"))) (#.Some 14) + (^or (^ (char "f")) (^ (char "F"))) (#.Some 15) _ #.None)) (do-template [<struct> <base> <to-character> <to-value> <error>] @@ -337,17 +339,17 @@ (def: (int/sign?? representation) (-> Text (Maybe Int)) (case (get-char! representation 0) - "-" + (^ (char "-")) (#.Some -1) - "+" + (^ (char "+")) (#.Some +1) _ #.None)) (def: (int-decode-loop input-size repr sign <base> <to-value> <error>) - (-> Nat Text Int Int (-> Text (Maybe Nat)) Text (Error Int)) + (-> Nat Text Int Int (-> Char (Maybe Nat)) Text (Error Int)) (loop [idx 1 output +0] (if (n/< input-size idx) @@ -397,32 +399,36 @@ ("lux text clip" input 1 ("lux text size" input))) (do-template [<struct> <nat> <char-bit-size> <error>] - [(structure: #export <struct> (Codec Text Rev) - (def: (encode value) - (let [raw-output (de-prefix (:: <nat> encode (:coerce Nat value))) - max-num-chars (n// <char-bit-size> 64) - raw-size ("lux text size" raw-output) - zero-padding (loop [zeroes-left (n/- raw-size max-num-chars) - output ""] - (if (n/= 0 zeroes-left) - output - (recur (dec zeroes-left) - ("lux text concat" "0" output)))) - padded-output ("lux text concat" zero-padding raw-output)] - ("lux text concat" "." padded-output))) - - (def: (decode repr) - (let [repr-size ("lux text size" repr)] - (if (n/>= 2 repr-size) - (case ("lux text char" repr 0) - (^multi (^ (#.Some (char "."))) - [(:: <nat> decode (de-prefix repr)) - (#error.Success output)]) - (#error.Success (:coerce Rev output)) - - _ - (#error.Error ("lux text concat" <error> repr))) - (#error.Error ("lux text concat" <error> repr))))))] + [(with-expansions [<error-output> (as-is (#error.Error ("lux text concat" <error> repr)))] + (structure: #export <struct> (Codec Text Rev) + (def: (encode value) + (let [raw-output (de-prefix (:: <nat> encode (:coerce Nat value))) + max-num-chars (n// <char-bit-size> 64) + raw-size ("lux text size" raw-output) + zero-padding (loop [zeroes-left (n/- raw-size max-num-chars) + output ""] + (if (n/= 0 zeroes-left) + output + (recur (dec zeroes-left) + ("lux text concat" "0" output)))) + padded-output ("lux text concat" zero-padding raw-output)] + ("lux text concat" "." padded-output))) + + (def: (decode repr) + (let [repr-size ("lux text size" repr)] + (if (n/>= 2 repr-size) + (case ("lux text char" repr 0) + (^ (char ".")) + (case (:: <nat> decode (de-prefix repr)) + (#error.Success output) + (#error.Success (:coerce Rev output)) + + _ + <error-output>) + + _ + <error-output>) + <error-output>)))))] [Binary@Codec<Text,Rev> Binary@Codec<Text,Nat> 1 "Invalid binary syntax: "] [Octal@Codec<Text,Rev> Octal@Codec<Text,Nat> 3 "Invalid octal syntax: "] @@ -442,9 +448,9 @@ (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>))] + digit-idx (|> shifted (f/% <base>) frac-to-int .nat)] (recur (f/% +1.0 shifted) - ("lux text concat" output digit))))))] + ("lux text concat" output ("lux text clip" <char-set> digit-idx (inc digit-idx))))))))] ("lux text concat" whole-part decimal-part))) (def: (decode repr) @@ -826,7 +832,7 @@ (loop [idx 0 output (make-digits [])] (if (n/< length idx) - (case ("lux text index" "+0123456789" (get-char! input idx) 0) + (case ("lux text index" "+0123456789" ("lux text clip" input idx (inc idx)) 0) #.None #.None diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index c33ab03a3..18ad49032 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -38,7 +38,9 @@ (def: #export (nth idx input) (-> Nat Text (Maybe Nat)) - ("lux text char" input idx)) + (if (n/< ("lux text size" input) idx) + (#.Some ("lux text char" input idx)) + #.None)) (def: #export (index-of' pattern from input) (-> Text Nat Text (Maybe Nat)) @@ -204,12 +206,11 @@ (loop [idx 0 hash 0] (if (n/< length idx) - (let [char (|> idx ("lux text char" input) (maybe.default 0))] - (recur (inc idx) - (|> hash - (i64.left-shift 5) - (n/- hash) - (n/+ char)))) + (recur (inc idx) + (|> hash + (i64.left-shift 5) + (n/- hash) + (n/+ ("lux text char" input idx)))) hash))))))) (def: #export concat 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 cfc164df9..108b350d0 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 @@ -165,7 +165,7 @@ (test "Can query the size/length of a text." (check-success+ "lux text size" (list subjectC) Nat)) (test "Can obtain the character code of a text at a given index." - (check-success+ "lux text char" (list subjectC fromC) (type (Maybe Nat)))) + (check-success+ "lux text char" (list subjectC fromC) Nat)) (test "Can clip a piece of text between 2 indices." (check-success+ "lux text clip" (list subjectC fromC toC) Text)) )))) |