diff options
17 files changed, 411 insertions, 167 deletions
diff --git a/lux-c++/source/program.lux b/lux-c++/source/program.lux index 4d669f5d5..9f7721aed 100644 --- a/lux-c++/source/program.lux +++ b/lux-c++/source/program.lux @@ -51,17 +51,18 @@ [macro (.only Expander)]] ["[0]" phase (.only Operation Phase) ["[0]" extension (.only Extender Handler) - ["[0]" analysis - ["[1]" js]] - ["[0]" translation - ["[1]" js]]] + ... ["[0]" analysis + ... ["[1]" js]] + ... ["[0]" translation + ... ["[1]" js]] + ] [translation ["[0]" reference] - ["[0]" c++ (.only) - ["[0]" runtime] - ["[0]" type] - ["[0]" primitive] - ["[0]" complex]]]]]] + ["/" c++ (.only) + ["[1][0]" runtime] + ["[1][0]" type] + ["[1][0]" primitive] + ["[1][0]" reference]]]]]] [default ["[0]" platform (.only Platform)]] [meta @@ -95,7 +96,7 @@ ... (program [] ... (do io.monad ... [? (cppyy::cppdef [(_.code (all _.then -... runtime.declaration +... /runtime.declaration ... (_.include "iostream") ... (_.function (_.local <say_hello>) @@ -103,10 +104,10 @@ ... (list) ... :.void ... (all _.then -... (print (_.deref (runtime.host_value type.bit (runtime.simple type.bit (primitive.bit true))))) -... (print (_.deref (runtime.host_value type.i64 (runtime.simple type.i64 (primitive.i64 +123))))) -... (print (_.deref (runtime.host_value type.f64 (runtime.simple type.f64 (primitive.f64 -456.789))))) -... ... (print (_.deref (runtime.host_value type.text (runtime.simple type.text (primitive.text "YOLO"))))) +... (print (_.deref (/runtime.host_value /type.bit (/runtime.simple /type.bit (/primitive.bit true))))) +... (print (_.deref (/runtime.host_value /type.i64 (/runtime.simple /type.i64 (/primitive.i64 +123))))) +... (print (_.deref (/runtime.host_value /type.f64 (/runtime.simple /type.f64 (/primitive.f64 -456.789))))) +... ... (print (_.deref (/runtime.host_value /type.text (/runtime.simple /type.text (/primitive.text "YOLO"))))) ... ))))]) ... .let [_ (debug.log! (%.format "BEFORE " (%.bit ?)))] ... global (cppyy::gbl) @@ -119,22 +120,22 @@ (ffi.import (getattr [(ffi.Object Any) Text] Any)) (def host - (IO (Host runtime.Value runtime.Declaration)) + (IO (Host /runtime.Value /runtime.Declaration)) (io (let [\n\t (%.format text.\n text.\t) - evaluate! (is (-> unit.ID [(Maybe unit.ID) runtime.Value] (Try Any)) + evaluate! (is (-> unit.ID [(Maybe unit.ID) /runtime.Value] (Try Any)) (function (evaluate! context [_ input]) (let [global (reference.artifact context) - definition (_.constant (_.local global) type.value input)] + definition (_.constant (_.local global) /type.value input)] (if (io.run! (cppyy::cppdef (_.code definition))) {try.#Success (getattr (io.run! (cppyy::gbl)) global)} {try.#Failure "Cannot evaluate!"})))) - execute! (is (-> runtime.Declaration + execute! (is (-> /runtime.Declaration (Try Any)) (function (execute! input) (if (io.run! (cppyy::cppdef (_.code input))) {try.#Success []} {try.#Failure "Cannot execute!"})))] - (is (Host runtime.Value runtime.Declaration) + (is (Host /runtime.Value /runtime.Declaration) (implementation (def evaluate evaluate!) (def execute execute!) @@ -143,16 +144,16 @@ custom) @global (_.local global)] (do try.monad - [.let [definition (_.constant @global type.value input)] + [.let [definition (_.constant @global /type.value input)] _ (execute! definition) - value (evaluate! context [@def @global])] + .let [value (getattr (io.run! (cppyy::gbl)) global)]] (in [global value definition])))) (def (ingest context content) (|> content (of utf8.codec decoded) try.trusted - (as runtime.Declaration))) + (as /runtime.Declaration))) (def (re_learn context custom content) (execute! content)) @@ -162,21 +163,21 @@ [_ (execute! content)] (evaluate! context [{.#None} (_.local (reference.artifact context))])))))))) -(def (phase_wrapper _) +(def phase_wrapper phase.Wrapper - (undefined)) + (|>>)) (def .public platform - (IO [runtime.Host - (Platform runtime.Anchor runtime.Value runtime.Declaration)]) + (IO [/runtime.Host + (Platform /runtime.Anchor /runtime.Value /runtime.Declaration)]) (do io.monad [host ..host] (in [host [platform.#file_system (file.async file.default) platform.#host host - platform.#phase c++.translation - platform.#runtime runtime.translation + platform.#phase /.translation + platform.#runtime /runtime.translation platform.#phase_wrapper ..phase_wrapper platform.#write (|>> _.code (of utf8.codec encoded))]]))) @@ -185,22 +186,17 @@ Extender (undefined)) -(def reference_system - (reference.System runtime.Value) - (implementation - (def constant' _.local) - (def variable' _.local))) - (def (expander macro inputs lux) Expander (undefined)) (def (c++_program name it) - (Program runtime.Value runtime.Declaration) + (Program /runtime.Value /runtime.Declaration) (undefined)) (def (declare_success! _) - (-> Any (Async Any)) + (-> Any + (Async Any)) (async.future (of environment.default exit +0))) (def _ @@ -217,10 +213,10 @@ extension.empty extension.empty ..c++_program - (reference.constant reference_system) + /reference.constant ..extender service - [(packager.package (is runtime.Declaration (_.manual "")) + [(packager.package (is /runtime.Declaration (_.manual "")) _.code _.also (_.namespace "lux_program")) 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 [<identity_name> <identity_value> <composition_name> <composition>] +(with_template [<identity_value> <identity_name> <composition_name> <composition>] [(def .public <identity_name> Predicate (//.constant <identity_value>)) (def .public (<composition_name> left right) - (All (_ a) (-> (Predicate a) (Predicate a) (Predicate a))) + (All (_ of) + (-> (Predicate of) (Predicate of) + (Predicate of))) (function (_ value) (<composition> (left value) (right value))))] - [none #0 or .or] - [all #1 and .and] + [#0 none or .or] + [#1 all and .and] ) (with_template [<name> <identity> <composition>] [(def .public <name> - (All (_ a) (Monoid (Predicate a))) + (All (_ of) + (Monoid (Predicate of))) (implementation (def identity <identity>) (def composite <composition>)))] @@ -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 [<prefix> <name>] + [(def .public <name> + (-> Register + /.Value) + (|>> %.nat + (%.format <prefix>) + _.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 <tuple>] (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 [<name> <prefix>] +(with_template [<prefix> <name>] [(def .public <name> - (-> Register Text) + (-> Register + Text) (|>> %.nat (format <prefix>)))] - [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 [<order> <name>] 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))) + ))) |