Optimizing-away unnecessary variable declarations/bindings.

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))))))
+          )))