diff options
| -rw-r--r-- | new-luxc/source/luxc/parser.lux | 45 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/parser.lux | 99 |
2 files changed, 106 insertions, 38 deletions
diff --git a/new-luxc/source/luxc/parser.lux b/new-luxc/source/luxc/parser.lux index 1114ba76c..7670d72c7 100644 --- a/new-luxc/source/luxc/parser.lux +++ b/new-luxc/source/luxc/parser.lux @@ -76,6 +76,16 @@ (l;either (single-line-comment^ where) (multi-line-comment^ where))) +(def: (padding^ where) + (-> Cursor (Lexer Cursor)) + (l;either (do Monad<Lexer> + [[comment where] (comment^ where)] + (padding^ where)) + (do Monad<Lexer> + [[white-space where] (space^ where)] + (wrap where)) + )) + (def: escaped-char^ (Lexer [Text Char]) (l;after (l;char #"\\") @@ -156,11 +166,7 @@ raw-char^)] (wrap [[where (#;CharS value)] (|> where - (update@ #;column (function [column] - ($_ n.+ - +3 - column - (text;size chunk)))))]))) + (update@ #;column (|>. ($_ n.+ +3 (text;size chunk)))))]))) (def: (text^ where) (-> Cursor (Lexer [AST Cursor])) @@ -174,7 +180,7 @@ next-line-start? false] (let [next-line (do @ [_ (l;text "\n")] - (recur text-read + (recur (format text-read "\n") (|> where (update@ #;line n.inc) (set@ #;column +0)) @@ -194,8 +200,8 @@ (update@ #;column (n.+ offset-size))) false) (l;fail (format "Each line of a multi-line text must have an appropriate offset!\n" - "Expected: " (%i (nat-to-int offset-column)) "\n" - " Actual: " (%i (nat-to-int offset-size)) "\n"))))) + "Expected: " (%i (nat-to-int offset-column)) " columns.\n" + " Actual: " (%i (nat-to-int offset-size)) " columns.\n"))))) ($_ l;either (do @ [normal (l;many' (l;none-of "\\\"\n"))] @@ -233,8 +239,7 @@ (recur (V;add elem elems) where')) (do @ - [[_ where'] (l;either (space^ where) - (comment^ where)) + [where' (padding^ where) _ (l;text <close>)] (wrap [(V;to-list elems) (|> where' @@ -261,8 +266,7 @@ (recur (V;add [key val] elems) where')) (do @ - [[_ where'] (l;either (space^ where) - (comment^ where)) + [where' (padding^ where) _ (l;text "}")] (wrap [(V;to-list elems) (|> where' @@ -274,7 +278,7 @@ (Lexer Text) (do Monad<Lexer> [#let [digits "0123456789" - delimiters "()[]{}#;" + delimiters "()[]{}#;\"" space "\t\v \n\r\f" head-lexer (l;none-of (format digits delimiters space)) tail-lexer (l;some' (l;none-of (format delimiters space)))] @@ -315,7 +319,7 @@ [[value length] <lexer>] (wrap [[where (<tag> value)] (|> where - (update@ #;column (function [column] ($_ n.+ column <extra> length))))])))] + (update@ #;column (|>. ($_ n.+ <extra> length))))])))] [symbol^ #;SymbolS ident^ +0] [tag^ #;TagS (l;after (l;char #"#") ident^) +1] @@ -324,19 +328,18 @@ (def: #export (ast^ where) (-> Cursor (Lexer [AST Cursor])) (do Monad<Lexer> - [[_ where] (l;either (space^ where) - (comment^ where))] + [where (padding^ where)] ($_ l;either + (form^ where ast^) + (tuple^ where ast^) + (record^ where ast^) (bool^ where) (nat^ where) (real^ where) (int^ where) (deg^ where) - (char^ where) - (text^ where) (symbol^ where) (tag^ where) - (form^ where ast^) - (tuple^ where ast^) - (record^ where ast^) + (char^ where) + (text^ where) ))) diff --git a/new-luxc/test/test/luxc/parser.lux b/new-luxc/test/test/luxc/parser.lux index d6b420660..32aad3b8f 100644 --- a/new-luxc/test/test/luxc/parser.lux +++ b/new-luxc/test/test/luxc/parser.lux @@ -3,11 +3,12 @@ (lux [io] (control monad pipe) - (data [char] + (data [char "C/" Eq<Char>] [text "T/" Eq<Text>] (text format ["l" lexer]) - [number]) + [number] + (coll [list])) ["R" math/random "R/" Monad<Random>] (macro [ast]) test) @@ -30,7 +31,7 @@ (R;filter (function [sample] (not (text;contains? (char;as-text sample) invalid-range)))))] - size (|> R;nat (:: @ map (n.% +20)))] + size (|> R;nat (:: @ map (|>. (n.% +20) (n.max +1))))] (R;text' char-gen size))) (def: ident^ @@ -39,30 +40,36 @@ (def: ast^ (R;Random AST) - (let [simple^ (: (R;Random AST) + (let [numeric^ (: (R;Random AST) + ($_ R;either + (|> R;bool (R/map (|>. #;BoolS [default-cursor]))) + (|> R;nat (R/map (|>. #;NatS [default-cursor]))) + (|> R;int (R/map (|>. #;IntS [default-cursor]))) + (|> R;deg (R/map (|>. #;DegS [default-cursor]))) + (|> R;real (R/map (|>. #;RealS [default-cursor]))))) + textual^ (: (R;Random AST) + ($_ R;either + (|> R;char (R/map (|>. #;CharS [default-cursor]))) + (do R;Monad<Random> + [size (|> R;nat (R/map (n.% +20)))] + (|> (R;text size) (R/map (|>. #;TextS [default-cursor])))) + (|> ident^ (R/map (|>. #;SymbolS [default-cursor]))) + (|> ident^ (R/map (|>. #;TagS [default-cursor]))))) + simple^ (: (R;Random AST) ($_ R;either - (|> R;bool (R/map (|>. #;BoolS [default-cursor]))) - (|> R;nat (R/map (|>. #;NatS [default-cursor]))) - (|> R;int (R/map (|>. #;IntS [default-cursor]))) - (|> R;deg (R/map (|>. #;DegS [default-cursor]))) - (|> R;real (R/map (|>. #;RealS [default-cursor]))) - (|> R;char (R/map (|>. #;CharS [default-cursor]))) - (do R;Monad<Random> - [size (|> R;nat (R/map (n.% +20)))] - (|> (R;text size) (R/map (|>. #;TextS [default-cursor])))) - (|> ident^ (R/map (|>. #;SymbolS [default-cursor]))) - (|> ident^ (R/map (|>. #;TagS [default-cursor])))))] + numeric^ + textual^))] (R;rec (function [ast^] (let [multi^ (do R;Monad<Random> - [size (|> R;nat (R/map (n.% +2)))] + [size (|> R;nat (R/map (n.% +3)))] (R;list size ast^)) composite^ (: (R;Random AST) ($_ R;either (|> multi^ (R/map (|>. #;FormS [default-cursor]))) (|> multi^ (R/map (|>. #;TupleS [default-cursor]))) (do R;Monad<Random> - [size (|> R;nat (R/map (n.% +2)))] + [size (|> R;nat (R/map (n.% +3)))] (|> (R;list size (R;seq ast^ ast^)) (R/map (|>. #;RecordS [default-cursor]))))))] (R;either simple^ @@ -79,3 +86,61 @@ (#;Right [parsed _]) (:: ast;Eq<AST> = parsed sample)) ))) + +(test: "Multi-line text & comments." + #seed +9223374029023245172 + [#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)))) + #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))] + ($_ 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 + + (#;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 _]) + (:: ast;Eq<AST> = + parsed + (ast;text good-output))) + )) + )) + (assert "Can handle single-line comments." + (|> (&;ast^ default-cursor) + (l;run (format "## " comment "\n" + (ast;to-text sample))) + (case> (#;Left error) + false + + (#;Right [parsed _]) + (:: ast;Eq<AST> = parsed sample)) + )) + )) |