aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/tool/compiler/phase/translation
diff options
context:
space:
mode:
authorEduardo Julian2019-02-19 22:52:52 -0400
committerEduardo Julian2019-02-19 22:52:52 -0400
commit2b105c8694b87a63bd151cd0966c9d5dcfaae672 (patch)
tree6264e1fceee61337b631ac0569c23d24a5f89149 /stdlib/source/lux/tool/compiler/phase/translation
parent8892e902809e680a067da9c85d54cae2acc82ce8 (diff)
Moved looping machinery over.
Diffstat (limited to 'stdlib/source/lux/tool/compiler/phase/translation')
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/js/case.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/js/loop.lux41
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/scheme/case.jvm.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/phase/translation/scheme/loop.jvm.lux12
4 files changed, 49 insertions, 8 deletions
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 91c7b4ace..0eee5383b 100644
--- a/stdlib/source/lux/tool/compiler/phase/translation/js/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/translation/js/case.lux
@@ -23,7 +23,7 @@
[//
[reference (#+ Register)]]]]])
-(def: register
+(def: #export register
(common-reference.local _.var))
(def: #export (let translate [valueS register bodyS])
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/js/loop.lux b/stdlib/source/lux/tool/compiler/phase/translation/js/loop.lux
new file mode 100644
index 000000000..8d0cefe4e
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation/js/loop.lux
@@ -0,0 +1,41 @@
+(.module:
+ [lux (#- Scope)
+ [control
+ ["." monad (#+ do)]]
+ [data
+ ["." product]
+ ["." text
+ format]
+ [collection
+ ["." list ("#/." functor)]]]
+ [host
+ ["_" js (#+ Computation Var)]]]
+ [//
+ [runtime (#+ Operation Phase)]
+ ["." reference]
+ ["//." case]
+ ["/." //
+ ["//." //
+ [synthesis (#+ Scope Synthesis)]]]])
+
+(def: @scope (_.var "scope"))
+
+(def: #export (scope translate [start initsS+ bodyS])
+ (-> Phase (Scope Synthesis) (Operation Computation))
+ (do ////.monad
+ [initsO+ (monad.map @ translate initsS+)
+ bodyO (///.with-anchor @scope
+ (translate bodyS))
+ #let [closure (_.function @scope
+ (|> initsS+
+ list.enumerate
+ (list/map (|>> product.left (n/+ start) //case.register)))
+ (_.return bodyO))]]
+ (wrap (_.apply/* closure initsO+))))
+
+(def: #export (recur translate argsS+)
+ (-> Phase (List Synthesis) (Operation Computation))
+ (do ////.monad
+ [@scope ///.anchor
+ argsO+ (monad.map @ translate argsS+)]
+ (wrap (_.apply/* @scope argsO+))))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/case.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/case.jvm.lux
index 0cb6a6c9d..c20fea5fe 100644
--- a/stdlib/source/lux/tool/compiler/phase/translation/scheme/case.jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/case.jvm.lux
@@ -23,7 +23,7 @@
[//
[reference (#+ Register)]]]]])
-(def: register
+(def: #export register
(common-reference.local _.var))
(def: #export (let translate [valueS register bodyS])
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/loop.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/loop.jvm.lux
index 0d85654c1..e1db0477c 100644
--- a/stdlib/source/lux/tool/compiler/phase/translation/scheme/loop.jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/loop.jvm.lux
@@ -7,16 +7,16 @@
["." text
format]
[collection
- ["." list ("#/." functor)]]]]
+ ["." list ("#/." functor)]]]
+ [host
+ ["_" scheme (#+ Computation Var)]]]
[//
[runtime (#+ Operation Phase)]
["." reference]
+ ["//." case]
["/." //
["//." //
- [synthesis (#+ Scope Synthesis)]
- [///
- [host
- ["_" scheme (#+ Computation Var)]]]]]])
+ [synthesis (#+ Scope Synthesis)]]]])
(def: @scope (_.var "scope"))
@@ -28,7 +28,7 @@
(translate bodyS))]
(wrap (_.letrec (list [@scope (_.lambda [(|> initsS+
list.enumerate
- (list/map (|>> product.left (n/+ start) reference.local')))
+ (list/map (|>> product.left (n/+ start) //case.register)))
#.None]
bodyO)])
(_.apply/* @scope initsO+)))))