aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--new-luxc/source/luxc/lang/translation/js/loop.jvm.lux35
-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
5 files changed, 49 insertions, 43 deletions
diff --git a/new-luxc/source/luxc/lang/translation/js/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/js/loop.jvm.lux
deleted file mode 100644
index c63cb2d32..000000000
--- a/new-luxc/source/luxc/lang/translation/js/loop.jvm.lux
+++ /dev/null
@@ -1,35 +0,0 @@
-(.module:
- lux
- (lux (control [monad #+ do])
- (data [text]
- text/format
- (coll [list "list/" Functor<List>]))
- [macro])
- (luxc [lang]
- (lang ["ls" synthesis]
- (host [js #+ JS Expression Statement])))
- [//]
- (// [".T" reference]))
-
-(def: #export (translate-loop translate offset initsS+ bodyS)
- (-> (-> ls.Synthesis (Meta Expression)) Nat (List ls.Synthesis) ls.Synthesis
- (Meta Expression))
- (do macro.Monad<Meta>
- [loop-name (:: @ map (|>> %code lang.normalize-name)
- (macro.gensym "loop"))
- initsJS+ (monad.map @ translate initsS+)
- bodyJS (//.with-anchor [loop-name offset]
- (translate bodyS))
- #let [registersJS+ (|> (list.n/range +0 (dec (list.size initsS+)))
- (list/map (|>> (n/+ offset) referenceT.variable)))]]
- (wrap (format "(function " loop-name "(" (text.join-with "," registersJS+) ") {"
- "return " bodyJS ";"
- "})(" (text.join-with "," initsJS+) ")"))))
-
-(def: #export (translate-recur translate argsS+)
- (-> (-> ls.Synthesis (Meta Expression)) (List ls.Synthesis)
- (Meta Expression))
- (do macro.Monad<Meta>
- [[loop-name offset] //.anchor
- argsJS+ (monad.map @ translate argsS+)]
- (wrap (format loop-name "(" (text.join-with "," argsJS+) ")"))))
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+)))))