aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2019-03-13 18:32:59 -0400
committerEduardo Julian2019-03-13 18:32:59 -0400
commit64e7676f2f4e495d64bc38a501475ccbf2b5e810 (patch)
treebd65dd80b5a80761fc26513577a293f275e6504a
parent5f874796c9c98dfaff03540f6fb0d6cfdb1d612b (diff)
Replaced using exceptions for alternation during pattern-matching with loop breaks.
-rw-r--r--stdlib/source/lux/host/js.lux13
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/js/case.lux31
2 files changed, 25 insertions, 19 deletions
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))