Implemented an optimization for getting fields/slots from records in the new compiler.

5 files changed, 287 insertions, 61 deletions

diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index 56be46610..7fc1c428d 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -20,6 +20,7 @@
    ["#." try]
    ["#." io]
    ["#." parser
+    ["#/." analysis]
     ["#/." text]
     ["#/." cli]]
    ["#." pipe]
@@ -57,6 +58,7 @@
   Test
   ($_ _.and
       /parser.test
+      /parser/analysis.test
       /parser/text.test
       /parser/cli.test
       ))
diff --git a/stdlib/source/test/lux/control/parser/analysis.lux b/stdlib/source/test/lux/control/parser/analysis.lux
new file mode 100644
index 000000000..397b2c779
--- /dev/null
+++ b/stdlib/source/test/lux/control/parser/analysis.lux
@@ -0,0 +1,146 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    [pipe (#+ case>)]
+    ["." try]
+    ["." exception]
+    ["<>" parser]]
+   [data
+    ["." name ("#@." equivalence)]
+    ["." bit ("#@." equivalence)]
+    ["." text ("#@." equivalence)]
+    [number
+     ["n" nat]
+     ["i" int]
+     ["f" frac]
+     ["r" rev]]
+    [collection
+     ["." list]]]
+   [math
+    ["." random (#+ Random)]]
+   [tool
+    [compiler
+     [reference (#+ Constant)]
+     [language
+      [lux
+       ["." analysis]]]]]]
+  {1
+   ["." /]})
+
+(template: (!expect <expectation> <computation>)
+  (case <computation>
+    <expectation>
+    true
+
+    _
+    false))
+
+(def: constant
+  (Random Constant)
+  (random.and (random.unicode 10)
+              (random.unicode 10)))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.with-cover [/.Parser])
+      (do {@ random.monad}
+        []
+        (`` ($_ _.and
+                (do {@ random.monad}
+                  [expected (:: @ map (|>> analysis.bit) random.bit)]
+                  (_.cover [/.run /.any]
+                           (|> (list expected)
+                               (/.run /.any)
+                               (case> (#try.Success actual)
+                                      (:: analysis.equivalence = expected actual)
+
+                                      (#try.Failure _)
+                                      false))))
+                (~~ (template [<query> <check> <random> <analysis> <=>]
+                      [(do {@ random.monad}
+                         [expected <random>]
+                         (_.cover [<query>]
+                                  (|> (list (<analysis> expected))
+                                      (/.run <query>)
+                                      (case> (#try.Success actual)
+                                             (<=> expected actual)
+
+                                             (#try.Failure _)
+                                             false))))
+                       (do {@ random.monad}
+                         [expected <random>]
+                         (_.cover [<check>]
+                                  (|> (list (<analysis> expected))
+                                      (/.run (<check> expected))
+                                      (!expect (#try.Success _)))))]
+                      
+                      [/.bit /.bit! random.bit analysis.bit bit@=]
+                      [/.nat /.nat! random.nat analysis.nat n.=]
+                      [/.int /.int! random.int analysis.int i.=]
+                      [/.frac /.frac! random.frac analysis.frac f.=]
+                      [/.rev /.rev! random.rev analysis.rev r.=]
+                      [/.text /.text! (random.unicode 10) analysis.text text@=]
+                      [/.local /.local! random.nat analysis.variable/local n.=]
+                      [/.foreign /.foreign! random.nat analysis.variable/foreign n.=]
+                      [/.constant /.constant! ..constant analysis.constant name@=]
+                      ))
+                (do {@ random.monad}
+                  [expected random.bit]
+                  (_.cover [/.tuple]
+                           (|> (list (analysis.tuple (list (analysis.bit expected))))
+                               (/.run (/.tuple /.bit))
+                               (case> (#try.Success actual)
+                                      (bit@= expected actual)
+
+                                      (#try.Failure _)
+                                      false))))
+                (do {@ random.monad}
+                  [dummy random.bit]
+                  (_.cover [/.end?]
+                           (and (|> (/.run /.end? (list))
+                                    (!expect (#try.Success #1)))
+                                (|> (/.run (do <>.monad
+                                             [verdict /.end?
+                                              _ /.bit]
+                                             (wrap verdict))
+                                           (list (analysis.bit dummy)))
+                                    (!expect (#try.Success #0))))))
+                (do {@ random.monad}
+                  [dummy random.bit]
+                  (_.cover [/.end!]
+                           (and (|> (/.run /.end! (list))
+                                    (!expect (#try.Success _)))
+                                (|> (/.run /.end! (list (analysis.bit dummy)))
+                                    (!expect (#try.Failure _))))))
+                (do {@ random.monad}
+                  [expected random.bit]
+                  (_.cover [/.cannot-parse]
+                           (and (|> (list (analysis.bit expected))
+                                    (/.run /.nat)
+                                    (case> (#try.Success _)
+                                           false
+
+                                           (#try.Failure error)
+                                           (exception.match? /.cannot-parse error)))
+                                (|> (list)
+                                    (/.run /.bit)
+                                    (case> (#try.Success _)
+                                           false
+
+                                           (#try.Failure error)
+                                           (exception.match? /.cannot-parse error))))))
+                (do {@ random.monad}
+                  [expected random.bit]
+                  (_.cover [/.unconsumed-input]
+                           (|> (list (analysis.bit expected) (analysis.bit expected))
+                               (/.run /.bit)
+                               (case> (#try.Success _)
+                                      false
+
+                                      (#try.Failure error)
+                                      (exception.match? /.unconsumed-input error)))))
+                )))))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux
index 5f9f14321..d084e0210 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux
@@ -1,15 +1,19 @@
 (.module:
   [lux #*
-   [abstract ["." monad (#+ do)]]
-   [data
-    ["." name]
-    [number
-     ["n" nat]]]
-   ["r" math/random (#+ Random) ("#@." monad)]
    ["_" test (#+ Test)]
+   [abstract
+    ["." monad (#+ do)]]
    [control
     pipe
-    ["." try ("#@." functor)]]]
+    ["." try ("#@." functor)]]
+   [data
+    ["." sum]
+    [number
+     ["n" nat]]
+    [collection
+     ["." list ("#@." fold monoid)]]]
+   [math
+    ["." random (#+ Random) ("#@." monad)]]]
   ["." // #_
    ["#." primitive]]
   {1
@@ -22,32 +26,33 @@
        ["#." analysis (#+ Branch Analysis)]
        ["#." synthesis (#+ Synthesis)]
        [///
-        ["#." reference]
+        ["#." reference
+         [variable (#+ Register)]]
         ["." phase]
         [meta
          ["." archive]]]]]]]})
 
-(def: dummy-vars
+(def: masking-test
   Test
-  (do {@ r.monad}
+  (do {@ random.monad}
     [maskedA //primitive.primitive
-     temp (|> r.nat (:: @ map (n.% 100)))
+     temp (|> random.nat (:: @ map (n.% 100)))
      #let [maskA (////analysis.control/case
                   [maskedA
                    [[(#////analysis.Bind temp)
                      (#////analysis.Reference (////reference.local temp))]
                     (list)]])]]
-    (_.test "Dummy variables created to mask expressions get eliminated during synthesis."
-            (|> maskA
-                (//.phase archive.empty)
-                (phase.run [///bundle.empty ////synthesis.init])
-                (try@map (//primitive.corresponds? maskedA))
-                (try.default false)))))
+    (_.cover [/.synthesize-masking]
+             (|> maskA
+                 (//.phase archive.empty)
+                 (phase.run [///bundle.empty ////synthesis.init])
+                 (try@map (//primitive.corresponds? maskedA))
+                 (try.default false)))))
 
-(def: let-expr
+(def: let-test
   Test
-  (do r.monad
-    [registerA r.nat
+  (do random.monad
+    [registerA random.nat
      inputA //primitive.primitive
      outputA //primitive.primitive
      #let [letA (////analysis.control/case
@@ -55,22 +60,22 @@
                   [[(#////analysis.Bind registerA)
                     outputA]
                    (list)]])]]
-    (_.test "Can detect and reify simple 'let' expressions."
-            (|> letA
-                (//.phase archive.empty)
-                (phase.run [///bundle.empty ////synthesis.init])
-                (case> (^ (#try.Success (////synthesis.branch/let [inputS registerS outputS])))
-                       (and (n.= registerA registerS)
-                            (//primitive.corresponds? inputA inputS)
-                            (//primitive.corresponds? outputA outputS))
+    (_.cover [/.synthesize-let]
+             (|> letA
+                 (//.phase archive.empty)
+                 (phase.run [///bundle.empty ////synthesis.init])
+                 (case> (^ (#try.Success (////synthesis.branch/let [inputS registerS outputS])))
+                        (and (n.= registerA registerS)
+                             (//primitive.corresponds? inputA inputS)
+                             (//primitive.corresponds? outputA outputS))
 
-                       _
-                       false)))))
+                        _
+                        false)))))
 
-(def: if-expr
+(def: if-test
   Test
-  (do r.monad
-    [then|else r.bit
+  (do random.monad
+    [then|else random.bit
      inputA //primitive.primitive
      thenA //primitive.primitive
      elseA //primitive.primitive
@@ -83,23 +88,83 @@
            ifA (if then|else
                  (////analysis.control/case [inputA [thenB (list elseB)]])
                  (////analysis.control/case [inputA [elseB (list thenB)]]))]]
-    (_.test "Can detect and reify simple 'if' expressions."
-            (|> ifA
-                (//.phase archive.empty)
-                (phase.run [///bundle.empty ////synthesis.init])
-                (case> (^ (#try.Success (////synthesis.branch/if [inputS thenS elseS])))
-                       (and (//primitive.corresponds? inputA inputS)
-                            (//primitive.corresponds? thenA thenS)
-                            (//primitive.corresponds? elseA elseS))
+    (_.cover [/.synthesize-if]
+             (|> ifA
+                 (//.phase archive.empty)
+                 (phase.run [///bundle.empty ////synthesis.init])
+                 (case> (^ (#try.Success (////synthesis.branch/if [inputS thenS elseS])))
+                        (and (//primitive.corresponds? inputA inputS)
+                             (//primitive.corresponds? thenA thenS)
+                             (//primitive.corresponds? elseA elseS))
+
+                        _
+                        false)))))
+
+(def: random-member
+  (Random ////synthesis.Member)
+  (do {@ random.monad}
+    [lefts (|> random.nat (:: @ map (n.% 10)))
+     right? random.bit]
+    (wrap (if right?
+            (#.Right lefts)
+            (#.Left lefts)))))
+
+(def: random-path
+  (Random (////analysis.Tuple ////synthesis.Member))
+  (do {@ random.monad}
+    [size-1 (|> random.nat (:: @ map (|>> (n.% 10) inc)))]
+    (random.list size-1 ..random-member)))
+
+(def: (get-pattern path)
+  (-> (////analysis.Tuple ////synthesis.Member)
+      (Random [////analysis.Pattern Register]))
+  (do random.monad
+    [@member random.nat]
+    (wrap [(list@fold (function (_ member inner)
+                        (case member
+                          (#.Left lefts)
+                          (////analysis.pattern/tuple
+                           (list@compose (list.repeat lefts (////analysis.pattern/unit))
+                                         (list inner (////analysis.pattern/unit))))
+                          
+                          (#.Right lefts)
+                          (////analysis.pattern/tuple
+                           (list@compose (list.repeat (inc lefts) (////analysis.pattern/unit))
+                                         (list inner)))))
+                      (#////analysis.Bind @member)
+                      (list.reverse path))
+           @member])))
+
+(def: get-test
+  Test
+  (do {@ random.monad}
+    [recordA (|> random.nat
+                 (:: @ map (|>> ////analysis.nat))
+                 (random.list 10)
+                 (:: @ map (|>> ////analysis.tuple)))
+     pathA ..random-path
+     [pattern @member] (get-pattern pathA)
+     #let [getA (////analysis.control/case [recordA [[pattern
+                                                      (#////analysis.Reference (////reference.local @member))]
+                                                     (list)]])]]
+    (_.cover [/.synthesize-get]
+             (|> getA
+                 (//.phase archive.empty)
+                 (phase.run [///bundle.empty ////synthesis.init])
+                 (case> (^ (#try.Success (////synthesis.branch/get [pathS recordS])))
+                        (and (:: (list.equivalence (sum.equivalence n.= n.=)) = pathA pathS)
+                             (//primitive.corresponds? recordA recordS))
 
-                       _
-                       false)))))
+                        _
+                        false)))))
 
 (def: #export test
   Test
-  (<| (_.context (name.module (name-of /._)))
+  (<| (_.covering /._)
+      (_.with-cover [/.synthesize])
       ($_ _.and
-          ..dummy-vars
-          ..let-expr
-          ..if-expr
+          ..masking-test
+          ..let-test
+          ..if-test
+          ..get-test
           )))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux
index 799a8a526..7350881b1 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux
@@ -16,7 +16,7 @@
      ["n" nat]]
     [collection
      ["." list ("#@." functor fold)]
-     ["dict" dictionary (#+ Dictionary)]
+     ["." dictionary (#+ Dictionary)]
      ["." set]]]]
   ["." // #_
    ["#." primitive]]
@@ -31,7 +31,8 @@
        ["#." synthesis (#+ Synthesis)]
        [///
         [arity (#+ Arity)]
-        ["#." reference (#+ Variable) ("variable@." equivalence)]
+        ["#." reference
+         ["." variable (#+ Variable) ("#@." equivalence)]]
         ["." phase]
         [meta
          ["." archive]]]]]]]})
@@ -61,16 +62,16 @@
   (do {@ r.monad}
     [num-locals (|> r.nat (:: @ map (|>> (n.% 100) (n.max 10))))
      #let [indices (list.n/range 0 (dec num-locals))
-           local-env (list@map (|>> #////reference.Local) indices)
-           foreign-env (list@map (|>> #////reference.Foreign) indices)]
+           local-env (list@map (|>> #variable.Local) indices)
+           foreign-env (list@map (|>> #variable.Foreign) indices)]
      [arity bodyA predictionA] (: (Random [Arity Analysis Variable])
                                   (loop [arity 1
                                          current-env foreign-env]
                                     (let [current-env/size (list.size current-env)
                                           resolver (list@fold (function (_ [idx var] resolver)
-                                                                (dict.put idx var resolver))
+                                                                (dictionary.put idx var resolver))
                                                               (: (Dictionary Nat Variable)
-                                                                 (dict.new n.hash))
+                                                                 (dictionary.new n.hash))
                                                               (list.enumerate current-env))]
                                       (do @
                                         [nest? r.bit]
@@ -83,7 +84,7 @@
                                                                               (list@map (function (_ pick)
                                                                                           (maybe.assume (list.nth pick current-env)))
                                                                                         picks))
-                                             #let [picked-env (list@map (|>> #////reference.Foreign) picks)]]
+                                             #let [picked-env (list@map (|>> #variable.Foreign) picks)]]
                                             (wrap [arity
                                                    (#////analysis.Function picked-env bodyA)
                                                    predictionA]))
@@ -91,7 +92,7 @@
                                             [chosen (pick (list.size current-env))]
                                             (wrap [arity
                                                    (#////analysis.Reference (////reference.foreign chosen))
-                                                   (maybe.assume (dict.get chosen resolver))])))))))]
+                                                   (maybe.assume (dictionary.get chosen resolver))])))))))]
     (wrap [arity
            (#////analysis.Function local-env bodyA)
            predictionA])))
@@ -111,7 +112,7 @@
         [chosen (|> r.nat (:: @ map (|>> (n.% 100) (n.max 2))))]
         (wrap [arity
                (#////analysis.Reference (////reference.local chosen))
-               (|> chosen (n.+ (dec arity)) #////reference.Local)])))))
+               (|> chosen (n.+ (dec arity)) #variable.Local)])))))
 
 (def: abstraction
   Test
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux
index cd7fe54eb..40f9efad4 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux
@@ -1,14 +1,18 @@
 (.module:
   [lux (#- primitive)
    [abstract ["." monad (#+ do)]]
+   [control
+    [pipe (#+ case>)]
+    ["." try]]
    [data
     ["%" text/format (#+ format)]
-    ["." name]]
+    ["." name]
+    [number
+     ["n" nat]]
+    [collection
+     ["." list]]]
    ["r" math/random (#+ Random) ("#@." monad)]
-   ["_" test (#+ Test)]
-   [control
-    pipe
-    ["." try]]]
+   ["_" test (#+ Test)]]
   {1
    ["." / #_
     ["/#" //
@@ -54,6 +58,14 @@
               [#////analysis.Frac (|>) #////synthesis.F64 (|>)]
               [#////analysis.Text (|>) #////synthesis.Text (|>)]
               ))
+
+        (^ [(////analysis.tuple expected)
+            (////synthesis.tuple actual)])
+        (and (n.= (list.size expected)
+                  (list.size actual))
+             (list.every? (function (_ [expected actual])
+                            (corresponds? expected actual))
+                          (list.zip2 expected actual)))
         
         _
         false)))