diff options
Diffstat (limited to 'stdlib/source/lux/macro/syntax.lux')
| -rw-r--r-- | stdlib/source/lux/macro/syntax.lux | 77 |
1 files changed, 39 insertions, 38 deletions
diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index dd7a3ac06..45aaee1bb 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -18,7 +18,7 @@ (struct [list #* "" Functor<List> Fold<List> "List/" Monoid<List>]) [product] [error #- fail])) - (.. [ast])) + (.. [ast "AST/" Eq<AST>])) ## [Utils] (def: (join-pairs pairs) @@ -78,7 +78,7 @@ ## [Utils] (def: (remaining-inputs asts) (-> (List AST) Text) - ($_ Text/append " | Remaining input: " + ($_ Text/append "\nRemaining input: " (|> asts (map ast;to-text) (interpose " ") (text;join-with "")))) ## [Syntaxs] @@ -90,7 +90,7 @@ #;Nil (#;Left "There are no tokens to parse!") (#;Cons [t tokens']) (#;Right [tokens' t])))) -(do-template [<get-name> <ask-name> <demand-name> <type> <tag> <eq> <desc>] +(do-template [<get-name> <type> <tag> <eq> <desc>] [(def: #export <get-name> {#;doc (#;TextM ($_ Text/append "Parses the next " <desc> " input AST."))} (Syntax <type>) @@ -100,46 +100,47 @@ (#;Right [tokens' x]) _ - (#;Left ($_ Text/append "Can't parse " <desc> (remaining-inputs tokens)))))) + (#;Left ($_ Text/append "Can't parse " <desc> (remaining-inputs tokens))))))] - (def: #export (<ask-name> v) - {#;doc (#;TextM ($_ Text/append "Asks if the given " <desc> " is the next input AST."))} - (-> <type> (Syntax Bool)) - (lambda [tokens] - (case tokens - (#;Cons [[_ (<tag> x)] tokens']) - (let [is-it? (:: <eq> = v x) - remaining (if is-it? - tokens' - tokens)] - (#;Right [remaining is-it?])) + [ bool Bool #;BoolS bool;Eq<Bool> "bool"] + [ nat Nat #;NatS number;Eq<Nat> "nat"] + [ int Int #;IntS number;Eq<Int> "int"] + [ frac Frac #;FracS number;Eq<Frac> "frac"] + [ real Real #;RealS number;Eq<Real> "real"] + [ char Char #;CharS char;Eq<Char> "char"] + [ text Text #;TextS text;Eq<Text> "text"] + [symbol Ident #;SymbolS ident;Eq<Ident> "symbol"] + [ tag Ident #;TagS ident;Eq<Ident> "tag"] + ) - _ - (#;Right [tokens false])))) +(def: #export (sample? ast) + {#;doc "Asks if the given AST is the next input."} + (-> AST (Syntax Bool)) + (lambda [tokens] + (case tokens + (#;Cons [token tokens']) + (let [is-it? (AST/= ast token) + remaining (if is-it? + tokens' + tokens)] + (#;Right [remaining is-it?])) - (def: #export (<demand-name> v) - {#;doc (#;TextM ($_ Text/append "Ensures the given " <desc> " is the next input AST."))} - (-> <type> (Syntax Unit)) - (lambda [tokens] - (case tokens - (#;Cons [[_ (<tag> x)] tokens']) - (if (:: <eq> = v x) - (#;Right [tokens' []]) - (#;Left ($_ Text/append "Expected a " <desc> " but instead got " (ast;to-text [_ (<tag> x)]) (remaining-inputs tokens)))) + _ + (#;Right [tokens false])))) - _ - (#;Left ($_ Text/append "Can't parse " <desc> (remaining-inputs tokens))))))] +(def: #export (sample! ast) + {#;doc "Ensures the given AST is the next input."} + (-> AST (Syntax Unit)) + (lambda [tokens] + (case tokens + (#;Cons [token tokens']) + (if (AST/= ast token) + (#;Right [tokens' []]) + (#;Left ($_ Text/append "Expected a " (ast;to-text ast) " but instead got " (ast;to-text token) + (remaining-inputs tokens)))) - [ bool bool? bool! Bool #;BoolS bool;Eq<Bool> "bool"] - [ nat nat? nat! Nat #;NatS number;Eq<Nat> "nat"] - [ int int? int! Int #;IntS number;Eq<Int> "int"] - [ frac frac? frac! Frac #;FracS number;Eq<Frac> "frac"] - [ real real? real! Real #;RealS number;Eq<Real> "real"] - [ char char? char! Char #;CharS char;Eq<Char> "char"] - [ text text? text! Text #;TextS text;Eq<Text> "text"] - [symbol symbol? symbol! Ident #;SymbolS ident;Eq<Ident> "symbol"] - [ tag tag? tag! Ident #;TagS ident;Eq<Ident> "tag"] - ) + _ + (#;Left "There are no tokens to parse!")))) (def: #export (assert message test) {#;doc "Fails with the given message if the test is false."} |