diff options
Diffstat (limited to 'stdlib/source/lux/data')
| -rw-r--r-- | stdlib/source/lux/data/bit.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/data/collection/dictionary.lux | 10 | ||||
| -rw-r--r-- | stdlib/source/lux/data/collection/list.lux | 22 | ||||
| -rw-r--r-- | stdlib/source/lux/data/collection/sequence.lux | 13 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/css.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/html.lux | 18 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/json.lux | 40 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/xml.lux | 22 | ||||
| -rw-r--r-- | stdlib/source/lux/data/maybe.lux | 13 | ||||
| -rw-r--r-- | stdlib/source/lux/data/number.lux | 232 | ||||
| -rw-r--r-- | stdlib/source/lux/data/text.lux | 76 | ||||
| -rw-r--r-- | stdlib/source/lux/data/text/lexer.lux | 255 | ||||
| -rw-r--r-- | stdlib/source/lux/data/text/regex.lux | 109 |
13 files changed, 464 insertions, 352 deletions
diff --git a/stdlib/source/lux/data/bit.lux b/stdlib/source/lux/data/bit.lux index 026f8bcab..8cf671429 100644 --- a/stdlib/source/lux/data/bit.lux +++ b/stdlib/source/lux/data/bit.lux @@ -45,7 +45,7 @@ ## [Values] (def: #export complement - {#.doc "Generates the complement of a predicate. - That is a predicate that returns the oposite of the original predicate."} + {#.doc (doc "Generates the complement of a predicate." + "That is a predicate that returns the oposite of the original predicate.")} (All [a] (-> (-> a Bit) (-> a Bit))) (compose not)) diff --git a/stdlib/source/lux/data/collection/dictionary.lux b/stdlib/source/lux/data/collection/dictionary.lux index e61d657a5..503ea312d 100644 --- a/stdlib/source/lux/data/collection/dictionary.lux +++ b/stdlib/source/lux/data/collection/dictionary.lux @@ -623,18 +623,16 @@ ) (def: #export (merge dict2 dict1) - {#.doc "Merges 2 dictionaries. - - If any collisions with keys occur, the values of dict2 will overwrite those of dict1."} + {#.doc (doc "Merges 2 dictionaries." + "If any collisions with keys occur, the values of dict2 will overwrite those of dict1.")} (All [k v] (-> (Dictionary k v) (Dictionary k v) (Dictionary k v))) (list/fold (function (_ [key val] dict) (put key val dict)) dict1 (entries dict2))) (def: #export (merge-with f dict2 dict1) - {#.doc "Merges 2 dictionaries. - - If any collisions with keys occur, a new value will be computed by applying 'f' to the values of dict2 and dict1."} + {#.doc (doc "Merges 2 dictionaries." + "If any collisions with keys occur, a new value will be computed by applying 'f' to the values of dict2 and dict1.")} (All [k v] (-> (-> v v v) (Dictionary k v) (Dictionary k v) (Dictionary k v))) (list/fold (function (_ [key val2] dict) (case (get key dict) diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux index d11f0a080..c49a7ba9f 100644 --- a/stdlib/source/lux/data/collection/list.lux +++ b/stdlib/source/lux/data/collection/list.lux @@ -53,9 +53,8 @@ [(filter p xs) (filter (complement p) xs)]) (def: #export (as-pairs xs) - {#.doc "Cut the list into pairs of 2. - - Caveat emptor: If the list has an uneven number of elements, the last one will be skipped."} + {#.doc (doc "Cut the list into pairs of 2." + "Caveat emptor: If the list has an uneven number of elements, the last one will be skipped.")} (All [a] (-> (List a) (List [a a]))) (case xs (^ (#.Cons [x1 (#.Cons [x2 xs'])])) @@ -436,8 +435,8 @@ (identifier$ ("lux text concat" base "'"))])))) pattern (` [(~+ (map (function (_ [v vs]) (` (#.Cons (~ v) (~ vs)))) vars+lists))]) - g!step (identifier$ "\tstep\t") - g!blank (identifier$ "\t_\t") + g!step (identifier$ "0step0") + g!blank (identifier$ "0_0") list-vars (map product.right vars+lists) code (` (: (~ zip-type) (function ((~ g!step) (~+ list-vars)) @@ -467,8 +466,8 @@ (if (n/> 0 num-lists) (let [(^open ".") Functor<List> indices (..indices num-lists) - g!return-type (identifier$ "\treturn-type\t") - g!func (identifier$ "\tfunc\t") + g!return-type (identifier$ "0return-type0") + g!func (identifier$ "0func0") type-vars (: (List Code) (map (|>> nat/encode identifier$) indices)) zip-type (` (All [(~+ type-vars) (~ g!return-type)] (-> (-> (~+ type-vars) (~ g!return-type)) @@ -483,8 +482,8 @@ (identifier$ ("lux text concat" base "'"))])))) pattern (` [(~+ (map (function (_ [v vs]) (` (#.Cons (~ v) (~ vs)))) vars+lists))]) - g!step (identifier$ "\tstep\t") - g!blank (identifier$ "\t_\t") + g!step (identifier$ "0step0") + g!blank (identifier$ "0_0") list-vars (map product.right vars+lists) code (` (: (~ zip-type) (function ((~ g!step) (~ g!func) (~+ list-vars)) @@ -517,9 +516,8 @@ (last xs'))) (def: #export (inits xs) - {#.doc "For a list of size N, returns the first N-1 elements. - - Empty lists will result in a #.None value being returned instead."} + {#.doc (doc "For a list of size N, returns the first N-1 elements." + "Empty lists will result in a #.None value being returned instead.")} (All [a] (-> (List a) (Maybe (List a)))) (case xs #.Nil diff --git a/stdlib/source/lux/data/collection/sequence.lux b/stdlib/source/lux/data/collection/sequence.lux index 6529a1ced..06209f4d6 100644 --- a/stdlib/source/lux/data/collection/sequence.lux +++ b/stdlib/source/lux/data/collection/sequence.lux @@ -41,9 +41,8 @@ (pending [x (repeat x)])) (def: #export (cycle xs) - {#.doc "Go over the elements of a list forever. - - The list should not be empty."} + {#.doc (doc "Go over the elements of a list forever." + "The list should not be empty.")} (All [a] (-> (List a) (Maybe (Sequence a)))) (case xs @@ -111,11 +110,9 @@ (filter p xs')))) (def: #export (partition p xs) - {#.doc "Split a sequence in two based on a predicate. - - The left side contains all entries for which the predicate is #1. - - The right side contains all entries for which the predicate is #0."} + {#.doc (doc "Split a sequence in two based on a predicate." + "The left side contains all entries for which the predicate is #1." + "The right side contains all entries for which the predicate is #0.")} (All [a] (-> (-> a Bit) (Sequence a) [(Sequence a) (Sequence a)])) [(filter p xs) (filter (complement p) xs)]) diff --git a/stdlib/source/lux/data/format/css.lux b/stdlib/source/lux/data/format/css.lux index 083195972..fbdad1885 100644 --- a/stdlib/source/lux/data/format/css.lux +++ b/stdlib/source/lux/data/format/css.lux @@ -37,7 +37,7 @@ (if (list.empty? style) "" (format selector "{" (inline style) "}")))) - (text.join-with "\n"))) + (text.join-with text.new-line))) (def: #export (rgb color) (-> Color Value) diff --git a/stdlib/source/lux/data/format/html.lux b/stdlib/source/lux/data/format/html.lux index cc5e6d0e9..45a7117ad 100644 --- a/stdlib/source/lux/data/format/html.lux +++ b/stdlib/source/lux/data/format/html.lux @@ -18,7 +18,7 @@ (text.replace-all "&" "&") (text.replace-all "<" "<") (text.replace-all ">" ">") - (text.replace-all "\"" """) + (text.replace-all text.double-quote """) (text.replace-all "'" "'") (text.replace-all "/" "/"))) @@ -28,7 +28,7 @@ (def: attrs-to-text (-> Attributes Text) - (|>> (list/map (function (_ [key val]) (format key "=" "\"" (text val) "\""))) + (|>> (list/map (function (_ [key val]) (format key "=" text.double-quote (text val) text.double-quote))) (text.join-with " "))) (def: #export (tag name attrs children) @@ -39,13 +39,15 @@ "</" name ">")) (do-template [<name> <doc-type>] - [(def: #export (<name> document) + [(def: #export <name> (-> HTML HTML) - (format <doc-type> - document))] + (let [doc-type <doc-type>] + (function (_ document) + (format doc-type + document))))] [html-5 "<!DOCTYPE html>"] - [html-4_01 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">"] - [xhtml-1_0 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"] - [xhtml-1_1 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">"] + [html-4_01 (format "<!DOCTYPE HTML PUBLIC " text.double-quote "-//W3C//DTD HTML 4.01//EN" text.double-quote " " text.double-quote "http://www.w3.org/TR/html4/strict.dtd" text.double-quote ">")] + [xhtml-1_0 (format "<!DOCTYPE html PUBLIC " text.double-quote "-//W3C//DTD XHTML 1.0 Strict//EN" text.double-quote " " text.double-quote "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd" text.double-quote ">")] + [xhtml-1_1 (format "<!DOCTYPE html PUBLIC " text.double-quote "-//W3C//DTD XHTML 1.1//EN" text.double-quote " " text.double-quote "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd" text.double-quote ">")] ) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 3594ef28c..20f059503 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -1,6 +1,5 @@ -(.module: {#.doc "Functionality for reading and writing values in the JSON format. - - For more information, please see: http://www.json.org/"} +(.module: {#.doc (.doc "Functionality for reading and writing values in the JSON format." + "For more information, please see: http://www.json.org/")} [lux #* [control ["." monad (#+ do Monad)] @@ -114,10 +113,10 @@ (#e.Success value) #.None - (#e.Error ($_ text/compose "Missing field \"" key "\" on object."))) + (#e.Error ($_ text/compose "Missing field '" key "' on object."))) _ - (#e.Error ($_ text/compose "Cannot get field \"" key "\" of a non-object.")))) + (#e.Error ($_ text/compose "Cannot get field '" key "' of a non-object.")))) (def: #export (set key value json) {#.doc "A JSON object field setter."} @@ -127,7 +126,7 @@ (#e.Success (#Object (dict.put key value obj))) _ - (#e.Error ($_ text/compose "Cannot set field \"" key "\" of a non-object.")))) + (#e.Error ($_ text/compose "Cannot set field '" key "' of a non-object.")))) (do-template [<name> <tag> <type> <desc>] [(def: #export (<name> key json) @@ -353,7 +352,7 @@ (fail error)) _ - (fail ($_ text/compose "JSON object does not have field \"" field-name "\"."))) + (fail ($_ text/compose "JSON object does not have field '" field-name "'."))) _ (fail "JSON value is not an object.")))) @@ -453,22 +452,29 @@ (def: escaped~ (l.Lexer Text) ($_ p.either - (p.after (l.this "\\t") (parser/wrap "\t")) - (p.after (l.this "\\b") (parser/wrap "\b")) - (p.after (l.this "\\n") (parser/wrap "\n")) - (p.after (l.this "\\r") (parser/wrap "\r")) - (p.after (l.this "\\f") (parser/wrap "\f")) - (p.after (l.this "\\\"") (parser/wrap "\"")) - (p.after (l.this "\\\\") (parser/wrap "\\")))) + (p.after (l.this "\t") + (parser/wrap text.tab)) + (p.after (l.this "\b") + (parser/wrap text.back-space)) + (p.after (l.this "\n") + (parser/wrap text.new-line)) + (p.after (l.this "\r") + (parser/wrap text.carriage-return)) + (p.after (l.this "\f") + (parser/wrap text.form-feed)) + (p.after (l.this (text/compose "\" text.double-quote)) + (parser/wrap text.double-quote)) + (p.after (l.this "\\") + (parser/wrap "\")))) (def: string~ (l.Lexer String) - (<| (l.enclosed ["\"" "\""]) + (<| (l.enclosed [text.double-quote text.double-quote]) (loop [_ []]) (do p.Monad<Parser> - [chars (l.some (l.none-of "\\\"")) + [chars (l.some (l.none-of (text/compose "\" text.double-quote))) stop l.peek]) - (if (text/= "\\" stop) + (if (text/= "\" stop) (do @ [escaped escaped~ next-chars (recur [])] diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index 61215813b..0ed744b46 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -33,7 +33,7 @@ (p.after (l.this ">") (parser/wrap ">")) (p.after (l.this "&") (parser/wrap "&")) (p.after (l.this "'") (parser/wrap "'")) - (p.after (l.this """) (parser/wrap "\"")))) + (p.after (l.this """) (parser/wrap text.double-quote)))) (def: xml-unicode-escape-char^ (l.Lexer Text) @@ -56,7 +56,7 @@ (def: xml-char^ (l.Lexer Text) - (p.either (l.none-of "<>&'\"") + (p.either (l.none-of ($_ text/compose "<>&'" text.double-quote)) xml-escape-char^)) (def: xml-identifier @@ -92,7 +92,7 @@ (def: attr-value^ (l.Lexer Text) (let [value^ (l.some xml-char^)] - (p.either (l.enclosed ["\"" "\""] value^) + (p.either (l.enclosed [text.double-quote text.double-quote] value^) (l.enclosed ["'" "'"] value^)))) (def: attrs^ @@ -110,9 +110,9 @@ spaced^ (p.after (l.this "/")) (l.enclosed ["<" ">"]))] - (p.assert ($_ text/compose "Close tag does not match open tag.\n" - "Expected: " (name/encode expected) "\n" - " Actual: " (name/encode actual) "\n") + (p.assert ($_ text/compose "Close tag does not match open tag." text.new-line + "Expected: " (name/encode expected) text.new-line + " Actual: " (name/encode actual) text.new-line) (name/= expected actual)))) (def: comment^ @@ -181,7 +181,7 @@ (text.replace-all "<" "<") (text.replace-all ">" ">") (text.replace-all "'" "'") - (text.replace-all "\"" """))) + (text.replace-all text.double-quote """))) (def: (write-tag [namespace name]) (-> Tag Text) @@ -194,12 +194,12 @@ (|> attrs d.entries (list/map (function (_ [key value]) - ($_ text/compose (write-tag key) "=" "\""(sanitize-value value) "\""))) + ($_ text/compose (write-tag key) "=" text.double-quote (sanitize-value value) text.double-quote))) (text.join-with " "))) (def: xml-header Text - "<?xml version=\"1.0\" encoding=\"UTF-8\"?>") + ($_ text/compose "<?xml version=" text.double-quote "1.0" text.double-quote " encoding=" text.double-quote "UTF-8" text.double-quote "?>")) (def: #export (write input) (-> XML Text) @@ -254,10 +254,12 @@ (exception: #export (wrong-tag {tag Name}) (name/encode tag)) +(def: blank-line ($_ text/compose text.new-line text.new-line)) + (exception: #export (unconsumed-inputs {inputs (List XML)}) (|> inputs (list/map (:: Codec<Text,XML> encode)) - (text.join-with "\n\n"))) + (text.join-with blank-line))) (def: #export text (Reader Text) diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux index 57ff95727..d0dfe1886 100644 --- a/stdlib/source/lux/data/maybe.lux +++ b/stdlib/source/lux/data/maybe.lux @@ -82,11 +82,14 @@ (monad.lift Monad<M> (:: Monad<Maybe> wrap))) (macro: #export (default tokens state) - {#.doc "## Allows you to provide a default value that will be used - ## if a (Maybe x) value turns out to be #.None. - (default +20 (#.Some +10)) => +10 - - (default +20 #.None) => +20"} + {#.doc (doc "Allows you to provide a default value that will be used" + "if a (Maybe x) value turns out to be #.None." + (default +20 (#.Some +10)) + "=>" + +10 + (default +20 #.None) + "=>" + +20)} (case tokens (^ (list else maybe)) (let [g!temp (: Code [dummy-cursor (#.Identifier ["" ""])]) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index 4b3b786b4..efd965d1b 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -178,9 +178,11 @@ ) ## [Values & Syntax] -(def: (get-char full idx) - (-> Text Nat (Maybe Text)) - ("lux text clip" full idx (inc idx))) +(type: Char Nat) + +(def: (get-char! full 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>] @@ -312,14 +314,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,29 +338,28 @@ (def: (int/sign?? representation) (-> Text (Maybe Int)) - (case (get-char representation 0) - (^ (#.Some "-")) + (case (get-char! representation 0) + (^ (char "-")) (#.Some -1) - (^ (#.Some "+")) + (^ (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) - (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,35 +396,39 @@ (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) - (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: "] @@ -444,17 +448,16 @@ (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-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) (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 +501,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 +630,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 +649,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)) @@ -674,15 +677,13 @@ encoding " number, generates a Nat, an Int, a Rev or a Frac.") underscore "Allows for the presence of underscore in the numbers." - description [cursor (#.Text ($_ "lux text concat" - encoding "\n" - underscore))]] + description [cursor (#.Text ($_ "lux text concat" encoding " " underscore))]] (#error.Success [state (list (` (doc (~ description) (~ example-1) (~ example-2))))])) _ - (#error.Error "Wrong syntax for \"encoding-doc\"."))) + (#error.Error "Wrong syntax for 'encoding-doc'."))) (def: (underscore-prefixed? number) (-> Text Bit) @@ -831,14 +832,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" ("lux text clip" input idx (inc idx)) 0) + #.None + #.None + + (#.Some digit) + (recur (inc idx) + (digits-put idx digit output))) (#.Some output))) #.None))) @@ -902,9 +902,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 48f35febe..18ad49032 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -16,13 +16,31 @@ [compiler ["." host]]]) +(def: #export from-code + (-> Nat Text) + (|>> (:coerce Int) "lux int char")) + +(do-template [<name> <code>] + [(def: #export <name> (from-code <code>))] + + [back-space 8] + [tab 9] + [new-line 10] + [vertical-tab 11] + [form-feed 12] + [carriage-return 13] + [double-quote 34] + ) + (def: #export (size x) (-> Text Nat) ("lux text size" x)) (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)) @@ -89,11 +107,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])) @@ -122,7 +146,7 @@ (#.Cons sample #.Nil))) (def: #export split-lines - (..split-all-with "\n")) + (..split-all-with ..new-line)) (def: #export (replace-once pattern value template) (-> Text Text Text Text) @@ -182,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 @@ -218,28 +241,19 @@ (def: #export encode (-> Text Text) - (|>> (replace-all "\\" "\\\\") - (replace-all "\t" "\\t") - (replace-all "\v" "\\v") - (replace-all "\b" "\\b") - (replace-all "\n" "\\n") - (replace-all "\r" "\\r") - (replace-all "\f" "\\f") - (replace-all "\"" "\\\"") - (..enclose' "\""))) - -(def: #export from-code - (-> Nat Text) - (|>> (:coerce Int) "lux int char")) + (..enclose' ..double-quote)) (def: #export (space? char) {#.doc "Checks whether the character is white-space."} (-> Nat Bit) - (case char - (^or (^ (char "\t")) (^ (char "\v")) - (^ (char " ")) (^ (char "\n")) - (^ (char "\r")) (^ (char "\f"))) - #1 - - _ - #0)) + (`` (case char + (^or (^ (char (~~ (static ..tab)))) + (^ (char (~~ (static ..vertical-tab)))) + (^ (char " ")) + (^ (char (~~ (static ..new-line)))) + (^ (char (~~ (static ..carriage-return)))) + (^ (char (~~ (static ..form-feed))))) + #1 + + _ + #0))) diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux index 481d17b0a..21aba8360 100644 --- a/stdlib/source/lux/data/text/lexer.lux +++ b/stdlib/source/lux/data/text/lexer.lux @@ -4,25 +4,29 @@ [monad (#+ do Monad)] ["p" parser]] [data - ["." text ("text/." Monoid<Text>)] ["." product] ["." maybe] ["e" error] [collection - ["." list]]] + ["." list ("list/." Fold<List>)]]] [macro - ["." code]]]) + ["." code]]] + ["." // ("text/." Monoid<Text>)]) -(type: Offset Nat) +(type: #export Offset Nat) (def: start-offset Offset 0) (type: #export Lexer (p.Parser [Offset Text])) +(type: #export Slice + {#basis Offset + #distance Offset}) + (def: (remaining offset tape) (-> Offset Text Text) - (|> tape (text.split offset) maybe.assume product.right)) + (|> tape (//.split offset) maybe.assume product.right)) (def: cannot-lex-error Text "Cannot lex from empty text.") @@ -37,54 +41,85 @@ (#e.Error msg) (#e.Success [[end-offset _] output]) - (if (n/= end-offset (text.size input)) + (if (n/= end-offset (//.size input)) (#e.Success output) (#e.Error (unconsumed-input-error end-offset input))) )) +(def: #export offset + (Lexer Offset) + (function (_ (^@ input [offset tape])) + (#e.Success [input offset]))) + +(def: (with-slices lexer) + (-> (Lexer (List Slice)) (Lexer Slice)) + (do p.Monad<Parser> + [offset ..offset + slices lexer] + (wrap (list/fold (function (_ [slice::basis slice::distance] + [total::basis total::distance]) + [total::basis ("lux i64 +" slice::distance total::distance)]) + {#basis offset + #distance 0} + slices)))) + (def: #export any {#.doc "Just returns the next character without applying any logic."} (Lexer Text) (function (_ [offset tape]) - (case (text.nth offset tape) + (case (//.nth offset tape) (#.Some output) - (#e.Success [[(inc offset) tape] (text.from-code output)]) + (#e.Success [[("lux i64 +" 1 offset) tape] (//.from-code output)]) _ - (#e.Error cannot-lex-error)) - )) + (#e.Error cannot-lex-error)))) -(def: #export (not p) - {#.doc "Produce a character if the lexer fails."} - (All [a] (-> (Lexer a) (Lexer Text))) - (function (_ input) - (case (p input) - (#e.Error msg) - (any input) - - _ - (#e.Error "Expected to fail; yet succeeded.")))) +(def: #export any! + {#.doc "Just returns the next character without applying any logic."} + (Lexer Slice) + (function (_ [offset tape]) + (#e.Success [[("lux i64 +" 1 offset) tape] + {#basis offset + #distance 1}]))) + +(do-template [<name> <type> <any>] + [(def: #export (<name> p) + {#.doc "Produce a character if the lexer fails."} + (All [a] (-> (Lexer a) (Lexer <type>))) + (function (_ input) + (case (p input) + (#e.Error msg) + (<any> input) + + _ + (#e.Error "Expected to fail; yet succeeded."))))] + + [not Text ..any] + [not! Slice ..any!] + ) (def: #export (this reference) {#.doc "Lex a text if it matches the given sample."} (-> Text (Lexer Any)) (function (_ [offset tape]) - (case (text.index-of' reference offset tape) + (case (//.index-of' reference offset tape) (#.Some where) (if (n/= offset where) - (#e.Success [[(n/+ (text.size reference) offset) tape] []]) - (#e.Error ($_ text/compose "Could not match: " (text.encode reference) " @ " (maybe.assume (text.clip' offset tape))))) + (#e.Success [[("lux i64 +" (//.size reference) offset) tape] + []]) + (#e.Error ($_ text/compose "Could not match: " (//.encode reference) " @ " (maybe.assume (//.clip' offset tape))))) _ - (#e.Error ($_ text/compose "Could not match: " (text.encode reference)))))) + (#e.Error ($_ text/compose "Could not match: " (//.encode reference)))))) (def: #export (this? reference) {#.doc "Lex a text if it matches the given sample."} (-> Text (Lexer Bit)) (function (_ (^@ input [offset tape])) - (case (text.index-of' reference offset tape) + (case (//.index-of' reference offset tape) (^multi (#.Some where) (n/= offset where)) - (#e.Success [[(n/+ (text.size reference) offset) tape] #1]) + (#e.Success [[("lux i64 +" (//.size reference) offset) tape] + #1]) _ (#e.Success [input #0])))) @@ -93,7 +128,7 @@ {#.doc "Ensure the lexer's input is empty."} (Lexer Any) (function (_ (^@ input [offset tape])) - (if (n/= offset (text.size tape)) + (if (n/= offset (//.size tape)) (#e.Success [input []]) (#e.Error (unconsumed-input-error offset tape))))) @@ -101,19 +136,18 @@ {#.doc "Ask if the lexer's input is empty."} (Lexer Bit) (function (_ (^@ input [offset tape])) - (#e.Success [input (n/= offset (text.size tape))]))) + (#e.Success [input (n/= offset (//.size tape))]))) (def: #export peek {#.doc "Lex the next character (without consuming it from the input)."} (Lexer Text) (function (_ (^@ input [offset tape])) - (case (text.nth offset tape) + (case (//.nth offset tape) (#.Some output) - (#e.Success [input (text.from-code output)]) + (#e.Success [input (//.from-code output)]) _ - (#e.Error cannot-lex-error)) - )) + (#e.Error cannot-lex-error)))) (def: #export get-input {#.doc "Get all of the remaining input (without consuming it)."} @@ -126,8 +160,8 @@ (-> Nat Nat (Lexer Text)) (do p.Monad<Parser> [char any - #let [char' (maybe.assume (text.nth 0 char))] - _ (p.assert ($_ text/compose "Character is not within range: " (text.from-code bottom) "-" (text.from-code top)) + #let [char' (maybe.assume (//.nth 0 char))] + _ (p.assert ($_ text/compose "Character is not within range: " (//.from-code bottom) "-" (//.from-code top)) (.and (n/>= bottom char') (n/<= top char')))] (wrap char))) @@ -162,43 +196,59 @@ (range (char "a") (char "f")) (range (char "A") (char "F")))) -(def: #export (one-of options) - {#.doc "Only lex characters that are part of a piece of text."} - (-> Text (Lexer Text)) - (function (_ [offset tape]) - (case (text.nth offset tape) - (#.Some output) - (let [output (text.from-code output)] - (if (text.contains? output options) - (#e.Success [[(inc offset) tape] output]) - (#e.Error ($_ text/compose "Character (" output ") is not one of: " options)))) - - _ - (#e.Error cannot-lex-error)))) - -(def: #export (none-of options) - {#.doc "Only lex characters that are not part of a piece of text."} - (-> Text (Lexer Text)) - (function (_ [offset tape]) - (case (text.nth offset tape) - (#.Some output) - (let [output (text.from-code output)] - (if (.not (text.contains? output options)) - (#e.Success [[(inc offset) tape] output]) - (#e.Error ($_ text/compose "Character (" output ") is one of: " options)))) +(do-template [<name> <description-modifier> <modifier>] + [(def: #export (<name> options) + {#.doc (code.text ($_ text/compose "Only lex characters that are" <description-modifier> " part of a piece of text."))} + (-> Text (Lexer Text)) + (function (_ [offset tape]) + (case (//.nth offset tape) + (#.Some output) + (let [output (//.from-code output)] + (if (<modifier> (//.contains? output options)) + (#e.Success [[("lux i64 +" 1 offset) tape] output]) + (#e.Error ($_ text/compose "Character (" output + ") is should " <description-modifier> + "be one of: " options)))) + + _ + (#e.Error cannot-lex-error))))] + + [one-of "" |>] + [none-of " not" .not] + ) - _ - (#e.Error cannot-lex-error)))) +(do-template [<name> <description-modifier> <modifier>] + [(def: #export (<name> options) + {#.doc (code.text ($_ text/compose "Only lex characters that are" <description-modifier> " part of a piece of text."))} + (-> Text (Lexer Slice)) + (function (_ [offset tape]) + (case (//.nth offset tape) + (#.Some output) + (let [output (//.from-code output)] + (if (<modifier> (//.contains? output options)) + (#e.Success [[("lux i64 +" 1 offset) tape] + {#basis offset + #distance 1}]) + (#e.Error ($_ text/compose "Character (" output + ") is should " <description-modifier> + "be one of: " options)))) + + _ + (#e.Error cannot-lex-error))))] + + [one-of! "" |>] + [none-of! " not" .not] + ) (def: #export (satisfies p) {#.doc "Only lex characters that satisfy a predicate."} (-> (-> Nat Bit) (Lexer Text)) (function (_ [offset tape]) - (case (text.nth offset tape) + (case (//.nth offset tape) (#.Some output) (if (p output) - (#e.Success [[(inc offset) tape] (text.from-code output)]) - (#e.Error ($_ text/compose "Character does not satisfy predicate: " (text.from-code output)))) + (#e.Success [[("lux i64 +" 1 offset) tape] (//.from-code output)]) + (#e.Error ($_ text/compose "Character does not satisfy predicate: " (//.from-code output)))) _ (#e.Error cannot-lex-error)))) @@ -206,7 +256,7 @@ (def: #export space {#.doc "Only lex white-space."} (Lexer Text) - (satisfies text.space?)) + (satisfies //.space?)) (def: #export (and left right) (-> (Lexer Text) (Lexer Text) (Lexer Text)) @@ -215,33 +265,64 @@ =right right] (wrap ($_ text/compose =left =right)))) -(do-template [<name> <base> <doc>] - [(def: #export (<name> p) - {#.doc <doc>} +(def: #export (and! left right) + (-> (Lexer Slice) (Lexer Slice) (Lexer Slice)) + (do p.Monad<Parser> + [[left::basis left::distance] left + [right::basis right::distance] right] + (wrap [left::basis ("lux i64 +" left::distance right::distance)]))) + +(do-template [<name> <base> <doc-modifier>] + [(def: #export (<name> lexer) + {#.doc (code.text ($_ text/compose "Lex " <doc-modifier> " characters as a single continuous text."))} (-> (Lexer Text) (Lexer Text)) - (|> p <base> (:: p.Monad<Parser> map text.concat)))] + (|> lexer <base> (:: p.Monad<Parser> map //.concat)))] - [some p.some "Lex some characters as a single continuous text."] - [many p.many "Lex many characters as a single continuous text."] + [some p.some "some"] + [many p.many "many"] ) -(do-template [<name> <base> <doc>] - [(def: #export (<name> n p) - {#.doc <doc>} +(do-template [<name> <base> <doc-modifier>] + [(def: #export (<name> lexer) + {#.doc (code.text ($_ text/compose "Lex " <doc-modifier> " characters as a single continuous text."))} + (-> (Lexer Slice) (Lexer Slice)) + (with-slices (<base> lexer)))] + + [some! p.some "some"] + [many! p.many "many"] + ) + +(do-template [<name> <base> <doc-modifier>] + [(def: #export (<name> amount lexer) + {#.doc (code.text ($_ text/compose "Lex " <doc-modifier> " N characters."))} (-> Nat (Lexer Text) (Lexer Text)) - (do p.Monad<Parser> - [] - (|> p (<base> n) (:: @ map text.concat))))] + (|> lexer (<base> amount) (:: p.Monad<Parser> map //.concat)))] + + [exactly p.exactly "exactly"] + [at-most p.at-most "at most"] + [at-least p.at-least "at least"] + ) - [exactly p.exactly "Lex exactly N characters."] - [at-most p.at-most "Lex at most N characters."] - [at-least p.at-least "Lex at least N characters."] +(do-template [<name> <base> <doc-modifier>] + [(def: #export (<name> amount lexer) + {#.doc (code.text ($_ text/compose "Lex " <doc-modifier> " N characters."))} + (-> Nat (Lexer Slice) (Lexer Slice)) + (with-slices (<base> amount lexer)))] + + [exactly! p.exactly "exactly"] + [at-most! p.at-most "at most"] + [at-least! p.at-least "at least"] ) -(def: #export (between from to p) +(def: #export (between from to lexer) {#.doc "Lex between N and M characters."} (-> Nat Nat (Lexer Text) (Lexer Text)) - (|> p (p.between from to) (:: p.Monad<Parser> map text.concat))) + (|> lexer (p.between from to) (:: p.Monad<Parser> map //.concat))) + +(def: #export (between! from to lexer) + {#.doc "Lex between N and M characters."} + (-> Nat Nat (Lexer Slice) (Lexer Slice)) + (with-slices (p.between from to lexer))) (def: #export (enclosed [start end] lexer) (All [a] (-> [Text Text] (Lexer a) (Lexer a))) @@ -259,3 +340,15 @@ (#e.Success value) (#e.Success [real-input value])))) + +(def: #export (slice lexer) + (-> (Lexer Slice) (Lexer Text)) + (do p.Monad<Parser> + [[basis distance] lexer] + (function (_ (^@ input [offset tape])) + (case (//.clip basis ("lux i64 +" basis distance) tape) + (#.Some output) + (#e.Success [input output]) + + #.None + (#e.Error "Cannot slice."))))) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index ffd937d8e..ba0128b7b 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -7,25 +7,25 @@ ["." product] ["e" error] ["." maybe] - ["." number ("int/." Codec<Text,Int>)] - ["." text - ["l" lexer] - format] + ["." number (#+ hex) ("int/." Codec<Text,Int>)] [collection ["." list ("list/." Fold<List> Monad<List>)]]] ["." macro (#+ with-gensyms) ["." code] - ["s" syntax (#+ syntax:)]]]) + ["s" syntax (#+ syntax:)]]] + ["." // + ["l" lexer] + format]) ## [Utils] (def: regex-char^ (l.Lexer Text) - (l.none-of "\\.|&()[]{}")) + (l.none-of "\.|&()[]{}")) (def: escaped-char^ (l.Lexer Text) (do p.Monad<Parser> - [? (l.this? "\\")] + [? (l.this? "\")] (if ? l.any regex-char^))) @@ -50,11 +50,11 @@ (-> (l.Lexer (List Text)) (l.Lexer Text)) (do p.Monad<Parser> [parts part^] - (wrap (text.join-with "" parts)))) + (wrap (//.join-with "" parts)))) (def: name-char^ (l.Lexer Text) - (l.none-of "[]{}()s\"#.<>")) + (l.none-of (format "[]{}()s#.<>" //.double-quote))) (def: name-part^ (l.Lexer Text) @@ -75,15 +75,15 @@ (def: (re-var^ current-module) (-> Text (l.Lexer Code)) (do p.Monad<Parser> - [name (l.enclosed ["\\@<" ">"] (name^ current-module))] + [name (l.enclosed ["\@<" ">"] (name^ current-module))] (wrap (` (: (l.Lexer Text) (~ (code.identifier name))))))) (def: re-range^ (l.Lexer Code) (do p.Monad<Parser> - [from (|> regex-char^ (:: @ map (|>> (text.nth 0) maybe.assume))) + [from (|> regex-char^ (:: @ map (|>> (//.nth 0) maybe.assume))) _ (l.this "-") - to (|> regex-char^ (:: @ map (|>> (text.nth 0) maybe.assume)))] + to (|> regex-char^ (:: @ map (|>> (//.nth 0) maybe.assume)))] (wrap (` (l.range (~ (code.nat from)) (~ (code.nat to))))))) (def: re-char^ @@ -122,20 +122,21 @@ (def: blank^ (l.Lexer Text) - (l.one-of " \t")) + (l.one-of (format " " //.tab))) (def: ascii^ (l.Lexer Text) - (l.range (char "\u0000") (char "\u007F"))) + (l.range (hex "0") (hex "7F"))) (def: control^ (l.Lexer Text) - (p.either (l.range (char "\u0000") (char "\u001F")) - (l.one-of "\u007F"))) + (p.either (l.range (hex "0") (hex "1F")) + (l.one-of (//.from-code (hex "7F"))))) (def: punct^ (l.Lexer Text) - (l.one-of "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~")) + (l.one-of (format "!#$%&'()*+,-./:;<=>?@[\]^_`{|}~" + //.double-quote))) (def: graph^ (l.Lexer Text) @@ -144,7 +145,7 @@ (def: print^ (l.Lexer Text) (p.either graph^ - (l.one-of "\u0020"))) + (l.one-of (//.from-code (hex "20"))))) (def: re-system-class^ (l.Lexer Code) @@ -152,27 +153,27 @@ [] ($_ p.either (p.after (l.this ".") (wrap (` l.any))) - (p.after (l.this "\\d") (wrap (` l.decimal))) - (p.after (l.this "\\D") (wrap (` (l.not l.decimal)))) - (p.after (l.this "\\s") (wrap (` l.space))) - (p.after (l.this "\\S") (wrap (` (l.not l.space)))) - (p.after (l.this "\\w") (wrap (` (~! word^)))) - (p.after (l.this "\\W") (wrap (` (l.not (~! word^))))) - - (p.after (l.this "\\p{Lower}") (wrap (` l.lower))) - (p.after (l.this "\\p{Upper}") (wrap (` l.upper))) - (p.after (l.this "\\p{Alpha}") (wrap (` l.alpha))) - (p.after (l.this "\\p{Digit}") (wrap (` l.decimal))) - (p.after (l.this "\\p{Alnum}") (wrap (` l.alpha-num))) - (p.after (l.this "\\p{Space}") (wrap (` l.space))) - (p.after (l.this "\\p{HexDigit}") (wrap (` l.hexadecimal))) - (p.after (l.this "\\p{OctDigit}") (wrap (` l.octal))) - (p.after (l.this "\\p{Blank}") (wrap (` (~! blank^)))) - (p.after (l.this "\\p{ASCII}") (wrap (` (~! ascii^)))) - (p.after (l.this "\\p{Contrl}") (wrap (` (~! control^)))) - (p.after (l.this "\\p{Punct}") (wrap (` (~! punct^)))) - (p.after (l.this "\\p{Graph}") (wrap (` (~! graph^)))) - (p.after (l.this "\\p{Print}") (wrap (` (~! print^)))) + (p.after (l.this "\d") (wrap (` l.decimal))) + (p.after (l.this "\D") (wrap (` (l.not l.decimal)))) + (p.after (l.this "\s") (wrap (` l.space))) + (p.after (l.this "\S") (wrap (` (l.not l.space)))) + (p.after (l.this "\w") (wrap (` (~! word^)))) + (p.after (l.this "\W") (wrap (` (l.not (~! word^))))) + + (p.after (l.this "\p{Lower}") (wrap (` l.lower))) + (p.after (l.this "\p{Upper}") (wrap (` l.upper))) + (p.after (l.this "\p{Alpha}") (wrap (` l.alpha))) + (p.after (l.this "\p{Digit}") (wrap (` l.decimal))) + (p.after (l.this "\p{Alnum}") (wrap (` l.alpha-num))) + (p.after (l.this "\p{Space}") (wrap (` l.space))) + (p.after (l.this "\p{HexDigit}") (wrap (` l.hexadecimal))) + (p.after (l.this "\p{OctDigit}") (wrap (` l.octal))) + (p.after (l.this "\p{Blank}") (wrap (` (~! blank^)))) + (p.after (l.this "\p{ASCII}") (wrap (` (~! ascii^)))) + (p.after (l.this "\p{Contrl}") (wrap (` (~! control^)))) + (p.after (l.this "\p{Punct}") (wrap (` (~! punct^)))) + (p.after (l.this "\p{Graph}") (wrap (` (~! graph^)))) + (p.after (l.this "\p{Print}") (wrap (` (~! print^)))) ))) (def: re-class^ @@ -188,11 +189,11 @@ (def: re-back-reference^ (l.Lexer Code) (p.either (do p.Monad<Parser> - [_ (l.this "\\") + [_ (l.this "\") id number^] (wrap (` ((~! ..copy) (~ (code.identifier ["" (int/encode (.int id))])))))) (do p.Monad<Parser> - [_ (l.this "\\k<") + [_ (l.this "\k<") captured-name name-part^ _ (l.this ">")] (wrap (` ((~! ..copy) (~ (code.identifier ["" captured-name])))))))) @@ -278,7 +279,7 @@ [idx names (list& (list g!temp complex - (' #let) (` [(~ g!total) (:: (~! text.Monoid<Text>) (~' compose) (~ g!total) (~ g!temp))])) + (' #let) (` [(~ g!total) (:: (~! //.Monoid<Text>) (~' compose) (~ g!total) (~ g!temp))])) steps)] (#.Right [(#Capturing [?name num-captures]) scoped]) @@ -294,7 +295,7 @@ [idx! (list& name! names) (list& (list name! scoped - (' #let) (` [(~ g!total) (:: (~! text.Monoid<Text>) (~' compose) (~ g!total) (~ access))])) + (' #let) (` [(~ g!total) (:: (~! //.Monoid<Text>) (~' compose) (~ g!total) (~ access))])) steps)]) ))) [+0 @@ -410,11 +411,11 @@ (regex ".") "Escaping" - (regex "\\.") + (regex "\.") "Character classes" - (regex "\\d") - (regex "\\p{Lower}") + (regex "\d") + (regex "\p{Lower}") (regex "[abc]") (regex "[a-z]") (regex "[a-zA-Z]") @@ -448,11 +449,11 @@ "Groups" (regex "a(.)c") (regex "a(b+)c") - (regex "(\\d{3})-(\\d{3})-(\\d{4})") - (regex "(\\d{3})-(?:\\d{3})-(\\d{4})") - (regex "(?<code>\\d{3})-\\k<code>-(\\d{4})") - (regex "(?<code>\\d{3})-\\k<code>-(\\d{4})-\\0") - (regex "(\\d{3})-((\\d{3})-(\\d{4}))") + (regex "(\d{3})-(\d{3})-(\d{4})") + (regex "(\d{3})-(?:\d{3})-(\d{4})") + (regex "(?<code>\d{3})-\k<code>-(\d{4})") + (regex "(?<code>\d{3})-\k<code>-(\d{4})-\0") + (regex "(\d{3})-((\d{3})-(\d{4}))") "Alternation" (regex "a|b") @@ -464,7 +465,7 @@ (p.before l.end) (l.run pattern)) (#e.Error error) - (macro.fail (format "Error while parsing regular-expression:\n" + (macro.fail (format "Error while parsing regular-expression:" //.new-line error)) (#e.Success regex) @@ -476,11 +477,11 @@ {branches (p.many s.any)}) {#.doc (doc "Allows you to test text against regular expressions." (case some-text - (^regex "(\\d{3})-(\\d{3})-(\\d{4})" + (^regex "(\d{3})-(\d{3})-(\d{4})" [_ country-code area-code place-code]) do-some-thing-when-number - (^regex "\\w+") + (^regex "\w+") do-some-thing-when-word _ |