From 64e7676f2f4e495d64bc38a501475ccbf2b5e810 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 13 Mar 2019 18:32:59 -0400
Subject: Replaced using exceptions for alternation during pattern-matching
 with loop breaks.

---
 stdlib/source/lux/host/js.lux                      | 13 +++++++--
 .../tool/compiler/phase/translation/js/case.lux    | 31 ++++++++++------------
 2 files changed, 25 insertions(+), 19 deletions(-)

(limited to 'stdlib/source')

diff --git a/stdlib/source/lux/host/js.lux b/stdlib/source/lux/host/js.lux
index e16c99c38..05778db9f 100644
--- a/stdlib/source/lux/host/js.lux
+++ b/stdlib/source/lux/host/js.lux
@@ -167,7 +167,7 @@
                           text.new-line
                           (:representation post))))
 
-  ## (def: nest
+  ## (def: indent
   ##   (-> Text Text)
   ##   (text.replace-all text.new-line (format text.new-line text.tab)))
 
@@ -176,7 +176,7 @@
     (let [close (format text.new-line "}")]
       (|>> :representation
            (format text.new-line)
-           ## ..nest
+           ## ..indent
            (text.enclose ["{"
                           close]))))
 
@@ -325,6 +325,11 @@
     (:abstraction (format "while(" (:representation test) ") "
                           (..block body))))
 
+  (def: #export (do-while test body)
+    (-> Expression Statement Statement)
+    (:abstraction (format "do " (..block body)
+                          " while(" (:representation test) ")" ..statement-suffix)))
+
   (def: #export (try body [exception catch])
     (-> Statement [Var Statement] Statement)
     (:abstraction (format "try "
@@ -340,6 +345,10 @@
                           ")"
                           (..block iteration))))
 
+  (def: #export break
+    Statement
+    (:abstraction (format "break" ..statement-suffix)))
+
   (do-template [<name> <js>]
     [(def: #export <name>
        (-> Location Expression)
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/js/case.lux b/stdlib/source/lux/tool/compiler/phase/translation/js/case.lux
index 889ad471b..fc25255df 100644
--- a/stdlib/source/lux/tool/compiler/phase/translation/js/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/translation/js/case.lux
@@ -31,6 +31,7 @@
   (do ////.monad
     [valueO (translate valueS)
      bodyO (translate bodyS)]
+    ## TODO: Find some way to do 'let' without paying the price of the closure.
     (wrap (_.apply/* (<| (_.closure (list))
                          ($_ _.then
                              (_.define (..register register) valueO)
@@ -86,18 +87,10 @@
   Statement
   (_.set @cursor (|> @savepoint (_.do "pop" (list)))))
 
-(def: pm-error (_.string "PM-ERROR"))
-(def: fail-pm! (_.throw pm-error))
+(def: fail-pm! _.break)
 
 (exception: #export unrecognized-path)
 
-(def: (pm-catch on-catch!)
-  (-> Statement [Var Statement])
-  [@alt-error
-   (_.if (_.= ..pm-error @alt-error)
-     on-catch!
-     (_.throw @alt-error))])
-
 (def: (pattern-matching' translate pathP)
   (-> Phase Path (Operation Statement))
   (.case pathP
@@ -144,12 +137,14 @@
          right! (pattern-matching' translate rightP)]
         (wrap <computation>)))
     ([synthesis.path/seq (_.then left! right!)]
-     [synthesis.path/alt (_.try ($_ _.then
-                                    ..save-cursor!
-                                    left!)
-                                (pm-catch ($_ _.then
-                                              ..restore-cursor!
-                                              right!)))])
+     [synthesis.path/alt ($_ _.then
+                             (_.do-while _.false
+                                         ($_ _.then
+                                             ..save-cursor!
+                                             left!))
+                             ($_ _.then
+                                 ..restore-cursor!
+                                 right!))])
 
     _
     (////.throw unrecognized-path [])))
@@ -158,8 +153,10 @@
   (-> Phase Path (Operation Statement))
   (do ////.monad
     [pattern-matching! (pattern-matching' translate pathP)]
-    (wrap (_.try pattern-matching!
-                 (pm-catch (_.throw (_.string "Invalid expression for pattern-matching.")))))))
+    (wrap ($_ _.then
+              (_.do-while _.false
+                          pattern-matching!)
+              (_.throw (_.string "Invalid expression for pattern-matching."))))))
 
 (def: #export (case translate [valueS pathP])
   (-> Phase [Synthesis Path] (Operation Computation))
-- 
cgit v1.2.3