From 7cc935bd3d2e716bfeb006badeeaa8bb05927d11 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 31 Oct 2017 23:48:20 -0400 Subject: - Re-named "parser" to "syntax". --- new-luxc/test/test/luxc/lang/parser.lux | 233 -------------------------------- new-luxc/test/test/luxc/lang/syntax.lux | 233 ++++++++++++++++++++++++++++++++ new-luxc/test/tests.lux | 2 +- 3 files changed, 234 insertions(+), 234 deletions(-) delete mode 100644 new-luxc/test/test/luxc/lang/parser.lux create mode 100644 new-luxc/test/test/luxc/lang/syntax.lux (limited to 'new-luxc/test') diff --git a/new-luxc/test/test/luxc/lang/parser.lux b/new-luxc/test/test/luxc/lang/parser.lux deleted file mode 100644 index c70bdaece..000000000 --- a/new-luxc/test/test/luxc/lang/parser.lux +++ /dev/null @@ -1,233 +0,0 @@ -(;module: - lux - (lux [io] - (control [monad #+ do]) - (data [number] - ["e" error] - [text] - (text format - ["l" lexer]) - (coll [list])) - ["r" math/random "r/" Monad] - (meta [code]) - test) - (luxc (lang ["&" parser]))) - -(def: default-cursor - Cursor - {#;module "" - #;line +0 - #;column +0}) - -(def: ident-part^ - (r;Random Text) - (do r;Monad - [#let [digits "0123456789" - delimiters "()[]{}#;\"" - space "\t\v \n\r\f" - invalid-range (format digits delimiters space) - char-gen (|> r;nat - (r;filter (function [sample] - (not (text;contains? (text;from-code sample) - invalid-range)))))] - 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^)) - -(def: code^ - (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;frac (r/map (|>. #;Frac [default-cursor]))))) - textual^ (: (r;Random Code) - ($_ r;either - (do r;Monad - [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 - (function [code^] - (let [multi^ (do r;Monad - [size (|> r;nat (r/map (n.% +3)))] - (r;list size code^)) - composite^ (: (r;Random Code) - ($_ r;either - (|> multi^ (r/map (|>. #;Form [default-cursor]))) - (|> multi^ (r/map (|>. #;Tuple [default-cursor]))) - (do r;Monad - [size (|> r;nat (r/map (n.% +3)))] - (|> (r;list size (r;seq code^ code^)) - (r/map (|>. #;Record [default-cursor]))))))] - (r;either simple^ - composite^)))))) - -(context: "Lux code parser." - (<| (times +100) - (do @ - [sample code^ - other code^] - ($_ seq - (test "Can parse Lux code." - (case (&;parse [default-cursor +0 (code;to-text sample)]) - (#e;Error error) - false - - (#e;Success [_ parsed]) - (:: code;Eq = parsed sample))) - (test "Can parse Lux multiple code nodes." - (case (&;parse [default-cursor +0 (format (code;to-text sample) " " - (code;to-text other))]) - (#e;Error error) - false - - (#e;Success [remaining =sample]) - (case (&;parse remaining) - (#e;Error error) - false - - (#e;Success [_ =other]) - (and (:: code;Eq = sample =sample) - (:: code;Eq = other =other))))) - )))) - -(def: nat-to-frac - (-> Nat Frac) - (|>. nat-to-int int-to-frac)) - -(context: "Frac special syntax." - (<| (times +100) - (do @ - [numerator (|> r;nat (:: @ map (|>. (n.% +100) nat-to-frac))) - denominator (|> r;nat (:: @ map (|>. (n.% +100) (n.max +1) nat-to-frac))) - signed? r;bool - #let [expected (|> numerator (f./ denominator) (f.* (if signed? -1.0 1.0)))]] - (test "Can parse frac ratio syntax." - (case (&;parse [default-cursor +0 - (format (if signed? "-" "") - (%i (frac-to-int numerator)) - "/" - (%i (frac-to-int denominator)))]) - (#e;Success [_ [_ (#;Frac actual)]]) - (f.= expected actual) - - _ - false) - )))) - -(context: "Nat special syntax." - (<| (times +100) - (do @ - [expected (|> r;nat (:: @ map (n.% +1_000)))] - (test "Can parse nat char syntax." - (case (&;parse [default-cursor +0 - (format "#" (%t (text;from-code expected)) "")]) - (#e;Success [_ [_ (#;Nat actual)]]) - (n.= expected actual) - - _ - false) - )))) - -(def: comment-text^ - (r;Random Text) - (let [char-gen (|> r;nat (r;filter (function [value] - (not (or (text;space? value) - (n.= (char "#") value) - (n.= (char "(") value) - (n.= (char ")") value))))))] - (do r;Monad - [size (|> r;nat (r/map (n.% +20)))] - (r;text' char-gen size)))) - -(def: comment^ - (r;Random Text) - (r;either (do r;Monad - [comment comment-text^] - (wrap (format "## " comment "\n"))) - (r;rec (function [nested^] - (do r;Monad - [comment (r;either comment-text^ - nested^)] - (wrap (format "#( " comment " )#"))))))) - -(context: "Multi-line text & comments." - (<| (times +100) - (do @ - [#let [char-gen (|> r;nat (r;filter (function [value] - (not (or (text;space? value) - (n.= (char "\"") 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 code^ - comment comment^ - unbalanced-comment comment-text^] - ($_ seq - (test "Will reject invalid multi-line text." - (let [bad-match (format (text;from-code x) "\n" - (text;from-code y) "\n" - (text;from-code z))] - (case (&;parse [default-cursor +0 - (format "\"" bad-match "\"")]) - (#e;Error error) - true - - (#e;Success [_ parsed]) - false))) - (test "Will accept valid multi-line text" - (let [good-input (format (text;from-code x) "\n" - offset (text;from-code y) "\n" - offset (text;from-code z)) - good-output (format (text;from-code x) "\n" - (text;from-code y) "\n" - (text;from-code z))] - (case (&;parse [(|> default-cursor (update@ #;column (n.+ (n.dec offset-size)))) - +0 - (format "\"" good-input "\"")]) - (#e;Error error) - false - - (#e;Success [_ parsed]) - (:: code;Eq = - parsed - (code;text good-output))))) - (test "Can handle comments." - (case (&;parse [default-cursor +0 - (format comment (code;to-text sample))]) - (#e;Error error) - false - - (#e;Success [_ parsed]) - (:: code;Eq = parsed sample))) - (test "Will reject unbalanced multi-line comments." - (and (case (&;parse [default-cursor +0 - (format "#(" "#(" unbalanced-comment ")#" - (code;to-text sample))]) - (#e;Error error) - true - - (#e;Success [_ parsed]) - false) - (case (&;parse [default-cursor +0 - (format "#(" unbalanced-comment ")#" ")#" - (code;to-text sample))]) - (#e;Error error) - true - - (#e;Success [_ parsed]) - false))) - )))) diff --git a/new-luxc/test/test/luxc/lang/syntax.lux b/new-luxc/test/test/luxc/lang/syntax.lux new file mode 100644 index 000000000..195fed2ca --- /dev/null +++ b/new-luxc/test/test/luxc/lang/syntax.lux @@ -0,0 +1,233 @@ +(;module: + lux + (lux [io] + (control [monad #+ do]) + (data [number] + ["e" error] + [text] + (text format + ["l" lexer]) + (coll [list])) + ["r" math/random "r/" Monad] + (meta [code]) + test) + (luxc (lang ["&" syntax]))) + +(def: default-cursor + Cursor + {#;module "" + #;line +0 + #;column +0}) + +(def: ident-part^ + (r;Random Text) + (do r;Monad + [#let [digits "0123456789" + delimiters "()[]{}#;\"" + space "\t\v \n\r\f" + invalid-range (format digits delimiters space) + char-gen (|> r;nat + (r;filter (function [sample] + (not (text;contains? (text;from-code sample) + invalid-range)))))] + 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^)) + +(def: code^ + (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;frac (r/map (|>. #;Frac [default-cursor]))))) + textual^ (: (r;Random Code) + ($_ r;either + (do r;Monad + [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 + (function [code^] + (let [multi^ (do r;Monad + [size (|> r;nat (r/map (n.% +3)))] + (r;list size code^)) + composite^ (: (r;Random Code) + ($_ r;either + (|> multi^ (r/map (|>. #;Form [default-cursor]))) + (|> multi^ (r/map (|>. #;Tuple [default-cursor]))) + (do r;Monad + [size (|> r;nat (r/map (n.% +3)))] + (|> (r;list size (r;seq code^ code^)) + (r/map (|>. #;Record [default-cursor]))))))] + (r;either simple^ + composite^)))))) + +(context: "Lux code syntax." + (<| (times +100) + (do @ + [sample code^ + other code^] + ($_ seq + (test "Can parse Lux code." + (case (&;parse [default-cursor +0 (code;to-text sample)]) + (#e;Error error) + false + + (#e;Success [_ parsed]) + (:: code;Eq = parsed sample))) + (test "Can parse Lux multiple code nodes." + (case (&;parse [default-cursor +0 (format (code;to-text sample) " " + (code;to-text other))]) + (#e;Error error) + false + + (#e;Success [remaining =sample]) + (case (&;parse remaining) + (#e;Error error) + false + + (#e;Success [_ =other]) + (and (:: code;Eq = sample =sample) + (:: code;Eq = other =other))))) + )))) + +(def: nat-to-frac + (-> Nat Frac) + (|>. nat-to-int int-to-frac)) + +(context: "Frac special syntax." + (<| (times +100) + (do @ + [numerator (|> r;nat (:: @ map (|>. (n.% +100) nat-to-frac))) + denominator (|> r;nat (:: @ map (|>. (n.% +100) (n.max +1) nat-to-frac))) + signed? r;bool + #let [expected (|> numerator (f./ denominator) (f.* (if signed? -1.0 1.0)))]] + (test "Can parse frac ratio syntax." + (case (&;parse [default-cursor +0 + (format (if signed? "-" "") + (%i (frac-to-int numerator)) + "/" + (%i (frac-to-int denominator)))]) + (#e;Success [_ [_ (#;Frac actual)]]) + (f.= expected actual) + + _ + false) + )))) + +(context: "Nat special syntax." + (<| (times +100) + (do @ + [expected (|> r;nat (:: @ map (n.% +1_000)))] + (test "Can parse nat char syntax." + (case (&;parse [default-cursor +0 + (format "#" (%t (text;from-code expected)) "")]) + (#e;Success [_ [_ (#;Nat actual)]]) + (n.= expected actual) + + _ + false) + )))) + +(def: comment-text^ + (r;Random Text) + (let [char-gen (|> r;nat (r;filter (function [value] + (not (or (text;space? value) + (n.= (char "#") value) + (n.= (char "(") value) + (n.= (char ")") value))))))] + (do r;Monad + [size (|> r;nat (r/map (n.% +20)))] + (r;text' char-gen size)))) + +(def: comment^ + (r;Random Text) + (r;either (do r;Monad + [comment comment-text^] + (wrap (format "## " comment "\n"))) + (r;rec (function [nested^] + (do r;Monad + [comment (r;either comment-text^ + nested^)] + (wrap (format "#( " comment " )#"))))))) + +(context: "Multi-line text & comments." + (<| (times +100) + (do @ + [#let [char-gen (|> r;nat (r;filter (function [value] + (not (or (text;space? value) + (n.= (char "\"") 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 code^ + comment comment^ + unbalanced-comment comment-text^] + ($_ seq + (test "Will reject invalid multi-line text." + (let [bad-match (format (text;from-code x) "\n" + (text;from-code y) "\n" + (text;from-code z))] + (case (&;parse [default-cursor +0 + (format "\"" bad-match "\"")]) + (#e;Error error) + true + + (#e;Success [_ parsed]) + false))) + (test "Will accept valid multi-line text" + (let [good-input (format (text;from-code x) "\n" + offset (text;from-code y) "\n" + offset (text;from-code z)) + good-output (format (text;from-code x) "\n" + (text;from-code y) "\n" + (text;from-code z))] + (case (&;parse [(|> default-cursor (update@ #;column (n.+ (n.dec offset-size)))) + +0 + (format "\"" good-input "\"")]) + (#e;Error error) + false + + (#e;Success [_ parsed]) + (:: code;Eq = + parsed + (code;text good-output))))) + (test "Can handle comments." + (case (&;parse [default-cursor +0 + (format comment (code;to-text sample))]) + (#e;Error error) + false + + (#e;Success [_ parsed]) + (:: code;Eq = parsed sample))) + (test "Will reject unbalanced multi-line comments." + (and (case (&;parse [default-cursor +0 + (format "#(" "#(" unbalanced-comment ")#" + (code;to-text sample))]) + (#e;Error error) + true + + (#e;Success [_ parsed]) + false) + (case (&;parse [default-cursor +0 + (format "#(" unbalanced-comment ")#" ")#" + (code;to-text sample))]) + (#e;Error error) + true + + (#e;Success [_ parsed]) + false))) + )))) diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux index c112e4076..f96d5bdfc 100644 --- a/new-luxc/test/tests.lux +++ b/new-luxc/test/tests.lux @@ -5,7 +5,7 @@ (concurrency [promise]) [cli #+ program:] [test]) - (test (luxc (lang ["_;P" parser] + (test (luxc (lang ["_;L" syntax] (analysis ["_;A" primitive] ["_;A" structure] ["_;A" reference] -- cgit v1.2.3