Fixes for pattern-matching/case synthesis & translation.

1 files changed, 36 insertions, 97 deletions

diff --git a/stdlib/source/lux/compiler/default/phase/analysis.lux b/stdlib/source/lux/compiler/default/phase/analysis.lux
index 19ef64af2..7663f6950 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis.lux
@@ -25,9 +25,16 @@
 
 (type: #export Tag Nat)
 
+(type: #export (Variant a)
+  {#lefts Nat
+   #right? Bit
+   #value a})
+
+(type: #export (Tuple a) (List a))
+
 (type: #export (Composite a)
-  (#Sum (Either a a))
-  (#Product [a a]))
+  (#Variant (Variant a))
+  (#Tuple (Tuple a)))
 
 (type: #export #rec Pattern
   (#Simple Primitive)
@@ -90,13 +97,6 @@
   [text Text #Text]
   )
 
-(type: #export (Variant a)
-  {#lefts Nat
-   #right? Bit
-   #value a})
-
-(type: #export (Tuple a) (List a))
-
 (type: #export Arity Nat)
 
 (type: #export (Abstraction c) [Environment Arity c])
@@ -112,92 +112,10 @@
       (#..Function (list))
       (#..Apply value)))
 
-(do-template [<name> <type> <structure> <prep-value>]
-  [(def: #export (<name> size tag value)
-     (-> Nat Tag <type> <type>)
-     (let [left (function.constant (|>> #.Left #Sum <structure>))
-           right (|>> #.Right #Sum <structure>)]
-       (if (last? size tag)
-         (list/fold left
-                    (right value)
-                    (list.indices (dec tag)))
-         (list/fold left
-                    (case value
-                      (<structure> (#Sum _))
-                      (<prep-value> value)
-
-                      _
-                      value)
-                    (list.indices (inc tag))))))]
-
-  [sum-analysis Analysis #Structure ..no-op]
-  [sum-pattern  Pattern  #Complex   id]
-  )
-
-(do-template [<name> <type> <primitive> <structure>]
-  [(def: #export (<name> members)
-     (-> (Tuple <type>) <type>)
-     (case (list.reverse members)
-       #.Nil
-       (<primitive> #Unit)
-
-       (#.Cons singleton #.Nil)
-       singleton
-
-       (#.Cons last prevs)
-       (list/fold (function (_ left right) (<structure> (#Product left right)))
-                  last prevs)))]
-
-  [product-analysis Analysis #Primitive #Structure]
-  [product-pattern  Pattern  #Simple    #Complex]
-  )
-
 (def: #export (apply [func args])
   (-> (Application Analysis) Analysis)
   (list/fold (function (_ arg func) (#Apply arg func)) func args))
 
-(do-template [<name> <type> <tag>]
-  [(def: #export (<name> value)
-     (-> <type> (Tuple <type>))
-     (case value
-       (<tag> (#Product left right))
-       (#.Cons left (<name> right))
-
-       _
-       (list value)))]
-
-  [tuple         Analysis #Structure]
-  [tuple-pattern Pattern  #Complex]
-  )
-
-(do-template [<name> <type> <tag>]
-  [(def: #export (<name> value)
-     (-> <type> (Maybe (Variant <type>)))
-     (loop [lefts 0
-            variantA value]
-       (case variantA
-         (<tag> (#Sum (#.Left valueA)))
-         (case valueA
-           (<tag> (#Sum _))
-           (recur (inc lefts) valueA)
-
-           _
-           (#.Some {#lefts lefts
-                    #right? #0
-                    #value valueA}))
-         
-         (<tag> (#Sum (#.Right valueA)))
-         (#.Some {#lefts lefts
-                  #right? #1
-                  #value valueA})
-
-         _
-         #.None)))]
-
-  [variant         Analysis #Structure]
-  [variant-pattern Pattern  #Complex]
-  )
-
 (def: #export (application analysis)
   (-> Analysis (Application Analysis))
   (case analysis
@@ -208,6 +126,26 @@
     _
     [analysis (list)]))
 
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (.<| #Complex
+          <tag>
+          content))]
+
+  [pattern/variant #..Variant]
+  [pattern/tuple   #..Tuple]
+  )
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (.<| #..Structure
+          <tag>
+          content))]
+
+  [variant #..Variant]
+  [tuple   #..Tuple]
+  )
+
 (template: #export (pattern/unit)
   (#..Simple #..Unit))
 
@@ -223,6 +161,9 @@
   [pattern/text #..Text]
   )
 
+(template: #export (pattern/bind register)
+  (#..Bind register))
+
 (def: #export (with-source-code source action)
   (All [a] (-> Source (Operation a) (Operation a)))
   (function (_ [bundle state])
@@ -314,13 +255,11 @@
     
     (#Structure structure)
     (case structure
-      (#Sum _)
-      (let [[lefts right? value] (maybe.assume (..variant analysis))]
-        (format "(" (%n lefts) " " (%b right?) " " (%analysis value) ")"))
+      (#Variant [lefts right? value])
+      (format "(" (%n lefts) " " (%b right?) " " (%analysis value) ")")
       
-      (#Product _)
-      (|> analysis
-          ..tuple
+      (#Tuple members)
+      (|> members
           (list/map %analysis)
           (text.join-with " ")
           (text.enclose ["[" "]"])))