aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux.lux25
-rw-r--r--stdlib/source/lux/compiler/default/syntax.lux197
-rw-r--r--stdlib/source/lux/data/number.lux154
-rw-r--r--stdlib/source/lux/data/text.lux15
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux2
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))
))))