From 670438b982bbe0b662b0a65958dc4f8b289d3906 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 18 Jan 2023 01:38:48 -0400 Subject: More efficient "let" and "exec" expressions. --- .../compiler/language/lux/analysis/evaluation.lux | 10 +- .../language/lux/phase/extension/analysis/lua.lux | 4 +- .../language/lux/phase/extension/analysis/ruby.lux | 4 +- .../lux/phase/extension/declaration/lux.lux | 8 +- .../lux/phase/extension/translation/jvm/host.lux | 11 +- .../language/lux/phase/synthesis/function.lux | 4 +- .../compiler/language/lux/phase/synthesis/loop.lux | 4 +- .../language/lux/phase/synthesis/variable.lux | 10 +- .../compiler/language/lux/phase/synthesis/when.lux | 4 +- .../language/lux/phase/translation/c++/when.lux | 67 ++------- .../compiler/language/lux/phase/translation/js.lux | 5 +- .../language/lux/phase/translation/js/function.lux | 10 +- .../language/lux/phase/translation/js/loop.lux | 10 +- .../lux/phase/translation/js/structure.lux | 8 +- .../language/lux/phase/translation/js/when.lux | 111 ++++++++------ .../language/lux/phase/translation/jvm/host.lux | 12 +- .../language/lux/phase/translation/jvm/when.lux | 6 +- .../language/lux/phase/translation/lua.lux | 5 +- .../lux/phase/translation/lua/function.lux | 10 +- .../language/lux/phase/translation/lua/loop.lux | 12 +- .../lux/phase/translation/lua/structure.lux | 10 +- .../language/lux/phase/translation/lua/when.lux | 167 ++++++++++++--------- .../lux/phase/translation/python/function.lux | 10 +- .../language/lux/phase/translation/python/loop.lux | 10 +- .../lux/phase/translation/python/structure.lux | 10 +- .../language/lux/phase/translation/python/when.lux | 76 +++++----- .../language/lux/phase/translation/ruby.lux | 5 +- .../lux/phase/translation/ruby/function.lux | 10 +- .../language/lux/phase/translation/ruby/loop.lux | 10 +- .../lux/phase/translation/ruby/structure.lux | 10 +- .../language/lux/phase/translation/ruby/when.lux | 103 +++++++------ .../lux/meta/compiler/language/lux/synthesis.lux | 76 +++++++--- .../lux/meta/compiler/language/lux/translation.lux | 8 +- .../compiler/meta/cache/dependency/artifact.lux | 2 +- stdlib/source/library/lux/test/property.lux | 3 +- 35 files changed, 434 insertions(+), 391 deletions(-) (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux index ba7dea6b9..376993dec 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux @@ -34,13 +34,15 @@ [/// [meta ["[0]" archive (.only Archive) - ["[0]" module]]]]]]]]) + ["[0]" module] + ["[0]" artifact]]]]]]]]) (type .public Eval - (-> Archive Type Code (Operation Any))) + (-> Archive Type Code + (Operation Any))) (def evals - (Atom (Dictionary module.ID Nat)) + (Atom (Dictionary module.ID artifact.ID)) (atom.atom (dictionary.empty n.hash))) (def .public (evaluator analysis @@ -79,4 +81,4 @@ (i64.or @eval) (i64.left_shifted 32))) (translation lux archive exprS))] - (translation.evaluate! [@module @eval] [{.#None} exprO])))))) + (translation.evaluate! [{.#None} exprO])))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lua.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lua.lux index b5d02fc22..40c6978b1 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lua.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lua.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Analysis) + [lux (.except) ["[0]" ffi] [abstract ["[0]" monad (.only do)]] @@ -28,7 +28,7 @@ ["[0]" extension] [// ["[0]" phase] - ["[0]" analysis (.only Analysis Operation Phase Handler Bundle) + ["[0]" analysis (.only Operation Phase Handler Bundle) ["[1]/[0]" type]]]]]) (def Nil diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/ruby.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/ruby.lux index cf78288f8..532c98f27 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/ruby.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/ruby.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Analysis) + [lux (.except) ["[0]" ffi] [abstract ["[0]" monad (.only do)]] @@ -28,7 +28,7 @@ ["[0]" extension] [// ["[0]" phase] - ["[0]" analysis (.only Analysis Operation Phase Handler Bundle) + ["[0]" analysis (.only Operation Phase Handler Bundle) ["[1]/[0]" type]]]]]) (def array::new diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux index a20110788..1768bdd07 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux @@ -74,12 +74,6 @@ {try.#Failure error} (phase.failure error)))) -(def (context [@module @artifact]) - (-> unit.ID - unit.ID) - ... TODO: Find a better way that doesn't rely on clever tricks. - [@module (n.- (++ @artifact) 0)]) - ... TODO: Inline "evaluate!'" into "evaluate!" ASAP (def (evaluate!' archive translation code//type codeS) (All (_ anchor expression declaration) @@ -94,7 +88,7 @@ id /////translation.next codeG (translation archive codeS) @module (/////translation.module_id module archive) - codeV (/////translation.evaluate! (..context [@module id]) [{.#None} codeG])] + codeV (/////translation.evaluate! [{.#None} codeG])] (in [code//type codeG codeV])))) (def .public (evaluate! archive type codeC) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/host.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/host.lux index 509d6dcf5..3441363b9 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/host.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/host.lux @@ -833,7 +833,7 @@ [1 _]) body - [2 [@ {synthesis.#Control {synthesis.#Branch {synthesis.#Let _ 2 (synthesis.tuple @ (list _ hidden))}}}]] + [2 [@ {synthesis.#Control {synthesis.#Branch {synthesis.#Let [2 _] (synthesis.tuple @ (list _ hidden))}}}]] hidden [_ [@ {synthesis.#Control {synthesis.#Branch {synthesis.#When _ path}}}]] @@ -926,9 +926,8 @@ {synthesis.#Exec (without_fake_parameter before) (without_fake_parameter after)} - {synthesis.#Let value register body} - {synthesis.#Let (without_fake_parameter value) - (-- register) + {synthesis.#Let [register value] body} + {synthesis.#Let [(-- register) (without_fake_parameter value)] (without_fake_parameter body)} {synthesis.#If when then else} @@ -1069,8 +1068,8 @@ (synthesis.branch/exec @ [this that]) (synthesis.branch/exec @ [(again this) (again that)]) - (synthesis.branch/let @ [inputS register outputS]) - (synthesis.branch/let @ [(again inputS) register (again outputS)]) + (synthesis.branch/let @ [[register inputS] outputS]) + (synthesis.branch/let @ [[register (again inputS)] (again outputS)]) (synthesis.branch/if @ [testS thenS elseS]) (synthesis.branch/if @ [(again testS) (again thenS) (again elseS)]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux index 0c9b3b3ab..a7b3d400d 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux @@ -182,11 +182,11 @@ that (grow environment that)] (in (/.branch/exec @ [this that]))) - {/.#Let [inputS register bodyS]} + {/.#Let [[register inputS] bodyS]} (do phase.monad [inputS' (grow environment inputS) bodyS' (grow environment bodyS)] - (in (/.branch/let @ [inputS' (++ register) bodyS']))) + (in (/.branch/let @ [[(++ register) inputS'] bodyS']))) {/.#If [testS thenS elseS]} (do phase.monad diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux index 27ce06b25..43c75fc6a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux @@ -138,11 +138,11 @@ that (again return? that)] (in (/.branch/exec @ [this that]))) - (/.branch/let @ [input register body]) + (/.branch/let @ [[register input] body]) (do maybe.monad [input' (again false input) body' (again return? body)] - (in (/.branch/let @ [input' (register_optimization offset register) body']))) + (in (/.branch/let @ [[(register_optimization offset register) input'] body']))) (/.branch/if @ [input then else]) (do maybe.monad diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/variable.lux index fd49b0350..53d9b2117 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/variable.lux @@ -145,9 +145,9 @@ {/.#Exec (again this) (again that)} - {/.#Let input register output} - {/.#Let (again input) - (..prune redundant register) + {/.#Let [register input] output} + {/.#Let [(..prune redundant register) + (again input)] (again output)} {/.#If test then else} @@ -393,7 +393,7 @@ (in [redundancy (/.branch/exec @ [this that])])) - {/.#Let input register output} + {/.#Let [register input] output} (do try.monad [[redundancy input] (optimization' [redundancy input]) redundancy (..declare register redundancy) @@ -404,7 +404,7 @@ (in [(dictionary.lacks register redundancy) [@ {/.#Control {/.#Branch (if redundant? {/.#Exec input (..remove_local register output)} - {/.#Let input register output})}}]])) + {/.#Let [register input] output})}}]])) {/.#If test then else} (do try.monad diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux index fbe1a96b6..080905e7f 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux @@ -276,7 +276,7 @@ (do phase.monad [body (/.with_new_local (synthesize archive body))] - (in (/.branch/let @ [input @variable body])))) + (in (/.branch/let @ [[@variable input] body])))) (def .public (synthesize_masking synthesize @ archive input @variable @output) (-> Phase Location Archive /.Term Register Register @@ -455,7 +455,7 @@ (/.branch/exec @ [before after]) (list#mix for_synthesis synthesis_storage (list before after)) - (/.branch/let @ [inputS register exprS]) + (/.branch/let @ [[register inputS] exprS]) (revised #dependencies (set.union (|> synthesis_storage (revised #bindings (set.has register)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/when.lux index 1f58294e5..7dda901f2 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/when.lux @@ -37,53 +37,30 @@ [reference [variable (.only Register)]]]]]) -(type (If of) - (Record - [#when of - #then of - #else of])) - (def .public (if next archive it) - (Term If) + (Term synthesis.If) (do phase.monad - [when (next archive (the #when it)) - then (next archive (the #then it)) - else (next archive (the #else it))] + [when (next archive (the synthesis.#if_when it)) + then (next archive (the synthesis.#if_then it)) + else (next archive (the synthesis.#if_else it))] (in (_.? when then else)))) -(type (Let of) - (Record - [#input of - #register Register - #body of])) - -(def (sub_bindings body) - (-> synthesis.Term - [(List [Register synthesis.Term]) synthesis.Term]) - (.when body - (synthesis.branch/let @ [input register body]) - (.let [[tail body] (sub_bindings body)] - [(list.partial [register input] tail) body]) - - _ - [(list) body])) - (def .public (let next archive it) - (Term Let) + (Term synthesis.Let) (do [! phase.monad] - [.let [[tail body] (sub_bindings (the #body it)) - head_binding (the #register it)] + [.let [[tail body] (synthesis.flat_let (the synthesis.#expression it)) + context (the synthesis.#context it)] bindings (monad.each ! (function (_ [binding value]) (do ! [value (next archive value)] (in (_.variable (//reference.local binding) //type.value value)))) - (list.partial [head_binding (the #input it)] + (list.partial context tail)) body (next archive body)] (in (_.on (list) - (_.lambda (.when head_binding - 0 (list) - _ (list _.all_by_value)) + (_.lambda (.when context + [0 _] (list) + [_ _] (list _.all_by_value)) (list) {.#Some //type.value} (list#mix _.then @@ -91,29 +68,13 @@ (list.reversed bindings)) ))))) -(type (Exec of) - (Record - [#before of - #after of])) - -(def (sub_statements after) - (-> synthesis.Term - [(List synthesis.Term) synthesis.Term]) - (.when after - (synthesis.branch/exec @ [before after]) - (.let [[tail after] (sub_statements after)] - [(list.partial before tail) after]) - - _ - [(list) after])) - (def .public (exec next archive it) - (Term Exec) + (Term synthesis.Exec) (do [! phase.monad] - [.let [[tail after] (sub_statements (the #after it))] + [.let [[tail after] (synthesis.flat_exec (the synthesis.#after it))] all_before (monad.each ! (|>> (next archive) (phase#each _.;)) - (list.partial (the #before it) tail)) + (list.partial (the synthesis.#before it) tail)) after (next archive after)] (in (_.on (list) (_.lambda (list _.all_by_value) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js.lux index 2cf2b2b00..7cfa582ae 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js.lux @@ -11,8 +11,9 @@ [meta [macro ["^" pattern]] - [target - ["_" js]]]]] + [compiler + [target + ["_" js]]]]]] ["[0]" / [runtime (.only Phase Phase!)] ["[1][0]" primitive] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/function.lux index 39b5abf84..b4bf4fa40 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/function.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Analysis Synthesis function) + [lux (.except function) [abstract ["[0]" monad (.only do)]] [data @@ -23,9 +23,9 @@ ["/[1]" // ["[1][0]" reference] ["//[1]" /// - [analysis (.only Abstraction Reification Analysis)] - [synthesis (.only Synthesis)] + [analysis (.only Abstraction Reification)] ["[0]" phase (.use "[1]#[0]" monad)] + ["[0]" synthesis] ["[1][0]" translation] ["//[1]" /// [arity (.only Arity)] @@ -39,7 +39,7 @@ ["[1]" artifact]]]]]]]]) (def .public (apply expression archive [functionS argsS+]) - (Translator (Reification Synthesis)) + (Translator (Reification synthesis.Term)) (do [! phase.monad] [functionO (expression archive functionS) argsO+ (monad.each ! (expression archive) argsS+)] @@ -77,7 +77,7 @@ (format (///reference.artifact function_name) "_scope")) (def .public (function statement expression archive [environment arity bodyS]) - (-> Phase! (Translator (Abstraction Synthesis))) + (-> Phase! (Translator (Abstraction synthesis.Term))) (do [! phase.monad] [dependencies (cache.dependencies archive bodyS) [function_name body!] (/////translation.with_new_context archive dependencies diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/loop.lux index 5747dfee9..50e19dcf6 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/loop.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Scope Synthesis) + [lux (.except Scope) [abstract ["[0]" monad (.only do)]] [data @@ -23,8 +23,8 @@ [runtime (.only Operation Phase Phase! Translator Translator!)] ["[1][0]" when] ["///[1]" //// - [synthesis (.only Scope Synthesis)] ["[0]" phase] + ["[0]" synthesis (.only Scope)] ["[1][0]" translation] [/// [reference @@ -66,7 +66,7 @@ (_.then (_.define $iteration (_.array bindings)))))) (def .public (scope! statement expression archive [start initsS+ bodyS]) - (Translator! (Scope Synthesis)) + (Translator! (Scope synthesis.Term)) (when initsS+ ... function/false/non-independent loop {.#End} @@ -88,7 +88,7 @@ body!))))))) (def .public (scope statement expression archive [start initsS+ bodyS]) - (-> Phase! (Translator (Scope Synthesis))) + (-> Phase! (Translator (Scope synthesis.Term))) (when initsS+ ... function/false/non-independent loop {.#End} @@ -104,7 +104,7 @@ (_.var "lux_again_values")) (def .public (again! statement expression archive argsS+) - (Translator! (List Synthesis)) + (Translator! (List synthesis.Term)) (do [! phase.monad] [[offset @scope] /////translation.anchor argsO+ (monad.each ! (expression archive) argsS+) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/structure.lux index 64680da6d..221425bbc 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/structure.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/structure.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Variant Tuple Synthesis) + [lux (.except Variant Tuple) [abstract ["[0]" monad (.only do)]] [meta @@ -15,12 +15,12 @@ ["[1][0]" primitive] ["///[1]" //// ["[0]" phase (.use "[1]#[0]" monad)] - ["[1][0]" synthesis (.only Synthesis)] + ["[0]" synthesis] [analysis [complex (.only Variant Tuple)]]]]) (def .public (tuple translate archive elemsS+) - (Translator (Tuple Synthesis)) + (Translator (Tuple synthesis.Term)) (when elemsS+ {.#End} (phase#in //runtime.unit) @@ -34,7 +34,7 @@ (in (_.array elemsT+))))) (def .public (variant translate archive [lefts right? valueS]) - (Translator (Variant Synthesis)) + (Translator (Variant synthesis.Term)) (phase#each (//runtime.variant (_.i32 (.int lefts)) (//runtime.flag right?)) (translate archive valueS))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/when.lux index 52b734977..75754f0fc 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/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)]] [control @@ -32,7 +32,7 @@ ["[1]/[0]" when]] ["/[1]" // ["[0]" phase (.use "[1]#[0]" monad)] - ["[1][0]" synthesis (.only Synthesis Path) + ["[0]" synthesis (.only Path) [access ["[0]" member (.only Member)]]] ["//[1]" /// @@ -45,16 +45,19 @@ (-> Register Var) (|>> (///reference.local //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)) +(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 (|> (_.array (list (_.array all_before) + after)) (_.at (_.int +1)))))) (def .public (exec! statement expression archive [this that]) - (Translator! [Synthesis Synthesis]) + (Translator! (synthesis.Exec synthesis.Term)) (do phase.monad [this (expression archive this) that (statement expression archive that)] @@ -62,18 +65,26 @@ (_.statement 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 (_.define (..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 (_.apply (_.closure (list (..register register)) - (_.return bodyO)) - (list valueO))))) - -(def .public (let! statement expression archive [valueS register bodyS]) - (Translator! [Synthesis Register Synthesis]) + (in (_.apply (<| (_.closure (list)) + (list#mix _.then + (_.return body) + (list.reversed bindings))) + (list))))) + +(def .public (let! statement expression archive [[register valueS] bodyS]) + (Translator! (synthesis.Let synthesis.Term)) (do phase.monad [valueO (expression archive valueS) bodyO (statement expression archive bodyS)] @@ -82,7 +93,7 @@ bodyO)))) (def .public (if expression archive [testS thenS elseS]) - (Translator [Synthesis Synthesis Synthesis]) + (Translator [synthesis.Term synthesis.Term synthesis.Term]) (do phase.monad [testO (expression archive testS) thenO (expression archive thenS) @@ -90,7 +101,7 @@ (in (_.? testO thenO elseO)))) (def .public (if! statement expression archive [testS thenS elseS]) - (Translator! [Synthesis Synthesis Synthesis]) + (Translator! [synthesis.Term synthesis.Term synthesis.Term]) (do phase.monad [testO (expression archive testS) thenO (statement expression archive thenS) @@ -100,7 +111,7 @@ elseO)))) (def .public (get expression archive [pathP valueS]) - (Translator [(List Member) Synthesis]) + (Translator [(List Member) synthesis.Term]) (do phase.monad [valueO (expression archive valueS)] (in (list#mix (function (_ side source) @@ -191,16 +202,16 @@ (|> nextP again (of phase.monad each (|>> (_.then ( true idx)) {.#Some})))]) - ([/////synthesis.simple_left_side ..left_choice] - [/////synthesis.simple_right_side ..right_choice]) + ([synthesis.simple_left_side ..left_choice] + [synthesis.simple_right_side ..right_choice]) - (/////synthesis.member/left 0) + (synthesis.member/left 0) (phase#in {.#Some (push_cursor! (_.at (_.i32 +0) ..peek_cursor))}) ... Extra optimization - (/////synthesis.path/seq - (/////synthesis.member/left 0) - (/////synthesis.!bind_top register thenP)) + (synthesis.path/seq + (synthesis.member/left 0) + (synthesis.!bind_top register thenP)) (do phase.monad [then! (again thenP)] (in {.#Some (all _.then @@ -209,25 +220,25 @@ ... Extra optimization (^.with_template [ ] - [(/////synthesis.path/seq + [(synthesis.path/seq ( lefts) - (/////synthesis.!bind_top register thenP)) + (synthesis.!bind_top register thenP)) (do phase.monad [then! (again thenP)] (in {.#Some (all _.then (_.define (..register register) ( (_.i32 (.int lefts)) ..peek_cursor)) then!)}))]) - ([/////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)] (in {.#Some (all _.then (_.define (..register register) ..peek_and_pop_cursor) then!)})) - (/////synthesis.!multi_pop nextP) + (synthesis.!multi_pop nextP) (.let [[extra_pops nextP'] (////synthesis/when.count_pops nextP)] (do phase.monad [next! (again nextP')] @@ -250,16 +261,16 @@ {.#None} (.when pathP - {/////synthesis.#Then bodyS} + {synthesis.#Then bodyS} (statement expression archive bodyS) - {/////synthesis.#Pop} + {synthesis.#Pop} (phase#in pop_cursor!) - {/////synthesis.#Bind register} + {synthesis.#Bind register} (phase#in (_.define (..register register) ..peek_cursor)) - {/////synthesis.#Bit_Fork when thenP elseP} + {synthesis.#Bit_Fork when thenP elseP} (do [! phase.monad] [then! (again thenP) else! (.when elseP @@ -276,7 +287,7 @@ else! then!)))) - {/////synthesis.#I64_Fork item} + {synthesis.#I64_Fork item} (do [! phase.monad] [clauses (monad.each ! (function (_ [match then]) (do ! @@ -299,20 +310,20 @@ (in (_.switch ..peek_cursor cases {.#Some ..fail_pm!})))]) - ([/////synthesis.#F64_Fork //primitive.f64] - [/////synthesis.#Text_Fork //primitive.text]) + ([synthesis.#F64_Fork //primitive.f64] + [synthesis.#Text_Fork //primitive.text]) (^.with_template [ ] [( idx) (phase#in ( false idx))]) - ([/////synthesis.side/left ..left_choice] - [/////synthesis.side/right ..right_choice]) + ([synthesis.side/left ..left_choice] + [synthesis.side/right ..right_choice]) (^.with_template [ ] [( lefts) (phase#in (push_cursor! ( (_.i32 (.int lefts)) ..peek_cursor)))]) - ([/////synthesis.member/left //runtime.tuple//left] - [/////synthesis.member/right //runtime.tuple//right]) + ([synthesis.member/left //runtime.tuple//left] + [synthesis.member/right //runtime.tuple//right]) (^.with_template [ ] [( leftP rightP) @@ -320,8 +331,8 @@ [left! (again leftP) right! (again rightP)] (in ( left! right!)))]) - ([/////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)) @@ -333,7 +344,7 @@ (_.throw (_.string ////synthesis/when.pattern_matching_error)))))) (def .public (when! statement expression archive [valueS pathP]) - (Translator! [Synthesis Path]) + (Translator! [synthesis.Term Path]) (do phase.monad [stack_init (expression archive valueS) pattern_matching! (pattern_matching statement expression archive pathP)] @@ -344,7 +355,7 @@ pattern_matching!)))) (def .public (when statement expression archive [valueS pathP]) - (-> Phase! (Translator [Synthesis Path])) + (-> Phase! (Translator [synthesis.Term Path])) (do phase.monad [pattern_matching! (..when! statement expression archive [valueS pathP])] (in (_.apply (_.closure (list) pattern_matching!) (list))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/host.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/host.lux index 5a8c50a16..7c0882b27 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/host.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/host.lux @@ -19,7 +19,7 @@ [binary (.only Binary) ["[0]" \\format]] ["[0]" text (.use "[1]#[0]" hash) - ["%" \\format (.only format)]] + ["%" \\format]] [collection ["[0]" array] ["[0]" dictionary (.only Dictionary)] @@ -181,13 +181,15 @@ (def .public host (IO [java/lang/ClassLoader //runtime.Host]) (io (let [library (loader.new_library []) - loader (loader.memory library)] + loader (loader.memory library) + id (atom.atom 0)] [loader (is //runtime.Host (implementation - (def (evaluate context @it,valueG) - (of try.monad each product.left - (..evaluate! library loader (format "E" (//runtime.class_name context)) @it,valueG))) + (def (evaluate @it,valueG) + (let [[id _] (io.run! (atom.update! ++ id))] + (of try.monad each product.left + (..evaluate! library loader (%.format "E" (%.nat id)) @it,valueG)))) (def execute (..execute! library loader)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux index a21bfc7e3..38d434942 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux @@ -291,7 +291,7 @@ (_.set_label @end))))))) (def .public (exec phase archive [this that]) - (Translator [synthesis.Term synthesis.Term]) + (Translator (synthesis.Exec synthesis.Term)) (do phase.monad [this! (phase archive this) that! (phase archive that)] @@ -300,8 +300,8 @@ _.pop that!)))) -(def .public (let phase archive [inputS register bodyS]) - (Translator [synthesis.Term Register synthesis.Term]) +(def .public (let phase archive [[register inputS] bodyS]) + (Translator (synthesis.Let synthesis.Term)) (do phase.monad [input! (phase archive inputS) body! (phase archive bodyS)] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua.lux index e05e41f83..1857be954 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua.lux @@ -11,8 +11,9 @@ [meta [macro ["^" pattern]] - [target - ["_" lua]]]]] + [compiler + [target + ["_" lua]]]]]] ["[0]" / [runtime (.only Phase)] ["[1][0]" primitive] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/function.lux index 38a769175..606631373 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/function.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Label Analysis Synthesis function) + [lux (.except Label function) [abstract ["[0]" monad (.only do)]] [data @@ -23,8 +23,8 @@ ["/[1]" // ["[1][0]" reference] ["//[1]" /// - [analysis (.only Abstraction Reification Analysis)] - [synthesis (.only Synthesis)] + [analysis (.only Abstraction Reification)] + ["[0]" synthesis] ["[0]" phase (.use "[1]#[0]" monad)] ["[1][0]" translation] ["//[1]" /// @@ -39,7 +39,7 @@ [variable (.only Register Variable)]]]]]]) (def .public (apply expression archive [functionS argsS+]) - (Translator (Reification Synthesis)) + (Translator (Reification synthesis.Term)) (do [! phase.monad] [functionO (expression archive functionS) argsO+ (monad.each ! (expression archive) argsS+)] @@ -73,7 +73,7 @@ (_.label (format (///reference.artifact function_name) "_scope"))) (def .public (function statement expression archive [environment arity bodyS]) - (-> Phase! (Translator (Abstraction Synthesis))) + (-> Phase! (Translator (Abstraction synthesis.Term))) (do [! phase.monad] [dependencies (cache.dependencies archive bodyS) [function_name body!] (/////translation.with_new_context archive dependencies diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/loop.lux index 60c1309a1..b12c5d271 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/loop.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Label Scope Synthesis) + [lux (.except Label Scope) [abstract ["[0]" monad (.only do)]] [data @@ -27,7 +27,7 @@ ["[1][0]" reference] ["//[1]" /// ["[0]" phase] - ["[0]" synthesis (.only Scope Synthesis)] + ["[0]" synthesis (.only Scope)] ["[1][0]" translation] ["//[1]" /// [meta @@ -56,8 +56,8 @@ body)))) (def .public (scope! statement expression archive as_expression? [start initsS+ bodyS]) - ... (Translator! (Scope Synthesis)) - (-> Phase! Phase Archive Bit (Scope Synthesis) + ... (Translator! (Scope synthesis.Term)) + (-> Phase! Phase Archive Bit (Scope synthesis.Term) (Operation [(List Expression) Statement])) (when initsS+ ... function/false/non-independent loop @@ -80,7 +80,7 @@ body!))])))) (def .public (scope statement expression archive [start initsS+ bodyS]) - (-> Phase! (Translator (Scope Synthesis))) + (-> Phase! (Translator (Scope synthesis.Term))) (when initsS+ ... function/false/non-independent loop {.#End} @@ -121,7 +121,7 @@ (in (_.apply initsO+ instantiation))))) (def .public (again! statement expression archive argsS+) - (Translator! (List Synthesis)) + (Translator! (List synthesis.Term)) (do [! phase.monad] [[offset @scope] /////translation.anchor argsO+ (monad.each ! (expression archive) argsS+)] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/structure.lux index d9ad51d0f..d3b266697 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/structure.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/structure.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Tuple Variant Synthesis) + [lux (.except Tuple Variant) [abstract ["[0]" monad (.only do)]] [meta @@ -15,15 +15,15 @@ ["[1][0]" primitive] ["///[1]" //// ["[0]" phase (.use "[1]#[0]" monad)] - ["[1][0]" synthesis (.only Synthesis)] + ["[0]" synthesis] [analysis [complex (.only Variant Tuple)]]]]) (def .public (tuple phase archive elemsS+) - (Translator (Tuple Synthesis)) + (Translator (Tuple synthesis.Term)) (when elemsS+ {.#End} - (phase#in (//primitive.text /////synthesis.unit)) + (phase#in (//primitive.text synthesis.unit)) {.#Item singletonS {.#End}} (phase archive singletonS) @@ -34,6 +34,6 @@ (phase#each _.array)))) (def .public (variant phase archive [lefts right? valueS]) - (Translator (Variant Synthesis)) + (Translator (Variant synthesis.Term)) (phase#each (//runtime.variant lefts right?) (phase archive valueS))) 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 [ ] [(def ( simple? idx) - (-> Bit Nat Statement) + (-> Bit Nat + Statement) (all _.then (_.set (list @temp) (//runtime.sum//get ..peek (|> 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 [ ] [( idx) @@ -238,19 +254,19 @@ ( idx nextP) (phase#each (_.then ( 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 [ ] [( lefts) (phase#in (|> ..peek ( (_.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 ( 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)))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/function.lux index 959c8a6d2..a17372cfe 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/function.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Analysis Synthesis function) + [lux (.except function) [abstract ["[0]" monad (.only do)]] [data @@ -24,8 +24,8 @@ ["/[1]" // ["[1][0]" reference] ["//[1]" /// - [analysis (.only Environment Abstraction Reification Analysis)] - [synthesis (.only Synthesis)] + [analysis (.only Environment Abstraction Reification)] + ["[0]" synthesis] ["[0]" phase] ["[1][0]" translation] ["//[1]" /// @@ -40,7 +40,7 @@ ["[1]" artifact]]]]]]]]) (def .public (apply expression archive [functionS argsS+]) - (Translator (Reification Synthesis)) + (Translator (Reification synthesis.Term)) (do [! phase.monad] [functionO (expression archive functionS) argsO+ (monad.each ! (expression archive) argsS+)] @@ -75,7 +75,7 @@ (|>> ++ //when.register)) (def .public (function statement expression archive [environment arity bodyS]) - (-> Phase! (Translator (Abstraction Synthesis))) + (-> Phase! (Translator (Abstraction synthesis.Term))) (do [! phase.monad] [dependencies (cache.dependencies archive bodyS) [[function_module function_artifact] body!] (/////translation.with_new_context archive dependencies diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/loop.lux index a74692875..d7a494c1a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/loop.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Scope Synthesis) + [lux (.except Scope) [abstract ["[0]" monad (.only do)]] [data @@ -30,7 +30,7 @@ ["[0]" when]] ["/[1]" // ["[0]" phase] - ["[0]" synthesis (.only Scope Synthesis)] + ["[0]" synthesis (.only Scope)] ["[1][0]" translation] ["//[1]" /// [meta @@ -56,7 +56,7 @@ {.#None})) (def .public (scope! statement expression archive [start initsS+ bodyS]) - (Translator! (Scope Synthesis)) + (Translator! (Scope synthesis.Term)) (when initsS+ ... function/false/non-independent loop {.#End} @@ -73,7 +73,7 @@ body!))))) (def .public (scope statement expression archive [start initsS+ bodyS]) - (-> Phase! (Translator (Scope Synthesis))) + (-> Phase! (Translator (Scope synthesis.Term))) (when initsS+ ... function/false/non-independent loop {.#End} @@ -116,7 +116,7 @@ (in (_.apply initsO+ instantiation))))) (def .public (again! statement expression archive argsS+) - (Translator! (List Synthesis)) + (Translator! (List synthesis.Term)) (do [! phase.monad] [offset /////translation.anchor @temp (//when.symbol "lux_again_values") diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/structure.lux index 0fbf74011..8fd7bfc0a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/structure.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/structure.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Variant Tuple Synthesis) + [lux (.except Variant Tuple) [abstract ["[0]" monad (.only do)]] [meta @@ -15,15 +15,15 @@ ["[1][0]" primitive] ["///[1]" //// ["[0]" phase (.use "[1]#[0]" monad)] - ["[1][0]" synthesis (.only Synthesis)] + ["[0]" synthesis] [analysis [complex (.only Variant Tuple)]]]]) (def .public (tuple translate archive elemsS+) - (Translator (Tuple Synthesis)) + (Translator (Tuple synthesis.Term)) (when elemsS+ {.#End} - (phase#in (//primitive.text /////synthesis.unit)) + (phase#in (//primitive.text synthesis.unit)) {.#Item singletonS {.#End}} (translate archive singletonS) @@ -34,6 +34,6 @@ (phase#each _.list)))) (def .public (variant translate archive [lefts right? valueS]) - (Translator (Variant Synthesis)) + (Translator (Variant synthesis.Term)) (phase#each (//runtime.variant lefts right?) (translate archive valueS))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/when.lux index 79b6e192d..b86f3c9c6 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python/when.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Synthesis when exec let if symbol) + [lux (.except when exec let if symbol) [abstract ["[0]" monad (.only do)]] [data @@ -34,7 +34,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]" /// @@ -59,8 +59,8 @@ (-> Register SVar) (|>> (///reference.foreign //reference.system) as_expected)) -(def .public (let expression archive [valueS register bodyS]) - (Translator [Synthesis Register Synthesis]) +(def .public (let expression archive [[register valueS] bodyS]) + (Translator (synthesis.Let synthesis.Term)) (do phase.monad [valueO (expression archive valueS) bodyO (expression archive bodyS)] @@ -69,8 +69,8 @@ (_.lambda (list (..register register)) bodyO))))) -(def .public (let! statement expression archive [valueS register bodyS]) - (Translator! [Synthesis Register Synthesis]) +(def .public (let! statement expression archive [[register valueS] bodyS]) + (Translator! (synthesis.Let synthesis.Term)) (do phase.monad [valueO (expression archive valueS) bodyO (statement expression archive bodyS)] @@ -78,15 +78,19 @@ (_.set (list (..register register)) valueO) bodyO)))) -(def .public (exec expression archive [pre post]) - (Translator [Synthesis Synthesis]) - (do phase.monad - [pre (expression archive pre) - post (expression archive post)] - (in (_.item (_.int +1) (_.tuple (list pre post)))))) +(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 +1) + (_.tuple (list (_.tuple all_before) + after)))))) (def .public (exec! statement expression archive [pre post]) - (Translator! [Synthesis Synthesis]) + (Translator! (synthesis.Exec synthesis.Term)) (do phase.monad [pre (expression archive pre) post (statement expression archive post)] @@ -95,7 +99,7 @@ post)))) (def .public (if expression archive [testS thenS elseS]) - (Translator [Synthesis Synthesis Synthesis]) + (Translator [synthesis.Term synthesis.Term synthesis.Term]) (do phase.monad [testO (expression archive testS) thenO (expression archive thenS) @@ -103,7 +107,7 @@ (in (_.? testO thenO elseO)))) (def .public (if! statement expression archive [testS thenS elseS]) - (Translator! [Synthesis Synthesis Synthesis]) + (Translator! [synthesis.Term synthesis.Term synthesis.Term]) (do phase.monad [test! (expression archive testS) then! (statement expression archive thenS) @@ -113,7 +117,7 @@ else!)))) (def .public (get expression archive [pathP valueS]) - (Translator [(List Member) Synthesis]) + (Translator [(List Member) synthesis.Term]) (do phase.monad [valueO (expression archive valueS)] (in (list#mix (function (_ side source) @@ -206,7 +210,7 @@ (-> (-> Path (Operation (Statement Any))) (-> Path (Operation (Maybe (Statement Any))))) (.when pathP - {/////synthesis.#Bit_Fork when thenP elseP} + {synthesis.#Bit_Fork when thenP elseP} (do [! phase.monad] [then! (again thenP) else! (.when elseP @@ -236,9 +240,9 @@ (_.if when then else)) ..fail_pm! clauses)}))]) - ([/////synthesis.#I64_Fork (<| //primitive.i64 .int)] - [/////synthesis.#F64_Fork (<| //primitive.f64)] - [/////synthesis.#Text_Fork (<| //primitive.text)]) + ([synthesis.#I64_Fork (<| //primitive.i64 .int)] + [synthesis.#F64_Fork (<| //primitive.f64)] + [synthesis.#Text_Fork (<| //primitive.text)]) _ (of phase.monad in {.#None}))) @@ -254,13 +258,13 @@ {.#None} (.when pathP - {/////synthesis.#Then bodyS} + {synthesis.#Then bodyS} (statement expression archive bodyS) - {/////synthesis.#Pop} + {synthesis.#Pop} (phase#in ..pop!) - {/////synthesis.#Bind register} + {synthesis.#Bind register} (phase#in (_.set (list (..register register)) ..peek)) (^.with_template [ ] @@ -271,26 +275,26 @@ (|> nextP again (phase#each (_.then ( true idx))))]) - ([/////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 +0)) ..push!)) (^.with_template [ ] [( lefts) (phase#in (|> ..peek ( (_.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 ! [then! (again thenP)] (phase#in (all _.then (_.set (list (..register register)) ..peek_and_pop) then!))) - (/////synthesis.!multi_pop nextP) + (synthesis.!multi_pop nextP) (.let [[extra_pops nextP'] (when.count_pops nextP)] (do ! [next! (again nextP')] @@ -298,13 +302,13 @@ (..multi_pop! (n.+ 2 extra_pops)) next!)))) - (/////synthesis.path/seq preP postP) + (synthesis.path/seq preP postP) (do ! [pre! (again preP) post! (again postP)] (in (_.then pre! post!))) - (/////synthesis.path/alt preP postP) + (synthesis.path/alt preP postP) (do ! [pre! (again preP) post! (again postP) @@ -338,7 +342,7 @@ (..capture register)))))) (def .public (when! in_closure? statement expression archive [valueS pathP]) - (-> Bit (Translator! [Synthesis Path])) + (-> Bit (Translator! [synthesis.Term Path])) (do phase.monad [stack_init (expression archive valueS) pattern_matching! (pattern_matching in_closure? statement expression archive pathP)] @@ -349,7 +353,7 @@ )))) (def .public (when statement expression archive [valueS pathP]) - (-> Phase! (Translator [Synthesis Path])) + (-> Phase! (Translator [synthesis.Term Path])) (do phase.monad [dependencies (cache.path_dependencies archive pathP) [[when_module when_artifact] pattern_matching!] (/////translation.with_new_context @@ -357,8 +361,8 @@ dependencies (when! true statement expression archive [valueS pathP])) .let [@when (_.var (///reference.artifact [when_module when_artifact])) - @dependencies+ (..dependencies (/////synthesis.path/seq (/////synthesis.path/then valueS) - pathP)) + @dependencies+ (..dependencies (synthesis.path/seq (synthesis.path/then valueS) + pathP)) declaration (_.def @when @dependencies+ pattern_matching!)] _ (/////translation.execute! declaration) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby.lux index 75e1a3957..4e5581db5 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby.lux @@ -11,8 +11,9 @@ [meta [macro ["^" pattern]] - [target - ["_" ruby]]]]] + [compiler + [target + ["_" ruby]]]]]] ["[0]" / [runtime (.only Phase Phase!)] ["[1][0]" primitive] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/function.lux index 237fa01b5..873c10419 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/function.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Analysis Synthesis function) + [lux (.except function) [abstract ["[0]" monad (.only do)]] [data @@ -24,9 +24,9 @@ ["/[1]" // ["[1][0]" reference] ["//[1]" /// - [synthesis (.only Synthesis)] - [analysis (.only Environment Abstraction Reification Analysis)] + [analysis (.only Environment Abstraction Reification)] ["[0]" phase] + ["[0]" synthesis] ["[1][0]" translation] ["//[1]" /// [arity (.only Arity)] @@ -38,7 +38,7 @@ ["[1]/[0]" artifact]]]]]]]]) (def .public (apply expression archive [functionS argsS+]) - (Translator (Reification Synthesis)) + (Translator (Reification synthesis.Term)) (do [! phase.monad] [functionO (expression archive functionS) argsO+ (monad.each ! (expression archive) argsS+)] @@ -70,7 +70,7 @@ (|>> ++ //when.register)) (def .public (function statement expression archive [environment arity bodyS]) - (-> Phase! (Translator (Abstraction Synthesis))) + (-> Phase! (Translator (Abstraction synthesis.Term))) (do [! phase.monad] [dependencies (cache/artifact.dependencies archive bodyS) [[function_module function_artifact] body!] (/////translation.with_new_context archive dependencies diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/loop.lux index dcb5d7ff6..4cff08fc6 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/loop.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Scope Synthesis symbol) + [lux (.except Scope symbol) [abstract ["[0]" monad (.only do)]] [data @@ -30,7 +30,7 @@ ["[0]" when]] ["/[1]" // ["[0]" phase] - ["[0]" synthesis (.only Scope Synthesis)] + ["[0]" synthesis (.only Scope)] ["[1][0]" translation] ["//[1]" /// [reference @@ -53,7 +53,7 @@ (_.while (_.bool true))) (def .public (scope! statement expression archive [start initsS+ bodyS]) - (Translator! (Scope Synthesis)) + (Translator! (Scope synthesis.Term)) (when initsS+ ... function/false/non-independent loop {.#End} @@ -70,7 +70,7 @@ body!))))) (def .public (scope statement expression archive [start initsS+ bodyS]) - (-> Phase! (Translator (Scope Synthesis))) + (-> Phase! (Translator (Scope synthesis.Term))) (when initsS+ ... function/false/non-independent loop {.#End} @@ -85,7 +85,7 @@ (_.apply_lambda (list))))))) (def .public (again! statement expression archive argsS+) - (Translator! (List Synthesis)) + (Translator! (List synthesis.Term)) (do [! phase.monad] [offset /////translation.anchor @temp (//when.symbol "lux_again_values") diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/structure.lux index 72d870f54..e072193e6 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/structure.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/structure.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Variant Tuple Synthesis) + [lux (.except Variant Tuple) [abstract ["[0]" monad (.only do)]] [meta @@ -15,15 +15,15 @@ ["[1][0]" primitive] ["///[1]" //// ["[0]" phase (.use "[1]#[0]" monad)] - ["[1][0]" synthesis (.only Synthesis)] + ["[0]" synthesis] [analysis [complex (.only Variant Tuple)]]]]) (def .public (tuple translate archive elemsS+) - (Translator (Tuple Synthesis)) + (Translator (Tuple synthesis.Term)) (when elemsS+ {.#End} - (phase#in (//primitive.text /////synthesis.unit)) + (phase#in (//primitive.text synthesis.unit)) {.#Item singletonS {.#End}} (translate archive singletonS) @@ -34,6 +34,6 @@ (phase#each _.array)))) (def .public (variant translate archive [lefts right? valueS]) - (Translator (Variant Synthesis)) + (Translator (Variant synthesis.Term)) (phase#each (//runtime.variant lefts right?) (translate archive valueS))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/when.lux index cb897c7ff..add3c973a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/ruby/when.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Synthesis when exec let if symbol) + [lux (.except when exec let if symbol) [abstract ["[0]" monad (.only do)]] [data @@ -34,7 +34,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]" /// @@ -55,16 +55,19 @@ (-> Register LVar) (|>> (///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)) +(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 (|> (_.array (list (_.array all_before) + after)) (_.item (_.int +1)))))) (def .public (exec! statement expression archive [this that]) - (Translator! [Synthesis Synthesis]) + (Translator! (synthesis.Exec synthesis.Term)) (do phase.monad [this (expression archive this) that (statement expression archive that)] @@ -73,19 +76,27 @@ 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 (_.set (list (..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 - [(list (..register register))] (_.lambda {.#None}) - (_.apply_lambda (list valueO)))))) - -(def .public (let! statement expression archive [valueS register bodyS]) - (Translator! [Synthesis Register Synthesis]) + (in (<| (_.apply_lambda (list)) + (_.lambda {.#None}) + [(list) + (list#mix _.then + (_.return body) + (list.reversed bindings))])))) + +(def .public (let! statement expression archive [[register valueS] bodyS]) + (Translator! (synthesis.Let synthesis.Term)) (do phase.monad [valueO (expression archive valueS) bodyO (statement expression archive bodyS)] @@ -94,7 +105,7 @@ bodyO)))) (def .public (if expression archive [testS thenS elseS]) - (Translator [Synthesis Synthesis Synthesis]) + (Translator [synthesis.Term synthesis.Term synthesis.Term]) (do phase.monad [testO (expression archive testS) thenO (expression archive thenS) @@ -102,7 +113,7 @@ (in (_.? testO thenO elseO)))) (def .public (if! statement expression archive [testS thenS elseS]) - (Translator! [Synthesis Synthesis Synthesis]) + (Translator! [synthesis.Term synthesis.Term synthesis.Term]) (do phase.monad [test! (expression archive testS) then! (statement expression archive thenS) @@ -112,7 +123,7 @@ else!)))) (def .public (get expression archive [pathP valueS]) - (Translator [(List Member) Synthesis]) + (Translator [(List Member) synthesis.Term]) (do phase.monad [valueO (expression archive valueS)] (in (list#mix (function (_ side source) @@ -213,7 +224,7 @@ (-> (-> Path (Operation Statement)) (-> Path (Operation (Maybe Statement)))) (.when pathP - {/////synthesis.#Bit_Fork when thenP elseP} + {synthesis.#Bit_Fork when thenP elseP} (do [! phase.monad] [then! (again thenP) else! (.when elseP @@ -243,9 +254,9 @@ (_.if when then else)) ..fail! clauses)}))]) - ([/////synthesis.#I64_Fork (<| //primitive.i64 .int)] - [/////synthesis.#F64_Fork (<| //primitive.f64)] - [/////synthesis.#Text_Fork (<| //primitive.text)]) + ([synthesis.#I64_Fork (<| //primitive.i64 .int)] + [synthesis.#F64_Fork (<| //primitive.f64)] + [synthesis.#Text_Fork (<| //primitive.text)]) _ (of phase.monad in {.#None}))) @@ -261,16 +272,16 @@ {.#None} (.when pathP - {/////synthesis.#Then bodyS} + {synthesis.#Then bodyS} (statement expression archive bodyS) - {/////synthesis.#Pop} + {synthesis.#Pop} (phase#in ..pop!) - {/////synthesis.#Bind register} + {synthesis.#Bind register} (phase#in (_.set (list (..register register)) ..peek)) - {/////synthesis.#Bit_Fork when thenP elseP} + {synthesis.#Bit_Fork when thenP elseP} (do [! phase.monad] [then! (again thenP) else! (.when elseP @@ -300,9 +311,9 @@ (_.if when then else)) ..fail! clauses)))]) - ([/////synthesis.#I64_Fork (<| //primitive.i64 .int)] - [/////synthesis.#F64_Fork (<| //primitive.f64)] - [/////synthesis.#Text_Fork (<| //primitive.text)]) + ([synthesis.#I64_Fork (<| //primitive.i64 .int)] + [synthesis.#F64_Fork (<| //primitive.f64)] + [synthesis.#Text_Fork (<| //primitive.text)]) (^.with_template [ ] [( idx) @@ -312,26 +323,26 @@ (|> nextP again (phase#each (_.then ( true idx))))]) - ([/////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 +0)) ..push!)) (^.with_template [ ] [( lefts) (phase#in (|> ..peek ( (_.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 (_.set (list (..register register)) ..peek_and_pop) then!))) - (/////synthesis.!multi_pop nextP) + (synthesis.!multi_pop nextP) (.let [[extra_pops nextP'] (when.count_pops nextP)] (do phase.monad [next! (again nextP')] @@ -339,7 +350,7 @@ (..multi_pop! (n.+ 2 extra_pops)) next!)))) - (/////synthesis.path/seq preP postP) + (synthesis.path/seq preP postP) (do phase.monad [pre! (again preP) post! (again postP)] @@ -347,7 +358,7 @@ pre! post!))) - (/////synthesis.path/alt preP postP) + (synthesis.path/alt preP postP) (do phase.monad [pre! (again preP) post! (again postP) @@ -367,7 +378,7 @@ (_.statement (_.raise (_.string when.pattern_matching_error))))))) (def .public (when! in_closure? statement expression archive [valueS pathP]) - (-> Bit (Translator! [Synthesis Path])) + (-> Bit (Translator! [synthesis.Term Path])) (do phase.monad [stack_init (expression archive valueS) pattern_matching! (pattern_matching in_closure? statement expression archive pathP)] @@ -378,7 +389,7 @@ )))) (def .public (when statement expression archive when) - (-> Phase! (Translator [Synthesis Path])) + (-> Phase! (Translator [synthesis.Term Path])) (|> when (when! true statement expression archive) (of phase.monad each diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux index 2006f836f..d10fdd654 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux @@ -94,13 +94,29 @@ [#function s #arguments (List s)])) -(type .public (Branch s) +(type .public (Exec of) + (Record + [#before of + #after of])) + +(type .public (Let of) + (Record + [#context [Register of] + #expression of])) + +(type .public (If of) + (Record + [##if_when of + #if_then of + ##if_else of])) + +(type .public (Branch of) (Variant - {#Exec s s} - {#Let s Register s} - {#If s s s} - {#Get (List Member) s} - {#When s (Path' s)})) + {#Exec (Exec of)} + {#Let (Let of)} + {#If (If of)} + {#Get (List Member) of} + {#When of (Path' of)})) (type .public (Scope s) (Record @@ -398,7 +414,7 @@ (|> (format (%synthesis this) " " (%synthesis that)) (text.enclosed ["{#exec " "}"])) - {#Let input register body} + {#Let [register input] body} (|> (format (%.nat register) " " (%synthesis input) " " (%synthesis body)) (text.enclosed ["{#let " "}"])) @@ -535,34 +551,34 @@ (n.* 29 (of super hash body)) )))) -(def (branch_equivalence (open "#[0]")) +(def (branch_equivalence (open "/#[0]")) (All (_ of) (-> (Equivalence of) (Equivalence (Branch of)))) (implementation (def (= reference sample) (when [reference sample] - [{#Let [reference_input reference_register reference_body]} - {#Let [sample_input sample_register sample_body]}] - (and (#= reference_input sample_input) + [{#Let [[reference_register reference_input] reference_body]} + {#Let [[sample_register sample_input] sample_body]}] + (and (/#= reference_input sample_input) (n.= reference_register sample_register) - (#= reference_body sample_body)) + (/#= reference_body sample_body)) [{#If [reference_test reference_then reference_else]} {#If [sample_test sample_then sample_else]}] - (and (#= reference_test sample_test) - (#= reference_then sample_then) - (#= reference_else sample_else)) + (and (/#= reference_test sample_test) + (/#= reference_then sample_then) + (/#= reference_else sample_else)) [{#Get [reference_path reference_record]} {#Get [sample_path sample_record]}] (and (of (list.equivalence /member.equivalence) = reference_path sample_path) - (#= reference_record sample_record)) + (/#= reference_record sample_record)) [{#When [reference_input reference_path]} {#When [sample_input sample_path]}] - (and (#= reference_input sample_input) - (of (path'_equivalence #=) = reference_path sample_path)) + (and (/#= reference_input sample_input) + (of (path'_equivalence /#=) = reference_path sample_path)) _ false)))) @@ -582,7 +598,7 @@ (of super hash this) (of super hash that)) - {#Let [input register body]} + {#Let [[register input] body]} (all n.* 3 (of super hash input) (of n.hash hash register) @@ -793,3 +809,25 @@ [simple_left_side ..side/left] [simple_right_side ..side/right] ) + +(def .public (flat_exec after) + (-> Term + [(List Term) Term]) + (.when after + (branch/exec @ [before after]) + (let [[tail after] (flat_exec after)] + [(list.partial before tail) after]) + + _ + [(list) after])) + +(def .public (flat_let body) + (-> Term + [(List [Register Term]) Term]) + (.when body + (branch/let @ [context body]) + (let [[tail body] (flat_let body)] + [(list.partial context tail) body]) + + _ + [(list) body])) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/translation.lux b/stdlib/source/library/lux/meta/compiler/language/lux/translation.lux index 0bf955402..9e14a005b 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/translation.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/translation.lux @@ -61,7 +61,7 @@ (type .public (Host expression declaration) (Interface - (is (-> unit.ID [(Maybe unit.ID) expression] + (is (-> [(Maybe unit.ID) expression] (Try Any)) evaluate) (is (-> declaration @@ -219,12 +219,12 @@ (Operation anchor expression declaration descriptor.Module)) (phase.read (the #module))) -(def .public (evaluate! label code) +(def .public (evaluate! code) (All (_ anchor expression declaration) - (-> unit.ID [(Maybe unit.ID) expression] + (-> [(Maybe unit.ID) expression] (Operation anchor expression declaration Any))) (function (_ state) - (when (of (the #host state) evaluate label code) + (when (of (the #host state) evaluate code) {try.#Success output} {try.#Success [state output]} diff --git a/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux b/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux index d6b3e055e..22a0bbf8a 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux @@ -113,7 +113,7 @@ (references this) (references that)) - {synthesis.#Let input _ body} + {synthesis.#Let [_ input] body} (.all list#composite (references input) (references body)) diff --git a/stdlib/source/library/lux/test/property.lux b/stdlib/source/library/lux/test/property.lux index a8a1fe1d5..4744d780b 100644 --- a/stdlib/source/library/lux/test/property.lux +++ b/stdlib/source/library/lux/test/property.lux @@ -60,8 +60,7 @@ (def .public context (-> Text Test Test) - (|>> %.text - //.context + (|>> //.context random#each)) (def .public failure -- cgit v1.2.3