Still more fixes for JVM interop.

8 files changed, 206 insertions, 150 deletions

diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux
index 0ac407738..e8f045d1e 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux
@@ -111,8 +111,9 @@
              )))
 
 (def: .public (with_var it)
-  (All (_ a) (-> (-> [check.Var Type] (Operation a))
-                 (Operation a)))
+  (All (_ a)
+    (-> (-> [check.Var Type] (Operation a))
+        (Operation a)))
   (do phase.monad
     [@it,:it: (..check check.var)
      it (it @it,:it:)
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux
index 1365d0e1e..118a5da91 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux
@@ -56,8 +56,8 @@
 (def: .public (function analyse function_name arg_name archive body)
   (-> Phase Text Text Phase)
   (do [! ///.monad]
-    [:function: (///extension.lifted meta.expected_type)]
-    (loop [expectedT :function:]
+    [expectedT (///extension.lifted meta.expected_type)]
+    (loop [expectedT expectedT]
       (/.with_exception ..cannot_analyse [expectedT function_name arg_name body]
         (case expectedT
           {.#Function :input: :output:}
@@ -73,8 +73,8 @@
               (/type.expecting :output:)
               (analyse archive body))
           
-          {.#Named name unnamedT}
-          (again unnamedT)
+          {.#Named name :anonymous:}
+          (again :anonymous:)
 
           {.#Apply argT funT}
           (case (type.applied (list argT) funT)
@@ -84,13 +84,15 @@
             {.#None}
             (/.failure (exception.error ..cannot_analyse [expectedT function_name arg_name body])))
 
-          (^template [<tag> <instancer>]
-            [{<tag> _}
-             (do !
-               [[_ instanceT] (/type.check <instancer>)]
-               (again (maybe.trusted (type.applied (list instanceT) expectedT))))])
-          ([.#UnivQ check.existential]
-           [.#ExQ check.var])
+          {.#UnivQ _}
+          (do !
+            [[@instance :instance:] (/type.check check.existential)]
+            (again (maybe.trusted (type.applied (list :instance:) expectedT))))
+
+          {.#ExQ _}
+          (<| /type.with_var
+              (.function (_ [@instance :instance:]))
+              (again (maybe.trusted (type.applied (list :instance:) expectedT))))
           
           {.#Var id}
           (do !
@@ -101,27 +103,32 @@
 
               ... Inference
               _
-              (do !
-                [[@input :input:] (/type.check check.var)
-                 [@output :output:] (/type.check check.var)
-                 .let [:function: {.#Function :input: :output:}]
-                 functionA (again :function:)
-                 specialization (/type.check (check.try (check.identity (list @output) @input)))
-                 :function: (case specialization
-                              {try.#Success :input:'}
-                              (in :function:)
+              (<| /type.with_var
+                  (.function (_ [@input :input:]))
+                  /type.with_var
+                  (.function (_ [@output :output:]))
+                  (do !
+                    [functionA (again {.#Function :input: :output:})])
+                  /type.check
+                  (do check.monad
+                    [:output: (check.identity (list) @output)
+                     ?:input: (check.try (check.identity (list @output) @input))
+                     ? (check.linked? @input @output)
+                     _ (<| (check.check expectedT)
+                           (case ?:input:
+                             {try.#Success :input:}
+                             {.#Function :input: (if ?
+                                                   :input:
+                                                   :output:)}
 
-                              {try.#Failure _}
-                              (/type.check
-                               (do [! check.monad]
-                                 [? (check.linked? @input @output)]
-                                 (# ! each
-                                    (|>> {.#Function :input:} (/inference.quantified @input 1) {.#UnivQ (list)})
-                                    (if ?
-                                      (in :input:)
-                                      (check.identity (list @input) @output))))))
-                 _ (/type.check (check.check expectedT :function:))]
-                (in functionA))))
+                             {try.#Failure _}
+                             (|> (if ?
+                                   :input:
+                                   :output:)
+                                 {.#Function :input:}
+                                 (/inference.quantified @input 1)
+                                 {.#UnivQ (list)})))]
+                    (in functionA)))))
 
           _
           (/.failure "")
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
index 22e29dd08..132ceca10 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
@@ -8,7 +8,7 @@
     ["[0]" predicate]]
    [control
     pipe
-    ["[0]" maybe]
+    ["[0]" maybe ("[1]#[0]" functor)]
     ["[0]" try {"+" Try} ("[1]#[0]" monad)]
     ["[0]" exception {"+" exception:}]
     ["<>" parser
@@ -255,13 +255,17 @@
   )
 
 (template [<name>]
-  [(exception: .public (<name> [class External
+  [(exception: .public (<name> [class_variables (List (Type Var))
+                                class External
                                 method Text
+                                method_variables (List (Type Var))
                                 inputsJT (List (Type Value))
                                 hints (List Method_Signature)])
      (exception.report
+      ["Class Variables" (exception.listing ..signature class_variables)]
       ["Class" class]
       ["Method" method]
+      ["Method Variables" (exception.listing ..signature method_variables)]
       ["Arguments" (exception.listing ..signature inputsJT)]
       ["Hints" (exception.listing %.type (list#each product.left hints))]))]
 
@@ -1127,6 +1131,34 @@
    {#Special}
    {#Interface}))
 
+(def: (de_aliased aliasing)
+  (-> Aliasing (Type Value) (Type Value))
+  (function (again it)
+    (`` (<| (case (parser.var? it)
+              {.#Some name}
+              (|> aliasing
+                  (dictionary.value name)
+                  (maybe#each jvm.var)
+                  (maybe.else it))
+              {.#None})
+            (case (parser.class? it)
+              {.#Some [name parameters]}
+              (|> parameters
+                  (list#each (|>> again (:as (Type Parameter))))
+                  (jvm.class name))
+              {.#None})
+            (~~ (template [<read> <as> <write>]
+                  [(case (<read> it)
+                     {.#Some :sub:}
+                     (<write> (:as (Type <as>) (again :sub:)))
+                     {.#None})]
+
+                  [parser.array? Value jvm.array]
+                  [parser.lower? Class jvm.lower]
+                  [parser.upper? Class jvm.upper]
+                  ))
+            it))))
+
 (def: (check_method aliasing class method_name method_style inputsJT method)
   (-> Aliasing (java/lang/Class java/lang/Object) Text Method_Style (List (Type Value)) java/lang/reflect/Method (Operation Bit))
   (do phase.monad
@@ -1137,41 +1169,28 @@
      .let [modifiers (java/lang/reflect/Method::getModifiers method)
            correct_class? (java/lang/Object::equals class (java/lang/reflect/Method::getDeclaringClass method))
            correct_method? (text#= method_name (java/lang/reflect/Method::getName method))
-           static_matches? (case method_style
-                             {#Static}
-                             (java/lang/reflect/Modifier::isStatic modifiers)
-
-                             _
-                             true)
-           special_matches? (case method_style
-                              {#Special}
-                              (not (or (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class))
-                                       (java/lang/reflect/Modifier::isAbstract modifiers)))
-
-                              _
-                              true)
-           arity_matches? (n.= (list.size inputsJT) (list.size parameters))
-           inputs_match? (and arity_matches?
-                              (list#mix (function (_ [expectedJC actualJC] prev)
-                                          (and prev
-                                               (jvm#= expectedJC (: (Type Value)
-                                                                    (case (parser.var? actualJC)
-                                                                      {.#Some name}
-                                                                      (|> aliasing
-                                                                          (dictionary.value name)
-                                                                          (maybe.else name)
-                                                                          jvm.var)
-
-                                                                      {.#None}
-                                                                      actualJC)))))
-                                        true
-                                        (list.zipped/2 parameters inputsJT)))]]
+           same_static? (case method_style
+                          {#Static}
+                          (java/lang/reflect/Modifier::isStatic modifiers)
+
+                          _
+                          true)
+           same_special? (case method_style
+                           {#Special}
+                           (not (or (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class))
+                                    (java/lang/reflect/Modifier::isAbstract modifiers)))
+
+                           _
+                           true)
+           same_inputs? (and (n.= (list.size inputsJT) (list.size parameters))
+                             (list.every? (function (_ [expectedJC actualJC])
+                                            (jvm#= expectedJC (de_aliased aliasing actualJC)))
+                                          (list.zipped/2 parameters inputsJT)))]]
     (in (and correct_class?
              correct_method?
-             static_matches?
-             special_matches?
-             arity_matches?
-             inputs_match?))))
+             same_static?
+             same_special?
+             same_inputs?))))
 
 (def: (check_constructor aliasing class inputsJT constructor)
   (-> Aliasing (java/lang/Class java/lang/Object) (List (Type Value)) (java/lang/reflect/Constructor java/lang/Object) (Operation Bit))
@@ -1183,16 +1202,7 @@
     (in (and (java/lang/Object::equals class (java/lang/reflect/Constructor::getDeclaringClass constructor))
              (n.= (list.size inputsJT) (list.size parameters))
              (list.every? (function (_ [expectedJC actualJC])
-                            (jvm#= expectedJC (: (Type Value)
-                                                 (case (parser.var? actualJC)
-                                                   {.#Some name}
-                                                   (|> aliasing
-                                                       (dictionary.value name)
-                                                       (maybe.else name)
-                                                       jvm.var)
-
-                                                   {.#None}
-                                                   actualJC))))
+                            (jvm#= expectedJC (de_aliased aliasing actualJC)))
                           (list.zipped/2 parameters inputsJT))))))
 
 (def: index_parameter
@@ -1380,10 +1390,10 @@
       (in method)
 
       {.#End}
-      (/////analysis.except ..no_candidates [class_name method_name inputsJT (list.all hint! candidates)])
+      (/////analysis.except ..no_candidates [actual_class_tvars class_name method_name actual_method_tvars inputsJT (list.all hint! candidates)])
       
       candidates
-      (/////analysis.except ..too_many_candidates [class_name method_name inputsJT candidates]))))
+      (/////analysis.except ..too_many_candidates [actual_class_tvars class_name method_name actual_method_tvars inputsJT candidates]))))
 
 (def: constructor_method
   "<init>")
@@ -1412,10 +1422,10 @@
       (in constructor)
 
       {.#End}
-      (/////analysis.except ..no_candidates [class_name ..constructor_method inputsJT (list.all hint! candidates)])
+      (/////analysis.except ..no_candidates [actual_class_tvars class_name ..constructor_method actual_method_tvars inputsJT (list.all hint! candidates)])
       
       candidates
-      (/////analysis.except ..too_many_candidates [class_name ..constructor_method inputsJT candidates]))))
+      (/////analysis.except ..too_many_candidates [actual_class_tvars class_name ..constructor_method actual_method_tvars inputsJT candidates]))))
 
 (template [<name> <category> <parser>]
   [(def: .public <name>
@@ -2175,7 +2185,7 @@
                              [[/////analysis.#when
                                {pattern.#Complex
                                 {complex.#Tuple
-                                 (|> arity
+                                 (|> (-- arity)
                                      list.indices
                                      (list#each (|>> (n.+ 2) {pattern.#Bind})))}}
                                
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 ffd226015..da2a15d70 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
@@ -179,25 +179,22 @@
                 body!
                 (_.when_continuous (_.goto @end)))))
       
-      (^template [<right?> <pattern>]
-        [(^ (<pattern> lefts))
-         (operation#in
-          (do _.monad
-            [@success _.new_label]
-            ($_ _.composite
-                ..peek
-                (_.checkcast //type.variant)
-                (//structure.lefts lefts)
-                (//structure.right? <right?>)
-                //runtime.case
-                _.dup
-                (_.ifnonnull @success)
-                _.pop
-                (_.goto @else)
-                (_.set_label @success)
-                //runtime.push)))])
-      ([#0 synthesis.side/left]
-       [#1 synthesis.side/right])
+      (^ (synthesis.side lefts right?))
+      (operation#in
+       (do _.monad
+         [@success _.new_label]
+         ($_ _.composite
+             ..peek
+             (_.checkcast //type.variant)
+             (//structure.lefts lefts)
+             (//structure.right? right?)
+             //runtime.case
+             _.dup
+             (_.ifnonnull @success)
+             _.pop
+             (_.goto @else)
+             (_.set_label @success)
+             //runtime.push)))
 
       (^template [<pattern> <projection>]
         [(^ (<pattern> lefts))
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 522da7f04..589de1abc 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
@@ -20,11 +20,12 @@
      ["[0]" frac]]]]]
  ["[0]" /// "_"
   [//
-   ["/" synthesis {"+" Path Synthesis Operation Phase}]
    ["[1][0]" analysis {"+" Match Analysis}
     ["[2][0]" simple]
     ["[2][0]" complex]
     ["[2][0]" pattern {"+" Pattern}]]
+   ["/" synthesis {"+" Path Synthesis Operation Phase}
+    ["[1][0]" side]]
    [///
     ["[1]" phase ("[1]#[0]" monad)]
     ["[1][0]" reference
@@ -66,9 +67,8 @@
         thenC)
 
     {///pattern.#Complex {///complex.#Variant [lefts right? value_pattern]}}
-    (<| (///#each (|>> {/.#Seq {/.#Access {/.#Side (if right?
-                                                     {.#Right lefts}
-                                                     {.#Left lefts})}}}))
+    (<| (///#each (|>> {/.#Seq {/.#Access {/.#Side [/side.#lefts lefts
+                                                    /side.#right? right?]}}}))
         (path' value_pattern end?)
         (when> [(new> (not end?) [])] [(///#each ..clean_up)])
         thenC)
@@ -175,14 +175,21 @@
        [/.#Text_Fork text.equivalence])
       
       (^template [<access> <side>]
+        [[{/.#Access {<access> [/side.#lefts newL /side.#right? <side>]}}
+          {/.#Access {<access> [/side.#lefts oldL /side.#right? <side>]}}]
+         (if (n.= newL oldL)
+           old
+           <default>)])
+      ([/.#Side #0]
+       [/.#Side #1])
+
+      (^template [<access> <side>]
         [[{/.#Access {<access> {<side> newL}}}
           {/.#Access {<access> {<side> oldL}}}]
          (if (n.= newL oldL)
            old
            <default>)])
-      ([/.#Side .#Left]
-       [/.#Side .#Right]
-       [/.#Member .#Left]
+      ([/.#Member .#Left]
        [/.#Member .#Right])
 
       [{/.#Bind newR} {/.#Bind oldR}]
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 99d99dbc6..409e97353 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux
@@ -26,6 +26,7 @@
      ["f" frac]]]]]
  ["[0]" / "_"
   ["[1][0]" simple {"+" Simple}]
+  ["[1][0]" side {"+" Side}]
   [//
    ["[0]" analysis {"+" Environment Analysis}
     ["[1]/[0]" complex {"+" Complex}]]
@@ -55,9 +56,6 @@
   [#locals 0
    #currying? false])
 
-(type: .public Side
-  (Either Nat Nat))
-
 (type: .public Member
   (Either Nat Nat))
 
@@ -72,14 +70,14 @@
 (type: .public (Path' s)
   (Variant
    {#Pop}
-   {#Access Access}
    {#Bind Register}
+   {#Access Access}
    {#Bit_Fork Bit (Path' s) (Maybe (Path' s))}
    {#I64_Fork (Fork (I64 Any) (Path' s))}
    {#F64_Fork (Fork Frac (Path' s))}
    {#Text_Fork (Fork Text (Path' s))}
-   {#Alt (Path' s) (Path' s)}
    {#Seq (Path' s) (Path' s)}
+   {#Alt (Path' s) (Path' s)}
    {#Then s}))
 
 (type: .public (Abstraction' s)
@@ -160,6 +158,20 @@
   [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>)])]
+
+  [#0 side/left]
+  [#1 side/right]
+  )
+
 (template [<name> <kind> <side>]
   [(template: .public (<name> content)
      [(.<| {..#Access}
@@ -167,8 +179,6 @@
            {<side>}
            content)])]
 
-  [side/left    ..#Side   .#Left]
-  [side/right   ..#Side   .#Right]
   [member/left  ..#Member .#Left]
   [member/right ..#Member .#Right]
   )
@@ -230,9 +240,9 @@
 
 (template [<name> <tag>]
   [(template: .public (<name> content)
-     [(<| {..#Structure}
-          {<tag>}
-          content)])]
+     [(.<| {..#Structure}
+           {<tag>}
+           content)])]
 
   [variant analysis/complex.#Variant]
   [tuple   analysis/complex.#Tuple]
@@ -300,13 +310,8 @@
     
     {#Access access}
     (case access
-      {#Side side}
-      (case side
-        {.#Left lefts}
-        (format "{" (%.nat lefts) " #0" "}")
-        
-        {.#Right lefts}
-        (format "{" (%.nat lefts) " #1" "}"))
+      {#Side it}
+      (/side.format it)
       
       {#Member member}
       (case member
@@ -421,18 +426,14 @@
   (Format Path)
   (%path' %synthesis))
 
-(def: side_equivalence
-  (Equivalence Side)
-  (sum.equivalence n.equivalence n.equivalence))
-
-(def: member_equivalence
-  (Equivalence Member)
-  (sum.equivalence n.equivalence n.equivalence))
-
 (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)
   
@@ -441,7 +442,7 @@
       (^template [<tag> <equivalence>]
         [[{<tag> reference} {<tag> sample}]
          (# <equivalence> = reference sample)])
-      ([#Side ..side_equivalence]
+      ([#Side /side.equivalence]
        [#Member ..member_equivalence])
 
       _
@@ -453,13 +454,12 @@
   (def: &equivalence ..access_equivalence)
   
   (def: (hash value)
-    (let [sub_hash (sum.hash n.hash n.hash)]
-      (case value
-        (^template [<tag>]
-          [{<tag> value}
-           (# sub_hash hash value)])
-        ([#Side]
-         [#Member])))))
+    (case value
+      (^template [<tag> <hash>]
+        [{<tag> value}
+         (# <hash> hash value)])
+      ([#Side /side.hash]
+       [#Member ..member_hash]))))
 
 (implementation: .public (path'_equivalence equivalence)
   (All (_ a) (-> (Equivalence a) (Equivalence (Path' a))))
@@ -615,7 +615,7 @@
           (# (..path'_hash super) hash path))
       )))
 
-(implementation: (loop_equivalence (^open "#[0]"))
+(implementation: (loop_equivalence (^open "/#[0]"))
   (All (_ a) (-> (Equivalence a) (Equivalence (Loop a))))
 
   (def: (= reference sample)
@@ -623,11 +623,11 @@
       [{#Scope [reference_start reference_inits reference_iteration]}
        {#Scope [sample_start sample_inits sample_iteration]}]
       (and (n.= reference_start sample_start)
-           (# (list.equivalence #=) = reference_inits sample_inits)
-           (#= reference_iteration sample_iteration))
+           (# (list.equivalence /#=) = reference_inits sample_inits)
+           (/#= reference_iteration sample_iteration))
 
       [{#Again reference} {#Again sample}]
-      (# (list.equivalence #=) = reference sample)
+      (# (list.equivalence /#=) = reference sample)
       
       _
       false)))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/side.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/side.lux
new file mode 100644
index 000000000..dd9bf4223
--- /dev/null
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/side.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 Side
+  (Record
+   [#lefts Nat
+    #right? Bit]))
+
+(def: .public (format it)
+  (%.Format Side)
+  (%.format "{" (%.nat (value@ #lefts it)) " " (%.bit (value@ #right? it)) "}"))
+
+(def: .public hash
+  (Hash Side)
+  ($_ product.hash
+      nat.hash
+      bit.hash
+      ))
+
+(def: .public equivalence
+  (Equivalence Side)
+  (# ..hash &equivalence))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/simple.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/simple.lux
index 0b1825953..dbf435a6d 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/simple.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/simple.lux
@@ -64,7 +64,7 @@
     (|>> (case> (^template [<factor> <tag> <hash>]
                   [{<tag> value'}
                    (n.* <factor>  (# <hash> hash value'))])
-                ([1 #Bit  bit.hash]
-                 [2 #F64  f.hash]
-                 [3 #Text text.hash]
-                 [5 #I64  i64.hash])))))
+                ([2 #Bit  bit.hash]
+                 [3 #F64  f.hash]
+                 [5 #Text text.hash]
+                 [7 #I64  i64.hash])))))