aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/lux/control.lux2
-rw-r--r--stdlib/source/test/lux/control/parser/synthesis.lux161
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux4
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux335
4 files changed, 501 insertions, 1 deletions
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index 80a94be6f..c0c673009 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -25,6 +25,7 @@
["#/." cli]
["#/." code]
["#/." json]
+ ["#/." synthesis]
["#/." text]]
["#." pipe]
["#." reader]
@@ -66,6 +67,7 @@
/parser/cli.test
/parser/code.test
/parser/json.test
+ /parser/synthesis.test
/parser/text.test
))
diff --git a/stdlib/source/test/lux/control/parser/synthesis.lux b/stdlib/source/test/lux/control/parser/synthesis.lux
new file mode 100644
index 000000000..5dbf6a383
--- /dev/null
+++ b/stdlib/source/test/lux/control/parser/synthesis.lux
@@ -0,0 +1,161 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ ["." monad (#+ do)]]
+ [math
+ ["." random (#+ Random)]]
+ [control
+ [pipe (#+ case>)]
+ ["." try]
+ ["." exception]
+ ["<>" parser]]
+ [data
+ ["." bit]
+ ["." name]
+ ["." text]
+ [number
+ ["." i64]
+ ["n" nat]
+ ["." frac]]
+ [collection
+ ["." list ("#@." functor)]]]
+ [tool
+ [compiler
+ [reference (#+)
+ ["." variable (#+ Variable)]]
+ [language
+ [lux
+ [analysis (#+ Environment)]
+ ["." synthesis]]]]]]
+ {1
+ ["." /]})
+
+(template: (!expect <pattern> <value>)
+ (case <value>
+ <pattern>
+ true
+
+ _
+ false))
+
+(def: random-constant
+ (Random Name)
+ (random.and (random.unicode 1)
+ (random.unicode 1)))
+
+(def: random-variable
+ (Random Variable)
+ (random.or random.nat
+ random.nat))
+
+(def: random-environment
+ (Random Environment)
+ (do {@ random.monad}
+ [size (:: @ map (n.% 5) random.nat)]
+ (random.list size ..random-variable)))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.with-cover [/.Parser])
+ ($_ _.and
+ (do {@ random.monad}
+ [expected (:: @ map (|>> synthesis.i64) random.nat)]
+ (_.cover [/.run /.any]
+ (|> (/.run /.any (list expected))
+ (!expect (^multi (#try.Success actual)
+ (:: synthesis.equivalence = expected actual))))))
+ (_.cover [/.empty-input]
+ (|> (/.run /.any (list))
+ (!expect (^multi (#try.Failure error)
+ (exception.match? /.empty-input error)))))
+ (do {@ random.monad}
+ [expected (:: @ map (|>> synthesis.i64) random.nat)]
+ (_.cover [/.unconsumed-input]
+ (|> (/.run /.any (list expected expected))
+ (!expect (^multi (#try.Failure error)
+ (exception.match? /.unconsumed-input error))))))
+ (do {@ random.monad}
+ [dummy (:: @ map (|>> synthesis.i64) random.nat)]
+ (_.cover [/.end! /.expected-empty-input]
+ (and (|> (/.run /.end! (list))
+ (!expect (#try.Success _)))
+ (|> (/.run /.end! (list dummy))
+ (!expect (^multi (#try.Failure error)
+ (exception.match? /.expected-empty-input error)))))))
+ (do {@ random.monad}
+ [dummy (:: @ map (|>> synthesis.i64) random.nat)]
+ (_.cover [/.end?]
+ (and (|> (/.run /.end? (list))
+ (!expect (#try.Success #1)))
+ (|> (/.run (<>.before /.any /.end?) (list dummy))
+ (!expect (#try.Success #0))))))
+ (_.with-cover [/.cannot-parse]
+ (`` ($_ _.and
+ (~~ (template [<query> <check> <random> <synthesis> <equivalence>]
+ [(do {@ random.monad}
+ [expected <random>
+ dummy (|> <random> (random.filter (|>> (:: <equivalence> = expected) not)))]
+ ($_ _.and
+ (_.cover [<query>]
+ (|> (/.run <query> (list (<synthesis> expected)))
+ (!expect (^multi (#try.Success actual)
+ (:: <equivalence> = expected actual)))))
+ (_.cover [<check>]
+ (and (|> (/.run (<check> expected) (list (<synthesis> expected)))
+ (!expect (#try.Success _)))
+ (|> (/.run (<check> expected) (list (<synthesis> dummy)))
+ (!expect (^multi (#try.Failure error)
+ (exception.match? /.cannot-parse error))))))))]
+
+ [/.bit /.bit! random.bit synthesis.bit bit.equivalence]
+ [/.i64 /.i64! (:: @ map .i64 random.nat) synthesis.i64 i64.equivalence]
+ [/.f64 /.f64! random.frac synthesis.f64 frac.equivalence]
+ [/.text /.text! (random.unicode 1) synthesis.text text.equivalence]
+ [/.local /.local! random.nat synthesis.variable/local n.equivalence]
+ [/.foreign /.foreign! random.nat synthesis.variable/foreign n.equivalence]
+ [/.constant /.constant! ..random-constant synthesis.constant name.equivalence]
+ ))
+ (do {@ random.monad}
+ [expected-bit random.bit
+ expected-i64 (:: @ map .i64 random.nat)
+ expected-f64 random.frac
+ expected-text (random.unicode 1)]
+ (_.cover [/.tuple]
+ (and (|> (/.run (/.tuple ($_ <>.and /.bit /.i64 /.f64 /.text))
+ (list (synthesis.tuple (list (synthesis.bit expected-bit)
+ (synthesis.i64 expected-i64)
+ (synthesis.f64 expected-f64)
+ (synthesis.text expected-text)))))
+ (!expect (^multi (#try.Success [actual-bit actual-i64 actual-f64 actual-text])
+ (and (:: bit.equivalence = expected-bit actual-bit)
+ (:: i64.equivalence = expected-i64 actual-i64)
+ (:: frac.equivalence = expected-f64 actual-f64)
+ (:: text.equivalence = expected-text actual-text)))))
+ (|> (/.run (/.tuple ($_ <>.and /.bit /.i64 /.f64 /.text))
+ (list (synthesis.text expected-text)))
+ (!expect (^multi (#try.Failure error)
+ (exception.match? /.cannot-parse error)))))))
+ (do {@ random.monad}
+ [arity random.nat
+ expected-environment ..random-environment
+ expected-body (random.unicode 1)]
+ (_.cover [/.function /.wrong-arity]
+ (and (|> (/.run (/.function arity /.text)
+ (list (synthesis.function/abstraction [expected-environment arity (synthesis.text expected-body)])))
+ (!expect (^multi (#try.Success [actual-environment actual-body])
+ (and (:: (list.equivalence variable.equivalence) =
+ expected-environment
+ actual-environment)
+ (:: text.equivalence = expected-body actual-body)))))
+ (|> (/.run (/.function arity /.text)
+ (list (synthesis.text expected-body)))
+ (!expect (^multi (#try.Failure error)
+ (exception.match? /.cannot-parse error))))
+ (|> (/.run (/.function (inc arity) /.text)
+ (list (synthesis.function/abstraction [expected-environment arity (synthesis.text expected-body)])))
+ (!expect (^multi (#try.Failure error)
+ (exception.match? /.wrong-arity error)))))))
+ )))
+ )))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux
index 46291b311..4a7a7c507 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux
@@ -6,7 +6,8 @@
["#." structure]
["#." case]
["#." function]
- ["#." loop]])
+ ["#." loop]
+ ["#." variable]])
(def: #export test
Test
@@ -16,4 +17,5 @@
/case.test
/function.test
/loop.test
+ /variable.test
))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux
new file mode 100644
index 000000000..b90829862
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux
@@ -0,0 +1,335 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ ["." monad (#+ do)]]
+ [math
+ ["." random (#+ Random)]]
+ [control
+ [pipe (#+ case>)]
+ ["." try]]
+ [data
+ ["." product]
+ ["." text
+ ["%" format (#+ format)]]
+ [number
+ ["n" nat]]
+ [collection
+ ["." list ("#@." functor fold)]
+ ["." dictionary (#+ Dictionary)]]]]
+ {1
+ ["." /
+ [////
+ ["." analysis]
+ ["." synthesis (#+ Side Member Path Synthesis)]
+ [///
+ [reference (#+)
+ ["." variable]]]]]})
+
+(template: (!expect <pattern> <value>)
+ (case <value>
+ <pattern>
+ true
+
+ _
+ false))
+
+(type: Context
+ {#redundants Nat
+ #necessary (Dictionary Nat Nat)})
+
+(type: (Scenario a)
+ (-> Context (Random [a a])))
+
+(template [<name> <synthesis> <random>]
+ [(def: (<name> context)
+ (Scenario Synthesis)
+ (do {@ random.monad}
+ [value <random>]
+ (wrap [(<synthesis> value)
+ (<synthesis> value)])))]
+
+ [bit-scenario synthesis.bit random.bit]
+ [i64-scenario synthesis.i64 (:: @ map .i64 random.nat)]
+ [f64-scenario synthesis.f64 random.frac]
+ [text-scenario synthesis.text (random.unicode 1)]
+ )
+
+(def: (primitive-scenario context)
+ (Scenario Synthesis)
+ (random.either (random.either (..bit-scenario context)
+ (..i64-scenario context))
+ (random.either (..f64-scenario context)
+ (..text-scenario context))))
+
+(def: (with-redundancy scenario context)
+ (-> (Scenario Synthesis) (Scenario Synthesis))
+ (do {@ random.monad}
+ [redundant? random.bit]
+ (if redundant?
+ (do @
+ [let? random.bit
+ [expected-input actual-input] (..primitive-scenario context)
+ #let [fake-register (n.+ (get@ #redundants context)
+ (dictionary.size (get@ #necessary context)))]
+ [expected-output actual-output] (scenario (update@ #redundants inc context))]
+ (wrap [(synthesis.branch/case [expected-input
+ (#synthesis.Seq #synthesis.Pop
+ (#synthesis.Then expected-output))])
+ (if let?
+ (synthesis.branch/let [actual-input fake-register actual-output])
+ (synthesis.branch/case [actual-input
+ (#synthesis.Seq (#synthesis.Bind fake-register)
+ (#synthesis.Seq #synthesis.Pop
+ (#synthesis.Then actual-output)))]))]))
+ (scenario context))))
+
+(def: (variant-scenario scenario context)
+ (-> (Scenario Synthesis) (Scenario Synthesis))
+ (do {@ random.monad}
+ [lefts random.nat
+ right? random.bit
+ [expected input] (scenario context)]
+ (wrap [(synthesis.variant [lefts right? expected])
+ (synthesis.variant [lefts right? input])])))
+
+(def: (tuple-scenario context)
+ (Scenario Synthesis)
+ (let [registers (dictionary.entries (get@ #necessary context))]
+ (:: random.monad wrap
+ [(synthesis.tuple (list@map (|>> product.left synthesis.variable/local) registers))
+ (synthesis.tuple (list@map (|>> product.right synthesis.variable/local) registers))])))
+
+(def: (structure-scenario context)
+ (Scenario Synthesis)
+ (random.either (..variant-scenario (..with-redundancy ..tuple-scenario) context)
+ (..tuple-scenario context)))
+
+(def: (let-scenario scenario context)
+ (-> (Scenario Synthesis) (Scenario Synthesis))
+ (do random.monad
+ [_ (wrap [])
+ [expected-input actual-input] (scenario context)
+ #let [real-register (dictionary.size (get@ #necessary context))
+ fake-register (n.+ (get@ #redundants context)
+ (dictionary.size (get@ #necessary context)))]
+ [expected-output actual-output] (scenario (update@ #necessary (dictionary.put real-register fake-register) context))]
+ (wrap [(synthesis.branch/let [expected-input real-register expected-output])
+ (synthesis.branch/let [actual-input fake-register actual-output])])))
+
+(def: (if-scenario scenario context)
+ (-> (Scenario Synthesis) (Scenario Synthesis))
+ (do random.monad
+ [_ (wrap [])
+ [expected-test actual-test] (scenario context)
+ [expected-then actual-then] (scenario context)
+ [expected-else actual-else] (scenario context)]
+ (wrap [(synthesis.branch/if [expected-test
+ expected-then
+ expected-else])
+ (synthesis.branch/if [actual-test
+ actual-then
+ actual-else])])))
+
+(def: random-member
+ (Random Member)
+ (do random.monad
+ [lefts random.nat
+ right? random.bit]
+ (wrap (if right?
+ (#.Right lefts)
+ (#.Left lefts)))))
+
+(def: (get-scenario scenario context)
+ (-> (Scenario Synthesis) (Scenario Synthesis))
+ (do {@ random.monad}
+ [length (:: @ map (|>> (n.% 5) inc) random.nat)
+ path (random.list length ..random-member)
+ [expected-record actual-record] (scenario context)]
+ (wrap [(synthesis.branch/get [path expected-record])
+ (synthesis.branch/get [path actual-record])])))
+
+(def: random-side
+ (Random Side)
+ ..random-member)
+
+(def: (path-scenario scenario context)
+ (-> (Scenario Synthesis) (Scenario Path))
+ (`` ($_ random.either
+ ($_ random.either
+ (do {@ random.monad}
+ [_ (wrap [])
+ [expected-then actual-then] (scenario context)]
+ (wrap [(#synthesis.Seq #synthesis.Pop
+ (#synthesis.Then expected-then))
+ (#synthesis.Seq #synthesis.Pop
+ (#synthesis.Then actual-then))]))
+ (do {@ random.monad}
+ [_ (wrap [])
+ #let [real-register (dictionary.size (get@ #necessary context))
+ fake-register (n.+ (get@ #redundants context)
+ (dictionary.size (get@ #necessary context)))]
+ [expected-then actual-then] (scenario (update@ #necessary (dictionary.put real-register fake-register) context))]
+ (wrap [(#synthesis.Seq (#synthesis.Bind real-register)
+ (#synthesis.Seq #synthesis.Pop
+ (#synthesis.Then expected-then)))
+ (#synthesis.Seq (#synthesis.Bind fake-register)
+ (#synthesis.Seq #synthesis.Pop
+ (#synthesis.Then actual-then)))])))
+ ($_ random.either
+ (~~ (template [<tag> <random>]
+ [(do {@ random.monad}
+ [test <random>
+ [expected-then actual-then] (scenario context)]
+ (wrap [(#synthesis.Seq (#synthesis.Test (<tag> test))
+ (#synthesis.Then expected-then))
+ (#synthesis.Seq (#synthesis.Test (<tag> test))
+ (#synthesis.Then actual-then))]))]
+
+ [#synthesis.Bit random.bit]
+ [#synthesis.I64 (:: @ map .i64 random.nat)]
+ [#synthesis.F64 random.frac]
+ [#synthesis.Text (random.unicode 1)]
+ )))
+ ($_ random.either
+ (do {@ random.monad}
+ [side ..random-side
+ [expected-next actual-next] (path-scenario scenario context)]
+ (wrap [(#synthesis.Seq (#synthesis.Access (#synthesis.Side side))
+ expected-next)
+ (#synthesis.Seq (#synthesis.Access (#synthesis.Side side))
+ actual-next)]))
+ (do {@ random.monad}
+ [member ..random-member
+ [expected-next actual-next] (path-scenario scenario context)]
+ (wrap [(#synthesis.Seq (#synthesis.Access (#synthesis.Member member))
+ expected-next)
+ (#synthesis.Seq (#synthesis.Access (#synthesis.Member member))
+ actual-next)])))
+ (do {@ random.monad}
+ [_ (wrap [])
+ [expected-left actual-left] (path-scenario scenario context)
+ [expected-right actual-right] (path-scenario scenario context)]
+ (wrap [(#synthesis.Alt expected-left expected-right)
+ (#synthesis.Alt actual-left actual-right)]))
+ )))
+
+(def: (case-scenario scenario context)
+ (-> (Scenario Synthesis) (Scenario Synthesis))
+ (do {@ random.monad}
+ [_ (wrap [])
+ [expected-input actual-input] (scenario context)
+ [expected-path actual-path] (..path-scenario scenario context)]
+ (wrap [(synthesis.branch/case [expected-input expected-path])
+ (synthesis.branch/case [actual-input actual-path])])))
+
+(def: (branch-scenario scenario context)
+ (-> (Scenario Synthesis) (Scenario Synthesis))
+ ($_ random.either
+ (..let-scenario scenario context)
+ (..if-scenario scenario context)
+ (..get-scenario scenario context)
+ (..case-scenario scenario context)
+ ))
+
+(def: scope-arity 5)
+
+(def: (scope-scenario scenario context)
+ (-> (Scenario Synthesis) (Scenario Synthesis))
+ (do {@ random.monad}
+ [_ (wrap [])
+ #let [real-start (dictionary.size (get@ #necessary context))
+ fake-start (n.+ (get@ #redundants context)
+ real-start)]
+ inits (random.list ..scope-arity (scenario context))
+ [expected-iteration actual-iteration] (scenario (update@ #necessary
+ (function (_ necessary)
+ (list@fold (function (_ [idx _] context)
+ (dictionary.put (n.+ real-start idx)
+ (n.+ fake-start idx)
+ context))
+ necessary
+ (list.enumerate inits)))
+ context))]
+ (wrap [(synthesis.loop/scope [real-start (list@map product.left inits) expected-iteration])
+ (synthesis.loop/scope [fake-start (list@map product.right inits) actual-iteration])])))
+
+(def: (recur-scenario scenario context)
+ (-> (Scenario Synthesis) (Scenario Synthesis))
+ (do {@ random.monad}
+ [_ (wrap [])
+ resets (random.list ..scope-arity (scenario context))]
+ (wrap [(synthesis.loop/recur (list@map product.left resets))
+ (synthesis.loop/recur (list@map product.right resets))])))
+
+(def: (loop-scenario scenario context)
+ (-> (Scenario Synthesis) (Scenario Synthesis))
+ ($_ random.either
+ (..scope-scenario scenario context)
+ (..recur-scenario scenario context)
+ ))
+
+(def: (abstraction-scenario scenario context)
+ (-> (Scenario Synthesis) (Scenario Synthesis))
+ (do {@ random.monad}
+ [_ (wrap [])
+ #let [registers (dictionary.entries (get@ #necessary context))
+ expected-environment (list@map (|>> product.left #variable.Local) registers)
+ actual-environment (list@map (|>> product.right #variable.Local) registers)]
+ [expected-body actual-body] (..primitive-scenario context)]
+ (wrap [(synthesis.function/abstraction [expected-environment 1 expected-body])
+ (synthesis.function/abstraction [actual-environment 1 actual-body])])))
+
+(def: (apply-scenario scenario context)
+ (-> (Scenario Synthesis) (Scenario Synthesis))
+ (do {@ random.monad}
+ [abstraction (:: @ map (|>> synthesis.constant)
+ (random.and (random.unicode 1)
+ (random.unicode 1)))
+ inputs (random.list ..scope-arity (scenario context))]
+ (wrap [(synthesis.function/apply [abstraction (list@map product.left inputs)])
+ (synthesis.function/apply [abstraction (list@map product.right inputs)])])))
+
+(def: (function-scenario scenario context)
+ (-> (Scenario Synthesis) (Scenario Synthesis))
+ ($_ random.either
+ (..abstraction-scenario scenario context)
+ (..apply-scenario scenario context)
+ ))
+
+(def: (control-scenario scenario context)
+ (-> (Scenario Synthesis) (Scenario Synthesis))
+ ($_ random.either
+ (..branch-scenario scenario context)
+ (..loop-scenario scenario context)
+ (..function-scenario scenario context)
+ ))
+
+(def: (scenario context)
+ (Scenario Synthesis)
+ ($_ random.either
+ (..primitive-scenario context)
+ (..structure-scenario context)
+ (..control-scenario (..with-redundancy
+ (..control-scenario
+ (..with-redundancy
+ ..structure-scenario)))
+ context)
+ ))
+
+(def: default
+ Context
+ {#redundants 0
+ #necessary (dictionary.new n.hash)})
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ ($_ _.and
+ (do random.monad
+ [[expected input] (..scenario ..default)]
+ (_.cover [/.optimization]
+ (|> (/.optimization input)
+ (!expect (^multi (#try.Success actual)
+ (:: synthesis.equivalence = expected actual))))))
+ )))