diff options
Diffstat (limited to 'stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/when.lux')
| -rw-r--r-- | stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/when.lux | 167 |
1 files changed, 93 insertions, 74 deletions
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/when.lux index 9d31368af..18fb379f6 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/when.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Synthesis when exec let if) + [lux (.except when exec let if) [abstract ["[0]" monad (.only do)]] [data @@ -30,7 +30,7 @@ ["/[1]" // ["[0]" phase (.use "[1]#[0]" monad)] ["[1][0]" translation] - ["[1][0]" synthesis (.only Synthesis Path) + ["[0]" synthesis (.only Path) [access ["[0]" member (.only Member)]]] ["//[1]" /// @@ -40,55 +40,67 @@ [archive (.only Archive)]]]]]]]) (def .public register - (-> Register Var) + (-> Register + Var) (|>> (///reference.local //reference.system) as_expected)) (def .public capture - (-> Register Var) + (-> Register + Var) (|>> (///reference.foreign //reference.system) as_expected)) -(def .public (exec expression archive [this that]) - (Translator [Synthesis Synthesis]) - (do phase.monad - [this (expression archive this) - that (expression archive that)] - (in (|> (_.array (list this that)) - (_.item (_.int +2)))))) - -(def .public (exec! statement expression archive [this that]) - (Translator! [Synthesis Synthesis]) +(def .public (exec next archive it) + (Translator (synthesis.Exec synthesis.Term)) + (do [! phase.monad] + [.let [[tail after] (synthesis.flat_exec (the synthesis.#after it))] + all_before (monad.each ! (next archive) + (list.partial (the synthesis.#before it) tail)) + after (next archive after)] + (in (_.item (_.int +2) + (_.array (list (_.array all_before) + after)))))) + +(def .public (exec! statement next archive [this that]) + (Translator! (synthesis.Exec synthesis.Term)) (do [! phase.monad] - [this (expression archive this) - that (statement expression archive that) + [this (next archive this) + that (statement next archive that) $dummy (of ! each _.var (/////translation.symbol "_exec"))] (in (all _.then (_.set (list $dummy) this) that)))) -(def .public (let expression archive [valueS register bodyS]) - (Translator [Synthesis Register Synthesis]) - (do phase.monad - [valueO (expression archive valueS) - bodyO (expression archive bodyS)] +(def .public (let next archive it) + (Translator (synthesis.Let synthesis.Term)) + (do [! phase.monad] + [.let [[tail body] (synthesis.flat_let (the synthesis.#expression it)) + context (the synthesis.#context it)] + bindings (monad.each ! (function (_ [binding value]) + (phase#each (_.local/1 (..register binding)) + (next archive value))) + (list.partial context + tail)) + body (next archive body)] ... TODO: Find some way to do 'let' without paying the price of the closure. - (in (|> bodyO - _.return - (_.closure (list (..register register))) - (_.apply (list valueO)))))) + (in (<| (_.apply (list)) + (_.closure (list)) + (list#mix _.then + (_.return body) + (list.reversed bindings)))))) -(def .public (let! statement expression archive [valueS register bodyS]) - (Translator! [Synthesis Register Synthesis]) +(def .public (let! statement next archive [[register valueS] bodyS]) + (Translator! (synthesis.Let synthesis.Term)) (do phase.monad - [valueO (expression archive valueS) - bodyO (statement expression archive bodyS)] + [valueO (next archive valueS) + bodyO (statement next archive bodyS)] (in (all _.then (_.local/1 (..register register) valueO) bodyO)))) -(def .public (get expression archive [pathP valueS]) - (Translator [(List Member) Synthesis]) +(def .public (get next archive [pathP valueS]) + (Translator [(List Member) synthesis.Term]) (do phase.monad - [valueO (expression archive valueS)] + [valueO (next archive valueS)] (in (list#mix (function (_ side source) (.let [method (.if (the member.#right? side) (//runtime.tuple//right (_.int (.int (the member.#lefts side)))) @@ -97,24 +109,24 @@ valueO pathP)))) -(def .public (if expression archive [testS thenS elseS]) - (Translator [Synthesis Synthesis Synthesis]) +(def .public (if next archive [testS thenS elseS]) + (Translator [synthesis.Term synthesis.Term synthesis.Term]) (do phase.monad - [testO (expression archive testS) - thenO (expression archive thenS) - elseO (expression archive elseS)] + [testO (next archive testS) + thenO (next archive thenS) + elseO (next archive elseS)] (in (|> (_.if testO (_.return thenO) (_.return elseO)) (_.closure (list)) (_.apply (list)))))) -(def .public (if! statement expression archive [testS thenS elseS]) - (Translator! [Synthesis Synthesis Synthesis]) +(def .public (if! statement next archive [testS thenS elseS]) + (Translator! [synthesis.Term synthesis.Term synthesis.Term]) (do phase.monad - [testO (expression archive testS) - thenO (statement expression archive thenS) - elseO (statement expression archive elseS)] + [testO (next archive testS) + thenO (statement next archive thenS) + elseO (statement next archive elseS)] (in (_.if testO thenO elseO)))) @@ -124,7 +136,8 @@ (def @temp (_.var "lux_pm_temp")) (def (push! value) - (-> Expression Statement) + (-> Expression + Statement) (_.statement (|> (_.var "table.insert") (_.apply (list @cursor value))))) (def peek_and_pop @@ -158,7 +171,8 @@ (with_template [<name> <flag>] [(def (<name> simple? idx) - (-> Bit Nat Statement) + (-> Bit Nat + Statement) (all _.then (_.set (list @temp) (//runtime.sum//get ..peek <flag> (|> idx .int _.int))) @@ -174,7 +188,8 @@ ) (def (alternation pre! post!) - (-> Statement Statement Statement) + (-> Statement Statement + Statement) (all _.then (_.while (_.boolean true) (all _.then @@ -184,20 +199,21 @@ ..restore! post!))) -(def (pattern_matching' statement expression archive) - (-> Phase! Phase Archive Path (Operation Statement)) +(def (pattern_matching' statement next archive) + (-> Phase! Phase Archive Path + (Operation Statement)) (function (again pathP) (.when pathP - {/////synthesis.#Then bodyS} - (statement expression archive bodyS) + {synthesis.#Then bodyS} + (statement next archive bodyS) - {/////synthesis.#Pop} + {synthesis.#Pop} (phase#in ..pop!) - {/////synthesis.#Bind register} + {synthesis.#Bind register} (phase#in (_.local/1 (..register register) ..peek)) - {/////synthesis.#Bit_Fork when thenP elseP} + {synthesis.#Bit_Fork when thenP elseP} (do [! phase.monad] [then! (again thenP) else! (.when elseP @@ -228,9 +244,9 @@ (_.if when then! else!)) ..fail! clauses)))]) - ([/////synthesis.#I64_Fork (<| _.int .int)] - [/////synthesis.#F64_Fork _.float] - [/////synthesis.#Text_Fork _.string]) + ([synthesis.#I64_Fork (<| _.int .int)] + [synthesis.#F64_Fork _.float] + [synthesis.#Text_Fork _.string]) (^.with_template [<complex> <simple> <choice>] [(<complex> idx) @@ -238,19 +254,19 @@ (<simple> idx nextP) (phase#each (_.then (<choice> true idx)) (again nextP))]) - ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] - [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) + ([synthesis.side/left synthesis.simple_left_side ..left_choice] + [synthesis.side/right synthesis.simple_right_side ..right_choice]) - (/////synthesis.member/left 0) + (synthesis.member/left 0) (phase#in (|> ..peek (_.item (_.int +1)) ..push!)) (^.with_template [<pm> <getter>] [(<pm> lefts) (phase#in (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) - ([/////synthesis.member/left //runtime.tuple//left] - [/////synthesis.member/right //runtime.tuple//right]) + ([synthesis.member/left //runtime.tuple//left] + [synthesis.member/right //runtime.tuple//right]) - (/////synthesis.!bind_top register thenP) + (synthesis.!bind_top register thenP) (do phase.monad [then! (again thenP)] (phase#in (all _.then @@ -263,20 +279,22 @@ [pre! (again preP) post! (again postP)] (in (<combinator> pre! post!)))]) - ([/////synthesis.path/seq _.then] - [/////synthesis.path/alt ..alternation])))) + ([synthesis.path/seq _.then] + [synthesis.path/alt ..alternation])))) -(def (pattern_matching statement expression archive pathP) - (-> Phase! Phase Archive Path (Operation Statement)) +(def (pattern_matching statement next archive pathP) + (-> Phase! Phase Archive Path + (Operation Statement)) (do phase.monad - [pattern_matching! (pattern_matching' statement expression archive pathP)] + [pattern_matching! (pattern_matching' statement next archive pathP)] (in (all _.then (_.while (_.boolean true) pattern_matching!) (_.statement (|> (_.var "error") (_.apply (list (_.string ////synthesis/when.pattern_matching_error))))))))) (def .public dependencies - (-> Path (List Var)) + (-> Path + (List Var)) (|>> ////synthesis/when.storage (the ////synthesis/when.#dependencies) set.list @@ -288,21 +306,22 @@ {///////variable.#Foreign register} (..capture register)))))) -(def .public (when! statement expression archive [valueS pathP]) - (Translator! [Synthesis Path]) +(def .public (when! statement next archive [valueS pathP]) + (Translator! [synthesis.Term Path]) (do phase.monad - [stack_init (expression archive valueS) - pattern_matching! (pattern_matching statement expression archive pathP)] + [stack_init (next archive valueS) + pattern_matching! (pattern_matching statement next archive pathP)] (in (all _.then (_.local (list @temp)) (_.local/1 @cursor (_.array (list stack_init))) (_.local/1 @savepoint (_.array (list))) pattern_matching!)))) -(def .public (when statement expression archive [valueS pathP]) - (-> Phase! (Translator [Synthesis Path])) +(def .public (when statement next archive [valueS pathP]) + (-> Phase! + (Translator [synthesis.Term Path])) (|> [valueS pathP] - (..when! statement expression archive) + (..when! statement next archive) (of phase.monad each (|>> (_.closure (list)) (_.apply (list)))))) |