diff options
Diffstat (limited to '')
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) |