From 8ca6fcf3f147cae24f385423e84ae1ab0821293f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 16 Jan 2023 14:31:15 -0400 Subject: Added compilation of references for C++. --- .../library/lux/control/function/predicate.lux | 41 +++++---- .../language/lux/phase/extension/analysis/js.lux | 4 +- .../lux/phase/extension/analysis/python.lux | 4 +- .../language/lux/phase/translation/c++.lux | 24 ++--- .../language/lux/phase/translation/c++/complex.lux | 20 ++-- .../lux/phase/translation/c++/primitive.lux | 25 +++-- .../lux/phase/translation/c++/reference.lux | 66 +++++++++++++ .../language/lux/phase/translation/c++/runtime.lux | 9 +- .../lux/phase/translation/jvm/reference.lux | 51 ++++++----- .../library/lux/world/finance/market/price.lux | 30 ++++-- stdlib/source/library/lux/world/finance/money.lux | 23 ++++- stdlib/source/test/lux/abstract/monad/indexed.lux | 6 +- .../source/test/lux/control/function/predicate.lux | 10 +- .../test/lux/meta/compiler/language/lux/phase.lux | 4 +- .../lux/phase/translation/jvm/function.lux | 102 ++++++++++++++------- .../lux/phase/translation/jvm/reference.lux | 87 ++++++++++++++++++ 16 files changed, 377 insertions(+), 129 deletions(-) create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/reference.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/reference.lux (limited to 'stdlib/source') diff --git a/stdlib/source/library/lux/control/function/predicate.lux b/stdlib/source/library/lux/control/function/predicate.lux index 1bd289e4d..593878eef 100644 --- a/stdlib/source/library/lux/control/function/predicate.lux +++ b/stdlib/source/library/lux/control/function/predicate.lux @@ -10,27 +10,31 @@ ["[0]" contravariant]]]]] ["[0]" //]) -(type .public (Predicate a) - (-> a Bit)) +(type .public (Predicate of) + (-> of + Bit)) -(with_template [ ] +(with_template [ ] [(def .public Predicate (//.constant )) (def .public ( left right) - (All (_ a) (-> (Predicate a) (Predicate a) (Predicate a))) + (All (_ of) + (-> (Predicate of) (Predicate of) + (Predicate of))) (function (_ value) ( (left value) (right value))))] - [none #0 or .or] - [all #1 and .and] + [#0 none or .or] + [#1 all and .and] ) (with_template [ ] [(def .public - (All (_ a) (Monoid (Predicate a))) + (All (_ of) + (Monoid (Predicate of))) (implementation (def identity ) (def composite )))] @@ -40,28 +44,31 @@ ) (def .public (complement predicate) - (All (_ a) (-> (Predicate a) (Predicate a))) + (All (_ of) + (-> (Predicate of) + (Predicate of))) (|>> predicate .not)) -(def .public not - (All (_ a) (-> (Predicate a) (Predicate a))) - ..complement) +(alias [not] + ..complement) (def .public (difference sub base) - (All (_ a) (-> (Predicate a) (Predicate a) (Predicate a))) + (All (_ of) + (-> (Predicate of) (Predicate of) + (Predicate of))) (function (_ value) (.and (base value) (.not (sub value))))) (def .public (rec predicate) - (All (_ a) - (-> (-> (Predicate a) (Predicate a)) - (Predicate a))) + (All (_ of) + (-> (-> (Predicate of) (Predicate of)) + (Predicate of))) (function (again input) (predicate again input))) (def .public functor (contravariant.Functor Predicate) (implementation - (def (each f fb) - (|>> f fb)))) + (def (each $ it) + (|>> $ it)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/js.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/js.lux index eb9d64c20..640cfdd6c 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/js.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/js.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/analysis/python.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/python.lux index e3ef6d16c..5c69be1ae 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/python.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/python.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Analysis) + [lux (.except) ["[0]" ffi] [abstract ["[0]" monad (.only do)]] @@ -27,7 +27,7 @@ ["/[1]" // (.only) [/// ["[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/translation/c++.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++.lux index 519863128..395d31e39 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Synthesis) + [lux (.except) [abstract [monad (.only do)]] [control @@ -27,15 +27,15 @@ [runtime (.only Operation Phase Handler)] ["[1][0]" primitive] ["[1][0]" complex] - ... ["[1][0]" reference] + ["[1][0]" reference] ... ["[1][0]" function] ... ["[1][0]" when] ... ["[1][0]" loop] - ["//[1]" /// + [/// ["[0]" extension] [// ["[0]" phase (.use "[1]#[0]" monad)] - ["[0]" synthesis (.only Synthesis)] + ["[0]" synthesis] ["[0]" translation] [/// ["[0]" reference]]]]]) @@ -59,13 +59,13 @@ (synthesis.tuple @ it) (/complex.tuple phase archive it) - ... [@ {synthesis.#Reference reference}] - ... (when reference - ... {reference.#Variable variable} - ... (/reference.variable archive variable) - - ... {reference.#Constant constant} - ... (/reference.constant archive constant)) + [@ {synthesis.#Reference reference}] + (when reference + {reference.#Variable it} + (/reference.variable it) + + {reference.#Constant it} + (/reference.constant archive it)) ... (synthesis.branch/when @ [valueS pathS]) ... (/when.when phase archive [valueS pathS]) @@ -100,5 +100,5 @@ ... (function (_ _) {.#None})) _ - (undefined) + (panic! (synthesis.%synthesis it)) ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/complex.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/complex.lux index 0b0dfe292..57c12d5dc 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/complex.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/complex.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Variant Tuple Synthesis Translation) + [lux (.except Variant Tuple) [abstract ["[0]" monad (.only do)]] [meta @@ -11,32 +11,32 @@ [target ["_" c++]]]]]] [// - ["[0]" runtime (.only Translation)] + ["[0]" runtime (.only Term)] [//// ["[0]" phase] - [synthesis (.only Synthesis)] + ["[0]" synthesis] [analysis [complex (.only Variant Tuple)]]]]) -(def .public (variant phase archive [lefts right? value]) - (Translation (Variant Synthesis)) +(def .public (variant next archive [lefts right? value]) + (Term Variant) (do phase.monad - [value (phase archive value)] + [value (next archive value)] (in (runtime.variant (_.int (.int lefts)) (_.bool right?) value)))) -(def .public (tuple phase archive values) - (Translation (Tuple Synthesis)) +(def .public (tuple next archive values) + (Term Tuple) (let [! phase.monad] (when values {.#End} (of ! in runtime.unit) {.#Item it {.#End}} - (phase archive it) + (next archive it) _ (|> values - (monad.each ! (phase archive)) + (monad.each ! (next archive)) (of ! each runtime.tuple))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/primitive.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/primitive.lux index 302a38d57..6b45145c1 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/primitive.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/primitive.lux @@ -7,26 +7,33 @@ [meta [compiler [target - ["_" c++ (.only Literal Expression)]]]]]]) + ["_" c++]]]]]] + [// + ["[0]" runtime] + ["[0]" type]]) (def .public bit (-> Bit - Literal) - _.bool) + _.Expression) + (|>> _.bool + (runtime.simple type.bit))) (def .public i64 (-> (I64 Any) - Expression) + _.Expression) (|>> .int _.int - _.int64_t)) + _.int64_t + (runtime.simple type.i64))) (def .public f64 (-> Frac - Literal) - _.double) + _.Expression) + (|>> _.double + (runtime.simple type.f64))) (def .public text (-> Text - Literal) - _.u32_string) + _.Expression) + (|>> _.u32_string + (runtime.simple type.text))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/reference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/reference.lux new file mode 100644 index 000000000..b43340b91 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/reference.lux @@ -0,0 +1,66 @@ +... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. + +(.require + [library + [lux (.except local) + [abstract + [monad (.only do)]] + [control + ["|" pipe]] + [data + ["[0]" product] + [text + ["%" \\format]]] + [meta + [compiler + [target + ["_" c++]]]]]] + [// + ["/" runtime (.only Operation)] + [// + ["[0]" reference] + [/// + ["[0]" phase (.use "[1]#[0]" monad)] + ["[0]" translation] + [/// + [reference + ["[0]" variable (.only Register Variable)]] + [meta + [archive (.only Archive)]]]]]]) + +(with_template [ ] + [(def .public + (-> Register + /.Value) + (|>> %.nat + (%.format ) + _.local))] + + ["l" local] + ["f" foreign] + ["p" partial] + ) + +(def .public this + /.Value + (..local 0)) + +(def .public variable + (-> Variable + (Operation /.Value)) + (|>> (|.when + {variable.#Local it} + (..local it) + + {variable.#Foreign it} + (..foreign it)) + phase#in)) + +(def .public (constant archive it) + (-> Archive Symbol + (Operation /.Value)) + (phase#each (|>> product.left + reference.artifact + _.local) + (translation.definition archive it))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/runtime.lux index 461b0ead8..47719dab3 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/runtime.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Declaration Translation) + [lux (.except Declaration) [abstract ["[0]" monad (.only do)]] [data @@ -27,6 +27,7 @@ ["[1][0]" type]] [///// ["[0]" phase] + ["[0]" synthesis] ["[0]" translation] [/// [meta @@ -56,8 +57,8 @@ (type .public Host (translation.Host Value Declaration)) -(type .public (Translation of) - (-> Phase Archive of +(type .public (Term it) + (-> Phase Archive (it synthesis.Term) (Operation Value))) (def .public (host_value of it) @@ -122,7 +123,7 @@ (let [arity (_.int (.int (list.size values))) type (_.type (_.global [..namespace ] (list)))] (lux_value type - (_.new (_.structure type (list arity (_.new (_.array type arity values)))))))) + (_.new (_.structure type (list arity (_.new (_.array //type.value arity values)))))))) (def .public declaration _.Declaration diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/reference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/reference.lux index 214979718..582147ac9 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/reference.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/reference.lux @@ -21,51 +21,54 @@ ["[1][0]" runtime (.only Operation)] ["[1][0]" value] ["[1][0]" type] - ["//[1]" /// - [// - ["[0]" phase (.use "[1]#[0]" monad)] - ["[0]" translation] - [/// - [reference - ["[0]" variable (.only Register Variable)]] - [meta - [archive (.only Archive)]]]]]]) + [//// + ["[0]" phase (.use "[1]#[0]" monad)] + ["[0]" translation] + [/// + [reference + ["[0]" variable (.only Register Variable)]] + [meta + [archive (.only Archive)]]]]]) (def .public this (Bytecode Any) _.aload_0) -(with_template [ ] +(with_template [ ] [(def .public - (-> Register Text) + (-> Register + Text) (|>> %.nat (format )))] - [foreign_name "f"] - [partial_name "p"] + ["f" foreign_name] + ["p" partial_name] ) -(def (foreign archive variable) - (-> Archive Register (Operation (Bytecode Any))) +(def (foreign archive it) + (-> Archive Register + (Operation (Bytecode Any))) (do [! phase.monad] [bytecode_name (of ! each //runtime.class_name (translation.context archive))] (in (all _.composite ..this (_.getfield (type.class bytecode_name (list)) - (..foreign_name variable) + (..foreign_name it) //type.value))))) -(def .public (variable archive variable) - (-> Archive Variable (Operation (Bytecode Any))) - (when variable - {variable.#Local variable} - (phase#in (_.aload variable)) +(def .public (variable archive it) + (-> Archive Variable + (Operation (Bytecode Any))) + (when it + {variable.#Local it} + (phase#in (_.aload it)) - {variable.#Foreign variable} - (..foreign archive variable))) + {variable.#Foreign it} + (..foreign archive it))) (def .public (constant archive name) - (-> Archive Symbol (Operation (Bytecode Any))) + (-> Archive Symbol + (Operation (Bytecode Any))) (do phase.monad [[@definition |abstraction|] (translation.definition archive name) .let [:definition: (type.class (//runtime.class_name @definition) (list))]] diff --git a/stdlib/source/library/lux/world/finance/market/price.lux b/stdlib/source/library/lux/world/finance/market/price.lux index b669147a8..041ce59d7 100644 --- a/stdlib/source/library/lux/world/finance/market/price.lux +++ b/stdlib/source/library/lux/world/finance/market/price.lux @@ -123,17 +123,31 @@ [- i.-] ) + (def too_negative + (of i.interval bottom)) + (def .public (format it) (All (_ $) (%.Format (Action $))) - (let [[currency movement] (nominal.representation it) - [macro micro] (i./% (.int (currency.sub_divisions currency)) - movement)] - (%.format (%.int macro) - (when micro - +0 "" - _ (%.format "." (%.nat (.nat (i.abs micro))))) - " " (currency.alphabetic_code currency)))) + (when (..movement it) + ..too_negative + (|> ..too_negative + ++ + i.abs + .nat + ++ + (money.money (..currency it)) + money.format + (%.format "-")) + + amount + (let [-|+ (if (i.< +0 amount) + "-" + "+")] + (|> (.nat (i.abs amount)) + (money.money (..currency it)) + money.format + (%.format -|+))))) ) (with_template [ ] diff --git a/stdlib/source/library/lux/world/finance/money.lux b/stdlib/source/library/lux/world/finance/money.lux index 3d5903c8c..d53ccd80e 100644 --- a/stdlib/source/library/lux/world/finance/money.lux +++ b/stdlib/source/library/lux/world/finance/money.lux @@ -118,15 +118,34 @@ #amount (n.- (the #amount parameter) (the #amount subject))])}))) + (def (padded range it) + (-> Nat Nat + Text) + (let [range (%.nat (-- range)) + it (%.nat it) + + expected_digits (text.size range) + actual_digits (text.size it)] + (if (n.= expected_digits + actual_digits) + it + (loop (next [leading_zeroes (n.- actual_digits expected_digits) + it it]) + (when leading_zeroes + 0 it + _ (next (-- leading_zeroes) + (%.format "0" it))))))) + (def .public (format it) (All (_ currency) (%.Format (Money currency))) (let [[currency amount] (nominal.representation it) - [macro micro] (n./% (/.sub_divisions currency) amount)] + range (/.sub_divisions currency) + [macro micro] (n./% range amount)] (%.format (%.nat macro) (when micro 0 "" - _ (%.format "." (%.nat micro))) + _ (%.format "." (padded range micro))) " " (/.alphabetic_code currency)))) ) diff --git a/stdlib/source/test/lux/abstract/monad/indexed.lux b/stdlib/source/test/lux/abstract/monad/indexed.lux index 152dc50d6..e0e89297d 100644 --- a/stdlib/source/test/lux/abstract/monad/indexed.lux +++ b/stdlib/source/test/lux/abstract/monad/indexed.lux @@ -16,7 +16,8 @@ ["[0]" /]]) (type (Effect input output value) - (-> input [output value])) + (-> input + [output value])) (def monad (/.Monad Effect) @@ -39,7 +40,8 @@ right random.nat .let [expected (n.+ left right)]]) (all _.and - (_.coverage [/.do] + (_.coverage [/.do + /.in /.then] (let [it (is (Effect [] [] Nat) (/.do ..monad [left' (in left) diff --git a/stdlib/source/test/lux/control/function/predicate.lux b/stdlib/source/test/lux/control/function/predicate.lux index 4640ba8fa..3e3ff9653 100644 --- a/stdlib/source/test/lux/control/function/predicate.lux +++ b/stdlib/source/test/lux/control/function/predicate.lux @@ -69,10 +69,12 @@ (bit#= (/.none sample) ((/.and /.none /.all) sample))) (_.coverage [/.complement] - (and (not (bit#= (/.none sample) - ((/.complement /.none) sample))) - (not (bit#= (/.all sample) - ((/.complement /.all) sample))))) + (and (bit#= (not (/.none sample)) + ((/.complement /.none) sample)) + (bit#= (not (/.all sample)) + ((/.complement /.all) sample)))) + (_.coverage [/.not] + (alias? /.complement /.not)) (_.coverage [/.difference] (let [/2? (multiple? 2) /3? (multiple? 3)] diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase.lux index 1ccb40e7f..35e683c48 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/phase.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase.lux @@ -37,7 +37,8 @@ ["[1]/[0]" value] ["[1]/[0]" runtime] ["[1]/[0]" complex] - ["[1]/[0]" function]]]]) + ["[1]/[0]" function] + ["[1]/[0]" reference]]]]) (def (injection value) (All (_ of) @@ -228,4 +229,5 @@ /translation/jvm/runtime.test /translation/jvm/complex.test /translation/jvm/function.test + /translation/jvm/reference.test ))) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux index c8d1d3e75..a2bdb6ce2 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux @@ -8,7 +8,8 @@ [monad (.only do)]] [control ["[0]" io] - ["[0]" try]] + ["[0]" try (.use "[1]#[0]" functor)] + ["[0]" function]] [data ["[0]" bit (.use "[1]#[0]" equivalence)] [collection @@ -21,9 +22,6 @@ [meta ["[0]" location] [compiler - [language - [lux - ["[0]" synthesis]]] [meta ["[0]" archive]]]] [test @@ -37,6 +35,7 @@ ["[0]" extension] [// ["[0]" phase] + ["[0]" synthesis] ["[0]" translation]]]]]] [// ["[0]T" complex]]) @@ -55,9 +54,10 @@ (undefined))) phase (//.translate extender complexT.lux) @ [module 0 0] - $unit [0 0]] + $unit [(-- 0) (-- 0)]] - arity (of ! each (|>> (n.% 16) ++) random.nat)]) + arity (of ! each (|>> (n.% 16) (n.+ 2)) random.nat) + inner_arity (of ! each (|>> (n.% arity) (n.+ 1)) random.nat)]) (all _.and (_.coverage [/.abstraction] (|> (do try.monad @@ -69,34 +69,72 @@ (<| (phase.result state) (do phase.monad [_ (translation.set_buffer translation.empty_buffer) - _ runtime.translation it (/.abstraction phase archive [(list) 1 (synthesis.i64 @ expected_i64)])] - (in (when (of host evaluate $unit [{.#None} it]) - {try.#Success it} - (i64#= expected_i64 ((as (-> [] I64) it) [])) - - {try.#Failure error} - false))))) + (in (|> it + [{.#None}] + (of host evaluate $unit) + (try#each (|>> (as (-> [] I64)) + (function.on []) + (i64#= expected_i64))) + (try.else false)))))) (try.else false))) (_.coverage [/.apply] - (|> (do try.monad - [[_ archive] (archive.reserve "" archive.empty) - [_ archive] (archive.reserve module archive) - .let [[_ host] (io.run! host.host) - state (is runtime.State - (translation.state host module))]] - (<| (phase.result state) - (do phase.monad - [_ (translation.set_buffer translation.empty_buffer) - it (/.apply phase archive - [(synthesis.function/abstraction @ [(list) arity (synthesis.i64 @ expected_i64)]) - (list.repeated arity (synthesis.bit @ expected_bit))])] - (in (when (of host evaluate $unit [{.#None} it]) - {try.#Success actual_i64} - (i64#= expected_i64 (as I64 actual_i64)) - - {try.#Failure error} - false))))) - (try.else false))) + (let [exact_arity! + (|> (do try.monad + [[_ archive] (archive.reserve "" archive.empty) + [_ archive] (archive.reserve module archive) + .let [[_ host] (io.run! host.host) + state (is runtime.State + (translation.state host module))]] + (<| (phase.result state) + (do phase.monad + [_ (translation.set_buffer translation.empty_buffer) + it (/.apply phase archive + [(synthesis.function/abstraction @ [(list) arity (synthesis.i64 @ expected_i64)]) + (list.repeated arity (synthesis.bit @ expected_bit))])] + (in (|> it + [{.#None}] + (of host evaluate $unit) + (try#each (|>> (as I64) + (i64#= expected_i64))) + (try.else false)))))) + (try.else false)) + + multiple_applications! + (|> (do try.monad + [[_ archive] (archive.reserve "" archive.empty) + [_ archive] (archive.reserve module archive) + .let [[_ host] (io.run! host.host) + state (is runtime.State + (translation.state host module))]] + (<| (phase.result state) + (do phase.monad + [_ (translation.set_buffer translation.empty_buffer) + .let [outer_arity (n.- inner_arity arity) + + inner_abstraction (is synthesis.Term + (<| (synthesis.function/abstraction @) + [(list) inner_arity + (synthesis.i64 @ expected_i64)])) + outer_abstraction (is synthesis.Term + (<| (synthesis.function/abstraction @) + [(list) outer_arity + inner_abstraction])) + outer_application (is synthesis.Term + (<| (synthesis.function/apply @) + [outer_abstraction + (list.repeated outer_arity (synthesis.bit @ expected_bit))]))] + it (/.apply phase archive + [outer_application + (list.repeated inner_arity (synthesis.bit @ expected_bit))])] + (in (|> it + [{.#None}] + (of host evaluate $unit) + (try#each (|>> (as I64) + (i64#= expected_i64))) + (try.else false)))))) + (try.else false))] + (and exact_arity! + multiple_applications!))) ))) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/reference.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/reference.lux new file mode 100644 index 000000000..a8d780b3e --- /dev/null +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/reference.lux @@ -0,0 +1,87 @@ +... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. + +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["[0]" io] + ["[0]" try (.use "[1]#[0]" functor)]] + [data + [collection + ["[0]" list (.use "[1]#[0]" monoid)]]] + [math + ["[0]" random (.only Random)] + [number + ["[0]" i64 (.use "[1]#[0]" equivalence)] + ["n" nat]]] + [meta + ["[0]" location] + [compiler + [meta + ["[0]" archive]]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / (.only) + ["[0]" // (.only) + ["[0]" host] + ["[0]" runtime] + ["[0]" function] + [/// + ["[0]" extension] + [// + ["[0]" phase] + ["[0]" synthesis] + ["[0]" translation]]]]]] + [// + ["[0]T" complex]]) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [module (random.lower_cased 1) + + expected random.i64 + dummy (random.only (|>> (i64#= expected) not) random.i64) + + .let [extender (is extension.Extender + (function (_ _) + (undefined))) + next (//.translate extender complexT.lux) + @ [module 0 0] + $unit [(-- 0) (-- 0)]] + + before (of ! each (n.% 8) random.nat) + after (of ! each (n.% 8) random.nat) + .let [arity (++ (n.+ before after)) + local (++ before)]]) + (all _.and + (_.coverage [/.variable] + (|> (do try.monad + [[_ archive] (archive.reserve "" archive.empty) + [_ archive] (archive.reserve module archive) + .let [[_ host] (io.run! host.host) + state (is runtime.State + (translation.state host module))]] + (<| (phase.result state) + (do phase.monad + [_ (translation.set_buffer translation.empty_buffer) + it (next archive (<| (synthesis.function/apply @) + [(<| (synthesis.function/abstraction @) + [(list) arity (synthesis.variable/local @ local)]) + (all list#composite + (list.repeated before (synthesis.i64 @ dummy)) + (list (synthesis.i64 @ expected)) + (list.repeated after (synthesis.i64 @ dummy)))]))] + (in (|> it + [{.#None}] + (of host evaluate $unit) + (try#each (|>> (as I64) + (i64#= expected))) + (try.else false)))))) + (try.else false))) + ))) -- cgit v1.2.3