diff options
Diffstat (limited to 'new-luxc/test/test/luxc/parser.lux')
| -rw-r--r-- | new-luxc/test/test/luxc/parser.lux | 130 |
1 files changed, 65 insertions, 65 deletions
diff --git a/new-luxc/test/test/luxc/parser.lux b/new-luxc/test/test/luxc/parser.lux index 5218bb926..f6ee8ea72 100644 --- a/new-luxc/test/test/luxc/parser.lux +++ b/new-luxc/test/test/luxc/parser.lux @@ -7,9 +7,9 @@ (text format ["l" lexer]) [number] - ["E" error] + ["R" result] (coll [list])) - ["R" math/random "R/" Monad<Random>] + ["r" math/random "r/" Monad<Random>] (macro [code]) test) (luxc ["&" parser])) @@ -21,103 +21,103 @@ #;column +0}) (def: ident-part^ - (R;Random Text) - (do R;Monad<Random> + (r;Random Text) + (do r;Monad<Random> [#let [digits "0123456789" delimiters "()[]{}#;" space "\t\v \n\r\f" invalid-range (format digits delimiters space) - char-gen (|> R;char - (R;filter (function [sample] + char-gen (|> r;char + (r;filter (function [sample] (not (text;contains? (char;as-text sample) invalid-range)))))] - size (|> R;nat (:: @ map (|>. (n.% +20) (n.max +1))))] - (R;text' char-gen size))) + size (|> r;nat (:: @ map (|>. (n.% +20) (n.max +1))))] + (r;text' char-gen size))) (def: ident^ - (R;Random Ident) - (R;seq ident-part^ ident-part^)) + (r;Random Ident) + (r;seq ident-part^ ident-part^)) (def: ast^ - (R;Random Code) - (let [numeric^ (: (R;Random Code) - ($_ R;either - (|> R;bool (R/map (|>. #;Bool [default-cursor]))) - (|> R;nat (R/map (|>. #;Nat [default-cursor]))) - (|> R;int (R/map (|>. #;Int [default-cursor]))) - (|> R;deg (R/map (|>. #;Deg [default-cursor]))) - (|> R;real (R/map (|>. #;Real [default-cursor]))))) - textual^ (: (R;Random Code) - ($_ R;either - (|> R;char (R/map (|>. #;Char [default-cursor]))) - (do R;Monad<Random> - [size (|> R;nat (R/map (n.% +20)))] - (|> (R;text size) (R/map (|>. #;Text [default-cursor])))) - (|> ident^ (R/map (|>. #;Symbol [default-cursor]))) - (|> ident^ (R/map (|>. #;Tag [default-cursor]))))) - simple^ (: (R;Random Code) - ($_ R;either + (r;Random Code) + (let [numeric^ (: (r;Random Code) + ($_ r;either + (|> r;bool (r/map (|>. #;Bool [default-cursor]))) + (|> r;nat (r/map (|>. #;Nat [default-cursor]))) + (|> r;int (r/map (|>. #;Int [default-cursor]))) + (|> r;deg (r/map (|>. #;Deg [default-cursor]))) + (|> r;real (r/map (|>. #;Real [default-cursor]))))) + textual^ (: (r;Random Code) + ($_ r;either + (|> r;char (r/map (|>. #;Char [default-cursor]))) + (do r;Monad<Random> + [size (|> r;nat (r/map (n.% +20)))] + (|> (r;text size) (r/map (|>. #;Text [default-cursor])))) + (|> ident^ (r/map (|>. #;Symbol [default-cursor]))) + (|> ident^ (r/map (|>. #;Tag [default-cursor]))))) + simple^ (: (r;Random Code) + ($_ r;either numeric^ textual^))] - (R;rec + (r;rec (function [ast^] - (let [multi^ (do R;Monad<Random> - [size (|> R;nat (R/map (n.% +3)))] - (R;list size ast^)) - composite^ (: (R;Random Code) - ($_ R;either - (|> multi^ (R/map (|>. #;Form [default-cursor]))) - (|> multi^ (R/map (|>. #;Tuple [default-cursor]))) - (do R;Monad<Random> - [size (|> R;nat (R/map (n.% +3)))] - (|> (R;list size (R;seq ast^ ast^)) - (R/map (|>. #;Record [default-cursor]))))))] - (R;either simple^ + (let [multi^ (do r;Monad<Random> + [size (|> r;nat (r/map (n.% +3)))] + (r;list size ast^)) + composite^ (: (r;Random Code) + ($_ r;either + (|> multi^ (r/map (|>. #;Form [default-cursor]))) + (|> multi^ (r/map (|>. #;Tuple [default-cursor]))) + (do r;Monad<Random> + [size (|> r;nat (r/map (n.% +3)))] + (|> (r;list size (r;seq ast^ ast^)) + (r/map (|>. #;Record [default-cursor]))))))] + (r;either simple^ composite^)))))) (test: "Lux code parser." [sample ast^] (assert "Can parse Lux code." (case (&;parse [default-cursor (code;to-text sample)]) - (#E;Error error) + (#R;Error error) false - (#E;Success [_ parsed]) + (#R;Success [_ parsed]) (:: code;Eq<Code> = parsed sample)) )) (def: comment-text^ - (R;Random Text) - (let [char-gen (|> R;char (R;filter (function [value] + (r;Random Text) + (let [char-gen (|> r;char (r;filter (function [value] (not (or (char;space? value) (C/= #"\n" value) (C/= #"#" value) (C/= #"(" value) (C/= #")" value))))))] - (do R;Monad<Random> - [size (|> R;nat (R/map (n.% +20)))] - (R;text' char-gen size)))) + (do r;Monad<Random> + [size (|> r;nat (r/map (n.% +20)))] + (r;text' char-gen size)))) (def: comment^ - (R;Random Text) - (R;either (do R;Monad<Random> + (r;Random Text) + (r;either (do r;Monad<Random> [comment comment-text^] (wrap (format "## " comment "\n"))) - (R;rec (function [nested^] - (do R;Monad<Random> - [comment (R;either comment-text^ + (r;rec (function [nested^] + (do r;Monad<Random> + [comment (r;either comment-text^ nested^)] (wrap (format "#( " comment " )#"))))))) (test: "Multi-line text & comments." - [#let [char-gen (|> R;char (R;filter (function [value] + [#let [char-gen (|> r;char (r;filter (function [value] (not (or (char;space? value) (C/= #"\"" value) (C/= #"\n" value))))))] x char-gen y char-gen z char-gen - offset-size (|> R;nat (R/map (|>. (n.% +10) (n.max +1)))) + offset-size (|> r;nat (r/map (|>. (n.% +10) (n.max +1)))) #let [offset (text;join-with "" (list;repeat offset-size " "))] sample ast^ comment comment^ @@ -129,10 +129,10 @@ (char;as-text z))] (case (&;parse [default-cursor (format "\"" bad-match "\"")]) - (#E;Error error) + (#R;Error error) true - (#E;Success [_ parsed]) + (#R;Success [_ parsed]) false))) (assert "Will accept valid multi-line text" (let [good-input (format (char;as-text x) "\n" @@ -144,36 +144,36 @@ (case (&;parse [(|> default-cursor (update@ #;column (n.+ (n.dec offset-size)))) (format "\"" good-input "\"")]) - (#E;Error error) + (#R;Error error) false - (#E;Success [_ parsed]) + (#R;Success [_ parsed]) (:: code;Eq<Code> = parsed (code;text good-output))))) (assert "Can handle comments." (case (&;parse [default-cursor (format comment (code;to-text sample))]) - (#E;Error error) + (#R;Error error) false - (#E;Success [_ parsed]) + (#R;Success [_ parsed]) (:: code;Eq<Code> = parsed sample))) (assert "Will reject unbalanced multi-line comments." (and (case (&;parse [default-cursor (format "#(" "#(" unbalanced-comment ")#" (code;to-text sample))]) - (#E;Error error) + (#R;Error error) true - (#E;Success [_ parsed]) + (#R;Success [_ parsed]) false) (case (&;parse [default-cursor (format "#(" unbalanced-comment ")#" ")#" (code;to-text sample))]) - (#E;Error error) + (#R;Error error) true - (#E;Success [_ parsed]) + (#R;Success [_ parsed]) false))) )) |