From eb37e9b2a851cab1aef7de293ec345d7925d639a Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 14 Mar 2019 19:01:28 -0400
Subject: Now doing multiple pops at once.

---
 .../lux/tool/compiler/phase/generation/js/case.lux | 38 ++++++++++++++++++++--
 1 file changed, 36 insertions(+), 2 deletions(-)

(limited to 'stdlib')

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 b8a0cd00d..11869fa7b 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux
@@ -77,10 +77,15 @@
   Statement
   (_.statement ..peek-and-pop-cursor))
 
+(def: length
+  (|>> (_.the "length")))
+
+(def: last-index
+  (|>> ..length (_.- (_.i32 +1))))
+
 (def: peek-cursor
   Expression
-  (.let [idx (|> @cursor (_.the "length") (_.- (_.i32 +1)))]
-    (|> @cursor (_.at idx))))
+  (|> @cursor (_.at (last-index @cursor))))
 
 (def: save-cursor!
   Statement
@@ -93,6 +98,24 @@
 
 (def: fail-pm! _.break)
 
+(def: (count-pops path)
+  (-> Path [Nat Path])
+  (.case path
+    (^ ($_ synthesis.path/seq
+           #synthesis.Pop
+           path'))
+    (.let [[pops post-pops] (count-pops path')]
+      [(inc pops) post-pops])
+
+    _
+    [0 path]))
+
+(def: (multi-pop-cursor! pops)
+  (-> Nat Statement)
+  (.let [popsJS (_.i32 (.int pops))]
+    (_.statement (|> @cursor (_.do "splice" (list (|> @cursor ..length (_.- popsJS))
+                                                  popsJS))))))
+
 (exception: #export unrecognized-path)
 
 (def: (pattern-matching' generate pathP)
@@ -144,6 +167,17 @@
                      (_.define (..register register) ..peek-and-pop-cursor)
                      then!)))
 
+    (^ ($_ synthesis.path/seq
+           #synthesis.Pop
+           #synthesis.Pop
+           nextP))
+    (.let [[extra-pops nextP'] (count-pops nextP)]
+      (do ////.monad
+        [next! (pattern-matching' generate nextP')]
+        (/////wrap ($_ _.then
+                       (multi-pop-cursor! (n/+ 2 extra-pops))
+                       next!))))
+
     (^template [<tag> <computation>]
       (^ (<tag> leftP rightP))
       (do ////.monad
-- 
cgit v1.2.3