aboutsummaryrefslogtreecommitdiff
path: root/new-luxc
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/parser.lux45
-rw-r--r--new-luxc/test/test/luxc/parser.lux99
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))
+ ))
+ ))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-11 04:18:51 +0000