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

4 files changed, 360 insertions, 53 deletions

diff --git a/stdlib/source/test/lux/math/number.lux b/stdlib/source/test/lux/math/number.lux
index 94849f0c0..beaa84aa6 100644
--- a/stdlib/source/test/lux/math/number.lux
+++ b/stdlib/source/test/lux/math/number.lux
@@ -41,16 +41,14 @@
                                      {try.#Failure error}
                                      false)]
 
-                                  [n.= n.binary "11001001"]
                                   [n.= n.binary "11,00,10,01"]
 
-                                  [i.= i.binary "+11001001"]
+                                  [i.= i.binary "+11,00,10,01"]
                                   [i.= i.binary "-11,00,10,01"]
 
-                                  [r.= r.binary ".11001001"]
                                   [r.= r.binary ".11,00,10,01"]
 
-                                  [f.= f.binary "+1100.1001"]
+                                  [f.= f.binary "+11,00.10,01"]
                                   [f.= f.binary "-11,00.10,01"]
                                   )))))
           (_.cover [/.oct]
@@ -62,16 +60,14 @@
                                      {try.#Failure error}
                                      false)]
 
-                                  [n.= n.octal "615243"]
                                   [n.= n.octal "615,243"]
 
-                                  [i.= i.octal "+615243"]
+                                  [i.= i.octal "+615,243"]
                                   [i.= i.octal "-615,243"]
 
-                                  [r.= r.octal ".615243"]
                                   [r.= r.octal ".615,243"]
 
-                                  [f.= f.octal "+6152.43"]
+                                  [f.= f.octal "+61,52.43"]
                                   [f.= f.octal "-61,52.43"]
                                   )))))
           (_.cover [/.hex]
@@ -83,16 +79,14 @@
                                      {try.#Failure error}
                                      false)]
 
-                                  [n.= n.hex "deadBEEF"]
                                   [n.= n.hex "dead,BEEF"]
 
-                                  [i.= i.hex "+deadBEEF"]
+                                  [i.= i.hex "+dead,BEEF"]
                                   [i.= i.hex "-dead,BEEF"]
 
-                                  [r.= r.hex ".deadBEEF"]
                                   [r.= r.hex ".dead,BEEF"]
 
-                                  [f.= f.hex "+dead.BEEF"]
+                                  [f.= f.hex "+dead,BE.EF"]
                                   [f.= f.hex "-dead,BE.EF"]
                                   )))))
 
diff --git a/stdlib/source/test/lux/target/ruby.lux b/stdlib/source/test/lux/target/ruby.lux
index d48e16ecb..5e2cecbde 100644
--- a/stdlib/source/test/lux/target/ruby.lux
+++ b/stdlib/source/test/lux/target/ruby.lux
@@ -9,6 +9,7 @@
     [\\specification
      ["$[0]" equivalence]]]
    [control
+    [pipe {"+" case>}]
     ["[0]" maybe ("[1]#[0]" functor)]
     ["[0]" try {"+" Try} ("[1]#[0]" functor)]]
    [data
@@ -20,7 +21,7 @@
      ["[0]" set]]]
    ["[0]" math
     ["[0]" random {"+" Random} ("[1]#[0]" monad)]
-    [number
+    [number {"+" hex}
      ["n" nat]
      ["i" int]
      ["f" frac]
@@ -46,6 +47,14 @@
                      (maybe.else false)))
       (try.else false)))
 
+(def: nil
+  (-> /.Expression Bit)
+  (|>> /.code
+       ..eval
+       (try#each (|>> (case> {.#None} true
+                             {.#Some _} false)))
+       (try.else false)))
+
 (def: test|literal
   Test
   (do [! random.monad]
@@ -55,14 +64,7 @@
      string (random.ascii/upper 5)]
     ($_ _.and
         (_.cover [/.nil]
-                 (|> /.nil
-                     /.code
-                     ..eval
-                     (try#each (function (_ it)
-                                 (case it
-                                   {.#None} true
-                                   {.#Some _} false)))
-                     (try.else false)))
+                 (..nil /.nil))
         (_.cover [/.bool]
                  (expression (|>> (:as Bit) (bit#= bool))
                              (/.bool bool)))
@@ -398,6 +400,22 @@
                                        (/.return $output))
                                    [(list $input)] (/.lambda {.#None})
                                    (/.apply_lambda/* (list (/.int input)))))))
+        (_.cover [/.redo]
+                 (let [expected (i.* (.int (n.- expected_inner_iterations full_inner_iterations)) input)]
+                   (expression (|>> (:as Frac) f.int (i.= expected))
+                               (|> ($_ /.then
+                                       (/.set (list $inner_index) (/.int +0))
+                                       (/.set (list $output) (/.int +0))
+                                       (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index)
+                                                ($_ /.then
+                                                    (/.set (list $inner_index) (/.+ (/.int +1) $inner_index))
+                                                    (/.when (/.<= (/.int (.int expected_inner_iterations)) $inner_index)
+                                                            /.redo)
+                                                    (/.set (list $output) (/.+ $input $output))
+                                                    ))
+                                       (/.return $output))
+                                   [(list $input)] (/.lambda {.#None})
+                                   (/.apply_lambda/* (list (/.int input)))))))
         )))
 
 (def: test|loop
@@ -435,17 +453,23 @@
         ..test|label
         )))
 
+(def: random_tag
+  (Random Int)
+  (random#each (i64.and (hex "FF,FF,FF,FF"))
+               random.int))
+
 (def: test|exception
   Test
   (do [! random.monad]
     [expected random.safe_frac
      dummy (random.only (|>> (f.= expected) not)
                         random.safe_frac)
+     error (random.ascii/lower 10)
      $ex (# ! each /.local (random.ascii/lower 10))
 
-     expected_tag random.int
+     expected_tag ..random_tag
      dummy_tag (random.only (|>> (i.= expected_tag) not)
-                            random.int)
+                            ..random_tag)
      .let [expected_tag (/.int expected_tag)
            dummy_tag (/.int dummy_tag)]]
     ($_ _.and
@@ -458,7 +482,7 @@
         (_.cover [/.Rescue /.throw/1]
                  (expression (|>> (:as Frac) (f.= expected))
                              (|> (/.begin ($_ /.then
-                                              (/.throw/1 (/.string ""))
+                                              (/.throw/1 (/.string error))
                                               (/.return (/.float dummy)))
                                           (list [(list) $ex (/.return (/.float expected))]))
                                  [(list)] (/.lambda {.#None})
@@ -466,7 +490,7 @@
         (_.cover [/.raise]
                  (expression (|>> (:as Frac) (f.= expected))
                              (|> (/.begin ($_ /.then
-                                              (/.statement (/.raise (/.string "")))
+                                              (/.statement (/.raise (/.string error)))
                                               (/.return (/.float dummy)))
                                           (list [(list) $ex (/.return (/.float expected))]))
                                  [(list)] (/.lambda {.#None})
@@ -492,6 +516,28 @@
                                       (/.catch dummy_tag) [(list)]
                                       /.statement (/.catch expected_tag) [(list)]
                                       (/.throw/2 expected_tag (/.float expected))))))
+        (_.cover [/.latest_error_message]
+                 (expression (|>> (:as Text) (text#= error))
+                             (|> (/.begin ($_ /.then
+                                              (/.statement (/.raise (/.string error)))
+                                              (/.return (/.float dummy)))
+                                          (list [(list) $ex (/.return (/.the "message" /.latest_error_message))]))
+                                 [(list)] (/.lambda {.#None})
+                                 (/.apply_lambda/* (list)))))
+        (_.cover [/.latest_error_location]
+                 (and (|> (/.return /.latest_error_location)
+                          [(list)] (/.lambda {.#None})
+                          (/.apply_lambda/* (list))
+                          ..nil)
+                      (expression (|>> (:as Bit) (bit#= true))
+                                  (|> (/.begin ($_ /.then
+                                                   (/.statement (/.raise (/.string error)))
+                                                   (/.return (/.float dummy)))
+                                               (list [(list) $ex (/.return ($_ /.and
+                                                                               (/.do "kind_of?" (list (/.local "Array")) {.#None} /.latest_error_location)
+                                                                               (/.> (/.int +0) (/.the "length" /.latest_error_location))))]))
+                                      [(list)] (/.lambda {.#None})
+                                      (/.apply_lambda/* (list))))))
         )))
 
 (def: test|function
@@ -625,30 +671,30 @@
 
 (def: test|global
   Test
-  ($_ _.and
-      (_.cover [/.script_name]
-               (expression (let [file (format (# file.default separator) packager.main_file)]
-                             (|>> (:as Text)
-                                  (predicate.or (text.ends_with? file)
-                                                (text#= "<script>"))))
-                           /.script_name))
-      (_.cover [/.input_record_separator]
-               (expression (|>> (:as Text)
-                                (text#= text.\n))
-                           /.input_record_separator))
-      (_.cover [/.output_record_separator]
-               (|> /.output_record_separator
-                   /.code
-                   ..eval
-                   (try#each (function (_ it)
-                               (case it
-                                 {.#None} true
-                                 {.#Some _} false)))
-                   (try.else false)))
-      (_.cover [/.process_id]
-               (expression (|>> (:as Nat) (n.= 0) not)
-                           /.process_id))
-      ))
+  (do random.monad
+    [_ (in [])]
+    ($_ _.and
+        (_.cover [/.script_name]
+                 (expression (let [file (format (# file.default separator) packager.main_file)]
+                               (|>> (:as Text)
+                                    (text.ends_with? file)))
+                             /.script_name))
+        (_.cover [/.input_record_separator]
+                 (expression (|>> (:as Text)
+                                  (text#= text.\n))
+                             /.input_record_separator))
+        (_.cover [/.output_record_separator]
+                 (..nil /.output_record_separator))
+        (_.cover [/.process_id]
+                 (expression (|>> (:as Nat) (n.= 0) not)
+                             /.process_id))
+        (_.cover [/.case_insensitivity_flag]
+                 (expression (|>> (:as Bit) (bit#= false))
+                             /.case_insensitivity_flag))
+        (_.cover [/.command_line_arguments]
+                 (expression (|>> (:as Int) (i.= +0))
+                             (/.the "length" /.command_line_arguments)))
+        )))
 
 (def: random_expression
   (Random /.Expression)
diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux
index 736c8757c..99db7ef1a 100644
--- a/stdlib/source/test/lux/tool.lux
+++ b/stdlib/source/test/lux/tool.lux
@@ -15,10 +15,11 @@
       ["[1]/[0]" simple]
       ["[1]/[0]" composite]
       ["[1]/[0]" pattern]]
-     ... [phase
-     ...  ["[1][0]" analysis]
-     ...  ["[1][0]" synthesis]]
-     ]]
+     ["[1][0]" phase "_"
+      ["[1]/[0]" extension]
+      ... ["[1]/[0]" analysis]
+      ... ["[1]/[0]" synthesis]
+      ]]]
    ["[1][0]" meta "_"
     ["[1]/[0]" archive "_"
      ["[1]/[0]" signature]
@@ -39,6 +40,7 @@
       /meta/archive/signature.test
       /meta/archive/key.test
       /meta/archive/document.test
+      /phase/extension.test
       ... /syntax.test
       ... /analysis.test
       ... /synthesis.test
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension.lux
new file mode 100644
index 000000000..517d5eb57
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension.lux
@@ -0,0 +1,265 @@
+(.using
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]
+   [abstract
+    ["[0]" monad {"+" do}]
+    [\\specification
+     ["$[0]" equivalence]
+     ["$[0]" hash]]]
+   [control
+    [pipe {"+" case>}]
+    ["[0]" try]
+    ["[0]" exception]]
+   [data
+    ["[0]" bit ("[1]#[0]" equivalence)]
+    ["[0]" text ("[1]#[0]" equivalence)
+     ["%" format {"+" format}]]
+    [collection
+     ["[0]" dictionary]
+     ["[0]" list ("[1]#[0]" mix)]]]
+   [math
+    ["[0]" random {"+" Random}]
+    [number
+     ["n" nat]
+     ["i" int]]]]]
+ [\\library
+  ["[0]" /
+   [/////
+    ["[0]" phase]
+    [meta
+     ["[0]" archive]]]]])
+
+(def: .public random
+  (Random (/.Extension Nat))
+  ($_ random.and
+      (random.ascii/lower 5)
+      (random.list 2 random.nat)
+      ))
+
+(def: test|state
+  Test
+  (do [! random.monad]
+    [state random.int
+     dummy (random.only (|>> (i.= state) not)
+                        random.int)]
+    ($_ _.and
+        (_.cover [/.read]
+                 (|> (: (/.Operation Int Nat Nat Text)
+                        (/.read %.int))
+                     (# phase.functor each (text#= (%.int state)))
+                     (phase.result [/.#bundle /.empty
+                                    /.#state state])
+                     (try.else false)))
+        (_.cover [/.update]
+                 (|> (: (/.Operation Int Nat Nat Text)
+                        (do phase.monad
+                          [_ (/.update ++)]
+                          (/.read %.int)))
+                     (# phase.functor each (text#= (%.int (++ state))))
+                     (phase.result [/.#bundle /.empty
+                                    /.#state state])
+                     (try.else false)))
+        (_.cover [/.temporary]
+                 (|> (: (/.Operation Int Nat Nat Text)
+                        (do phase.monad
+                          [|state'| (/.temporary ++ (/.read %.int))
+                           |state| (/.read %.int)]
+                          (in (format |state'| " " |state|))))
+                     (# phase.functor each (text#= (format (%.int (++ state)) " " (%.int state))))
+                     (phase.result [/.#bundle /.empty
+                                    /.#state state])
+                     (try.else false)))
+        (_.cover [/.with_state]
+                 (|> (: (/.Operation Int Nat Nat Text)
+                        (/.with_state state
+                          (/.read %.int)))
+                     (# phase.functor each (text#= (%.int state)))
+                     (phase.result [/.#bundle /.empty
+                                    /.#state dummy])
+                     (try.else false)))
+        (_.cover [/.localized]
+                 (|> (: (/.Operation Int Nat Nat Text)
+                        (do phase.monad
+                          [|state| (/.localized %.int
+                                                (function (_ _ old) (++ old))
+                                                (text.enclosed ["<" ">"])
+                                                (/.read %.int))
+                           |state'| (/.read %.int)]
+                          (in (format |state'| " " |state|))))
+                     (# phase.functor each (text#= (format (%.int (i.+ +2 state))
+                                                           " " (%.int (i.+ +1 state)))))
+                     (phase.result [/.#bundle /.empty
+                                    /.#state state])
+                     (try.else false))))
+    ))
+
+(def: extender
+  /.Extender
+  (|>> :expected))
+
+(def: handler/0
+  (/.Handler Int Nat Nat)
+  (function (_ @self phase archive inputs)
+    (# phase.monad in (list#mix n.+ 0 inputs))))
+
+(def: handler/1
+  (/.Handler Int Nat Nat)
+  (function (_ @self phase archive inputs)
+    (# phase.monad in (list#mix n.* 1 inputs))))
+
+(def: test|name
+  Test
+  (do [! random.monad]
+    [state random.int
+     extension (random.ascii/lower 1)
+     left random.nat
+     right random.nat]
+    ($_ _.and
+        (_.cover [/.cannot_overwrite]
+                 (|> (do phase.monad
+                       [_ (/.install extender extension handler/0)]
+                       (/.install extender extension handler/1))
+                     (phase.result [/.#bundle /.empty
+                                    /.#state state])
+                     (case> {try.#Failure error}
+                            (exception.match? /.cannot_overwrite error)
+
+                            _
+                            false)))
+        (_.cover [/.unknown]
+                 (|> (/.apply archive.empty (function (_ archive input)
+                                              (# phase.monad in (++ input)))
+                              [extension (list left right)])
+                     (phase.result [/.#bundle /.empty
+                                    /.#state state])
+                     (case> {try.#Failure error}
+                            (exception.match? /.unknown error)
+
+                            _
+                            false)))
+        )))
+
+(def: test|bundle
+  Test
+  (let [phase (: (/.Phase Int Nat Nat)
+                 (function (_ archive input)
+                   (# phase.monad in (++ input))))]
+    (do [! random.monad]
+      [state random.int
+
+       extension (random.ascii/lower 1)
+       left random.nat
+       right random.nat]
+      ($_ _.and
+          (_.cover [/.empty]
+                   (dictionary.empty? /.empty))
+          (<| (_.for [/.Extender /.Handler])
+              ($_ _.and
+                  (_.cover [/.install /.apply]
+                           (|> (do phase.monad
+                                 [_ (/.install extender extension handler/0)]
+                                 (/.apply archive.empty phase [extension (list left right)]))
+                               (# phase.functor each (n.= (n.+ left right)))
+                               (phase.result [/.#bundle /.empty
+                                              /.#state state])
+                               (try.else false)))
+                  (_.cover [/.Phase]
+                           (let [handler (: (/.Handler Int Nat Nat)
+                                            (function (_ @self phase archive inputs)
+                                              (let [! phase.monad]
+                                                (|> inputs
+                                                    (monad.each ! (phase archive))
+                                                    (# ! each (list#mix n.+ 0))))))]
+                             (|> (do phase.monad
+                                   [_ (/.install extender extension handler)]
+                                   (/.apply archive.empty phase [extension (list left right)]))
+                                 (# phase.functor each (n.= (n.+ (++ left) (++ right))))
+                                 (phase.result [/.#bundle /.empty
+                                                /.#state state])
+                                 (try.else false))))
+                  (_.cover [/.with]
+                           (|> (do phase.monad
+                                 [_ (/.with extender (dictionary.of_list text.hash (list [extension handler/1])))]
+                                 (/.apply archive.empty (function (_ archive input)
+                                                          (# phase.monad in (++ input)))
+                                          [extension (list left right)]))
+                               (# phase.functor each (n.= (n.* left right)))
+                               (phase.result [/.#bundle /.empty
+                                              /.#state state])
+                               (try.else false)))
+                  (_.cover [/.incorrect_arity]
+                           (let [handler (: (/.Handler Int Nat Nat)
+                                            (function (_ @self phase archive inputs)
+                                              (phase.except /.incorrect_arity [@self 2 (list.size inputs)])))]
+                             (|> (do phase.monad
+                                   [_ (/.install extender extension handler)]
+                                   (/.apply archive.empty phase [extension (list)]))
+                                 (phase.result [/.#bundle /.empty
+                                                /.#state state])
+                                 (case> {try.#Failure error}
+                                        (exception.match? /.incorrect_arity error)
+
+                                        _
+                                        false))))
+                  (_.cover [/.invalid_syntax]
+                           (let [handler (: (/.Handler Int Nat Nat)
+                                            (function (_ @self phase archive inputs)
+                                              (phase.except /.invalid_syntax [@self %.nat inputs])))]
+                             (|> (do phase.monad
+                                   [_ (/.install extender extension handler)]
+                                   (/.apply archive.empty phase [extension (list left right)]))
+                                 (phase.result [/.#bundle /.empty
+                                                /.#state state])
+                                 (case> {try.#Failure error}
+                                        (exception.match? /.invalid_syntax error)
+
+                                        _
+                                        false))))
+                  (_.for [/.Name]
+                         ..test|name)
+                  ))
+          ))))
+
+(def: .public test
+  Test
+  (<| (_.covering /._)
+      (_.for [/.Extension])
+      (do [! random.monad]
+        [state random.int
+         dummy (random.only (|>> (i.= state) not)
+                            random.int)
+         expected random.nat
+         expected_error (random.ascii/lower 1)]
+        ($_ _.and
+            (_.for [/.equivalence]
+                   ($equivalence.spec (/.equivalence n.equivalence) ..random))
+            (_.for [/.hash]
+                   ($hash.spec (/.hash n.hash) ..random))
+            
+            (<| (_.for [/.Operation])
+                ($_ _.and
+                    (_.cover [/.lifted]
+                             (and (|> (: (/.Operation Int Nat Nat Nat)
+                                         (/.lifted (do phase.monad
+                                                     []
+                                                     (in expected))))
+                                      (# phase.functor each (same? expected))
+                                      (phase.result [/.#bundle /.empty
+                                                     /.#state state])
+                                      (try.else false))
+                                  (|> (: (/.Operation Int Nat Nat Nat)
+                                         (/.lifted (phase.lifted {try.#Failure expected_error})))
+                                      (phase.result [/.#bundle /.empty
+                                                     /.#state state])
+                                      (case> {try.#Failure actual_error}
+                                             (same? expected_error actual_error)
+
+                                             _
+                                             false))))
+                    ))
+            (_.for [/.State]
+                   ..test|state)
+            (_.for [/.Bundle]
+                   ..test|bundle)
+            ))))