aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2017-04-15 19:41:38 -0400
committerEduardo Julian2017-04-15 19:41:38 -0400
commit4295ff3a08dae2d1a31284d752c2e955456d9a32 (patch)
tree0ddc8fded7c209f940d8fde50d29226926955391
parentd458ffd3e769fd1e1582f607091fd15e94e93cdf (diff)
- Fixed a bug with multi-line comments.
-rw-r--r--new-luxc/source/luxc/parser.lux50
-rw-r--r--new-luxc/test/test/luxc/parser.lux90
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