aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/test/test/luxc/analyser/case.lux1
-rw-r--r--new-luxc/test/test/luxc/analyser/common.lux1
-rw-r--r--new-luxc/test/test/luxc/analyser/primitive.lux3
-rw-r--r--new-luxc/test/test/luxc/generator/primitive.lux3
-rw-r--r--new-luxc/test/test/luxc/generator/structure.lux5
-rw-r--r--new-luxc/test/test/luxc/parser.lux44
-rw-r--r--new-luxc/test/test/luxc/synthesizer/case.lux213
-rw-r--r--new-luxc/test/test/luxc/synthesizer/case/special.lux66
-rw-r--r--new-luxc/test/test/luxc/synthesizer/common.lux5
-rw-r--r--new-luxc/test/test/luxc/synthesizer/primitive.lux2
10 files changed, 301 insertions, 42 deletions
diff --git a/new-luxc/test/test/luxc/analyser/case.lux b/new-luxc/test/test/luxc/analyser/case.lux
index 037f99feb..280c52245 100644
--- a/new-luxc/test/test/luxc/analyser/case.lux
+++ b/new-luxc/test/test/luxc/analyser/case.lux
@@ -62,7 +62,6 @@
[#;Int r;int code;int]
[#;Deg r;deg code;deg]
[#;Real r;real code;real]
- [#;Char r;char code;char]
[#;Text (r;text +5) code;text])
(^ [_ (#;Tuple (list))])
diff --git a/new-luxc/test/test/luxc/analyser/common.lux b/new-luxc/test/test/luxc/analyser/common.lux
index 9a17fbb45..683ede10f 100644
--- a/new-luxc/test/test/luxc/analyser/common.lux
+++ b/new-luxc/test/test/luxc/analyser/common.lux
@@ -25,7 +25,6 @@
[Int code;int r;int]
[Deg code;deg r;deg]
[Real code;real r;real]
- [Char code;char r;char]
[Text code;text (r;text +5)]
)]
($_ r;either
diff --git a/new-luxc/test/test/luxc/analyser/primitive.lux b/new-luxc/test/test/luxc/analyser/primitive.lux
index 545b4e0fd..f291e2c7f 100644
--- a/new-luxc/test/test/luxc/analyser/primitive.lux
+++ b/new-luxc/test/test/luxc/analyser/primitive.lux
@@ -4,7 +4,6 @@
(control monad
pipe)
(data [bool "B/" Eq<Bool>]
- [char "C/" Eq<Char>]
[text "T/" Eq<Text>]
(text format
["l" lexer])
@@ -33,7 +32,6 @@
%int% r;int
%deg% r;deg
%real% r;real
- %char% r;char
%text% (r;text +5)]
(with-expansions
[<tests> (do-template [<desc> <type> <tag> <value> <analyser>]
@@ -55,7 +53,6 @@
["int" Int #~;Int %int% @;analyse-int]
["deg" Deg #~;Deg %deg% @;analyse-deg]
["real" Real #~;Real %real% @;analyse-real]
- ["char" Char #~;Char %char% @;analyse-char]
["text" Text #~;Text %text% @;analyse-text]
)]
($_ seq
diff --git a/new-luxc/test/test/luxc/generator/primitive.lux b/new-luxc/test/test/luxc/generator/primitive.lux
index b1ea17f95..134ff312d 100644
--- a/new-luxc/test/test/luxc/generator/primitive.lux
+++ b/new-luxc/test/test/luxc/generator/primitive.lux
@@ -6,7 +6,6 @@
(data text/format
["R" result]
[bool "B/" Eq<Bool>]
- [char "C/" Eq<Char>]
[text "T/" Eq<Text>])
["r" math/random "R/" Monad<Random>]
[macro]
@@ -26,7 +25,6 @@
%int% r;int
%deg% r;deg
%real% r;real
- %char% r;char
%text% (r;text +5)]
(with-expansions
[<tests> (do-template [<desc> <type> <synthesis> <sample> <test>]
@@ -44,7 +42,6 @@
["int" Int #ls;Int %int% i.=]
["deg" Deg #ls;Deg %deg% d.=]
["real" Real #ls;Real %real% r.=]
- ["char" Char #ls;Char %char% C/=]
["text" Text #ls;Text %text% T/=])]
($_ seq
(test "Can generate unit."
diff --git a/new-luxc/test/test/luxc/generator/structure.lux b/new-luxc/test/test/luxc/generator/structure.lux
index 1fcba59d4..51c6c80c7 100644
--- a/new-luxc/test/test/luxc/generator/structure.lux
+++ b/new-luxc/test/test/luxc/generator/structure.lux
@@ -6,7 +6,6 @@
(data text/format
["R" result]
[bool "B/" Eq<Bool>]
- [char "C/" Eq<Char>]
[text "T/" Eq<Text>]
(coll ["a" array]
[list]))
@@ -33,8 +32,7 @@
(r/map (|>. #ls;Int) r;int)))
(r;either (r;either (r/map (|>. #ls;Deg) r;deg)
(r/map (|>. #ls;Real) r;real))
- (r;either (r/map (|>. #ls;Char) r;char)
- (r/map (|>. #ls;Text) (r;text +5))))))
+ (r/map (|>. #ls;Text) (r;text +5)))))
(def: (corresponds? [prediction sample])
(-> [ls;Synthesis Top] Bool)
@@ -55,7 +53,6 @@
[#ls;Int Int i.=]
[#ls;Deg Deg d.=]
[#ls;Real Real r.=]
- [#ls;Char Char C/=]
[#ls;Text Text T/=])
_
diff --git a/new-luxc/test/test/luxc/parser.lux b/new-luxc/test/test/luxc/parser.lux
index 21d34f7c0..b7eaa0ea5 100644
--- a/new-luxc/test/test/luxc/parser.lux
+++ b/new-luxc/test/test/luxc/parser.lux
@@ -2,8 +2,7 @@
lux
(lux [io]
(control monad)
- (data [char "C/" Eq<Char>]
- [text "T/" Eq<Text>]
+ (data [text "T/" Eq<Text>]
(text format
["l" lexer])
[number]
@@ -27,9 +26,9 @@
delimiters "()[]{}#;"
space "\t\v \n\r\f"
invalid-range (format digits delimiters space)
- char-gen (|> r;char
+ char-gen (|> r;nat
(r;filter (function [sample]
- (not (text;contains? (char;as-text sample)
+ (not (text;contains? (text;from-code sample)
invalid-range)))))]
size (|> r;nat (:: @ map (|>. (n.% +20) (n.max +1))))]
(r;text' char-gen size)))
@@ -49,7 +48,6 @@
(|> r;real (r/map (|>. #;Real [default-cursor])))))
textual^ (: (r;Random Code)
($_ r;either
- (|> r;char (r/map (|>. #;Char [default-cursor])))
(do r;Monad<Random>
[size (|> r;nat (r/map (n.% +20)))]
(|> (r;text size) (r/map (|>. #;Text [default-cursor]))))
@@ -89,12 +87,11 @@
(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))))))]
+ (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<Random>
[size (|> r;nat (r/map (n.% +20)))]
(r;text' char-gen size))))
@@ -112,10 +109,9 @@
(context: "Multi-line text & comments."
#seed +13835085537605735783
- [#let [char-gen (|> r;char (r;filter (function [value]
- (not (or (char;space? value)
- (C/= #"\"" value)
- (C/= #"\n" value))))))]
+ [#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
@@ -126,9 +122,9 @@
unbalanced-comment comment-text^]
($_ seq
(test "Will reject invalid multi-line text."
- (let [bad-match (format (char;as-text x) "\n"
- (char;as-text y) "\n"
- (char;as-text z))]
+ (let [bad-match (format (text;from-code x) "\n"
+ (text;from-code y) "\n"
+ (text;from-code z))]
(case (&;parse [default-cursor
(format "\"" bad-match "\"")])
(#R;Error error)
@@ -137,12 +133,12 @@
(#R;Success [_ parsed])
false)))
(test "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))]
+ (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))))
(format "\"" good-input "\"")])
diff --git a/new-luxc/test/test/luxc/synthesizer/case.lux b/new-luxc/test/test/luxc/synthesizer/case.lux
new file mode 100644
index 000000000..5e1cf2a32
--- /dev/null
+++ b/new-luxc/test/test/luxc/synthesizer/case.lux
@@ -0,0 +1,213 @@
+(;module:
+ lux
+ (lux [io]
+ (control monad
+ pipe
+ eq)
+ (data [bool "B/" Eq<Bool>]
+ [text "T/" Eq<Text>]
+ [product]
+ [number]
+ text/format
+ (coll [list "L/" Functor<List> Fold<List> Monoid<List>]
+ ["s" set]))
+ ["r" math/random "r/" Monad<Random>]
+ test)
+ (luxc (lang ["la" analysis]
+ ["ls" synthesis])
+ [synthesizer]
+ (synthesizer ["@" case]))
+ (.. common))
+
+(struct: _ (Eq ls;Synthesis)
+ (def: (= reference sample)
+ (case [reference sample]
+ (^template [<tag> <test>]
+ [(<tag> reference') (<tag> sample')]
+ (<test> reference' sample'))
+ ([#ls;Unit is]
+ [#ls;Bool B/=]
+ [#ls;Nat n.=]
+ [#ls;Int i.=]
+ [#ls;Deg d.=]
+ [#ls;Real r.=]
+ [#ls;Text T/=])
+
+ _
+ false)))
+
+(struct: _ (Eq ls;Path)
+ (def: (= reference sample)
+ (case [reference sample]
+ (^or [#ls;UnitP #ls;UnitP]
+ [(#ls;ExecP _) (#ls;ExecP _)])
+ true
+
+ (^template [<tag> <eq>]
+ [(<tag> reference') (<tag> sample')]
+ (<eq> reference' sample'))
+ ([#ls;BindP n.=]
+ [#ls;BoolP B/=]
+ [#ls;NatP n.=]
+ [#ls;IntP i.=]
+ [#ls;DegP d.=]
+ [#ls;RealP r.=]
+ [#ls;TextP T/=])
+
+ (^template [<outer> <inner>]
+ [(<outer> (<inner> reference') reference-then)
+ (<outer> (<inner> sample') sample-then)]
+ (and (n.= reference' sample')
+ (= reference-then sample-then)))
+ ([#ls;VariantP #;Left]
+ [#ls;VariantP #;Right]
+ [#ls;TupleP #;Left]
+ [#ls;TupleP #;Right])
+
+ (^template [<tag>]
+ [(<tag> referenceL referenceR) (<tag> sampleL sampleR)]
+ (and (= referenceL sampleL)
+ (= referenceR sampleR)))
+ ([#ls;AltP]
+ [#ls;SeqP])
+
+ _
+ false)))
+
+(do-template [<name> <path> <sampler> <hash> <max>]
+ [(def: <name>
+ (r;Random ls;Path)
+ (do r;Monad<Random>
+ [num-alts (|> r;nat (:: @ map (|>. (n.% <max>) (n.max +1))))
+ samples (|> (r;set <hash> num-alts <sampler>)
+ (:: @ map s;to-list))]
+ (case (|> samples
+ (L/map (|>. <path>))
+ list;reverse)
+ (#;Cons last prevs)
+ (wrap (L/fold (function [left right]
+ (#ls;AltP left right))
+ last
+ prevs))
+
+ #;Nil
+ (undefined))))]
+
+ [gen-bool #ls;BoolP r;bool bool;Hash<Bool> +2]
+ [gen-nat #ls;NatP r;nat number;Hash<Nat> +5]
+ [gen-int #ls;IntP r;int number;Hash<Int> +5]
+ [gen-deg #ls;DegP r;deg number;Hash<Deg> +5]
+ [gen-real #ls;RealP r;real number;Hash<Real> +5]
+ [gen-text #ls;TextP (r;text +5) text;Hash<Text> +5]
+ )
+
+(def: gen-primitive-path
+ (r;Random ls;Path)
+ (r;either (r;either (r;either (r/wrap #ls;UnitP)
+ gen-bool)
+ (r;either gen-nat
+ gen-int))
+ (r;either (r;either gen-deg
+ gen-real)
+ gen-text)))
+
+(do-template [<name> <tag> <join>]
+ [(def: (<name> gen-path)
+ (-> (-> (Maybe ls;Synthesis) (r;Random ls;Path))
+ (r;Random ls;Path))
+ (do r;Monad<Random>
+ [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2))))
+ members (r;list size (gen-path #;None))]
+ (case (list;reverse (list;enumerate members))
+ (#;Cons [last-idx last-path] prevs)
+ (wrap (L/fold (function [[left-idx left-path] right-path]
+ (<join> (<tag> (#;Right left-idx) left-path)
+ right-path))
+ (<tag> (#;Right last-idx) last-path)
+ prevs))
+
+ #;Nil
+ (undefined))))]
+
+ [gen-tuple-path #ls;TupleP #ls;SeqP]
+ [gen-variant-path #ls;VariantP #ls;AltP]
+ )
+
+(def: (gen-path ?body)
+ (-> (Maybe ls;Synthesis) (r;Random ls;Path))
+ (do r;Monad<Random>
+ [pattern (r;either (r;either (r/wrap (#ls;BindP +0))
+ gen-primitive-path)
+ (r;either (gen-tuple-path gen-path)
+ (gen-variant-path gen-path)))]
+ (case ?body
+ #;None
+ (wrap pattern)
+
+ (#;Some body)
+ (wrap (#ls;SeqP pattern (#ls;ExecP body))))))
+
+(def: (to-branches path)
+ (-> ls;Path (List la;Pattern))
+ (case path
+ (^template [<from> <to>]
+ (<from> value)
+ (list (<to> value)))
+ ([#ls;UnitP #la;UnitP]
+ [#ls;BoolP #la;BoolP]
+ [#ls;NatP #la;NatP]
+ [#ls;IntP #la;IntP]
+ [#ls;DegP #la;DegP]
+ [#ls;RealP #la;RealP]
+ [#ls;TextP #la;TextP]
+ [#ls;BindP #la;BindP])
+
+ (#ls;AltP left right)
+ (L/append (to-branches left)
+ (to-branches right))
+
+ (#ls;SeqP (#ls;TupleP (#;Left +0) head)
+ tail)
+ (loop [head head
+ tail tail]
+ (case [(path-to-pattern head) tail]
+ [(#;Some =head) (#ls;SeqP (#ls;TupleP (#;Left idx) head')
+ tail')]
+ (list& =head (recur head' tail'))
+
+ [(#;Some =head) (#ls;SeqP (#ls;TupleP (#;Left idx) head')
+ tail')]
+ (list& =head (recur head' tail'))
+
+ [(#;Some =head) (#ls;SeqP (#ls;TupleP (#;Right last-idx))
+ tail')]
+ (do list;Monad<List>
+ [=tail' (to-branches tail')
+ =right (to-branches right)]
+ )))
+
+ (#ls;SeqP left right)
+ (do list;Monad<List>
+ [=left (to-branches left)
+ =right (to-branches right)]
+ )
+
+ #PopP
+ (#VariantP (Either Nat Nat))
+ (#TupleP (Either Nat Nat))
+
+
+ (#ExecP s)
+ ))
+
+(context: "Pattern-matching."
+ [outputA gen-primitive
+ prediction (gen-path (#;Some (synthesizer;synthesize outputA)))
+ #let [branches (to-branches outputA prediction)]]
+ (test "Can efficiently synthesize pattern-matching trees."
+ (|> (synthesizer;synthesize (#la;Case #la;Unit branches))
+ (case> (#la;Case #ls;Unit pathS)
+ (:: Eq<Path> prediction pathS)
+
+ _
+ false))))
diff --git a/new-luxc/test/test/luxc/synthesizer/case/special.lux b/new-luxc/test/test/luxc/synthesizer/case/special.lux
new file mode 100644
index 000000000..fe5ad20ac
--- /dev/null
+++ b/new-luxc/test/test/luxc/synthesizer/case/special.lux
@@ -0,0 +1,66 @@
+(;module:
+ lux
+ (lux [io]
+ (control monad
+ pipe)
+ (data [product]
+ [number]
+ text/format
+ (coll [list "L/" Functor<List> Fold<List>]
+ ["D" dict]
+ ["s" set]))
+ ["r" math/random "r/" Monad<Random>]
+ test)
+ (luxc (lang ["la" analysis]
+ ["ls" synthesis])
+ [synthesizer])
+ (../.. common))
+
+(context: "Dummy variables."
+ [maskedA gen-primitive
+ temp r;nat
+ #let [maskA (#la;Case maskedA
+ (list [(#la;BindP temp)
+ (#la;Relative (#;Local temp))]))]]
+ (test "Dummy variables created to mask expressions get eliminated during synthesis."
+ (|> (synthesizer;synthesize maskA)
+ (corresponds? maskedA))))
+
+(context: "Let expressions."
+ [registerA r;nat
+ inputA gen-primitive
+ outputA gen-primitive
+ #let [letA (#la;Case inputA
+ (list [(#la;BindP registerA)
+ outputA]))]]
+ (test "Can detect and reify simple 'let' expressions."
+ (|> (synthesizer;synthesize letA)
+ (case> (#ls;Let registerS inputS outputS)
+ (and (n.= registerA registerS)
+ (corresponds? inputA inputS)
+ (corresponds? outputA outputS))
+
+ _
+ false))))
+
+(context: "If expressions."
+ [then|else r;bool
+ inputA gen-primitive
+ thenA gen-primitive
+ elseA gen-primitive
+ #let [ifA (if then|else
+ (#la;Case inputA
+ (list [(#la;BoolP true) thenA]
+ [(#la;BoolP false) elseA]))
+ (#la;Case inputA
+ (list [(#la;BoolP false) elseA]
+ [(#la;BoolP true) thenA])))]]
+ (test "Can detect and reify simple 'if' expressions."
+ (|> (synthesizer;synthesize ifA)
+ (case> (#ls;If inputS thenS elseS)
+ (and (corresponds? inputA inputS)
+ (corresponds? thenA thenS)
+ (corresponds? elseA elseS))
+
+ _
+ false))))
diff --git a/new-luxc/test/test/luxc/synthesizer/common.lux b/new-luxc/test/test/luxc/synthesizer/common.lux
index c02e23c7c..88eeaea7c 100644
--- a/new-luxc/test/test/luxc/synthesizer/common.lux
+++ b/new-luxc/test/test/luxc/synthesizer/common.lux
@@ -1,7 +1,6 @@
(;module:
lux
(lux (data [bool "B/" Eq<Bool>]
- [char "C/" Eq<Char>]
[text "T/" Eq<Text>])
["r" math/random "r/" Monad<Random>])
(luxc (lang ["la" analysis]
@@ -15,8 +14,7 @@
(r/map (|>. #la;Int) r;int)))
(r;either (r;either (r/map (|>. #la;Deg) r;deg)
(r/map (|>. #la;Real) r;real))
- (r;either (r/map (|>. #la;Char) r;char)
- (r/map (|>. #la;Text) (r;text +5))))))
+ (r/map (|>. #la;Text) (r;text +5)))))
(def: #export (corresponds? analysis synthesis)
(-> la;Analysis ls;Synthesis Bool)
@@ -30,7 +28,6 @@
[#la;Int #ls;Int i.=]
[#la;Deg #ls;Deg d.=]
[#la;Real #ls;Real r.=]
- [#la;Char #ls;Char C/=]
[#la;Text #ls;Text T/=])
_
diff --git a/new-luxc/test/test/luxc/synthesizer/primitive.lux b/new-luxc/test/test/luxc/synthesizer/primitive.lux
index c17d41a78..e1e37e469 100644
--- a/new-luxc/test/test/luxc/synthesizer/primitive.lux
+++ b/new-luxc/test/test/luxc/synthesizer/primitive.lux
@@ -17,7 +17,6 @@
%int% r;int
%deg% r;deg
%real% r;real
- %char% r;char
%text% (r;text +5)]
(with-expansions
[<tests> (do-template [<desc> <analysis> <synthesis> <sample>]
@@ -35,7 +34,6 @@
["int" #la;Int #ls;Int %int%]
["deg" #la;Deg #ls;Deg %deg%]
["real" #la;Real #ls;Real %real%]
- ["char" #la;Char #ls;Char %char%]
["text" #la;Text #ls;Text %text%])]
($_ seq
<tests>)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 09:07:42 +0000