Added a small optimization when checking variants whose internal value can is ignored/popped.

4 files changed, 122 insertions, 67 deletions

diff --git a/stdlib/source/lux/host/python.lux b/stdlib/source/lux/host/python.lux
index 322ac261e..ce9a2e504 100644
--- a/stdlib/source/lux/host/python.lux
+++ b/stdlib/source/lux/host/python.lux
@@ -328,14 +328,13 @@
      (format "for " (:representation var) " in " (:representation inputs) ":"
              (..nest (:representation body!)))))
 
-  (def: #export (statement expression)
+  (def: #export statement
     (-> (Expression Any) (Statement Any))
-    (:abstraction
-     (format (:representation expression) ";")))
+    (|>> :transmutation))
 
-  (def: #export no-op!
+  (def: #export pass
     (Statement Any)
-    (:abstraction text.new-line))
+    (:abstraction "pass"))
 
   (type: #export Except
     {#classes (List SVar)
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux
index 4a28ccb3f..4561e5e84 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux
@@ -104,6 +104,32 @@
     (_.statement (|> @cursor (_.do "splice" (list (|> @cursor ..length (_.- popsJS))
                                                   popsJS))))))
 
+(template [<name> <flag> <prep>]
+  [(def: (<name> simple? idx)
+     (-> Bit Nat Statement)
+     ($_ _.then
+         (_.set @temp (|> idx <prep> .int _.i32 (//runtime.sum//get ..peek-cursor <flag>)))
+         (_.if (_.= _.null @temp)
+           fail-pm!
+           (.if simple?
+             (_.statement _.null)
+             (push-cursor! @temp)))))]
+
+  [left-choice  _.null        (<|)]
+  [right-choice (_.string "") inc]
+  )
+
+(def: (alternation pre! post!)
+  (-> Statement Statement Statement)
+  ($_ _.then
+      (_.do-while _.false
+                  ($_ _.then
+                      ..save-cursor!
+                      pre!))
+      ($_ _.then
+          ..restore-cursor!
+          post!)))
+
 (def: (pattern-matching' generate pathP)
   (-> Phase Path (Operation Statement))
   (.case pathP
@@ -127,15 +153,16 @@
      [/////synthesis.path/f64  //primitive.f64           _.=]
      [/////synthesis.path/text //primitive.text          _.=])
 
-    (^template [<pm> <flag> <prep>]
-      (^ (<pm> idx))
-      (////@wrap ($_ _.then
-                     (_.set @temp (|> idx <prep> .int _.i32 (//runtime.sum//get ..peek-cursor <flag>)))
-                     (_.if (_.= _.null @temp)
-                       fail-pm!
-                       (push-cursor! @temp)))))
-    ([/////synthesis.side/left  _.null        (<|)]
-     [/////synthesis.side/right (_.string "") inc])
+    (^template [<complex> <simple> <choice>]
+      (^ (<complex> idx))
+      (////@wrap (<choice> false idx))
+
+      (^ (<simple> idx nextP))
+      (|> nextP
+          (pattern-matching' generate)
+          (:: ////.monad map (_.then (<choice> true idx)))))
+    ([/////synthesis.side/left  /////synthesis.simple-left-side  ..left-choice]
+     [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice])
 
     (^template [<pm> <getter> <prep>]
       (^ (<pm> idx))
@@ -143,20 +170,14 @@
     ([/////synthesis.member/left  //runtime.product//left  (<|)]
      [/////synthesis.member/right //runtime.product//right inc])
 
-    (^ ($_ /////synthesis.path/seq
-           (#/////synthesis.Bind register)
-           #/////synthesis.Pop
-           thenP))
+    (^ (/////synthesis.!bind-top register thenP))
     (do ////.monad
       [then! (pattern-matching' generate thenP)]
       (////@wrap ($_ _.then
                      (_.define (..register register) ..peek-and-pop-cursor)
                      then!)))
 
-    (^ ($_ /////synthesis.path/seq
-           #/////synthesis.Pop
-           #/////synthesis.Pop
-           nextP))
+    (^ (/////synthesis.!multi-pop nextP))
     (.let [[extra-pops nextP'] (case.count-pops nextP)]
       (do ////.monad
         [next! (pattern-matching' generate nextP')]
@@ -164,21 +185,14 @@
                        (multi-pop-cursor! (n/+ 2 extra-pops))
                        next!))))
 
-    (^template [<tag> <computation>]
+    (^template [<tag> <combinator>]
       (^ (<tag> leftP rightP))
       (do ////.monad
         [left! (pattern-matching' generate leftP)
          right! (pattern-matching' generate rightP)]
-        (wrap <computation>)))
-    ([/////synthesis.path/seq (_.then left! right!)]
-     [/////synthesis.path/alt ($_ _.then
-                                  (_.do-while _.false
-                                              ($_ _.then
-                                                  ..save-cursor!
-                                                  left!))
-                                  ($_ _.then
-                                      ..restore-cursor!
-                                      right!))])
+        (wrap (<combinator> left! right!))))
+    ([/////synthesis.path/seq _.then]
+     [/////synthesis.path/alt alternation])
 
     _
     (////.throw unrecognized-path [])))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux
index 82a96836d..b1f53a8b2 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux
@@ -100,13 +100,37 @@
   (-> Nat (Statement Any))
   (_.delete (_.slice-from (_.int (i/* -1 (.int pops))) @cursor)))
 
+(template [<name> <flag> <prep>]
+  [(def: (<name> simple? idx)
+     (-> Bit Nat (Statement Any))
+     ($_ _.then
+         (_.set (list @temp) (|> idx <prep> .int _.int (//runtime.sum//get ..peek-cursor <flag>)))
+         (_.if (_.= _.none @temp)
+           fail-pm!
+           (.if simple?
+             _.pass
+             (push-cursor! @temp)))))]
+
+  [left-choice  _.none        (<|)]
+  [right-choice (_.string "") inc]
+  )
+
+(def: (alternation pre! post!)
+  (-> (Statement Any) (Statement Any) (Statement Any))
+  ($_ _.then
+      (_.while (_.bool true)
+               ($_ _.then
+                   ..save-cursor!
+                   pre!))
+      ($_ _.then
+          ..restore-cursor!
+          post!)))
+
 (def: (pattern-matching' generate pathP)
   (-> Phase Path (Operation (Statement Any)))
   (.case pathP
     (^ (/////synthesis.path/then bodyS))
-    (do ////.monad
-      [body! (generate bodyS)]
-      (wrap (_.return body!)))
+    (:: ////.monad map _.return (generate bodyS))
 
     #/////synthesis.Pop
     (////@wrap pop-cursor!)
@@ -123,15 +147,16 @@
      [/////synthesis.path/f64  //primitive.f64]
      [/////synthesis.path/text //primitive.text])
 
-    (^template [<pm> <flag> <prep>]
-      (^ (<pm> idx))
-      (////@wrap ($_ _.then
-                     (_.set (list @temp) (|> idx <prep> .int _.int (//runtime.sum//get ..peek-cursor <flag>)))
-                     (_.if (_.= _.none @temp)
-                       fail-pm!
-                       (push-cursor! @temp)))))
-    ([/////synthesis.side/left  _.none        (<|)]
-     [/////synthesis.side/right (_.string "") inc])
+    (^template [<complex> <simple> <choice>]
+      (^ (<complex> idx))
+      (////@wrap (<choice> false idx))
+
+      (^ (<simple> idx nextP))
+      (|> nextP
+          (pattern-matching' generate)
+          (:: ////.monad map (_.then (<choice> true idx)))))
+    ([/////synthesis.side/left  /////synthesis.simple-left-side  ..left-choice]
+     [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice])
 
     (^template [<pm> <getter> <prep>]
       (^ (<pm> idx))
@@ -139,20 +164,14 @@
     ([/////synthesis.member/left  //runtime.product//left  (<|)]
      [/////synthesis.member/right //runtime.product//right inc])
 
-    (^ ($_ /////synthesis.path/seq
-           (#/////synthesis.Bind register)
-           #/////synthesis.Pop
-           thenP))
+    (^ (/////synthesis.!bind-top register thenP))
     (do ////.monad
       [then! (pattern-matching' generate thenP)]
       (////@wrap ($_ _.then
                      (_.set (list (..register register)) ..peek-and-pop-cursor)
                      then!)))
 
-    (^ ($_ /////synthesis.path/seq
-           #/////synthesis.Pop
-           #/////synthesis.Pop
-           nextP))
+    (^ (/////synthesis.!multi-pop nextP))
     (.let [[extra-pops nextP'] (case.count-pops nextP)]
       (do ////.monad
         [next! (pattern-matching' generate nextP')]
@@ -160,21 +179,14 @@
                        (multi-pop-cursor! (n/+ 2 extra-pops))
                        next!))))
 
-    (^template [<tag> <computation>]
-      (^ (<tag> leftP rightP))
+    (^template [<tag> <combinator>]
+      (^ (<tag> preP postP))
       (do ////.monad
-        [left! (pattern-matching' generate leftP)
-         right! (pattern-matching' generate rightP)]
-        (wrap <computation>)))
-    ([/////synthesis.path/seq (_.then left! right!)]
-     [/////synthesis.path/alt ($_ _.then
-                                  (_.while (_.bool true)
-                                           ($_ _.then
-                                               ..save-cursor!
-                                               left!))
-                                  ($_ _.then
-                                      ..restore-cursor!
-                                      right!))])
+        [pre! (pattern-matching' generate preP)
+         post! (pattern-matching' generate postP)]
+        (wrap (<combinator> pre! post!))))
+    ([/////synthesis.path/seq _.then]
+     [/////synthesis.path/alt ..alternation])
 
     _
     (////.throw unrecognized-path [])))
diff --git a/stdlib/source/lux/tool/compiler/synthesis.lux b/stdlib/source/lux/tool/compiler/synthesis.lux
index 6b147ffae..39b62ac88 100644
--- a/stdlib/source/lux/tool/compiler/synthesis.lux
+++ b/stdlib/source/lux/tool/compiler/synthesis.lux
@@ -466,3 +466,33 @@
 (def: #export path-equivalence
   (Equivalence Path)
   (path'-equivalence equivalence))
+
+(template: #export (!bind-top register thenP)
+  ($_ ..path/seq
+      (#..Bind register)
+      #..Pop
+      thenP))
+
+(template: #export (!multi-pop nextP)
+  ($_ ..path/seq
+      #..Pop
+      #..Pop
+      nextP))
+
+## TODO: There are sister patterns to the simple side checks for tuples.
+## These correspond to the situation where tuple members are accessed
+## and bound to variables, but those variables are never used, so they
+## become POPs.
+## After re-implementing unused-variable-elimination, must add those
+## pattern-optimizations again, since a lot of BINDs will become POPs
+## and thus will result in useless code being generated.
+(template [<name> <side>]
+  [(template: #export (<name> idx nextP)
+     ($_ ..path/seq
+         (<side> idx)
+         #..Pop
+         nextP))]
+
+  [simple-left-side ..side/left]
+  [simple-right-side ..side/right]
+  )