diff options
Diffstat (limited to 'stdlib/source')
| -rw-r--r-- | stdlib/source/lux/data/format/json.lux | 20 | ||||
| -rw-r--r-- | stdlib/source/lux/lexer.lux | 34 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/syntax.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/pipe.lux | 10 | ||||
| -rw-r--r-- | stdlib/source/lux/regex.lux | 100 |
5 files changed, 85 insertions, 81 deletions
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 280aab24b..e8189a594 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -217,19 +217,19 @@ (def: data-sep (Lexer [Text Char Text]) - ($_ lexer;seq space~ (lexer;this-char #",") space~)) + ($_ lexer;seq space~ (lexer;char #",") space~)) (def: null~ (Lexer Null) (do Monad<Lexer> - [_ (lexer;this "null")] + [_ (lexer;text "null")] (wrap []))) (do-template [<name> <token> <value>] [(def: <name> (Lexer Boolean) (do Monad<Lexer> - [_ (lexer;this <token>)] + [_ (lexer;text <token>)] (wrap <value>)))] [t~ "true" true] @@ -244,12 +244,12 @@ (Lexer Number) (do Monad<Lexer> [?sign (: (Lexer (Maybe Text)) - (lexer;opt (lexer;this "-"))) + (lexer;opt (lexer;text "-"))) digits (: (Lexer Text) (lexer;many' lexer;digit)) ?decimals (: (Lexer (Maybe Text)) (lexer;opt (do @ - [_ (lexer;this ".")] + [_ (lexer;text ".")] (lexer;many' lexer;digit))))] (case (: (Error Real) (Real/decode (format (default "" ?sign) @@ -290,9 +290,9 @@ (def: string~ (Lexer String) (do Monad<Lexer> - [_ (lexer;this "\"") + [_ (lexer;text "\"") string-body string-body~ - _ (lexer;this "\"")] + _ (lexer;text "\"")] (wrap string-body))) (def: (kv~ json~) @@ -300,7 +300,7 @@ (do Monad<Lexer> [key string~ _ space~ - _ (lexer;this-char #":") + _ (lexer;char #":") _ space~ value (json~ [])] (wrap [key value]))) @@ -309,11 +309,11 @@ [(def: (<name> json~) (-> (-> Unit (Lexer JSON)) (Lexer <type>)) (do Monad<Lexer> - [_ (lexer;this-char <open>) + [_ (lexer;char <open>) _ space~ elems (lexer;sep-by data-sep <elem-parser>) _ space~ - _ (lexer;this-char <close>)] + _ (lexer;char <close>)] (wrap (<prep> elems))))] [array~ Array #"[" #"]" (json~ []) vector;from-list] diff --git a/stdlib/source/lux/lexer.lux b/stdlib/source/lux/lexer.lux index 6d54f2614..e27e1925a 100644 --- a/stdlib/source/lux/lexer.lux +++ b/stdlib/source/lux/lexer.lux @@ -147,8 +147,8 @@ output output))) -(def: #export (assert test message) - (-> Bool Text (Lexer Unit)) +(def: #export (assert message test) + (-> Text Bool (Lexer Unit)) (lambda [input] (if test (#;Right [input []]) @@ -225,14 +225,14 @@ (#;Right [input (#;Some value)]) ))) -(def: #export (this text) +(def: #export (text test) (-> Text (Lexer Text)) (lambda [input] - (if (text;starts-with? text input) - (case (text;split (text;size text) input) + (if (text;starts-with? test input) + (case (text;split (text;size test) input) #;None (#;Left "") - (#;Some [_ input']) (#;Right [input' text])) - (#;Left (format "Invalid match: " text " @ " (:: text;Codec<Text,Text> encode input)))) + (#;Some [_ input']) (#;Right [input' test])) + (#;Left (format "Invalid match: " test " @ " (:: text;Codec<Text,Text> encode input)))) )) (def: #export (sep-by sep p) @@ -268,15 +268,15 @@ (#;Left "Can't peek character from empty text.")) )) -(def: #export (this-char char) +(def: #export (char test) (-> Char (Lexer Char)) (lambda [input] (case [(text;at +0 input) (text;split +1 input)] [(#;Some char') (#;Some [_ input'])] - (if (Char/= char char') - (#;Right [input' char]) - (#;Left (format "Expected " (:: char;Codec<Text,Char> encode char) " @ " (:: text;Codec<Text,Text> encode input) - " " (Int/encode (c2l char))" " (Int/encode (c2l [char']))))) + (if (Char/= test char') + (#;Right [input' test]) + (#;Left (format "Expected " (:: char;Codec<Text,Char> encode test) " @ " (:: text;Codec<Text,Text> encode input) + " " (Int/encode (c2l test))" " (Int/encode (c2l [char']))))) _ (#;Left "Can't parse character from empty text.")) @@ -292,9 +292,9 @@ (do Monad<Lexer> [input get-input char any - _ (assert (and (Char/>= bottom char) - (Char/<= top char)) - (format "Character is not within range: " (:: char;Codec<Text,Char> encode bottom) "-" (:: char;Codec<Text,Char> encode top) " @ " (:: text;Codec<Text,Text> encode input)))] + _ (assert (format "Character is not within range: " (:: char;Codec<Text,Char> encode bottom) "-" (:: char;Codec<Text,Char> encode top) " @ " (:: text;Codec<Text,Text> encode input)) + (and (Char/>= bottom char) + (Char/<= top char)))] (wrap char))) (do-template [<name> <bottom> <top>] @@ -434,6 +434,6 @@ (def: #export (enclosed [start end] lexer) (All [a] (-> [Text Text] (Lexer a) (Lexer a))) - (_& (this start) + (_& (text start) (&_ lexer - (this end)))) + (text end)))) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 00a2ba96e..ce36cef19 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -446,7 +446,7 @@ (wrap [(ast;symbol var-name) (` any)]) _ - (compiler;fail "Syntax pattern expects records or symbols.")))) + (compiler;fail "Syntax pattern expects tuples or symbols.")))) args) #let [g!state (ast;symbol ["" "*compiler*"]) g!end (ast;symbol ["" ""]) diff --git a/stdlib/source/lux/pipe.lux b/stdlib/source/lux/pipe.lux index 95167f7f2..5c553b7ec 100644 --- a/stdlib/source/lux/pipe.lux +++ b/stdlib/source/lux/pipe.lux @@ -31,13 +31,17 @@ _ (undefined))) -(syntax: #export (@> [body body^] +(syntax: #export (@> [name (s;default "@" s;local-symbol)] + [body body^] prev) {#;doc (doc "Gives the name '@' to the piped-argument, within the given expression." (|> 5 - (@> [(i.+ @ @)])))} + (@> [(i.+ @ @)])) + + (|> 5 + (@> X [(i.+ X X)])))} (wrap (list (fold (lambda [next prev] - (` (let% [(~' @) (~ prev)] + (` (let% [(~ (ast;symbol ["" name])) (~ prev)] (~ next)))) prev body)))) diff --git a/stdlib/source/lux/regex.lux b/stdlib/source/lux/regex.lux index 95599852c..e3cd95811 100644 --- a/stdlib/source/lux/regex.lux +++ b/stdlib/source/lux/regex.lux @@ -31,7 +31,7 @@ (def: escaped-char^ (Lexer Char) (do Monad<Lexer> - [? (&;opt (&;this-char #"\\")) + [? (&;opt (&;char #"\\")) char (case ? (#;Some _) &;any #;None regex-char^)] @@ -57,7 +57,7 @@ (def: #hidden word^ (Lexer Char) (&;either &;alpha-num - (&;this-char #"_"))) + (&;char #"_"))) (def: #hidden (join-text^ part^) (-> (Lexer (List Text)) (Lexer Text)) @@ -82,9 +82,9 @@ (do Monad<Lexer> [] ($_ &;either - (&;seq (wrap current-module) (&;_& (&;this ";;") identifier-part^)) - (&;seq identifier-part^ (&;_& (&;this ";") identifier-part^)) - (&;seq (wrap "lux") (&;_& (&;this ";") identifier-part^)) + (&;seq (wrap current-module) (&;_& (&;text ";;") identifier-part^)) + (&;seq identifier-part^ (&;_& (&;text ";") identifier-part^)) + (&;seq (wrap "lux") (&;_& (&;text ";") identifier-part^)) (&;seq (wrap "") identifier-part^)))) (def: (re-var^ current-module) @@ -97,7 +97,7 @@ (Lexer AST) (do Monad<Lexer> [from regex-char^ - _ (&;this-char #"-") + _ (&;char #"-") to regex-char^] (wrap (` (&;char-range (~ (ast;char from)) (~ (ast;char to))))))) @@ -105,7 +105,7 @@ (Lexer AST) (do Monad<Lexer> [char escaped-char^] - (wrap (` (&;this-char (~ (ast;char char))))))) + (wrap (` (&;char (~ (ast;char char))))))) (def: re-char+^ (Lexer AST) @@ -122,7 +122,7 @@ (def: re-user-class^' (Lexer AST) (do Monad<Lexer> - [negate? (&;opt (&;this-char #"^")) + [negate? (&;opt (&;char #"^")) parts (&;many ($_ &;either re-char-range^ re-char-options^))] @@ -135,7 +135,7 @@ (do Monad<Lexer> [_ (wrap []) init re-user-class^' - rest (&;some (&;_& (&;this "&&") (&;enclosed ["[" "]"] re-user-class^')))] + rest (&;some (&;_& (&;text "&&") (&;enclosed ["[" "]"] re-user-class^')))] (wrap (fold (lambda [refinement base] (` (refine^ (~ refinement) (~ base)))) init @@ -152,7 +152,7 @@ (def: #hidden control^ (Lexer Char) (&;either (&;char-range #"\u0000" #"\u001F") - (&;this-char #"\u007F"))) + (&;char #"\u007F"))) (def: #hidden punct^ (Lexer Char) @@ -165,36 +165,36 @@ (def: #hidden print^ (Lexer Char) (&;either graph^ - (&;this-char #"\u0020"))) + (&;char #"\u0020"))) (def: re-system-class^ (Lexer AST) (do Monad<Lexer> [] ($_ &;either - (&;_& (&;this-char #".") (wrap (` (->Text &;any)))) - (&;_& (&;this "\\d") (wrap (` (->Text &;digit)))) - (&;_& (&;this "\\D") (wrap (` (->Text (&;not &;digit))))) - (&;_& (&;this "\\s") (wrap (` (->Text &;space)))) - (&;_& (&;this "\\S") (wrap (` (->Text (&;not &;space))))) - (&;_& (&;this "\\w") (wrap (` (->Text word^)))) - (&;_& (&;this "\\W") (wrap (` (->Text (&;not word^))))) - (&;_& (&;this "\\d") (wrap (` (->Text &;digit)))) - - (&;_& (&;this "\\p{Lower}") (wrap (` (->Text &;lower)))) - (&;_& (&;this "\\p{Upper}") (wrap (` (->Text &;upper)))) - (&;_& (&;this "\\p{Alpha}") (wrap (` (->Text &;alpha)))) - (&;_& (&;this "\\p{Digit}") (wrap (` (->Text &;digit)))) - (&;_& (&;this "\\p{Alnum}") (wrap (` (->Text &;alpha-num)))) - (&;_& (&;this "\\p{Space}") (wrap (` (->Text &;space)))) - (&;_& (&;this "\\p{HexDigit}") (wrap (` (->Text &;hex-digit)))) - (&;_& (&;this "\\p{OctDigit}") (wrap (` (->Text &;oct-digit)))) - (&;_& (&;this "\\p{Blank}") (wrap (` (->Text blank^)))) - (&;_& (&;this "\\p{ASCII}") (wrap (` (->Text ascii^)))) - (&;_& (&;this "\\p{Contrl}") (wrap (` (->Text control^)))) - (&;_& (&;this "\\p{Punct}") (wrap (` (->Text punct^)))) - (&;_& (&;this "\\p{Graph}") (wrap (` (->Text graph^)))) - (&;_& (&;this "\\p{Print}") (wrap (` (->Text print^)))) + (&;_& (&;char #".") (wrap (` (->Text &;any)))) + (&;_& (&;text "\\d") (wrap (` (->Text &;digit)))) + (&;_& (&;text "\\D") (wrap (` (->Text (&;not &;digit))))) + (&;_& (&;text "\\s") (wrap (` (->Text &;space)))) + (&;_& (&;text "\\S") (wrap (` (->Text (&;not &;space))))) + (&;_& (&;text "\\w") (wrap (` (->Text word^)))) + (&;_& (&;text "\\W") (wrap (` (->Text (&;not word^))))) + (&;_& (&;text "\\d") (wrap (` (->Text &;digit)))) + + (&;_& (&;text "\\p{Lower}") (wrap (` (->Text &;lower)))) + (&;_& (&;text "\\p{Upper}") (wrap (` (->Text &;upper)))) + (&;_& (&;text "\\p{Alpha}") (wrap (` (->Text &;alpha)))) + (&;_& (&;text "\\p{Digit}") (wrap (` (->Text &;digit)))) + (&;_& (&;text "\\p{Alnum}") (wrap (` (->Text &;alpha-num)))) + (&;_& (&;text "\\p{Space}") (wrap (` (->Text &;space)))) + (&;_& (&;text "\\p{HexDigit}") (wrap (` (->Text &;hex-digit)))) + (&;_& (&;text "\\p{OctDigit}") (wrap (` (->Text &;oct-digit)))) + (&;_& (&;text "\\p{Blank}") (wrap (` (->Text blank^)))) + (&;_& (&;text "\\p{ASCII}") (wrap (` (->Text ascii^)))) + (&;_& (&;text "\\p{Contrl}") (wrap (` (->Text control^)))) + (&;_& (&;text "\\p{Punct}") (wrap (` (->Text punct^)))) + (&;_& (&;text "\\p{Graph}") (wrap (` (->Text graph^)))) + (&;_& (&;text "\\p{Print}") (wrap (` (->Text print^)))) ))) (def: re-class^ @@ -209,14 +209,14 @@ (def: re-back-reference^ (Lexer AST) (&;either (do Monad<Lexer> - [_ (&;this-char #"\\") + [_ (&;char #"\\") id int^] - (wrap (` (&;this (~ (ast;symbol ["" (Int/encode id)])))))) + (wrap (` (&;text (~ (ast;symbol ["" (Int/encode id)])))))) (do Monad<Lexer> - [_ (&;this "\\k<") + [_ (&;text "\\k<") captured-name identifier-part^ - _ (&;this ">")] - (wrap (` (&;this (~ (ast;symbol ["" captured-name])))))))) + _ (&;text ">")] + (wrap (` (&;text (~ (ast;symbol ["" captured-name])))))))) (def: (re-simple^ current-module) (-> Text (Lexer AST)) @@ -250,15 +250,15 @@ (&;enclosed ["{" "}"] ($_ &;either (do @ - [[from to] (&;seq int^ (&;_& (&;this-char #",") int^))] + [[from to] (&;seq int^ (&;_& (&;char #",") int^))] (wrap (` (join-text^ (&;between (~ (ast;nat (int-to-nat from))) (~ (ast;nat (int-to-nat to))) (~ base)))))) (do @ - [limit (&;_& (&;this-char #",") int^)] + [limit (&;_& (&;char #",") int^)] (wrap (` (join-text^ (&;at-most (~ (ast;nat (int-to-nat limit))) (~ base)))))) (do @ - [limit (&;&_ int^ (&;this-char #","))] + [limit (&;&_ int^ (&;char #","))] (wrap (` (join-text^ (&;at-least (~ (ast;nat (int-to-nat limit))) (~ base)))))) (do @ [limit int^] @@ -382,7 +382,7 @@ (do Monad<Lexer> [#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)] head sub^ - tail (&;some (&;_& (&;this-char #"|") sub^)) + tail (&;some (&;_& (&;char #"|") sub^)) #let [g!op (if capturing? (` |||^) (` |||_^))]] @@ -395,24 +395,24 @@ (-> Text (Lexer [Re-Group AST])) ($_ &;either (do Monad<Lexer> - [_ (&;this "(?:") + [_ (&;text "(?:") [_ scoped] (re-alternative^ false re-scoped^ current-module) - _ (&;this-char #")")] + _ (&;char #")")] (wrap [#Non-Capturing scoped])) (do Monad<Lexer> [complex (re-complex^ current-module)] (wrap [#Non-Capturing complex])) (do Monad<Lexer> - [_ (&;this "(?<") + [_ (&;text "(?<") captured-name identifier-part^ - _ (&;this ">") + _ (&;text ">") [num-captures pattern] (re-alternative^ true re-scoped^ current-module) - _ (&;this-char #")")] + _ (&;char #")")] (wrap [(#Capturing [(#;Some captured-name) num-captures]) pattern])) (do Monad<Lexer> - [_ (&;this-char #"(") + [_ (&;char #"(") [num-captures pattern] (re-alternative^ true re-scoped^ current-module) - _ (&;this-char #")")] + _ (&;char #")")] (wrap [(#Capturing [#;None num-captures]) pattern])))) (def: (regex^ current-module) |