Finishing the meta-compiler [Part 1]

6 files changed, 270 insertions, 27 deletions

diff --git a/stdlib/source/test/lux/target/python.lux b/stdlib/source/test/lux/target/python.lux
index e936ba850..dc4a3871f 100644
--- a/stdlib/source/test/lux/target/python.lux
+++ b/stdlib/source/test/lux/target/python.lux
@@ -5,7 +5,10 @@
    ["[0]" ffi]
    [abstract
     [monad {"+" do}]
-    ["[0]" predicate]]
+    ["[0]" predicate]
+    [\\specification
+     ["$[0]" equivalence]
+     ["$[0]" hash]]]
    [control
     ["[0]" maybe ("[1]#[0]" functor)]
     ["[0]" try {"+" Try} ("[1]#[0]" functor)]]
@@ -125,6 +128,12 @@
                   [/.>= f.>=]
                   [/.=  f.=]
                   ))
+            (_.cover [/.float/1]
+                     (expression (|>> (:as Frac) (f.= subject))
+                                 (/.float/1 (/.string (%.frac subject)))))
+            (_.cover [/.repr/1]
+                     (expression (|>> (:as Text) (text#= (text.replaced "+" "" (%.frac subject))))
+                                 (/.repr/1 (/.float subject))))
             ))))
 
 (def: int/16
@@ -163,6 +172,12 @@
                        (expression (|>> (:as Frac) f.int (i.= expected))
                                    (/.bit_shr (/.int (.int shift))
                                               (/.int i16)))))
+            (_.cover [/.int/1]
+                     (expression (|>> (:as Int) (i.= left))
+                                 (/.int/1 (/.string (%.int left)))))
+            (_.cover [/.str/1]
+                     (expression (|>> (:as Text) (text#= (text.replaced "+" "" (%.int left))))
+                                 (/.str/1 (/.int left))))
             ))))
 
 (def: test|array
@@ -301,10 +316,15 @@
 (def: .public test
   Test
   (do [! random.monad]
-    []
+    [.let [random (# ! each /.int random.int)]]
     (<| (_.covering /._)
         (_.for [/.Code /.code])
         ($_ _.and
+            (_.for [/.equivalence]
+                   ($equivalence.spec /.equivalence random))
+            (_.for [/.hash]
+                   ($hash.spec /.hash random))
+            
             (_.for [/.Expression]
                    ..test|expression)
             ))))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux
index ccca4213f..135ac5840 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux
@@ -24,13 +24,14 @@
     [number
      ["f" frac]]]]]
  ["[0]" / "_"
-  ["[1][0]" simple]
   ["[1][0]" complex]
-  ["[1][0]" pattern]
+  ["[1][0]" inference]
   ["[1][0]" macro]
-  ["[1][0]" type]
   ["[1][0]" module]
-  ["[1][0]" inference]
+  ["[1][0]" pattern]
+  ["[1][0]" scope]
+  ["[1][0]" simple]
+  ["[1][0]" type]
   [////
    ["[1][0]" reference
     ["[2][0]" variable]]
@@ -437,11 +438,12 @@
                      (bit#= (# /.equivalence = left right)
                             (text#= (/.format left) (/.format right))))
 
-            /simple.test
             /complex.test
-            /pattern.test
+            /inference.test
             /macro.test
-            /type.test
             /module.test
-            /inference.test
+            /pattern.test
+            /scope.test
+            /simple.test
+            /type.test
             ))))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/scope.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/scope.lux
new file mode 100644
index 000000000..dbd1f83de
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/scope.lux
@@ -0,0 +1,203 @@
+(.using
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]
+   [abstract
+    [monad {"+" do}]]
+   [control
+    [pipe {"+" case>}]
+    ["[0]" maybe ("[1]#[0]" functor)]
+    ["[0]" try ("[1]#[0]" functor)]
+    ["[0]" exception]]
+   [data
+    ["[0]" product]
+    [collection
+     ["[0]" list]]]
+   [math
+    ["[0]" random {"+" Random}]
+    [number
+     ["n" nat]]]
+   ["[0]" type "_"
+    ["$[1]" \\test]]]]
+ [\\library
+  ["[0]" /
+   ["/[1]" //
+    [//
+     [phase
+      ["[1][0]" extension]]
+     [///
+      ["[1][0]" phase ("[1]#[0]" monad)]
+      [reference
+       ["[1][0]" variable {"+" Register Variable}]]]]]]]
+ ["$[0]" // "_"
+  ["[1][0]" type]])
+
+(template [<name> <tag>]
+  [(def: (<name> expected_type expected_register [actual_type actual_var])
+     (-> Type Register [Type Variable] Bit)
+     (and (same? expected_type actual_type)
+          (case actual_var
+            {<tag> actual_register}
+            (n.= expected_register actual_register)
+            
+            _
+            false)))]
+
+  [local? //variable.#Local]
+  [foreign? //variable.#Foreign]
+  )
+
+(def: .public test
+  Test
+  (<| (_.covering /._)
+      (do [! random.monad]
+        [lux $//type.random_state
+         .let [state [//extension.#bundle //extension.empty
+                      //extension.#state lux]]
+         name/0 (random.ascii/lower 1)
+         name/1 (random.ascii/lower 2)
+         type/0 ($type.random 0)
+         type/1 ($type.random 0)]
+        ($_ _.and
+            (_.cover [/.find]
+                     (|> (/.find name/0)
+                         /.with
+                         (//phase.result state)
+                         (try#each (|>> product.right
+                                        (case> {.#None} true
+                                               {.#Some _} false)))
+                         (try.else false)))
+            (_.cover [/.with_local]
+                     (|> (/.with_local [name/0 type/0]
+                           (/.find name/0))
+                         /.with
+                         (//phase.result state)
+                         (try#each (|>> product.right
+                                        (maybe#each (..local? type/0 0))
+                                        (maybe.else false)))
+                         (try.else false)))
+            (_.cover [/.next]
+                     (|> (<| (do [! //phase.monad]
+                               [register/0 /.next])
+                             (/.with_local [name/0 type/0])
+                             (do !
+                               [var/0 (/.find name/0)])
+                             (do !
+                               [register/1 /.next])
+                             (/.with_local [name/1 type/1])
+                             (do !
+                               [var/1 (/.find name/1)])
+                             (in (do maybe.monad
+                                   [var/0 var/0
+                                    var/1 var/1]
+                                   (in [[register/0 var/0] [register/1 var/1]]))))
+                         /.with
+                         (//phase.result state)
+                         (try#each (|>> product.right
+                                        (maybe#each (function (_ [[register/0 var/0] [register/1 var/1]])
+                                                      (and (..local? type/0 register/0 var/0)
+                                                           (..local? type/1 register/1 var/1))))
+                                        (maybe.else false)))
+                         (try.else false)))
+            (_.cover [/.no_scope]
+                     (and (|> (/.with_local [name/0 type/0]
+                                (//phase#in false))
+                              (//phase.result state)
+                              (exception.otherwise (exception.match? /.no_scope)))
+                          (|> (do //phase.monad
+                                [_ /.next]
+                                (in false))
+                              (//phase.result state)
+                              (exception.otherwise (exception.match? /.no_scope)))))
+            (_.cover [/.reset]
+                     (and (|> /.next
+                              (/.with_local [name/0 type/0])
+                              /.with
+                              (//phase.result state)
+                              (try#each (|>> product.right
+                                             (n.= 1)))
+                              (try.else false))
+                          (|> /.next
+                              /.reset
+                              (/.with_local [name/0 type/0])
+                              /.with
+                              (//phase.result state)
+                              (try#each (|>> product.right
+                                             (n.= 0)))
+                              (try.else false))))
+            (_.cover [/.drained]
+                     (|> (function (_ [bundle state])
+                           {try.#Success [[bundle (with@ .#scopes (list) state)]
+                                          false]})
+                         (/.with_local [name/0 type/0])
+                         /.with
+                         (//phase#each product.right)
+                         (//phase.result state)
+                         (exception.otherwise (exception.match? /.drained))))
+            (_.cover [/.with]
+                     (|> (<| /.with
+                             (/.with_local [name/0 type/0])
+                             (do //phase.monad
+                               [var/0' (/.find name/0)
+                                [scope/1 var/0''] (/.with (/.find name/0))]
+                               (<| //phase.lifted
+                                   try.of_maybe
+                                   (do maybe.monad
+                                     [var/0' var/0'
+                                      var/0'' var/0'']
+                                     (in [var/0' scope/1 var/0''])))))
+                         (//phase.result state)
+                         (try#each (function (_ [scope/0 var/0' scope/1 var/0''])
+                                     (and (local? type/0 0 var/0')
+                                          (n.= 0 (list.size (value@ [.#locals .#mappings] scope/0)))
+                                          (n.= 0 (list.size (value@ [.#captured .#mappings] scope/0)))
+
+                                          (foreign? type/0 0 var/0'')
+                                          (n.= 0 (list.size (value@ [.#locals .#mappings] scope/1)))
+                                          (n.= 1 (list.size (value@ [.#captured .#mappings] scope/1))))))
+                         (try.else false)))
+            (_.cover [/.environment]
+                     (let [(^open "list#[0]") (list.equivalence //variable.equivalence)]
+                       (and (|> (<| /.with
+                                    (/.with_local [name/0 type/0])
+                                    (/.with_local [name/1 type/1])
+                                    (do //phase.monad
+                                      [[scope/1 _] (/.with (in []))]
+                                      (in (/.environment scope/1))))
+                                (//phase.result state)
+                                (try#each (|>> product.right
+                                               (list#= (list))))
+                                (try.else false))
+                            (|> (<| /.with
+                                    (do [! //phase.monad]
+                                      [register/0 /.next])
+                                    (/.with_local [name/0 type/0])
+                                    (/.with_local [name/1 type/1])
+                                    (do !
+                                      [[scope/1 _] (/.with (/.find name/0))]
+                                      (in [register/0 (/.environment scope/1)])))
+                                (//phase.result state)
+                                (try#each (function (_ [_ [register/0 environment]])
+                                            (list#= (list {//variable.#Local register/0})
+                                                    environment)))
+                                (try.else false))
+                            (|> (<| /.with
+                                    (do [! //phase.monad]
+                                      [register/0 /.next])
+                                    (/.with_local [name/0 type/0])
+                                    (do [! //phase.monad]
+                                      [register/1 /.next])
+                                    (/.with_local [name/1 type/1])
+                                    (do [! //phase.monad]
+                                      [[scope/1 _] (/.with (do !
+                                                             [_ (/.find name/1)
+                                                              _ (/.find name/0)]
+                                                             (in [])))]
+                                      (in [register/0 register/1 (/.environment scope/1)])))
+                                (//phase.result state)
+                                (try#each (function (_ [_ [register/0 register/1 environment]])
+                                            (list#= (list {//variable.#Local register/1}
+                                                          {//variable.#Local register/0})
+                                                    environment)))
+                                (try.else false)))))
+            ))))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux
index 781a7f38f..2e63f1bc8 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux
@@ -22,7 +22,7 @@
      [///
       ["[2][0]" phase]]]]]])
 
-(def: random_state
+(def: .public random_state
   (Random Lux)
   (do random.monad
     [version random.nat
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux
index 89c341c2a..fcf0a556e 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux
@@ -42,7 +42,8 @@
        ["[2][0]" macro]
        ["[2][0]" type]
        ["[2][0]" module]
-       ["[2][0]" complex]]
+       ["[2][0]" complex]
+       ["[2][0]" scope]]
       [///
        ["[1][0]" phase ("[1]#[0]" monad)]
        [meta
@@ -488,7 +489,7 @@
                             (//phase.result state)
                             (case> {try.#Success {.#None}}
                                    true
-                        
+                                   
                                    _
                                    false)))))
         (_.cover [/.order]
@@ -499,7 +500,7 @@
                                      (|> (do //phase.monad
                                            [_ (//module.declare_labels true slots/0 false :record:)]
                                            (/.order pattern_matching? input))
-                                         //analysis.with_scope
+                                         //scope.with
                                          (//module.with_module 0 module)
                                          (//phase#each (|>> product.right product.right))
                                          (//phase.result state)
@@ -554,7 +555,7 @@
                                         (|> (do //phase.monad
                                               [_ (//module.declare_labels true slots/0 false :record:)]
                                               (/.order pattern_matching? input))
-                                            //analysis.with_scope
+                                            //scope.with
                                             (//module.with_module 0 module)
                                             (//phase.result state)
                                             (..failure? /.record_size_mismatch))))]
@@ -574,7 +575,7 @@
                                               [_ (//module.declare_labels true slots/0 false :record:)
                                                _ (//module.declare_labels true slots/1 false :record:)]
                                               (/.order pattern_matching? input))
-                                            //analysis.with_scope
+                                            //scope.with
                                             (//module.with_module 0 module)
                                             (//phase.result state)
                                             (..failure? /.slot_does_not_belong_to_record))))]
@@ -589,7 +590,7 @@
                                           [_ (//module.declare_labels true slots false type)]
                                           (/.record ..analysis archive.empty tuple))
                                         (//type.expecting type)
-                                        //analysis.with_scope
+                                        //scope.with
                                         (//module.with_module 0 module)
                                         (//phase#each (|>> product.right product.right))
                                         (//phase.result state)
@@ -601,7 +602,7 @@
                                             [_ (//module.declare_labels true slots/0 false :record:)]
                                             (//type.inferring
                                              (/.record ..analysis archive.empty record)))
-                                          //analysis.with_scope
+                                          //scope.with
                                           (//module.with_module 0 module)
                                           (//phase#each (|>> product.right product.right))
                                           (//phase.result state)
diff --git a/stdlib/source/test/lux/tool/compiler/meta/cli.lux b/stdlib/source/test/lux/tool/compiler/meta/cli.lux
index 7c5f0266e..5a128b0ff 100644
--- a/stdlib/source/test/lux/tool/compiler/meta/cli.lux
+++ b/stdlib/source/test/lux/tool/compiler/meta/cli.lux
@@ -15,12 +15,23 @@
     [collection
      ["[0]" list ("[1]#[0]" monoid monad)]]]
    [math
-    ["[0]" random]
+    ["[0]" random {"+" Random}]
     [number
-     ["n" nat]]]]]
+     ["n" nat]]]
+   [meta
+    ["[0]" symbol "_"
+     ["$[1]" \\test]]]]]
  [\\library
   ["[0]" /]])
 
+(def: random_compiler
+  (Random /.Compiler)
+  (do [! random.monad]
+    [definition ($symbol.random 1 1)
+     amount (# ! each (n.% 5) random.nat)
+     parameters (random.list amount (random.ascii/lower 2))]
+    (in [definition parameters])))
+
 (def: .public test
   Test
   (<| (_.covering /._)
@@ -33,10 +44,12 @@
          libraries (random.list amount (random.ascii/lower 3))
          target (random.ascii/lower 4)
          module (random.ascii/lower 5)
+         compilers (random.list amount ..random_compiler)
          .let [compilation' ($_ list#composite
-                                (list#conjoint (list#each (|>> (list "--source")) sources))
                                 (list#conjoint (list#each (|>> (list "--host_dependency")) host_dependencies))
                                 (list#conjoint (list#each (|>> (list "--library")) libraries))
+                                (list#conjoint (list#each (|>> /.compiler_format (list "--compiler")) compilers))
+                                (list#conjoint (list#each (|>> (list "--source")) sources))
                                 (list "--target" target)
                                 (list "--module" module))
                export ($_ list#composite
@@ -58,9 +71,10 @@
                                                                      false)))
                                                (try.else false)))]
 
-                                 [/.Source /.#sources (list#= sources)]
                                  [/.Host_Dependency /.#host_dependencies (list#= host_dependencies)]
                                  [/.Library /.#libraries (list#= libraries)]
+                                 [/.Compiler /.#compilers (# (list.equivalence /.compiler_equivalence) = compilers)]
+                                 [/.Source /.#sources (list#= sources)]
                                  [/.Target /.#target (same? target)]
                                  [/.Module /.#module (same? module)]
                                  ))
@@ -78,9 +92,10 @@
                                                                false)))
                                          (try.else false))]
 
-                                    [/.#sources (list#= sources)]
                                     [/.#host_dependencies (list#= host_dependencies)]
                                     [/.#libraries (list#= libraries)]
+                                    [/.#compilers (# (list.equivalence /.compiler_equivalence) = compilers)]
+                                    [/.#sources (list#= sources)]
                                     [/.#target (same? target)]
                                     [/.#module (same? module)]
                                     )))))
@@ -104,14 +119,16 @@
                      (`` (and (~~ (template [<it>]
                                     [(same? target (/.target <it>))]
 
-                                    [{/.#Compilation [/.#sources sources
-                                                      /.#host_dependencies host_dependencies
+                                    [{/.#Compilation [/.#host_dependencies host_dependencies
                                                       /.#libraries libraries
+                                                      /.#compilers compilers
+                                                      /.#sources sources
                                                       /.#target target
                                                       /.#module module]}]
-                                    [{/.#Interpretation [/.#sources sources
-                                                         /.#host_dependencies host_dependencies
+                                    [{/.#Interpretation [/.#host_dependencies host_dependencies
                                                          /.#libraries libraries
+                                                         /.#compilers compilers
+                                                         /.#sources sources
                                                          /.#target target
                                                          /.#module module]}]
                                     [{/.#Export [sources target]}]