aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--stdlib/source/lux/target/common-lisp.lux45
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/common-lisp/case.lux38
2 files changed, 33 insertions, 50 deletions
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)))