aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/target/common-lisp.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/common-lisp/runtime.lux49
2 files changed, 33 insertions, 21 deletions
diff --git a/stdlib/source/lux/target/common-lisp.lux b/stdlib/source/lux/target/common-lisp.lux
index ad3d9be8f..dc8694dc9 100644
--- a/stdlib/source/lux/target/common-lisp.lux
+++ b/stdlib/source/lux/target/common-lisp.lux
@@ -420,3 +420,8 @@
(:transmutation else)
(list.reverse clauses)))
)
+
+(def: #export (while condition body)
+ (-> (Expression Any) (Expression Any) (Computation Any))
+ (..form (list (..var "loop") (..var "while") condition
+ (..var "do") body)))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/runtime.lux
index 87fc7741d..774844bdf 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/runtime.lux
@@ -182,27 +182,34 @@
## TODO: Find a way to extract parts of the sum without "nth", which
## does a linear search, and is thus expensive.
(runtime: (sum//get sum wantsLast wantedTag)
- (let [no-match! sum
- sum-tag (_.nth/2 [(_.int +0) sum])
- sum-flag (_.nth/2 [(_.int +1) sum])
- sum-value (_.nth/2 [(_.int +2) sum])
- test-recursion! (_.if sum-flag
- ## Must recurse.
- (sum//get sum-value wantsLast (_.- sum-tag wantedTag))
- no-match!)]
- (_.cond (list [(_.= sum-tag wantedTag)
- (_.if (_.equal wantsLast sum-flag)
- sum-value
- test-recursion!)]
-
- [(_.> sum-tag wantedTag)
- test-recursion!]
-
- [(_.and (_.< sum-tag wantedTag)
- wantsLast)
- (variant' (_.- wantedTag sum-tag) sum-flag sum-value)])
-
- no-match!)))
+ (with-vars [sum-tag sum-flag]
+ (let [@exit (_.label "exit")
+ return! (_.return-from @exit)
+ no-match! (return! sum)
+ sum-value (_.nth/2 [(_.int +2) sum])
+ test-recursion! (_.if sum-flag
+ ## Must iterate.
+ ($_ _.progn
+ (_.setq sum sum-value)
+ (_.setq wantedTag (_.- sum-tag wantedTag)))
+ no-match!)]
+ (<| (_.progn (_.setq sum-tag (_.nth/2 [(_.int +0) sum])))
+ (_.progn (_.setq sum-flag (_.nth/2 [(_.int +1) sum])))
+ (_.block @exit)
+ (_.while (_.bool true))
+ (_.cond (list [(_.= sum-tag wantedTag)
+ (_.if (_.equal wantsLast sum-flag)
+ (return! sum-value)
+ test-recursion!)]
+
+ [(_.> sum-tag wantedTag)
+ test-recursion!]
+
+ [(_.and (_.< sum-tag wantedTag)
+ wantsLast)
+ (return! (variant' (_.- wantedTag sum-tag) sum-flag sum-value))])
+
+ no-match!)))))
(def: runtime//adt
($_ _.progn