aboutsummaryrefslogtreecommitdiff
path: root/lux-jvm/source/luxc/lang/translation/jvm
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/case.lux58
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/expression.lux3
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux16
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/function.lux3
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/loop.lux3
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/reference.lux7
6 files changed, 63 insertions, 27 deletions
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux
index 0d8aaa91e..23f84ad4e 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux
@@ -7,7 +7,9 @@
["ex" exception (#+ exception:)]]
[data
[number
- ["n" nat]]]
+ ["n" nat]]
+ [collection
+ ["." list ("#@." fold)]]]
[target
[jvm
["." type (#+ Type)
@@ -21,7 +23,8 @@
[archive (#+ Archive)]]
[language
[lux
- ["." synthesis (#+ Path Synthesis)]]]]]]
+ ["." synthesis (#+ Path Synthesis)
+ ["#/." case]]]]]]]
[luxc
[lang
[host
@@ -55,6 +58,24 @@
_.AALOAD
(_.CHECKCAST runtime.$Stack)))
+(def: (left-projection lefts)
+ (-> Nat Inst)
+ (.let [accessI (.case lefts
+ 0
+ _.AALOAD
+
+ lefts
+ (_.INVOKESTATIC //.$Runtime "tuple_left" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)])))]
+ (|>> (_.CHECKCAST //.$Tuple)
+ (_.int (.int lefts))
+ accessI)))
+
+(def: (right-projection lefts)
+ (-> Nat Inst)
+ (|>> (_.CHECKCAST //.$Tuple)
+ (_.int (.int lefts))
+ (_.INVOKESTATIC //.$Runtime "tuple_right" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)]))))
+
(def: (path' stack-depth @else @end phase archive path)
(-> Nat Label Label Phase Archive Path (Operation Inst))
(.case path
@@ -121,23 +142,13 @@
[synthesis.side/right (_.string "") .inc])
(^ (synthesis.member/left lefts))
- (operation@wrap (.let [accessI (.case lefts
- 0
- _.AALOAD
-
- lefts
- (_.INVOKESTATIC //.$Runtime "tuple_left" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)])))]
- (|>> peekI
- (_.CHECKCAST //.$Tuple)
- (_.int (.int lefts))
- accessI
- pushI)))
+ (operation@wrap (|>> peekI
+ (..left-projection lefts)
+ pushI))
(^ (synthesis.member/right lefts))
(operation@wrap (|>> peekI
- (_.CHECKCAST //.$Tuple)
- (_.int (.int lefts))
- (_.INVOKESTATIC //.$Runtime "tuple_right" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)]))
+ (..right-projection lefts)
pushI))
## Extra optimization
@@ -226,6 +237,21 @@
(_.ASTORE register)
exprI))))
+(def: #export (get phase archive [path recordS])
+ (Generator [(List synthesis.Member) Synthesis])
+ (do phase.monad
+ [recordG (phase archive recordS)]
+ (wrap (list@fold (function (_ step so-far)
+ (.let [next (.case step
+ (#.Left lefts)
+ (..left-projection lefts)
+
+ (#.Right lefts)
+ (..right-projection lefts))]
+ (|>> so-far next)))
+ recordG
+ path))))
+
(def: #export (case phase archive [valueS path])
(Generator [Synthesis Path])
(do phase.monad
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/expression.lux b/lux-jvm/source/luxc/lang/translation/jvm/expression.lux
index 144e35f9b..01425750f 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/expression.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/expression.lux
@@ -53,6 +53,9 @@
(^ (synthesis.branch/if data))
(case.if translate archive data)
+ (^ (synthesis.branch/get data))
+ (case.get translate archive data)
+
(^ (synthesis.branch/case data))
(case.case translate archive data)
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 7b90a8e4f..482521e34 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
@@ -30,8 +30,9 @@
["." parser]]]]
[tool
[compiler
- ["." reference (#+ Variable)]
["." phase ("#@." monad)]
+ [reference (#+)
+ ["." variable (#+ Variable)]]
[meta
[archive (#+ Archive)]]
[language
@@ -864,6 +865,9 @@
(^ (synthesis.branch/if [testS thenS elseS]))
(synthesis.branch/if [(recur testS) (recur thenS) (recur elseS)])
+ (^ (synthesis.branch/get [path recordS]))
+ (synthesis.branch/get [path (recur recordS)])
+
(^ (synthesis.loop/scope [offset initsS+ bodyS]))
(synthesis.loop/scope [offset (list@map recur initsS+) (recur bodyS)])
@@ -969,14 +973,14 @@
## Combine them.
list@join
## Remove duplicates.
- (set.from-list reference.hash)
+ (set.from-list variable.hash)
set.to-list)
global-mapping (|> total-environment
## Give them names as "foreign" variables.
list.enumerate
(list@map (function (_ [id capture])
- [capture (#reference.Foreign id)]))
- (dictionary.from-list reference.hash))
+ [capture (#variable.Foreign id)]))
+ (dictionary.from-list variable.hash))
normalized-methods (list@map (function (_ [environment
[ownerT name
strict-fp? annotations vars
@@ -985,11 +989,11 @@
(let [local-mapping (|> environment
list.enumerate
(list@map (function (_ [foreign-id capture])
- [(#reference.Foreign foreign-id)
+ [(#variable.Foreign foreign-id)
(|> global-mapping
(dictionary.get capture)
maybe.assume)]))
- (dictionary.from-list reference.hash))]
+ (dictionary.from-list variable.hash))]
[ownerT name
strict-fp? annotations vars
self-name arguments returnT exceptionsT
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/function.lux b/lux-jvm/source/luxc/lang/translation/jvm/function.lux
index 888ad9545..bfa11f1c2 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/function.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux
@@ -21,8 +21,9 @@
[tool
[compiler
[arity (#+ Arity)]
- [reference (#+ Register)]
["." phase]
+ [reference
+ [variable (#+ Register)]]
[language
[lux
[analysis (#+ Environment)]
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/loop.lux b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux
index 1f2168fed..10fb23cbd 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/loop.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux
@@ -11,8 +11,9 @@
["." list ("#/." functor monoid)]]]
[tool
[compiler
- [reference (#+ Register)]
["." phase]
+ [reference
+ [variable (#+ Register)]]
[language
[lux
["." synthesis (#+ Synthesis)]
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/reference.lux b/lux-jvm/source/luxc/lang/translation/jvm/reference.lux
index 6bcf4a2e5..61eac8dcc 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/reference.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/reference.lux
@@ -10,7 +10,8 @@
["." type]]]
[tool
[compiler
- ["." reference (#+ Register Variable)]
+ [reference
+ ["." variable (#+ Register Variable)]]
["." phase ("operation@." monad)]
[meta
[archive (#+ Archive)]]
@@ -51,10 +52,10 @@
(def: #export (variable archive variable)
(-> Archive Variable (Operation Inst))
(case variable
- (#reference.Local variable)
+ (#variable.Local variable)
(operation@wrap (local variable))
- (#reference.Foreign variable)
+ (#variable.Foreign variable)
(foreign archive variable)))
(def: #export (constant archive name)