diff options
Diffstat (limited to 'stdlib/source')
| -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 |
5 files changed, 90 insertions, 98 deletions
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])) |