Fixes for the pure-Lux JVM compiler machinery. [Part 5]

3 files changed, 139 insertions, 3 deletions

diff --git a/stdlib/source/test/lux/target/ruby.lux b/stdlib/source/test/lux/target/ruby.lux
index 7723cd776..61fb1197e 100644
--- a/stdlib/source/test/lux/target/ruby.lux
+++ b/stdlib/source/test/lux/target/ruby.lux
@@ -16,7 +16,8 @@
     ["[0]" text ("[1]#[0]" equivalence)
      ["%" format {"+" format}]]
     [collection
-     ["[0]" list ("[1]#[0]" functor)]]]
+     ["[0]" list ("[1]#[0]" functor)]
+     ["[0]" set]]]
    ["[0]" math
     ["[0]" random {"+" Random} ("[1]#[0]" monad)]
     [number
@@ -299,7 +300,16 @@
   (do [! random.monad]
     [float/0 random.safe_frac
      $foreign (# ! each /.local (random.ascii/lower 10))
-     field (# ! each /.string (random.ascii/upper 10))]
+     field (# ! each /.string (random.ascii/upper 10))
+
+     $inputs (# ! each /.local (random.ascii/lower 10))
+     arity (# ! each (n.% 10) random.nat)
+     vals (|> random.int
+              (# ! each /.int)
+              (random.list arity))
+     keys (|> (random.ascii/lower 1)
+              (random.set text.hash arity)
+              (# ! each (|>> set.list (list#each /.string))))]
     ($_ _.and
         (<| (_.for [/.Var])
             ($_ _.and
@@ -310,6 +320,24 @@
                                              (/.return $foreign))
                                          [(list $foreign)] (/.lambda {.#None})
                                          (/.apply_lambda/* (list (/.float float/0))))))
+                (<| (_.for [/.LVar*])
+                    ($_ _.and
+                        (_.cover [/.variadic]
+                                 (expression (|>> (:as Int) .nat (n.= arity))
+                                             (|> (/.return (/.the "length" $inputs))
+                                                 [(list (/.variadic $inputs))] (/.lambda {.#None})
+                                                 (/.apply_lambda/* vals))))
+                        (_.cover [/.splat]
+                                 (expression (|>> (:as Int) .nat (n.= arity))
+                                             (|> (/.return (/.the "length" (/.array (list (/.splat $inputs)))))
+                                                 [(list (/.variadic $inputs))] (/.lambda {.#None})
+                                                 (/.apply_lambda/* vals))))))
+                (<| (_.for [/.LVar**])
+                    (_.cover [/.variadic_kv /.double_splat]
+                             (expression (|>> (:as Int) .nat (n.= arity))
+                                         (|> (/.return (/.the "length" $inputs))
+                                             [(list (/.variadic_kv $inputs))] (/.lambda {.#None})
+                                             (/.apply_lambda/* (list (/.double_splat (/.hash (list.zipped/2 keys vals)))))))))
                 ))
         (_.cover [/.Access]
                  (and (expression (|>> (:as Frac) (f.= (f.+ float/0 float/0)))
diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux
index df128f232..761192245 100644
--- a/stdlib/source/test/lux/tool.lux
+++ b/stdlib/source/test/lux/tool.lux
@@ -12,7 +12,8 @@
      ... ["[1][0]" syntax]
      ["[1][0]" analysis "_"
       ["[1]/[0]" primitive]
-      ["[1]/[0]" composite]]
+      ["[1]/[0]" composite]
+      ["[1]/[0]" pattern]]
      ... [phase
      ...  ["[1][0]" analysis]
      ...  ["[1][0]" synthesis]]
@@ -30,6 +31,7 @@
       /reference.test
       /analysis/primitive.test
       /analysis/composite.test
+      /analysis/pattern.test
       /meta/archive/signature.test
       ... /syntax.test
       ... /analysis.test
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux
new file mode 100644
index 000000000..b4ee9e9c8
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux
@@ -0,0 +1,106 @@
+(.using
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]
+   [abstract
+    [monad {"+" do}]
+    [\\specification
+     ["$[0]" equivalence]]]
+   [data
+    ["[0]" bit ("[1]#[0]" equivalence)]
+    ["[0]" text ("[1]#[0]" equivalence)]]
+   [math
+    ["[0]" random {"+" Random} ("[1]#[0]" monad)]
+    [number
+     ["f" frac]]]]]
+ [\\library
+  ["[0]" /]]
+ ["[0]" // "_"
+  ["[1][0]" primitive]
+  ["[1][0]" composite]])
+
+(def: .public random
+  (Random /.Pattern)
+  (random.rec
+   (function (_ random)
+     ($_ random.or
+         //primitive.random
+         (//composite.random 4 random)
+         random.nat
+         ))))
+
+(def: .public test
+  Test
+  (<| (_.covering /._)
+      (_.for [/.Pattern])
+      (do random.monad
+        [expected_register random.nat
+         expected_bit random.bit
+         expected_nat random.nat
+         expected_int random.int
+         expected_rev random.rev
+         expected_frac random.frac
+         expected_text (random.ascii/lower 2)
+
+         expected_lefts random.nat
+         expected_right? random.bit])
+      (`` ($_ _.and
+              (_.for [/.equivalence]
+                     ($equivalence.spec /.equivalence ..random))
+              
+              (_.cover [/.unit]
+                       (case (/.unit)
+                         (^ (/.unit))
+                         true
+
+                         _
+                         false))
+              (~~ (template [<tag> <value>]
+                    [(_.cover [<tag>]
+                              (case (<tag> <value>)
+                                (^ (<tag> actual))
+                                (same? <value> actual)
+
+                                _
+                                false))]
+
+                    [/.bind expected_register]
+                    [/.bit expected_bit]
+                    [/.nat expected_nat]
+                    [/.int expected_int]
+                    [/.rev expected_rev]
+                    [/.frac expected_frac]
+                    [/.text expected_text]
+                    ))
+              (_.cover [/.variant]
+                       (case (/.variant [expected_lefts expected_right? (/.text expected_text)])
+                         (^ (/.variant [actual_lefts actual_right? (/.text actual_text)]))
+                         (and (same? expected_lefts actual_lefts)
+                              (same? expected_right? actual_right?)
+                              (same? expected_text actual_text))
+
+                         _
+                         false))
+              (_.cover [/.tuple]
+                       (case (/.tuple (list (/.bit expected_bit)
+                                            (/.nat expected_nat)
+                                            (/.int expected_int)
+                                            (/.rev expected_rev)
+                                            (/.frac expected_frac)
+                                            (/.text expected_text)))
+                         (^ (/.tuple (list (/.bit actual_bit)
+                                           (/.nat actual_nat)
+                                           (/.int actual_int)
+                                           (/.rev actual_rev)
+                                           (/.frac actual_frac)
+                                           (/.text actual_text))))
+                         (and (same? expected_bit actual_bit)
+                              (same? expected_nat actual_nat)
+                              (same? expected_int actual_int)
+                              (same? expected_rev actual_rev)
+                              (same? expected_frac actual_frac)
+                              (same? expected_text actual_text))
+
+                         _
+                         false))
+              ))))