diff options
| -rw-r--r-- | stdlib/source/lux/target/common-lisp.lux | 5 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/phase/generation/common-lisp/runtime.lux | 49 |
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 |