aboutsummaryrefslogtreecommitdiff
path: root/lux-jvm/source/luxc/lang/translation
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/case.lux74
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux19
2 files changed, 62 insertions, 31 deletions
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux
index 7962ea991..573e9764b 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux
@@ -1,7 +1,7 @@
(.module:
[lux (#- Type if let case)
[abstract
- [monad (#+ do)]]
+ ["." monad (#+ do)]]
[control
["." function]
["ex" exception (#+ exception:)]]
@@ -98,33 +98,51 @@
(operation@wrap (|>> peekI
(_.ASTORE register)))
- (^ (synthesis.path/bit value))
- (operation@wrap (.let [jumpI (.if value _.IFEQ _.IFNE)]
- (|>> peekI
- (_.unwrap type.boolean)
- (jumpI @else))))
-
- (^ (synthesis.path/i64 value))
- (operation@wrap (|>> peekI
- (_.unwrap type.long)
- (_.long (.int value))
- _.LCMP
- (_.IFNE @else)))
-
- (^ (synthesis.path/f64 value))
- (operation@wrap (|>> peekI
- (_.unwrap type.double)
- (_.double value)
- _.DCMPL
- (_.IFNE @else)))
-
- (^ (synthesis.path/text value))
- (operation@wrap (|>> peekI
- (_.string value)
- (_.INVOKEVIRTUAL (type.class "java.lang.Object" (list))
- "equals"
- (type.method [(list //.$Value) type.boolean (list)]))
- (_.IFEQ @else)))
+ (#synthesis.Bit-Fork when thenP elseP)
+ (do phase.monad
+ [thenG (path' stack-depth @else @end phase archive thenP)
+ elseG (.case elseP
+ (#.Some elseP)
+ (path' stack-depth @else @end phase archive elseP)
+
+ #.None
+ (wrap (_.GOTO @else)))
+ #let [ifI (.if when _.IFEQ _.IFNE)]]
+ (wrap (<| _.with-label (function (_ @else))
+ (|>> peekI
+ (_.unwrap type.boolean)
+ (ifI @else)
+ thenG
+ (_.label @else)
+ elseG))))
+
+ (^template [<tag> <unwrap> <dup> <pop> <test> <comparison> <if>]
+ (<tag> cons)
+ (do {@ phase.monad}
+ [forkG (: (Operation Inst)
+ (monad.fold @ (function (_ [test thenP] elseG)
+ (do @
+ [thenG (path' stack-depth @else @end phase archive thenP)]
+ (wrap (<| _.with-label (function (_ @else))
+ (|>> <dup>
+ (<test> test)
+ <comparison>
+ (<if> @else)
+ <pop>
+ thenG
+ (_.label @else)
+ elseG)))))
+ (|>> <pop>
+ (_.GOTO @else))
+ (#.Cons cons)))]
+ (wrap (|>> peekI
+ <unwrap>
+ forkG))))
+ ([#synthesis.I64-Fork (_.unwrap type.long) _.DUP2 _.POP2 (|>> .int _.long) _.LCMP _.IFNE]
+ [#synthesis.F64-Fork (_.unwrap type.double) _.DUP2 _.POP2 _.double _.DCMPL _.IFNE]
+ [#synthesis.Text-Fork (|>) _.DUP _.POP _.string
+ (_.INVOKEVIRTUAL (type.class "java.lang.Object" (list)) "equals" (type.method [(list //.$Value) type.boolean (list)]))
+ _.IFEQ])
(#synthesis.Then bodyS)
(do phase.monad
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
index 482521e34..c25151bcf 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
@@ -11,7 +11,7 @@
["<s>" synthesis (#+ Parser)]]]
[data
["." product]
- ["." maybe]
+ ["." maybe ("#@." functor)]
["." text ("#@." equivalence)
["%" format (#+ format)]]
[number
@@ -830,9 +830,22 @@
(^ (<tag> value))
path)
([#synthesis.Pop]
- [#synthesis.Test]
[#synthesis.Bind]
- [#synthesis.Access]))))
+ [#synthesis.Access])
+
+ (#synthesis.Bit-Fork when then else)
+ (#synthesis.Bit-Fork when (recur then) (maybe@map recur else))
+
+ (^template [<tag>]
+ (<tag> [[test then] elses])
+ (<tag> [[test (recur then)]
+ (list@map (function (_ [else-test else-then])
+ [else-test (recur else-then)])
+ elses)]))
+ ([#synthesis.I64-Fork]
+ [#synthesis.F64-Fork]
+ [#synthesis.Text-Fork])
+ )))
(def: (normalize-method-body mapping)
(-> (Dictionary Variable Variable) Synthesis Synthesis)