From ab1829d77c7d12af344af68d6c50d391f1126640 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 5 Jan 2023 02:33:52 -0400 Subject: Compilation of simple literals in C++. --- .../source/library/lux/control/security/policy.lux | 12 ++- stdlib/source/library/lux/ffi.lux | 2 +- .../language/lux/phase/extension/analysis/lua.lux | 5 +- .../lux/phase/extension/translation/lua/common.lux | 5 +- .../lux/phase/extension/translation/lua/host.lux | 23 ++--- .../lux/phase/translation/c++/primitive.lux | 28 +++++ .../lux/phase/translation/jvm/primitive.lux | 30 ++++-- .../language/lux/phase/translation/lua.lux | 8 +- .../language/lux/phase/translation/lua/runtime.lux | 28 +++-- stdlib/source/library/lux/meta/target/c++.lux | 114 +++++++++++++++++++++ stdlib/source/library/lux/meta/target/lua.lux | 26 ++--- stdlib/source/specification/lux/world/console.lux | 60 ----------- .../source/specification/lux/world/environment.lux | 34 ------ stdlib/source/test/lux.lux | 1 - stdlib/source/test/lux/control/security/policy.lux | 5 +- stdlib/source/test/lux/meta.lux | 4 - .../test/lux/meta/compiler/language/lux/phase.lux | 4 +- .../language/lux/phase/translation/jvm/host.lux | 7 +- .../lux/phase/translation/jvm/primitive.lux | 51 +++++++++ stdlib/source/test/lux/meta/compiler/meta.lux | 6 +- stdlib/source/test/lux/world/console.lux | 56 ++++++++-- stdlib/source/test/lux/world/environment.lux | 27 +++-- stdlib/source/test/lux/world/finance/money.lux | 8 +- 23 files changed, 359 insertions(+), 185 deletions(-) create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/primitive.lux create mode 100644 stdlib/source/library/lux/meta/target/c++.lux delete mode 100644 stdlib/source/specification/lux/world/console.lux delete mode 100644 stdlib/source/specification/lux/world/environment.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux (limited to 'stdlib') diff --git a/stdlib/source/library/lux/control/security/policy.lux b/stdlib/source/library/lux/control/security/policy.lux index 517d60638..9d8059b01 100644 --- a/stdlib/source/library/lux/control/security/policy.lux +++ b/stdlib/source/library/lux/control/security/policy.lux @@ -13,10 +13,12 @@ value (type .public (Can_Upgrade brand label value) - (-> value (Policy brand value label))) + (-> value + (Policy brand value label))) (type .public (Can_Downgrade brand label value) - (-> (Policy brand value label) value)) + (-> (Policy brand value label) + value)) (type .public (Privilege brand label) (Record @@ -51,9 +53,11 @@ (context ..privilege)) (def (of_policy constructor) - (-> Type Type) + (-> Type + Type) (type_literal (All (_ brand label) - (constructor (All (_ value) (Policy brand value label)))))) + (constructor (All (_ value) + (Policy brand value label)))))) (def .public functor (, (..of_policy Functor)) diff --git a/stdlib/source/library/lux/ffi.lux b/stdlib/source/library/lux/ffi.lux index 0ad5a846f..261e555ba 100644 --- a/stdlib/source/library/lux/ffi.lux +++ b/stdlib/source/library/lux/ffi.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Symbol Alias Global Declaration global function type_of undefined) + [lux (.except Symbol Alias Global Declaration global function type_of undefined alias) [abstract ["[0]" monad (.only do)]] [control 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 06a60ef41..092ca0575 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 @@ -23,10 +23,9 @@ [/// ["[0]" extension] [// + ["[0]" phase] ["[0]" analysis (.only Analysis Operation Phase Handler Bundle) - ["[1]/[0]" type]] - [/// - ["[0]" phase]]]]]) + ["[1]/[0]" type]]]]]) (def Nil (for @.lua ffi.Nil diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/lua/common.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/lua/common.lux index 31f782b48..e9a458146 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/lua/common.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/lua/common.lux @@ -40,11 +40,10 @@ ["[1][0]" loop] ["[1][0]" function]]] [// + ["[0]" phase (.use "[1]#[0]" monad)] ["[0]" translation] ["[0]" synthesis (.only %synthesis) - ["?[1]" \\parser (.only Parser)]] - [/// - ["[0]" phase (.use "[1]#[0]" monad)]]]]) + ["?[1]" \\parser (.only Parser)]]]]) (def .public (custom [parser handler]) (All (_ s) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/lua/host.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/lua/host.lux index b69079a05..d27a45487 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/lua/host.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/lua/host.lux @@ -27,11 +27,10 @@ ["[1][0]" runtime (.only Operation Phase Handler Bundle with_vars)]]] ["/[1]" // + ["[0]" phase] ["[0]" translation] [synthesis - ["" \\parser (.only Parser)]] - ["//[1]" /// - ["[1][0]" phase]]]]]) + ["" \\parser (.only Parser)]]]]]) (def array::new (Unary Expression) @@ -67,7 +66,7 @@ (custom [(all <>.and .text .any) (function (_ phase archive [fieldS objectS]) - (do ////////phase.monad + (do phase.monad [objectG (phase archive objectS)] (in (_.the fieldS objectG))))])) @@ -76,7 +75,7 @@ (custom [(all <>.and .text .any (<>.some .any)) (function (_ phase archive [methodS objectS inputsS]) - (do [! ////////phase.monad] + (do [! phase.monad] [objectG (phase archive objectS) inputsG (monad.each ! (phase archive) inputsS)] (in (_.do methodS inputsG objectG))))])) @@ -103,7 +102,7 @@ (custom [.any (function (_ phase archive inputS) - (do [! ////////phase.monad] + (do [! phase.monad] [inputG (phase archive inputS)] (in (<| (_.apply (list inputG)) (_.closure (list $input)) @@ -115,7 +114,7 @@ (custom [.any (function (_ phase archive inputS) - (do [! ////////phase.monad] + (do [! phase.monad] [inputG (phase archive inputS)] (in (_.apply (list (_.apply (list inputG) (_.var "table.unpack"))) @@ -131,13 +130,13 @@ (custom [.text (function (_ phase archive name) - (of ////////phase.monad in (_.var name)))])) + (of phase.monad in (_.var name)))])) (def lua::apply (custom [(all <>.and .any (<>.some .any)) (function (_ phase archive [abstractionS inputsS]) - (do [! ////////phase.monad] + (do [! phase.monad] [abstractionG (phase archive abstractionS) inputsG (monad.each ! (phase archive) inputsS)] (in (_.apply inputsG abstractionG))))])) @@ -146,7 +145,7 @@ (custom [(all <>.and .any .any) (function (_ phase archive [powerS baseS]) - (do [! ////////phase.monad] + (do [! phase.monad] [powerG (phase archive powerS) baseG (phase archive baseS)] (in (_.^ powerG baseG))))])) @@ -155,14 +154,14 @@ (custom [.text (function (_ phase archive module) - (of ////////phase.monad in + (of phase.monad in (_.require/1 (_.string module))))])) (def lua::function (custom [(all <>.and .i64 .any) (function (_ phase archive [arity abstractionS]) - (do [! ////////phase.monad] + (do [! phase.monad] [abstractionG (phase archive abstractionS) .let [variable (is (-> Text (Operation Var)) (|>> translation.symbol 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 new file mode 100644 index 000000000..6deddbdd5 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/primitive.lux @@ -0,0 +1,28 @@ +(.require + [library + [lux (.except i64) + [meta + [target + ["_" c++ (.only Literal Expression)]]]]]) + +(def .public bit + (-> Bit + Literal) + _.bool) + +(def .public i64 + (-> (I64 Any) + Expression) + (|>> .int + _.int + _.int64_t)) + +(def .public f64 + (-> Frac + Literal) + _.double) + +(def .public text + (-> Text + Literal) + _.u32string) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux index 5c9677bb7..db64e3fa0 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux @@ -17,23 +17,23 @@ ["_" bytecode (.only Bytecode)] ["[0]" type] [encoding - ["[0]" signed]]]]]]] - ["[0]" // - ["[1][0]" runtime]]) + ["[0]" signed]]]]]]]) (def $Boolean (type.class "java.lang.Boolean" (list))) (def $Long (type.class "java.lang.Long" (list))) (def $Double (type.class "java.lang.Double" (list))) (def .public (bit value) - (-> Bit (Bytecode Any)) + (-> Bit + (Bytecode Any)) (_.getstatic $Boolean (if value "TRUE" "FALSE") $Boolean)) (def wrap_i64 (_.invokestatic $Long "valueOf" (type.method [(list) (list type.long) $Long (list)]))) (def .public (i64 value) - (-> (I64 Any) (Bytecode Any)) + (-> (I64 Any) + (Bytecode Any)) (when (.int value) (^.with_template [ ] [ @@ -83,14 +83,21 @@ (import java/lang/Double "[1]::[0]" - ("static" doubleToRawLongBits "manual" [double] int)) + ("static" doubleToRawLongBits [double] long)) + +(def double_bits + (-> Frac + Int) + (|>> java/lang/Double::doubleToRawLongBits + ffi.of_long)) (def d0_bits Int - (java/lang/Double::doubleToRawLongBits +0.0)) + (double_bits +0.0)) (def .public (f64 value) - (-> Frac (Bytecode Any)) + (-> Frac + (Bytecode Any)) (when value (^.with_template [ ] [ @@ -122,10 +129,11 @@ [+5.0 _.iconst_5]) _ - (let [constantI (if (i.= ..d0_bits - (java/lang/Double::doubleToRawLongBits (as java/lang/Double value))) + (let [constantI (if (|> value + ..double_bits + (i.= ..d0_bits)) _.dconst_0 - (_.double value))] + (_.double (as java/lang/Double value)))] (do _.monad [_ constantI] ..wrap_f64)))) 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 b39309d74..3f428775f 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 @@ -27,9 +27,9 @@ ["[1]/[0]" common]]]] ["/[1]" // [analysis (.only)] + ["[0]" phase (.use "[1]#[0]" monad)] ["[0]" synthesis] - ["//[1]" /// - ["[1][0]" phase (.use "[1]#[0]" monad)] + [/// [reference (.only) [variable (.only)]]]]]]]) @@ -41,7 +41,7 @@ (when synthesis (^.with_template [ ] [( @ value) - (//////phase#in ( value))]) + (phase#in ( value))]) ([synthesis.bit /primitive.bit] [synthesis.i64 /primitive.i64] [synthesis.f64 /primitive.f64] @@ -75,7 +75,7 @@ (/loop.scope ///extension/common.statement expression archive scope) (synthesis.loop/again @ updates) - (//////phase.except ..cannot_recur_as_an_expression []) + (phase.except ..cannot_recur_as_an_expression []) (synthesis.function/abstraction @ abstraction) (/function.function ///extension/common.statement expression archive abstraction) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux index 2ff224e3b..78741fe06 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux @@ -250,14 +250,26 @@ (runtime (lux//try risky) - (with_vars [success value] - (all _.then - (_.let (list success value) (|> risky (_.apply (list ..unit)) - _.return (_.closure (list)) - list _.apply (|> (_.var "pcall")))) - (_.if success - (_.return (..right value)) - (_.return (..left value)))))) + (let [closure (|> risky + (_.apply (list ..unit)) + _.return + (_.closure (list))) + $debug (_.var "debug") + $xpcall (_.var "xpcall")] + (with_vars [success value] + (_.if (_.and $debug $xpcall) + (all _.then + (_.let (list success value) (_.apply (list closure (_.the "traceback" $debug)) + $xpcall)) + (_.if success + (_.return (..right value)) + (_.return (..left value)))) + (all _.then + (_.let (list success value) (_.apply (list closure) + (_.var "pcall"))) + (_.if success + (_.return (..right value)) + (_.return (..left value)))))))) (runtime (lux//program_args raw) diff --git a/stdlib/source/library/lux/meta/target/c++.lux b/stdlib/source/library/lux/meta/target/c++.lux new file mode 100644 index 000000000..b8c2414f4 --- /dev/null +++ b/stdlib/source/library/lux/meta/target/c++.lux @@ -0,0 +1,114 @@ +(.require + [library + [lux (.except Code Type int) + [control + ["|" pipe]] + [data + ["[0]" text (.only) + ["%" \\format]] + [collection + ["[0]" list (.use "[1]#[0]" functor)]]] + [math + [number + ["f" frac]]] + [meta + [macro + ["[0]" template]] + [type + ["[0]" nominal]]]]]) + +(nominal.def .public (Code of) + Text + + (def .public code + (-> (Code Any) + Text) + (|>> nominal.representation)) + + (with_template [ +] + [(with_expansions [ (template.symbol [ "'"])] + (nominal.def ( of) + Any) + (`` (type .public + (|> Any (,, (template.spliced +))))))] + + [Type [Code]] + [Expression [Code]] + [Computation [Expression' Code]] + ) + + (with_template [ +] + [(with_expansions [ (template.symbol [ "'"])] + (nominal.def Any) + (`` (type .public (|> (,, (template.spliced +))))))] + + [Literal [Computation' Expression' Code]] + ) + + (def .public bool + (-> Bit + Literal) + (|>> (|.when + .false "false" + .true "true") + nominal.abstraction)) + + (def .public double + (-> Frac + Literal) + (|>> (|.cond [(f.= f.positive_infinity)] + [(|.new "(+1.0/0.0)" [])] + + [(f.= f.negative_infinity)] + [(|.new "(-1.0/0.0)" [])] + + [(f.= f.not_a_number)] + [(|.new "(0.0/0.0)" [])] + + ... else + [%.frac]) + nominal.abstraction)) + + (def .public (cast type term) + (-> Type Expression + Computation) + (nominal.abstraction + (%.format "(" (nominal.representation type) ")" + " " (nominal.representation term)))) + + (def .public int + (-> Int + Literal) + (|>> %.int + nominal.abstraction)) + + (def .public (on parameters function) + (-> (List Expression) Expression + Expression) + (nominal.abstraction + (%.format (nominal.representation function) + "(" + (|> parameters + (list#each (|>> nominal.representation)) + (text.interposed ", ")) + ")"))) + + ... https://en.cppreference.com/w/cpp/types/integer + (with_template [] + [(def .public ( it) + (-> Expression + Expression) + (..on (list it) + (nominal.abstraction (template.text []))))] + + [int64_t] + ) + + ... https://en.cppreference.com/w/cpp/string/basic_string + (def .public u32string + (-> Text + Literal) + (|>> %.text + (%.format "U") + nominal.abstraction)) + ) diff --git a/stdlib/source/library/lux/meta/target/lua.lux b/stdlib/source/library/lux/meta/target/lua.lux index 84a566839..bc5ead9aa 100644 --- a/stdlib/source/library/lux/meta/target/lua.lux +++ b/stdlib/source/library/lux/meta/target/lua.lux @@ -6,7 +6,7 @@ [hash (.only Hash)] ["[0]" enum]] [control - ["[0]" pipe]] + ["|" pipe]] [data ["[0]" text (.only) ["%" \\format (.only format)]] @@ -91,7 +91,7 @@ (def .public boolean (-> Bit Literal) - (|>> (pipe.when + (|>> (|.when #0 "false" #1 "true") abstraction)) @@ -108,17 +108,17 @@ (def .public float (-> Frac Literal) - (|>> (pipe.cond [(f.= f.positive_infinity)] - [(pipe.new "(1.0/0.0)" [])] - - [(f.= f.negative_infinity)] - [(pipe.new "(-1.0/0.0)" [])] - - [(f.= f.not_a_number)] - [(pipe.new "(0.0/0.0)" [])] - - ... else - [%.frac (text.replaced "+" "")]) + (|>> (|.cond [(f.= f.positive_infinity)] + [(|.new "(1.0/0.0)" [])] + + [(f.= f.negative_infinity)] + [(|.new "(-1.0/0.0)" [])] + + [(f.= f.not_a_number)] + [(|.new "(0.0/0.0)" [])] + + ... else + [%.frac (text.replaced "+" "")]) abstraction)) (def safe diff --git a/stdlib/source/specification/lux/world/console.lux b/stdlib/source/specification/lux/world/console.lux deleted file mode 100644 index c941d4da7..000000000 --- a/stdlib/source/specification/lux/world/console.lux +++ /dev/null @@ -1,60 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [monad (.only do)]] - [control - [io (.only IO)] - ["[0]" try] - [concurrency - ["[0]" async (.only Async)]]] - [data - ["[0]" text (.only) - ["%" \\format (.only format)]]] - [math - ["[0]" random]] - [test - ["_" property (.only Test)] - ["[0]" unit]]]] - [\\library - ["[0]" /]]) - -(def .public (spec console) - (-> (IO (/.Console Async)) Test) - (do random.monad - [message (random.alphabetic 10)] - (in (do async.monad - [console (async.future console) - ?write (of console write (format message text.new_line)) - ?read (of console read []) - ?read_line (of console read_line []) - ?close/good (of console close []) - ?close/bad (of console close []) - - .let [can_write! - (when ?write - {try.#Success _} - true - - _ - false) - - can_read! - (when [?read ?read_line] - [{try.#Success _} {try.#Success _}] - true - - _ - false) - - can_close! - (when [?close/good ?close/bad] - [{try.#Success _} {try.#Failure _}] - true - - _ - false)]] - (unit.coverage [/.Console] - (and can_write! - can_read! - can_close!)))))) diff --git a/stdlib/source/specification/lux/world/environment.lux b/stdlib/source/specification/lux/world/environment.lux deleted file mode 100644 index 1a586c554..000000000 --- a/stdlib/source/specification/lux/world/environment.lux +++ /dev/null @@ -1,34 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [monad (.only do)]] - [control - ["[0]" try] - [concurrency - ["[0]" async (.only Async)]]] - [data - ["[0]" text] - [collection - ["[0]" dictionary] - ["[0]" list]]] - [math - ["[0]" random]] - [test - ["_" property (.only Test)] - ["[0]" unit]]]] - [\\library - ["[0]" /]]) - -(def .public (spec subject) - (-> (/.Environment Async) Test) - (do random.monad - [exit random.int] - (in (do [! async.monad] - [environment (/.environment ! subject)] - (unit.coverage [/.Environment] - (and (not (dictionary.empty? environment)) - (list.every? (|>> text.empty? not) - (dictionary.keys environment)) - (not (text.empty? (of subject home))) - (not (text.empty? (of subject directory))))))))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index bda6c17fc..be6350aa8 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -6,7 +6,6 @@ [monad (.only do)]] [control ["[0]" io] - ["[0]" try] ["[0]" maybe (.use "[1]#[0]" functor)] [concurrency ["[0]" atom (.only Atom)]]] diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux index 59f6968e3..0919d422a 100644 --- a/stdlib/source/test/lux/control/security/policy.lux +++ b/stdlib/source/test/lux/control/security/policy.lux @@ -92,7 +92,10 @@ (_.for [/.monad] (monadT.spec (..injection (of policy_0 #can_upgrade)) (..comparison (of policy_0 #can_downgrade)) /.monad)))) - (_.coverage [/.Privilege /.Context /.with_policy] + (_.coverage [/.Privilege + /.#can_upgrade /.#can_downgrade + + /.Context /.with_policy] (and (of policy_0 = password password) (n.= (of text.hash hash raw_password) (of policy_0 hash password)))) diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index 477d1e31e..1043b77c2 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -57,8 +57,6 @@ ["[1][0]" compiler ... ["[1]/[0]" phase] ... ["[1]/[0]" meta - ... ["[1]/[0]" cli] - ... ["[1]/[0]" export] ... ["[1]/[0]" import] ... ["[1]/[0]" context] ... ["[1]/[0]" cache]] @@ -1067,8 +1065,6 @@ /global.test /compiler.test - ... /compiler/meta/cli.test - ... /compiler/meta/export.test ... /compiler/meta/import.test ... /compiler/meta/context.test ... /compiler/meta/cache.test 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 c0ceabbd7..ce1def236 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/phase.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase.lux @@ -28,7 +28,8 @@ ["[0]" / ["[1][0]" translation ["[1]/[0]" jvm - ["[1]/[0]" host]]]]) + ["[1]/[0]" host] + ["[1]/[0]" primitive]]]]) (def (injection value) (All (_ of) @@ -213,4 +214,5 @@ ..test|phase) /translation/jvm/host.test + /translation/jvm/primitive.test ))) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/host.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/host.lux index c311d107a..698a6d326 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/host.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/host.lux @@ -14,8 +14,7 @@ [meta [target [jvm - ["[0]" bytecode] - ["[0]" type]]]] + ["[0]" bytecode]]]] [test ["_" property (.only Test)]]]] [\\library @@ -25,9 +24,7 @@ Test (<| (_.covering /._) (do [! random.monad] - [$module random.nat - $artifact random.nat - .let [$unit [$module $artifact]] + [.let [$unit [0 0]] expected (random.upper_cased 1)]) (all _.and (_.coverage [/.host] diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux new file mode 100644 index 000000000..de32bc4a0 --- /dev/null +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux @@ -0,0 +1,51 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["[0]" io] + ["[0]" try]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)] + ["[0]" text (.use "[1]#[0]" equivalence)]] + [math + ["[0]" random (.only Random)] + [number + ["[0]" int (.use "[1]#[0]" equivalence)] + ["[0]" frac (.use "[1]#[0]" equivalence)]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / (.only) + [// + ["[0]" host]]]]) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [expected_bit random.bit + expected_i64 random.i64 + expected_f64 random.frac + expected_text (random.lower_cased 1) + + .let [$unit [0 0]]]) + (`` (all _.and + (,, (with_template [ <=>] + [(_.coverage [] + (io.run! (do io.monad + [[class_loader host] host.host] + (in (when (of host evaluate $unit [{.#None} ( )]) + {try.#Success actual} + (<=> (as actual)) + + {try.#Failure error} + false)))))] + + [/.bit expected_bit Bit bit#=] + [/.i64 expected_i64 Int int#=] + [/.f64 expected_f64 Frac frac#=] + [/.text expected_text Text text#=] + )) + )))) diff --git a/stdlib/source/test/lux/meta/compiler/meta.lux b/stdlib/source/test/lux/meta/compiler/meta.lux index c2d1ac5c6..e127adcbc 100644 --- a/stdlib/source/test/lux/meta/compiler/meta.lux +++ b/stdlib/source/test/lux/meta/compiler/meta.lux @@ -15,7 +15,9 @@ ["[0]" /]] ["[0]" / ["[1][0]" io] - ["[1][0]" archive]]) + ["[1][0]" archive] + ["[1][0]" cli] + ["[1][0]" export]]) (def .public test Test @@ -29,4 +31,6 @@ /io.test /archive.test + /cli.test + /export.test ))) diff --git a/stdlib/source/test/lux/world/console.lux b/stdlib/source/test/lux/world/console.lux index 7d933d926..4e26b107c 100644 --- a/stdlib/source/test/lux/world/console.lux +++ b/stdlib/source/test/lux/world/console.lux @@ -4,20 +4,62 @@ [abstract [monad (.only do)]] [control - ["[0]" io] + ["[0]" io (.only IO)] ["[0]" try (.only Try)] - ["[0]" exception]] + ["[0]" exception] + [concurrency + ["[0]" async (.only Async)]]] [data ["[0]" text (.use "[1]#[0]" equivalence) ["%" \\format (.only format)]]] [math ["[0]" random]] [test - ["_" property (.only Test)]]]] + ["_" property (.only Test)] + ["[0]" unit]]]] [\\library - ["[0]" /]] - [\\specification - ["$[0]" /]]) + ["[0]" /]]) + +(def .public (spec console) + (-> (IO (/.Console Async)) + Test) + (do random.monad + [message (random.alphabetic 10)] + (in (do async.monad + [console (async.future console) + ?write (of console write (format message text.new_line)) + ?read (of console read []) + ?read_line (of console read_line []) + ?close/good (of console close []) + ?close/bad (of console close []) + + .let [can_write! + (when ?write + {try.#Success _} + true + + _ + false) + + can_read! + (when [?read ?read_line] + [{try.#Success _} {try.#Success _}] + true + + _ + false) + + can_close! + (when [?close/good ?close/bad] + [{try.#Success _} {try.#Failure _}] + true + + _ + false)]] + (unit.coverage [/.Console] + (and can_write! + can_read! + can_close!)))))) (exception.def dead) @@ -54,7 +96,7 @@ (<| (_.covering /._) (all _.and (_.for [/.async /.mock /.Mock] - ($/.spec (io.io (/.async (/.mock ..mock [false ""]))))) + (..spec (io.io (/.async (/.mock ..mock [false ""]))))) (do random.monad [expected (random.alphabetic 10) .let [console (/.mock ..mock [false ""])]] diff --git a/stdlib/source/test/lux/world/environment.lux b/stdlib/source/test/lux/world/environment.lux index 8c2484e7b..c6b2e95e2 100644 --- a/stdlib/source/test/lux/world/environment.lux +++ b/stdlib/source/test/lux/world/environment.lux @@ -9,7 +9,9 @@ ["[0]" io] ["[0]" maybe (.use "[1]#[0]" functor)] ["[0]" try] - ["[0]" exception]] + ["[0]" exception] + [concurrency + ["[0]" async (.only Async)]]] [data ["[0]" text (.use "[1]#[0]" equivalence)] [collection @@ -20,14 +22,27 @@ [number ["n" nat]]] [test - ["_" property (.only Test)]]]] + ["_" property (.only Test)] + ["[0]" unit]]]] ["[0]" \\parser (.only Environment)] [\\library ["[0]" / (.only) [// - [file (.only Path)]]]] - [\\specification - ["$[0]" /]]) + [file (.only Path)]]]]) + +(def .public (spec subject) + (-> (/.Environment Async) + Test) + (do random.monad + [exit random.int] + (in (do [! async.monad] + [environment (/.environment ! subject)] + (unit.coverage [/.Environment] + (and (not (dictionary.empty? environment)) + (list.every? (|>> text.empty? not) + (dictionary.keys environment)) + (not (text.empty? (of subject home))) + (not (text.empty? (of subject directory))))))))) (def \\parser Test @@ -84,7 +99,7 @@ unknown (random.alphabetic 1)] (all _.and (_.for [/.mock /.async] - ($/.spec (/.async (/.mock environment home directory)))) + (..spec (/.async (/.mock environment home directory)))) (_.coverage [/.environment] (let [it (/.mock environment home directory)] (io.run! diff --git a/stdlib/source/test/lux/world/finance/money.lux b/stdlib/source/test/lux/world/finance/money.lux index 872414dbf..cc798afdd 100644 --- a/stdlib/source/test/lux/world/finance/money.lux +++ b/stdlib/source/test/lux/world/finance/money.lux @@ -90,12 +90,8 @@ (bit#= (/.<= expected_parameter expected_subject) (/.>= expected_subject expected_parameter))) )) - (_.coverage [/.units /.sub_units] - (let [expected (/.money currency.usd expected_amount) - actual (/.money currency.usd (n.+ (/.units expected) - (/.sub_units expected)))] - (/.= expected actual))) - (_.coverage [/.of_units /.of_sub_units] + (_.coverage [/.units /.sub_units + /.of_units /.of_sub_units] (let [expected (/.money currency.usd expected_amount) actual (/.+ (/.of_units currency.usd (/.units expected)) (/.of_sub_units currency.usd (/.sub_units expected)))] -- cgit v1.2.3