From 8f7fa3f0592aa33dcfbca8b5e978b0b9075cdd81 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 1 May 2019 21:29:32 -0400
Subject: Now using "block" instead of "tagbody".

---
 stdlib/source/lux/target/common-lisp.lux           | 45 +++++++++-------------
 .../compiler/phase/generation/common-lisp/case.lux | 38 +++++++-----------
 2 files changed, 33 insertions(+), 50 deletions(-)

(limited to 'stdlib')

diff --git a/stdlib/source/lux/target/common-lisp.lux b/stdlib/source/lux/target/common-lisp.lux
index eb7e78d01..ad3d9be8f 100644
--- a/stdlib/source/lux/target/common-lisp.lux
+++ b/stdlib/source/lux/target/common-lisp.lux
@@ -50,7 +50,7 @@
        (`` (abstract: #export <brand> {} Any))
        (`` (type: #export <type> (<super> <brand>))))]
 
-    [Tag Code]
+    [Label Code]
     [Literal Expression]
     [Var/1 Var]
     [Var/* Input]
@@ -64,10 +64,18 @@
     Literal
     (:abstraction "()"))
 
+  (template [<prefix> <name>]
+    [(def: #export <name>
+       (-> Text Literal)
+       (|>> (format <prefix>) :abstraction))]
+    
+    ["'" symbol]
+    [":" keyword])
+
   (def: #export bool
     (-> Bit Literal)
     (|>> (case> #0 ..nil
-                #1 (:abstraction "t"))))
+                #1 (..symbol "t"))))
 
   (def: #export int
     (-> Int Literal)
@@ -129,14 +137,6 @@
          (text.enclose' text.double-quote)
          :abstraction))
 
-  (template [<name> <prefix>]
-    [(def: #export <name>
-       (-> Text Literal)
-       (|>> (format <prefix>) :abstraction))]
-
-    [symbol "'"]
-    [keyword ":"])
-
   (def: #export var
     (-> Text Var/1)
     (|>> :abstraction))
@@ -401,24 +401,17 @@
     [conditional+ "#+"]
     [conditional- "#-"])
 
-  (def: #export tag
-    (-> Text Tag)
+  (def: #export label
+    (-> Text Label)
     (|>> :abstraction))
 
-  (def: #export (go tag)
-    (-> Tag (Expression Any))
-    (..form (list (..var "go") (:transmutation tag))))
-
-  (def: #export (tagbody main tagged)
-    (-> (Expression Any)
-        (List [Tag (Expression Any)])
-        (Computation Any))
-    (|> tagged
-        (list@map (function (_ [tag then])
-                    (list (:transmutation tag) then)))
-        list@join
-        (list& (..var "tagbody") main)
-        ..form))
+  (def: #export (block name body)
+    (-> Label (Expression Any) (Computation Any))
+    (..form (list (..var "block") (:transmutation name) body)))
+
+  (def: #export (return-from target value)
+    (-> Label (Expression Any) (Computation Any))
+    (..form (list (..var "return-from") (:transmutation target) value)))
 
   (def: #export (cond clauses else)
     (-> (List [(Expression Any) (Expression Any)]) (Expression Any) (Computation Any))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/case.lux
index 144c0236e..dd5b89e38 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/case.lux
@@ -69,7 +69,6 @@
 (def: @cursor (_.var "lux_pm_cursor"))
 (def: @temp (_.var "lux_pm_temp"))
 (def: @variant (_.var "lux_pm_variant"))
-(def: @return (_.var "lux_pm_return"))
 
 (def: (push! value)
   (-> (Expression Any) (Expression Any))
@@ -93,11 +92,10 @@
       (_.setq @cursor (_.car/1 @savepoint))
       (_.setq @savepoint (_.cdr/1 @savepoint))))
 
-(def: fail-tag (_.tag "lux_pm_fail"))
-(def: done-tag (_.tag "lux_pm_done"))
+(def: @fail (_.label "lux_pm_fail"))
+(def: @done (_.label "lux_pm_done"))
 
-(def: fail! (_.go ..fail-tag))
-(def: return! (_.go ..done-tag))
+(def: fail! (_.return-from ..@fail _.nil))
 
 (exception: #export unrecognized-path)
 
@@ -126,23 +124,18 @@
 
 (def: (alternation pre! post!)
   (-> (Expression Any) (Expression Any) (Expression Any))
-  (_.tagbody ($_ _.progn
-                 ..save!
-                 pre!)
-             (list [fail-tag
-                    ($_ _.progn
-                        ..restore!
-                        post!)])))
+  (_.progn (<| (_.block ..@fail)
+               (_.progn ..save!)
+               pre!)
+           ($_ _.progn
+               ..restore!
+               post!)))
 
 (def: (pattern-matching' generate pathP)
   (-> Phase Path (Operation (Expression Any)))
   (.case pathP
     (^ (/////synthesis.path/then bodyS))
-    (do ////.monad
-      [bodyG (generate bodyS)]
-      (wrap ($_ _.progn
-                (_.setq @return bodyG)
-                ..return!)))
+    (:: ////.monad map (_.return-from ..@done) (generate bodyS))
 
     #/////synthesis.Pop
     (////@wrap ..pop!)
@@ -204,13 +197,10 @@
   (-> Phase Path (Operation (Expression Any)))
   (do ////.monad
     [pattern-matching! (pattern-matching' generate pathP)]
-    (wrap ($_ _.progn
-              (_.tagbody pattern-matching!
-                         (list [..fail-tag
-                                (_.error/1 (_.string "Invalid expression for pattern-matching."))]
-                               [..done-tag
-                                _.nil]))
-              @return))))
+    (wrap (_.block ..@done
+                   (_.progn (_.block ..@fail
+                                     pattern-matching!)
+                            (_.error/1 (_.string case.pattern-matching-error)))))))
 
 (def: #export (case generate [valueS pathP])
   (-> Phase [Synthesis Path] (Operation (Expression Any)))
-- 
cgit v1.2.3