diff options
Diffstat (limited to 'new-luxc')
| -rw-r--r-- | new-luxc/source/luxc/parser.lux | 50 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/parser.lux | 90 |
2 files changed, 81 insertions, 59 deletions
diff --git a/new-luxc/source/luxc/parser.lux b/new-luxc/source/luxc/parser.lux index 7670d72c7..25f9af46a 100644 --- a/new-luxc/source/luxc/parser.lux +++ b/new-luxc/source/luxc/parser.lux @@ -46,30 +46,32 @@ (def: (multi-line-comment^ where) (-> Cursor (Lexer [Text Cursor])) (do Monad<Lexer> - [_ (l;text "#(") - [comment end] (loop [comment "" - where (|> where - (update@ #;column (n.+ +2)))] - ($_ l;either - (do @ - [_ (l;one-of "\n")] - (recur (format comment "\n") - (|> where - (update@ #;line n.inc) - (set@ #;column +0)))) - (do @ - [chunk (l;some' (l;not comment-bound^))] - (recur (format comment chunk) - (|> where - (update@ #;column (n.+ (text;size chunk)))))) - (do @ - [[sub-comment sub-where] (multi-line-comment^ where)] - (wrap [(format comment "#(" sub-comment ")#") - sub-where])))) - _ (l;text ")#")] - (wrap [comment - (|> end - (update@ #;column (n.+ +2)))]))) + [_ (l;text "#(")] + (loop [comment "" + where (|> where + (update@ #;column (n.+ +2)))] + ($_ l;either + (do @ + [chunk (l;many' (l;not comment-bound^))] + (recur (format comment chunk) + (|> where + (update@ #;column (n.+ (text;size chunk)))))) + (do @ + [_ (l;one-of "\n")] + (recur (format comment "\n") + (|> where + (update@ #;line n.inc) + (set@ #;column +0)))) + (do @ + [[sub-comment sub-where] (multi-line-comment^ where)] + (recur (format comment "#(" sub-comment ")#") + sub-where)) + (do @ + [_ (l;text ")#")] + (wrap [comment + (|> where + (update@ #;column (n.+ +2)))])) + )))) (def: (comment^ where) (-> Cursor (Lexer [Text Cursor])) diff --git a/new-luxc/test/test/luxc/parser.lux b/new-luxc/test/test/luxc/parser.lux index 32aad3b8f..79414b920 100644 --- a/new-luxc/test/test/luxc/parser.lux +++ b/new-luxc/test/test/luxc/parser.lux @@ -87,8 +87,30 @@ (:: ast;Eq<AST> = parsed sample)) ))) +(def: comment-text^ + (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)))) + +(def: comment^ + (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^ + nested^)] + (wrap (format "#( " comment " )#"))))))) + (test: "Multi-line text & comments." - #seed +9223374029023245172 [#let [char-gen (|> R;char (R;filter (function [value] (not (or (char;space? value) (C/= #"\"" value) @@ -99,44 +121,42 @@ offset-size (|> R;nat (R/map (|>. (n.% +10) (n.max +1)))) #let [offset (text;join-with "" (list;repeat offset-size " "))] sample ast^ - comment (do @ - [size (|> R;nat (R/map (n.% +20)))] - (R;text' char-gen size))] + comment comment^] ($_ seq - (assert "Can handle multi-line text." - (and (let [bad-match (format (char;as-text x) "\n" - (char;as-text y) "\n" - (char;as-text z))] - (|> (&;ast^ default-cursor) - (l;run (format "\"" bad-match "\"")) - (case> (#;Left error) - true + (assert "Will reject invalid multi-line text." + (let [bad-match (format (char;as-text x) "\n" + (char;as-text y) "\n" + (char;as-text z))] + (|> (&;ast^ default-cursor) + (l;run (format "\"" bad-match "\"")) + (case> (#;Left error) + true - (#;Right [parsed _]) - false) - )) - (let [good-input (format (char;as-text x) "\n" - offset (char;as-text y) "\n" - offset (char;as-text z)) - good-output (format (char;as-text x) "\n" - (char;as-text y) "\n" - (char;as-text z))] - (|> (&;ast^ (|> default-cursor - (update@ #;column (n.+ (n.dec offset-size))))) - (l;run (format "\"" good-input "\"")) - (case> (#;Left error) - false + (#;Right [parsed _]) + false) + ))) + (assert "Will accept valid multi-line text" + (let [good-input (format (char;as-text x) "\n" + offset (char;as-text y) "\n" + offset (char;as-text z)) + good-output (format (char;as-text x) "\n" + (char;as-text y) "\n" + (char;as-text z))] + (|> (&;ast^ (|> default-cursor + (update@ #;column (n.+ (n.dec offset-size))))) + (l;run (format "\"" good-input "\"")) + (case> (#;Left error) + false - (#;Right [parsed _]) - (:: ast;Eq<AST> = - parsed - (ast;text good-output))) - )) - )) - (assert "Can handle single-line comments." + (#;Right [parsed _]) + (:: ast;Eq<AST> = + parsed + (ast;text good-output))) + )) + ) + (assert "Can handle comments." (|> (&;ast^ default-cursor) - (l;run (format "## " comment "\n" - (ast;to-text sample))) + (l;run (format comment (ast;to-text sample))) (case> (#;Left error) false |