Keeping the JVM interop fixes coming...

10 files changed, 124 insertions, 95 deletions

diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux
index 2e4e790fe..6940b2f5e 100644
--- a/stdlib/source/library/lux/debug.lux
+++ b/stdlib/source/library/lux/debug.lux
@@ -170,7 +170,7 @@
                                             (|> (%.format (%.nat (.nat (ffi.of_long (java/lang/Integer::longValue tag))))
                                                           " " (%.bit last?)
                                                           " " (inspection choice))
-                                                (text.enclosed ["(" ")"])))
+                                                (text.enclosed ["{" "}"])))
 
                                           _
                                           (tuple_inspection inspection value)))
@@ -199,7 +199,7 @@
                     (|> (%.format (JSON::stringify variant_tag)
                                   " " (%.bit (not ("js object null?" variant_flag)))
                                   " " (inspection variant_value))
-                        (text.enclosed ["(" ")"]))
+                        (text.enclosed ["{" "}"]))
 
                     (not (or ("js object undefined?" ("js object get" "_lux_low" value))
                              ("js object undefined?" ("js object get" "_lux_high" value))))
@@ -240,7 +240,7 @@
                       (|> (%.format (|> variant_tag (:as .Nat) %.nat)
                                     " " (|> variant_flag "python object none?" not %.bit)
                                     " " (inspection variant_value))
-                          (text.enclosed ["(" ")"]))))
+                          (text.enclosed ["{" "}"]))))
                 _ (..str value)))
 
             _
@@ -273,7 +273,7 @@
                 (|> (%.format (|> variant_tag (:as .Nat) %.nat)
                               " " (%.bit (not ("lua object nil?" variant_flag)))
                               " " (inspection variant_value))
-                    (text.enclosed ["(" ")"]))))
+                    (text.enclosed ["{" "}"]))))
 
             _
             (..tostring value))
@@ -311,7 +311,7 @@
                             (|> (%.format (|> variant_tag (:as .Nat) %.nat)
                                           " " (%.bit (not ("ruby object nil?" variant_flag)))
                                           " " (inspection variant_value))
-                                (text.enclosed ["(" ")"]))))
+                                (text.enclosed ["{" "}"]))))
 
                         (same? (class_of [[] []]) value_class)
                         (tuple_inspection inspection value)
@@ -341,7 +341,7 @@
                 (|> (%.format (|> variant_tag (:as .Nat) %.nat)
                               " " (%.bit (not ("php object null?" variant_flag)))
                               " " (inspection variant_value))
-                    (text.enclosed ["(" ")"]))))
+                    (text.enclosed ["{" "}"]))))
 
             _
             (..strval value))
@@ -369,7 +369,7 @@
                           (|> (%.format (|> variant_tag (:as .Nat) %.nat)
                                         " " (%.bit (not ("scheme object nil?" variant_flag)))
                                         " " (inspection variant_value))
-                              (text.enclosed ["(" ")"])))
+                              (text.enclosed ["{" "}"])))
                         (..format ["~s" value])))
 
                     ... else
@@ -463,7 +463,7 @@
 
                                             _
                                             (undefined)))]
-            (%.format "(" (%.nat lefts) " " (%.bit right?) " " sub_repr ")"))))))
+            (%.format "{" (%.nat lefts) " " (%.bit right?) " " sub_repr "}"))))))
 
 (def: (tuple_representation representation)
   (-> (Parser Representation) (Parser Representation))
diff --git a/stdlib/source/library/lux/target/jvm/reflection.lux b/stdlib/source/library/lux/target/jvm/reflection.lux
index f8cce5214..6d170ac6b 100644
--- a/stdlib/source/library/lux/target/jvm/reflection.lux
+++ b/stdlib/source/library/lux/target/jvm/reflection.lux
@@ -6,7 +6,7 @@
    [abstract
     ["[0]" monad {"+" do}]]
    [control
-    ["[0]" try {"+" Try}]
+    ["[0]" try {"+" Try} ("[1]#[0]" functor)]
     ["[0]" exception {"+" exception:}]
     [parser
      ["<t>" text]]]
@@ -86,7 +86,9 @@
    (getName [] java/lang/String)
    (isAssignableFrom [(java/lang/Class java/lang/Object)] boolean)
    (getTypeParameters [] [(java/lang/reflect/TypeVariable (java/lang/Class c))])
-   (getDeclaredField [java/lang/String] "try" java/lang/reflect/Field)])
+   (getDeclaredField [java/lang/String] "try" java/lang/reflect/Field)
+   (isArray [] boolean)
+   (getComponentType [] (java/lang/Class java/lang/Object))])
 
 (exception: .public (unknown_class [class External])
   (exception.report
@@ -147,18 +149,19 @@
         {.#Some reflection}
         (let [raw (java/lang/reflect/ParameterizedType::getRawType reflection)]
           (case (ffi.check java/lang/Class raw)
-            {.#Some raw}
+            {.#Some raw'}
             (let [! try.monad]
               (|> reflection
                   java/lang/reflect/ParameterizedType::getActualTypeArguments
                   (array.list {.#None})
                   (monad.each ! parameter)
-                  (# ! each (/.class (|> raw
+                  (# ! each (/.class (|> raw'
                                          (:as (java/lang/Class java/lang/Object))
-                                         java/lang/Class::getName)))))
+                                         java/lang/Class::getName)))
+                  (exception.with ..cannot_convert_to_a_lux_type [reflection])))
 
             _
-            (exception.except ..not_a_class [raw])))
+            (exception.except ..not_a_class [reflection])))
         _)
       ... else
       (exception.except ..cannot_convert_to_a_lux_type [reflection])))
@@ -199,6 +202,15 @@
             type
             (# try.monad each /.array))
         _)
+      (case (ffi.check java/lang/Class reflection)
+        {.#Some class}
+        (if (java/lang/Class::isArray class)
+          (|> class
+              java/lang/Class::getComponentType
+              type
+              (try#each /.array))
+          (..class' (parameter type) reflection))
+        _)
       (..class' (parameter type) reflection)))
 
 (def: .public (type reflection)
@@ -272,6 +284,12 @@
 (def: .public (correspond class type)
   (-> (java/lang/Class java/lang/Object) Type (Try Mapping))
   (case type
+    (^ {.#Primitive (static array.type_name) (list :member:)})
+    (if (java/lang/Class::isArray class)
+      (correspond (java/lang/Class::getComponentType class)
+                  :member:)
+      (exception.except ..cannot_correspond [class type]))
+    
     {.#Primitive name params}
     (let [class_name (java/lang/Class::getName class)
           class_params (array.list {.#None} (java/lang/Class::getTypeParameters class))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux
index da2a15d70..e2e1df881 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux
@@ -28,8 +28,9 @@
   ["[1][0]" value]
   ["[1][0]" structure]
   [////
-   ["[0]" synthesis {"+" Path Fork Synthesis}]
    ["[0]" generation]
+   ["[0]" synthesis {"+" Path Fork Synthesis}
+    ["[0]" member {"+" Member}]]
    [///
     ["[0]" phase ("operation#[0]" monad)]
     [reference
@@ -294,16 +295,13 @@
             body!))))
 
 (def: .public (get phase archive [path recordS])
-  (Generator [(List synthesis.Member) Synthesis])
+  (Generator [(List Member) Synthesis])
   (do phase.monad
     [record! (phase archive recordS)]
     (in (list#mix (function (_ step so_far!)
-                    (.let [next! (.case step
-                                   {.#Left lefts}
-                                   (..left_projection lefts)
-                                   
-                                   {.#Right lefts}
-                                   (..right_projection lefts))]
+                    (.let [next! (.if (value@ member.#right? step)
+                                   (..right_projection (value@ member.#lefts step))
+                                   (..left_projection (value@ member.#lefts step)))]
                       ($_ _.composite
                           so_far!
                           next!)))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux
index 400e47cfb..f78fb404b 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux
@@ -27,8 +27,9 @@
     [synthesis
      ["[0]" case]]
     ["/[1]" // "_"
-     ["[1][0]" synthesis {"+" Member Synthesis Path}]
      ["[1][0]" generation]
+     ["[1][0]" synthesis {"+" Synthesis Path}
+      ["[0]" member {"+" Member}]]
      ["//[1]" /// "_"
       [reference
        ["[1][0]" variable {"+" Register}]]
@@ -109,12 +110,9 @@
   (do ///////phase.monad
     [valueO (expression archive valueS)]
     (in (list#mix (function (_ side source)
-                    (.let [method (.case side
-                                    (^template [<side> <accessor>]
-                                      [{<side> lefts}
-                                       (<accessor> (_.int (.int lefts)))])
-                                    ([.#Left //runtime.tuple//left]
-                                     [.#Right //runtime.tuple//right]))]
+                    (.let [method (.if (value@ member.#right? side)
+                                    (//runtime.tuple//right (_.int (.int (value@ member.#lefts side))))
+                                    (//runtime.tuple//left (_.int (.int (value@ member.#lefts side)))))]
                       (method source)))
                   valueO
                   (list.reversed pathP)))))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux
index 589de1abc..5441ec92f 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux
@@ -25,7 +25,8 @@
     ["[2][0]" complex]
     ["[2][0]" pattern {"+" Pattern}]]
    ["/" synthesis {"+" Path Synthesis Operation Phase}
-    ["[1][0]" side]]
+    ["[1][0]" side]
+    ["[1][0]" member {"+" Member}]]
    [///
     ["[1]" phase ("[1]#[0]" monad)]
     ["[1][0]" reference
@@ -83,9 +84,10 @@
                     _
                     (let [right? (n.= tuple::last tuple::lefts)
                           end?' (and end? right?)]
-                      (<| (///#each (|>> {/.#Seq {/.#Access {/.#Member (if right?
-                                                                         {.#Right (-- tuple::lefts)}
-                                                                         {.#Left tuple::lefts})}}}))
+                      (<| (///#each (|>> {/.#Seq {/.#Access {/.#Member [/member.#lefts (if right?
+                                                                                         (-- tuple::lefts)
+                                                                                         tuple::lefts)
+                                                                        /member.#right? right?]}}}))
                           (path' tuple::member end?')
                           (when> [(new> (not end?') [])] [(///#each ..clean_up)])
                           nextC))))
@@ -174,23 +176,17 @@
        [/.#F64_Fork frac.equivalence]
        [/.#Text_Fork text.equivalence])
       
-      (^template [<access> <side>]
-        [[{/.#Access {<access> [/side.#lefts newL /side.#right? <side>]}}
-          {/.#Access {<access> [/side.#lefts oldL /side.#right? <side>]}}]
+      (^template [<access> <side> <lefts> <right?>]
+        [[{/.#Access {<access> [<lefts> newL <right?> <side>]}}
+          {/.#Access {<access> [<lefts> oldL <right?> <side>]}}]
          (if (n.= newL oldL)
            old
            <default>)])
-      ([/.#Side #0]
-       [/.#Side #1])
+      ([/.#Side #0 /side.#lefts /side.#right?]
+       [/.#Side #1 /side.#lefts /side.#right?]
 
-      (^template [<access> <side>]
-        [[{/.#Access {<access> {<side> newL}}}
-          {/.#Access {<access> {<side> oldL}}}]
-         (if (n.= newL oldL)
-           old
-           <default>)])
-      ([/.#Member .#Left]
-       [/.#Member .#Right])
+       [/.#Member #0 /member.#lefts /member.#right?]
+       [/.#Member #1 /member.#lefts /member.#right?])
 
       [{/.#Bind newR} {/.#Bind oldR}]
       (if (n.= newR oldR)
@@ -201,15 +197,17 @@
       <default>)))
 
 (def: (get patterns @selection)
-  (-> (///complex.Tuple Pattern) Register (List /.Member))
+  (-> (///complex.Tuple Pattern) Register (List Member))
   (loop [lefts 0
          patterns patterns]
     (with_expansions [<failure> (as_is (list))
                       <continue> (as_is (again (++ lefts)
                                                tail))
-                      <member> (as_is (if (list.empty? tail)
-                                        {.#Right (-- lefts)}
-                                        {.#Left lefts}))]
+                      <member> (as_is (let [right? (list.empty? tail)]
+                                        [/member.#lefts (if right?
+                                                          (-- lefts)
+                                                          lefts)
+                                         /member.#right? right?]))]
       (case patterns
         {.#End}
         <failure>
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux
index beccd504c..ba6f29f89 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux
@@ -282,7 +282,7 @@
                                                            (in [redundancy [else_test else_then]]))))
                                                     [redundancy elses])]
            (in [redundancy {<tag> [[test then] elses]}]))])
-      ([/.#I64_Fork (I64 Any)]
+      ([/.#I64_Fork I64]
        [/.#F64_Fork Frac]
        [/.#Text_Fork Text])
       
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux
index 409e97353..a5767f301 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux
@@ -27,6 +27,7 @@
  ["[0]" / "_"
   ["[1][0]" simple {"+" Simple}]
   ["[1][0]" side {"+" Side}]
+  ["[1][0]" member {"+" Member}]
   [//
    ["[0]" analysis {"+" Environment Analysis}
     ["[1]/[0]" complex {"+" Complex}]]
@@ -56,9 +57,6 @@
   [#locals 0
    #currying? false])
 
-(type: .public Member
-  (Either Nat Nat))
-
 (type: .public Access
   (Variant
    {#Side Side}
@@ -73,7 +71,7 @@
    {#Bind Register}
    {#Access Access}
    {#Bit_Fork Bit (Path' s) (Maybe (Path' s))}
-   {#I64_Fork (Fork (I64 Any) (Path' s))}
+   {#I64_Fork (Fork I64 (Path' s))}
    {#F64_Fork (Fork Frac (Path' s))}
    {#Text_Fork (Fork Text (Path' s))}
    {#Seq (Path' s) (Path' s)}
@@ -158,29 +156,26 @@
   [path/member ..#Member]
   )
 
-(template: .public (side lefts right?)
-  [(.<| {..#Access}
-        {..#Side}
-        [/side.#lefts lefts
-         /side.#right? right?])])
-
-(template [<side> <name>]
-  [(template: .public (<name> lefts)
-     [(..side lefts <side>)])]
+(template [<name> <access> <lefts> <right?>]
+  [(template: .public (<name> lefts right?)
+     [(.<| {..#Access}
+           {<access>}
+           [<lefts> lefts
+            <right?> right?])])]
 
-  [#0 side/left]
-  [#1 side/right]
+  [side ..#Side /side.#lefts /side.#right?]
+  [member ..#Member /member.#lefts /member.#right?]
   )
 
-(template [<name> <kind> <side>]
-  [(template: .public (<name> content)
-     [(.<| {..#Access}
-           {<kind>}
-           {<side>}
-           content)])]
+(template [<access> <side> <name>]
+  [(template: .public (<name> lefts)
+     [(<access> lefts <side>)])]
+
+  [..side #0 side/left]
+  [..side #1 side/right]
 
-  [member/left  ..#Member .#Left]
-  [member/right ..#Member .#Right]
+  [..member #0 member/left]
+  [..member #1 member/right]
   )
 
 (template [<name> <tag>]
@@ -313,13 +308,8 @@
       {#Side it}
       (/side.format it)
       
-      {#Member member}
-      (case member
-        {.#Left lefts}
-        (format "[" (%.nat lefts) " #0" "]")
-        
-        {.#Right lefts}
-        (format "[" (%.nat lefts) " #1" "]")))
+      {#Member it}
+      (/member.format it))
     
     {#Bind register}
     (format "(@ " (%.nat register) ")")
@@ -426,14 +416,6 @@
   (Format Path)
   (%path' %synthesis))
 
-(def: member_hash
-  (Hash Member)
-  (sum.hash n.hash n.hash))
-
-(def: member_equivalence
-  (Equivalence Member)
-  (# ..member_hash &equivalence))
-
 (implementation: .public access_equivalence
   (Equivalence Access)
   
@@ -443,7 +425,7 @@
         [[{<tag> reference} {<tag> sample}]
          (# <equivalence> = reference sample)])
       ([#Side /side.equivalence]
-       [#Member ..member_equivalence])
+       [#Member /member.equivalence])
 
       _
       false)))
@@ -459,7 +441,7 @@
         [{<tag> value}
          (# <hash> hash value)])
       ([#Side /side.hash]
-       [#Member ..member_hash]))))
+       [#Member /member.hash]))))
 
 (implementation: .public (path'_equivalence equivalence)
   (All (_ a) (-> (Equivalence a) (Equivalence (Path' a))))
@@ -481,7 +463,7 @@
          (# (list.equivalence (product.equivalence <equivalence> =)) =
             {.#Item reference_item}
             {.#Item sample_item})])
-      ([#I64_Fork i64.equivalence]
+      ([#I64_Fork (: (Equivalence I64) i64.equivalence)]
        [#F64_Fork f.equivalence]
        [#Text_Fork text.equivalence])
       
@@ -568,7 +550,7 @@
       
       [{#Get [reference_path reference_record]}
        {#Get [sample_path sample_record]}]
-      (and (# (list.equivalence ..member_equivalence) = reference_path sample_path)
+      (and (# (list.equivalence /member.equivalence) = reference_path sample_path)
            (#= reference_record sample_record))
       
       [{#Case [reference_input reference_path]}
@@ -606,7 +588,7 @@
       
       {#Get [path record]}
       ($_ n.* 7
-          (# (list.hash ..member_hash) hash path)
+          (# (list.hash /member.hash) hash path)
           (# super hash record))
       
       {#Case [input path]}
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/member.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/member.lux
new file mode 100644
index 000000000..4e1ed910b
--- /dev/null
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/member.lux
@@ -0,0 +1,34 @@
+(.using
+ [library
+  [lux "*"
+   [abstract
+    [equivalence {"+" Equivalence}]
+    [hash {"+" Hash}]]
+   [data
+    ["[0]" product]
+    ["[0]" bit]
+    [text
+     ["%" format]]]
+   [math
+    [number
+     ["[0]" nat]]]]])
+
+(type: .public Member
+  (Record
+   [#lefts Nat
+    #right? Bit]))
+
+(def: .public (format it)
+  (%.Format Member)
+  (%.format "[" (%.nat (value@ #lefts it)) " " (%.bit (value@ #right? it)) "]"))
+
+(def: .public hash
+  (Hash Member)
+  ($_ product.hash
+      nat.hash
+      bit.hash
+      ))
+
+(def: .public equivalence
+  (Equivalence Member)
+  (# ..hash &equivalence))
diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux
index 02b8e7055..6489b6fb7 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux
@@ -68,7 +68,7 @@
                                                       //.#category {<tag> it}
                                                       //.#mandatory? mandatory?]
                                                      dependencies]))
-              (revised@ #resolver (dictionary.has (<name> it) [id <+resolver>]))
+              (revised@ #resolver (dictionary.has (<name> it) [id (: (Maybe //category.Definition) <+resolver>)]))
               :abstraction)]))
 
      (def: .public (<fetch> registry)
diff --git a/stdlib/source/library/lux/world/program.lux b/stdlib/source/library/lux/world/program.lux
index 2eb9e3f62..95118c399 100644
--- a/stdlib/source/library/lux/world/program.lux
+++ b/stdlib/source/library/lux/world/program.lux
@@ -310,6 +310,7 @@
                                 java/util/Map::keySet
                                 java/util/Set::iterator
                                 ..jvm##consume
+                                (list#each (|>> ffi.of_string))
                                 io.io)]
       (for [@.old <jvm>
             @.jvm <jvm>