Keeping the JVM interop fixes coming...

7 files changed, 91 insertions, 81 deletions

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)