From 09a29c952edb851e13edd454bd118c1c1ae83ade Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 25 Nov 2022 01:26:00 -0400 Subject: Added support for saturation arithmetic. --- stdlib/source/library/lux/data/text.lux | 4 +- .../source/library/lux/data/text/encoding/utf8.lux | 4 +- stdlib/source/library/lux/debug.lux | 16 +- stdlib/source/library/lux/ffi.lux | 18 +- stdlib/source/library/lux/ffi/export.lua.lux | 35 ++- .../library/lux/math/arithmetic/saturation.lux | 26 +++ stdlib/source/library/lux/math/number/frac.lux | 4 +- .../language/lux/phase/extension/analysis/lua.lux | 189 +++++++++------- .../lux/phase/extension/translation/lua/common.lux | 249 +++++++++++---------- .../lux/phase/extension/translation/lua/host.lux | 119 +++++----- .../language/lux/phase/translation/lua.lux | 79 ++++--- .../lux/phase/translation/lua/function.lux | 2 +- .../language/lux/phase/translation/lua/loop.lux | 2 +- .../lux/phase/translation/lua/structure.lux | 2 +- .../language/lux/phase/translation/lua/when.lux | 2 +- .../language/lux/phase/translation/reference.lux | 2 +- stdlib/source/library/lux/world/time/instant.lux | 2 +- .../source/specification/lux/abstract/functor.lux | 80 ++++--- stdlib/source/test/lux/debug.lux | 7 +- stdlib/source/test/lux/math.lux | 5 +- .../source/test/lux/math/arithmetic/saturation.lux | 51 +++++ stdlib/source/unsafe/lux/data/collection/array.lux | 12 +- 22 files changed, 510 insertions(+), 400 deletions(-) create mode 100644 stdlib/source/library/lux/math/arithmetic/saturation.lux create mode 100644 stdlib/source/test/lux/math/arithmetic/saturation.lux (limited to 'stdlib/source') diff --git a/stdlib/source/library/lux/data/text.lux b/stdlib/source/library/lux/data/text.lux index 6222ada19..c0273bf85 100644 --- a/stdlib/source/library/lux/data/text.lux +++ b/stdlib/source/library/lux/data/text.lux @@ -371,7 +371,7 @@ (.python_object_do# "lower" value [])) @.lua (as Text - ("lua apply" ("lua constant" "string.lower") [value])) + (.lua_apply# (.lua_constant# "string.lower") [value])) @.ruby (as Text ("ruby object do" "downcase" value [])))) @@ -394,7 +394,7 @@ (.python_object_do# "upper" value [])) @.lua (as Text - ("lua apply" ("lua constant" "string.upper") [value])) + (.lua_apply# (.lua_constant# "string.upper") [value])) @.ruby (as Text ("ruby object do" "upcase" value [])))) diff --git a/stdlib/source/library/lux/data/text/encoding/utf8.lux b/stdlib/source/library/lux/data/text/encoding/utf8.lux index cc5dcacd3..c6b8d80a5 100644 --- a/stdlib/source/library/lux/data/text/encoding/utf8.lux +++ b/stdlib/source/library/lux/data/text/encoding/utf8.lux @@ -93,7 +93,7 @@ (as Binary (.python_apply# (as_expected (.python_constant# "bytearray")) [value "utf-8"])) @.lua - ("lua utf8 encode" value) + (.lua_utf8_encoded# value) @.ruby (|> value @@ -136,7 +136,7 @@ (try (as Text (.python_object_do# "decode" (as_expected value) ["utf-8"]))) @.lua - {try.#Success ("lua utf8 decode" value)} + {try.#Success (.lua_utf8_decoded# value)} @.ruby (|> value diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux index 8be252760..25b040c90 100644 --- a/stdlib/source/library/lux/debug.lux +++ b/stdlib/source/library/lux/debug.lux @@ -127,8 +127,8 @@ (-> (array.Array Any) (array.Array Any)) (array.of_list (loop (again [idx 0]) - (let [member ("lua array read" idx tuple)] - (if ("lua object nil?" member) + (let [member (.lua_array_read# idx tuple)] + (if (.lua_object_nil?# member) {.#End} {.#Item member (again (++ idx))}))))) (these)) @@ -268,14 +268,14 @@ (..tostring value)) "table" - (let [variant_tag ("lua object get" "_lux_tag" value) - variant_flag ("lua object get" "_lux_flag" value) - variant_value ("lua object get" "_lux_value" value)] - (if (or ("lua object nil?" variant_tag) - ("lua object nil?" variant_value)) + (let [variant_tag (.lua_object_get# "_lux_tag" value) + variant_flag (.lua_object_get# "_lux_flag" value) + variant_value (.lua_object_get# "_lux_value" value)] + (if (or (.lua_object_nil?# variant_tag) + (.lua_object_nil?# variant_value)) (tuple_inspection inspection value) (|> (%.format (|> variant_tag (as .Nat) %.nat) - " " (%.bit (not ("lua object nil?" variant_flag))) + " " (%.bit (not (.lua_object_nil?# variant_flag))) " " (inspection variant_value)) (text.enclosed ["{" "}"])))) diff --git a/stdlib/source/library/lux/ffi.lux b/stdlib/source/library/lux/ffi.lux index fee15e46d..fb5270605 100644 --- a/stdlib/source/library/lux/ffi.lux +++ b/stdlib/source/library/lux/ffi.lux @@ -188,34 +188,34 @@ (with_expansions [ (for @.js "js constant" @.python .python_constant# - @.lua "lua constant" + @.lua .lua_constant# @.ruby "ruby constant") (for @.js "js apply" @.python .python_apply# - @.lua "lua apply" + @.lua .lua_apply# @.ruby "ruby apply") (for @.js "js object new" @.python .python_apply# (these)) (for @.js "js object do" @.python .python_object_do# - @.lua "lua object do" + @.lua .lua_object_do# @.ruby "ruby object do") (for @.js "js object get" @.python .python_object_get# - @.lua "lua object get" + @.lua .lua_object_get# @.ruby "ruby object get" (these)) - (for @.lua "lua object set" + (for @.lua .lua_object_set# @.ruby "ruby object set" (these)) (for @.python .python_import# - @.lua "lua import" + @.lua .lua_import# @.ruby "ruby import" (these)) (for @.js "js function" @.python .python_function# - @.lua "lua function" + @.lua .lua_function# (these))] (nominal.def .public (Object brand) Any) @@ -464,8 +464,8 @@ null? "js object null?"] @.python [none .python_object_none# none? .python_object_none?#] - @.lua [nil "lua object nil" - nil? "lua object nil?"] + @.lua [nil .lua_object_nil# + nil? .lua_object_nil?#] @.ruby [nil "ruby object nil" nil? "ruby object nil?"])) )) diff --git a/stdlib/source/library/lux/ffi/export.lua.lux b/stdlib/source/library/lux/ffi/export.lua.lux index 64a94c874..54aa573b6 100644 --- a/stdlib/source/library/lux/ffi/export.lua.lux +++ b/stdlib/source/library/lux/ffi/export.lua.lux @@ -15,7 +15,6 @@ ["[0]" random]] ["[0]" meta (.only) [extension (.only declaration)] - ["[0]" static] ["[0]" code (.only) ["<[1]>" \\parser]] [macro @@ -51,19 +50,19 @@ ... [15.3 – Packages and Files](https://www.lua.org/pil/15.3.html) ... [15.4 – Using the Global Table](https://www.lua.org/pil/15.4.html) -(with_expansions [ (static.random (|>> %.nat (%.format "lua export ") code.text) - random.nat)] - (declaration ( self phase archive [name .text - term .any]) +(def .public export_one + (declaration (_ phase archive [name .text + term .any]) (do [! phase.monad] [next declaration.analysis [_ term] (<| declaration.of_analysis type.inferring (next archive term)) + lux (declaration.of_analysis meta.compiler_state) next declaration.synthesis term (declaration.of_synthesis - (next archive term)) + (next lux archive term)) dependencies (declaration.of_translation (dependency.dependencies archive term)) @@ -71,7 +70,7 @@ next declaration.translation [interim_artifacts term] (declaration.of_translation (translation.with_interim_artifacts archive - (next archive term))) + (next lux archive term))) _ (declaration.of_translation (do ! @@ -99,15 +98,15 @@ (/.local/1 (/.var name) term) export!))] (translation.log! (%.format "Export " (%.text name)))))] - (in declaration.no_requirements))) + (in declaration.no_requirements)))) - (def .public export - (syntax (_ [exports (<>.many .any)]) - (let [! meta.monad] - (|> exports - (monad.each ! expansion.complete) - (at ! each (|>> list#conjoint - (monad.each ! ..definition))) - (at ! conjoint) - (at ! each (list#each (function (_ [name term]) - (` ( (, (code.text name)) (, term))))))))))) +(def .public export + (syntax (_ [exports (<>.many .any)]) + (let [! meta.monad] + (|> exports + (monad.each ! expansion.complete) + (at ! each (|>> list#conjoint + (monad.each ! ..definition))) + (at ! conjoint) + (at ! each (list#each (function (_ [name term]) + (` (export_one (, (code.text name)) (, term)))))))))) diff --git a/stdlib/source/library/lux/math/arithmetic/saturation.lux b/stdlib/source/library/lux/math/arithmetic/saturation.lux new file mode 100644 index 000000000..dc1f2d380 --- /dev/null +++ b/stdlib/source/library/lux/math/arithmetic/saturation.lux @@ -0,0 +1,26 @@ +(.require + [library + [lux (.except) + [abstract + ["[0]" order (.only Order)]]]] + [// (.only Arithmetic)]) + +(def .public (arithmetic order [left right] it) + (All (_ of) + (-> (Order of) [of of] (Arithmetic of) + (Arithmetic of))) + (let [min (order.min order left right) + max (order.max order left right)] + (`` (implementation + (,, (with_template [] + [(def ( left right) + (|> (at it left right) + (order.max order min) + (order.min order max)))] + + [+] + [-] + [*] + [/] + [%] + )))))) diff --git a/stdlib/source/library/lux/math/number/frac.lux b/stdlib/source/library/lux/math/number/frac.lux index 481b37e96..d3ec7c660 100644 --- a/stdlib/source/library/lux/math/number/frac.lux +++ b/stdlib/source/library/lux/math/number/frac.lux @@ -194,7 +194,7 @@ (-> Frac Frac) (|>> [] - ("lua apply" ("lua constant" )) + (.lua_apply# (.lua_constant# )) (as Frac)))] [cos "math.cos"] @@ -217,7 +217,7 @@ (def .public (pow param subject) (-> Frac Frac Frac) - ("lua power" param subject)) + (.lua_power# param subject)) (def .public (root_3 it) (-> Frac 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 df55ed895..06a60ef41 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 @@ -11,7 +11,7 @@ ["[0]" array] ["[0]" dictionary] ["[0]" list]]] - [meta + ["[0]" meta (.only) ["@" target (.only) ["_" lua]] ["[0]" code @@ -20,9 +20,9 @@ ["[0]" check]]]]] [// ["/" lux (.only custom)] - [// - ["[0]" bundle] - [/// + [/// + ["[0]" extension] + [// ["[0]" analysis (.only Analysis Operation Phase Handler Bundle) ["[1]/[0]" type]] [/// @@ -41,7 +41,7 @@ Any)) (def array::new - Handler + (-> Text Handler) (custom [.any (function (_ extension phase archive lengthC) @@ -52,11 +52,13 @@ (do phase.monad [lengthA (analysis/type.expecting Nat (phase archive lengthC)) - _ (analysis/type.inference (type_literal (array.Array' :read: :write:)))] - (in {analysis.#Extension extension (list lengthA)}))))])) + _ (analysis/type.inference (type_literal (array.Array' :read: :write:))) + @ meta.location] + (in [@ {analysis.#Extension (/.translation extension) + (list lengthA)}]))))])) (def array::length - Handler + (-> Text Handler) (custom [.any (function (_ extension phase archive arrayC) @@ -67,11 +69,13 @@ (do phase.monad [arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) (phase archive arrayC)) - _ (analysis/type.inference Nat)] - (in {analysis.#Extension extension (list arrayA)}))))])) + _ (analysis/type.inference Nat) + @ meta.location] + (in [@ {analysis.#Extension (/.translation extension) + (list arrayA)}]))))])) (def array::read - Handler + (-> Text Handler) (custom [(<>.and .any .any) (function (_ extension phase archive [indexC arrayC]) @@ -84,11 +88,13 @@ (phase archive indexC)) arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) (phase archive arrayC)) - _ (analysis/type.inference :read:)] - (in {analysis.#Extension extension (list indexA arrayA)}))))])) + _ (analysis/type.inference :read:) + @ meta.location] + (in [@ {analysis.#Extension (/.translation extension) + (list indexA arrayA)}]))))])) (def array::write - Handler + (-> Text Handler) (custom [(all <>.and .any .any .any) (function (_ extension phase archive [indexC valueC arrayC]) @@ -103,11 +109,13 @@ (phase archive valueC)) arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) (phase archive arrayC)) - _ (analysis/type.inference (type_literal (array.Array' :read: :write:)))] - (in {analysis.#Extension extension (list indexA valueA arrayA)}))))])) + _ (analysis/type.inference (type_literal (array.Array' :read: :write:))) + @ meta.location] + (in [@ {analysis.#Extension (/.translation extension) + (list indexA valueA arrayA)}]))))])) (def array::delete - Handler + (-> Text Handler) (custom [(all <>.and .any .any) (function (_ extension phase archive [indexC arrayC]) @@ -120,34 +128,36 @@ (phase archive indexC)) arrayA (analysis/type.expecting (type_literal (array.Array' :read: :write:)) (phase archive arrayC)) - _ (analysis/type.inference (type_literal (array.Array' :read: :write:)))] - (in {analysis.#Extension extension (list indexA arrayA)}))))])) + _ (analysis/type.inference (type_literal (array.Array' :read: :write:))) + @ meta.location] + (in [@ {analysis.#Extension (/.translation extension) + (list indexA arrayA)}]))))])) -(def bundle::array - Bundle - (<| (bundle.prefix "array") - (|> bundle.empty - (bundle.install "new" array::new) - (bundle.install "length" array::length) - (bundle.install "read" array::read) - (bundle.install "write" array::write) - (bundle.install "delete" array::delete) - ))) +(def with_array_extensions + (-> Bundle Bundle) + (|>> (/.install "lua_array_new#" array::new) + (/.install "lua_array_length#" array::length) + (/.install "lua_array_read#" array::read) + (/.install "lua_array_write#" array::write) + (/.install "lua_array_delete#" array::delete) + )) (def object::get - Handler + (-> Text Handler) (custom [(all <>.and .text .any) (function (_ extension phase archive [fieldC objectC]) (do phase.monad [objectA (analysis/type.expecting ..Object (phase archive objectC)) - _ (analysis/type.inference .Any)] - (in {analysis.#Extension extension (list (analysis.text fieldC) - objectA)})))])) + _ (analysis/type.inference .Any) + @ meta.location] + (in [@ {analysis.#Extension (/.translation extension) + (list (analysis.text @ fieldC) + objectA)}])))])) (def object::do - Handler + (-> Text Handler) (custom [(all <>.and .text .any (.tuple (<>.some .any))) (function (_ extension phase archive [methodC objectC inputsC]) @@ -155,56 +165,58 @@ [objectA (analysis/type.expecting ..Object (phase archive objectC)) inputsA (monad.each ! (|>> (phase archive) (analysis/type.expecting Any)) inputsC) - _ (analysis/type.inference .Any)] - (in {analysis.#Extension extension (list.partial (analysis.text methodC) - objectA - inputsA)})))])) + _ (analysis/type.inference .Any) + @ meta.location] + (in [@ {analysis.#Extension (/.translation extension) + (list.partial (analysis.text @ methodC) + objectA + inputsA)}])))])) -(def bundle::object - Bundle - (<| (bundle.prefix "object") - (|> bundle.empty - (bundle.install "get" object::get) - (bundle.install "do" object::do) - (bundle.install "nil" (/.nullary ..Nil)) - (bundle.install "nil?" (/.unary Any Bit)) - ))) +(def with_object_extensions + (-> Bundle Bundle) + (|>> (/.install "lua_object_get#" object::get) + (/.install "lua_object_do#" object::do) + (/.install "lua_object_nil#" (/.nullary ..Nil)) + (/.install "lua_object_nil?#" (/.unary Any Bit)) + )) (with_template [ ] [(def - Handler + (-> Text Handler) (custom [.any (function (_ extension phase archive inputC) (do [! phase.monad] [inputA (analysis/type.expecting (type_literal ) (phase archive inputC)) - _ (analysis/type.inference (type_literal ))] - (in {analysis.#Extension extension (list inputA)})))]))] + _ (analysis/type.inference (type_literal )) + @ meta.location] + (in [@ {analysis.#Extension (/.translation extension) + (list inputA)}])))]))] [utf8::encode Text (array.Array (I64 Any))] [utf8::decode (array.Array (I64 Any)) Text] ) -(def bundle::utf8 - Bundle - (<| (bundle.prefix "utf8") - (|> bundle.empty - (bundle.install "encode" utf8::encode) - (bundle.install "decode" utf8::decode) - ))) +(def with_utf8_extensions + (-> Bundle Bundle) + (|>> (/.install "lua_utf8_encoded#" utf8::encode) + (/.install "lua_utf8_decoded#" utf8::decode) + )) (def lua::constant - Handler + (-> Text Handler) (custom [.text (function (_ extension phase archive name) (do phase.monad - [_ (analysis/type.inference Any)] - (in {analysis.#Extension extension (list (analysis.text name))})))])) + [_ (analysis/type.inference Any) + @ meta.location] + (in [@ {analysis.#Extension (/.translation extension) + (list (analysis.text @ name))}])))])) (def lua::apply - Handler + (-> Text Handler) (custom [(all <>.and .any (.tuple (<>.some .any))) (function (_ extension phase archive [abstractionC inputsC]) @@ -212,11 +224,13 @@ [abstractionA (analysis/type.expecting ..Function (phase archive abstractionC)) inputsA (monad.each ! (|>> (phase archive) (analysis/type.expecting Any)) inputsC) - _ (analysis/type.inference Any)] - (in {analysis.#Extension extension (list.partial abstractionA inputsA)})))])) + _ (analysis/type.inference Any) + @ meta.location] + (in [@ {analysis.#Extension (/.translation extension) + (list.partial abstractionA inputsA)}])))])) (def lua::power - Handler + (-> Text Handler) (custom [(all <>.and .any .any) (function (_ extension phase archive [powerC baseC]) @@ -225,20 +239,24 @@ (phase archive powerC)) baseA (analysis/type.expecting Frac (phase archive baseC)) - _ (analysis/type.inference Frac)] - (in {analysis.#Extension extension (list powerA baseA)})))])) + _ (analysis/type.inference Frac) + @ meta.location] + (in [@ {analysis.#Extension (/.translation extension) + (list powerA baseA)}])))])) (def lua::import - Handler + (-> Text Handler) (custom [.text (function (_ extension phase archive name) (do phase.monad - [_ (analysis/type.inference ..Object)] - (in {analysis.#Extension extension (list (analysis.text name))})))])) + [_ (analysis/type.inference ..Object) + @ meta.location] + (in [@ {analysis.#Extension (/.translation extension) + (list (analysis.text @ name))}])))])) (def lua::function - Handler + (-> Text Handler) (custom [(all <>.and .nat .any) (function (_ extension phase archive [arity abstractionC]) @@ -246,22 +264,23 @@ [.let [inputT (type.tuple (list.repeated arity Any))] abstractionA (analysis/type.expecting (-> inputT Any) (phase archive abstractionC)) - _ (analysis/type.inference ..Function)] - (in {analysis.#Extension extension (list (analysis.nat arity) - abstractionA)})))])) + _ (analysis/type.inference ..Function) + @ meta.location] + (in [@ {analysis.#Extension (/.translation extension) + (list (analysis.nat @ arity) + abstractionA)}])))])) (def .public bundle Bundle - (<| (bundle.prefix "lua") - (|> bundle.empty - (dictionary.composite bundle::array) - (dictionary.composite bundle::object) - (dictionary.composite bundle::utf8) + (|> extension.empty + with_array_extensions + with_object_extensions + with_utf8_extensions - (bundle.install "constant" lua::constant) - (bundle.install "apply" lua::apply) - (bundle.install "power" lua::power) - (bundle.install "import" lua::import) - (bundle.install "function" lua::function) - (bundle.install "script universe" (/.nullary .Bit)) - ))) + (/.install "lua_constant#" lua::constant) + (/.install "lua_apply#" lua::apply) + (/.install "lua_power#" lua::power) + (/.install "lua_import#" lua::import) + (/.install "lua_function#" lua::function) + (/.install "lua_script_universe#" (/.nullary .Bit)) + )) 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 b332a5639..89c91235d 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 @@ -21,28 +21,42 @@ [macro ["^" pattern]] ["@" target (.only) - ["_" lua (.only Expression Statement)]]]]] - ["[0]" //// - ["/" bundle] - ["/[1]" // - ["[0]" extension] - [translation - [extension (.only Nullary Unary Binary Trinary - nullary unary binary trinary)] - ["//" lua - ["[1][0]" runtime (.only Operation Phase Phase! Handler Bundle Translator)] - ["[1][0]" primitive] - ["[1][0]" structure] - ["[1][0]" reference] - ["[1][0]" when] - ["[1][0]" loop] - ["[1][0]" function]]] - [// - ["[0]" translation] - ["[0]" synthesis (.only %synthesis) - ["" \\parser (.only Parser)]] - [/// - ["[1]" phase (.use "[1]#[0]" monad)]]]]]) + ["_" lua (.only Expression Statement)]] + [compiler + [meta + [archive (.only Archive)]]]]]] + [///// + ["[0]" extension] + [translation + [extension (.only Nullary Unary Binary Trinary Variadic + nullary unary binary trinary variadic)] + ["//" lua + ["[1][0]" runtime (.only Operation Phase Phase! Handler Bundle Translator)] + ["[1][0]" primitive] + ["[1][0]" structure] + ["[1][0]" reference] + ["[1][0]" when] + ["[1][0]" loop] + ["[1][0]" function]]] + [// + ["[0]" translation] + ["[0]" synthesis (.only %synthesis) + ["?[1]" \\parser (.only Parser)]] + [/// + ["[0]" phase (.use "[1]#[0]" monad)]]]]) + +(def .public (custom [parser handler]) + (All (_ s) + (-> [(Parser s) + (-> Phase Archive s (Operation Expression))] + Handler)) + (function (_ phase archive input) + (when (?synthesis.result parser input) + {try.#Success input'} + (handler phase archive input') + + {try.#Failure error} + (phase.failure error)))) (def !unary (template (_ function) @@ -52,14 +66,14 @@ Phase! (when synthesis ... TODO: Get rid of this ASAP - {synthesis.#Extension [.prelude "when_char#|translation"] parameters} - (do /////.monad + [@ {synthesis.#Extension [.prelude "when_char#|translation"] parameters}] + (do phase.monad [body (expression archive synthesis)] (in (as Statement body))) (^.with_template [] - [( value) - (/////#each _.return (expression archive synthesis))]) + [( @ value) + (phase#each _.return (expression archive synthesis))]) ([synthesis.bit] [synthesis.i64] [synthesis.f64] @@ -70,44 +84,44 @@ [synthesis.function/apply]) (^.with_template [] - [{ value} - (/////#each _.return (expression archive synthesis))]) + [[@ { value}] + (phase#each _.return (expression archive synthesis))]) ([synthesis.#Reference] [synthesis.#Extension]) - (synthesis.branch/when when) + (synthesis.branch/when @ when) (//when.when! statement expression archive when) - (synthesis.branch/exec it) + (synthesis.branch/exec @ it) (//when.exec! statement expression archive it) - (synthesis.branch/let let) + (synthesis.branch/let @ let) (//when.let! statement expression archive let) - (synthesis.branch/if if) + (synthesis.branch/if @ if) (//when.if! statement expression archive if) - (synthesis.loop/scope scope) - (do /////.monad + (synthesis.loop/scope @ scope) + (do phase.monad [[inits scope!] (//loop.scope! statement expression archive false scope)] (in scope!)) - (synthesis.loop/again updates) + (synthesis.loop/again @ updates) (//loop.again! statement expression archive updates) - (synthesis.function/abstraction abstraction) - (/////#each _.return (//function.function statement expression archive abstraction)) + (synthesis.function/abstraction @ abstraction) + (phase#each _.return (//function.function statement expression archive abstraction)) )) ... TODO: Get rid of this ASAP (def lux::syntax_char_case! (..custom [(all <>.and - .any - .any - (<>.some (.tuple (all <>.and - (.tuple (<>.many .i64)) - .any)))) - (function (_ extension_name phase archive [input else conditionals]) + ?synthesis.any + ?synthesis.any + (<>.some (?synthesis.tuple (all <>.and + (?synthesis.tuple (<>.many ?synthesis.i64)) + ?synthesis.any)))) + (function (_ phase archive [input else conditionals]) (|> conditionals (list#each (function (_ [chars branch]) {synthesis.#Seq (when chars @@ -127,53 +141,56 @@ {synthesis.#Then else}) [input] (//when.when! statement phase archive) - (at /////.monad each (|>> (as Expression)))))])) - -(def lux_procs - Bundle - (|> /.empty - (/.install "syntax char case!" lux::syntax_char_case!) - (/.install "is" (binary (product.uncurried _.=))) - (/.install "try" (unary //runtime.lux//try)))) - -(def i64_procs - Bundle - (<| (/.prefix "i64") - (|> /.empty - (/.install "and" (binary (product.uncurried _.bit_and))) - (/.install "or" (binary (product.uncurried _.bit_or))) - (/.install "xor" (binary (product.uncurried _.bit_xor))) - (/.install "left-shift" (binary (product.uncurried //runtime.i64//left_shifted))) - (/.install "right-shift" (binary (product.uncurried //runtime.i64//right_shifted))) - (/.install "=" (binary (product.uncurried _.=))) - (/.install "+" (binary (product.uncurried _.+))) - (/.install "-" (binary (product.uncurried _.-))) - (/.install "<" (binary (product.uncurried _.<))) - (/.install "*" (binary (product.uncurried _.*))) - (/.install "/" (binary (product.uncurried //runtime.i64//division))) - (/.install "%" (binary (product.uncurried //runtime.i64//remainder))) - (/.install "f64" (unary (_./ (_.float +1.0)))) - (/.install "char" (unary (function (_ it) (_.apply (list it) (_.var "utf8.char"))))) - ))) + (at phase.monad each (|>> (as Expression)))))])) + +(def with_basic_extensions + (-> Bundle Bundle) + (|>> (dictionary.has "when_char#|translation" lux::syntax_char_case!) + (dictionary.has "is?#|translation" (binary (product.uncurried _.=))) + (dictionary.has "try#|translation" (unary //runtime.lux//try)))) + +(def with_i64_extensions + (-> Bundle Bundle) + (|>> (dictionary.has "i64_and#|translation" (binary (product.uncurried _.bit_and))) + (dictionary.has "i64_or#|translation" (binary (product.uncurried _.bit_or))) + (dictionary.has "i64_xor#|translation" (binary (product.uncurried _.bit_xor))) + (dictionary.has "i64_left#|translation" (binary (product.uncurried //runtime.i64//left_shifted))) + (dictionary.has "i64_right#|translation" (binary (product.uncurried //runtime.i64//right_shifted))) + + (dictionary.has "i64_=#|translation" (binary (product.uncurried _.=))) + (dictionary.has "i64_+#|translation" (binary (product.uncurried _.+))) + (dictionary.has "i64_-#|translation" (binary (product.uncurried _.-))) + )) + +(def with_int_extensions + (-> Bundle Bundle) + (|>> (dictionary.has "int_<#|translation" (binary (product.uncurried _.<))) + (dictionary.has "int_*#|translation" (binary (product.uncurried _.*))) + (dictionary.has "int_/#|translation" (binary (product.uncurried //runtime.i64//division))) + (dictionary.has "int_%#|translation" (binary (product.uncurried //runtime.i64//remainder))) + + (dictionary.has "int_f64#|translation" (unary (_./ (_.float +1.0)))) + (dictionary.has "int_char#|translation" (unary (function (_ it) (_.apply (list it) (_.var "utf8.char"))))) + )) (def f64//decode (Unary Expression) (|>> list _.apply (|> (_.var "tonumber")) _.return (_.closure (list)) //runtime.lux//try)) -(def f64_procs - Bundle - (<| (/.prefix "f64") - (|> /.empty - (/.install "+" (binary (product.uncurried _.+))) - (/.install "-" (binary (product.uncurried _.-))) - (/.install "*" (binary (product.uncurried _.*))) - (/.install "/" (binary (product.uncurried _./))) - (/.install "%" (binary (product.uncurried (function (_ parameter subject) (_.apply (list subject parameter) (_.var "math.fmod")))))) - (/.install "=" (binary (product.uncurried _.=))) - (/.install "<" (binary (product.uncurried _.<))) - (/.install "i64" (unary (!unary "math.floor"))) - (/.install "encode" (unary (function (_ it) (_.apply (list (_.string "%.17g") it) (_.var "string.format"))))) - (/.install "decode" (unary ..f64//decode))))) +(def with_frac_extensions + (-> Bundle Bundle) + (|>> (dictionary.has "f64_+#|translation" (binary (product.uncurried _.+))) + (dictionary.has "f64_-#|translation" (binary (product.uncurried _.-))) + (dictionary.has "f64_*#|translation" (binary (product.uncurried _.*))) + (dictionary.has "f64_/#|translation" (binary (product.uncurried _./))) + (dictionary.has "f64_%#|translation" (binary (product.uncurried (function (_ parameter subject) (_.apply (list subject parameter) (_.var "math.fmod")))))) + + (dictionary.has "f64_=#|translation" (binary (product.uncurried _.=))) + (dictionary.has "f64_<#|translation" (binary (product.uncurried _.<))) + + (dictionary.has "f64_int#|translation" (unary (!unary "math.floor"))) + (dictionary.has "f64_encoded#|translation" (unary (function (_ it) (_.apply (list (_.string "%.17g") it) (_.var "string.format"))))) + (dictionary.has "f64_decoded#|translation" (unary ..f64//decode)))) (def (text//char [paramO subjectO]) (Binary Expression) @@ -187,40 +204,46 @@ (Trinary Expression) (//runtime.text//index textO partO startO)) -(def text_procs - Bundle - (<| (/.prefix "text") - (|> /.empty - (/.install "=" (binary (product.uncurried _.=))) - (/.install "<" (binary (product.uncurried _.<))) - (/.install "concat" (binary (product.uncurried (function.flipped _.concat)))) - (/.install "index" (trinary ..text//index)) - (/.install "size" (unary //runtime.text//size)) - ... TODO: Use version below once the Lua compiler becomes self-hosted. - ... (/.install "size" (unary (for @.lua (!unary "utf8.len") - ... (!unary "string.len")))) - (/.install "char" (binary ..text//char)) - (/.install "clip" (trinary ..text//clip)) - ))) +(def (text::composite parts) + (Variadic Expression) + (when parts + (list) + (_.string "") + + (list.partial head tail) + (list#mix _.concat head tail))) + +(def with_text_extensions + (-> Bundle Bundle) + (|>> (dictionary.has "text_=#|translation" (binary (product.uncurried _.=))) + (dictionary.has "text_<#|translation" (binary (product.uncurried _.<))) + (dictionary.has "text_composite#|translation" (variadic ..text::composite)) + (dictionary.has "text_index#|translation" (trinary ..text//index)) + (dictionary.has "text_size#|translation" (unary //runtime.text//size)) + ... TODO: Use version below once the Lua compiler becomes self-hosted. + ... (dictionary.has "size" (unary (for @.lua (!unary "utf8.len") + ... (!unary "string.len")))) + (dictionary.has "text_char#|translation" (binary ..text//char)) + (dictionary.has "text_clip#|translation" (trinary ..text//clip)) + )) (def (io//log! messageO) (Unary Expression) (|> (_.apply (list messageO) (_.var "print")) (_.or //runtime.unit))) -(def io_procs - Bundle - (<| (/.prefix "io") - (|> /.empty - (/.install "log" (unary ..io//log!)) - (/.install "error" (unary (!unary "error")))))) +(def with_io_extensions + (-> Bundle Bundle) + (|>> (dictionary.has "log!#|translation" (unary ..io//log!)) + (dictionary.has "error#|translation" (unary (!unary "error"))))) (def .public bundle Bundle - (<| (/.prefix "lux") - (|> lux_procs - (dictionary.composite i64_procs) - (dictionary.composite f64_procs) - (dictionary.composite text_procs) - (dictionary.composite io_procs) - ))) + (|> extension.empty + with_basic_extensions + with_i64_extensions + with_int_extensions + with_frac_extensions + with_text_extensions + with_io_extensions + )) 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 97cb5fa8f..6e3bf9a0f 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 @@ -17,23 +17,21 @@ ["_" lua (.only Var Expression)]]]]] ["[0]" // ["[1][0]" common (.only custom)] - ["//[1]" /// - ["/" bundle] + ["///[1]" //// + ["[0]" extension] + [translation + [extension (.only Nullary Unary Binary Trinary + nullary unary binary trinary)] + ["[0]" reference] + ["//" lua + ["[1][0]" runtime (.only Operation Phase Handler Bundle + with_vars)]]] ["/[1]" // - ["[0]" extension] - [translation - [extension (.only Nullary Unary Binary Trinary - nullary unary binary trinary)] - ["[0]" reference] - ["//" lua - ["[1][0]" runtime (.only Operation Phase Handler Bundle - with_vars)]]] - ["/[1]" // - ["[0]" translation] - [synthesis - ["" \\parser (.only Parser)]] - ["//[1]" /// - ["[1][0]" phase]]]]]]) + ["[0]" translation] + [synthesis + ["" \\parser (.only Parser)]] + ["//[1]" /// + ["[1][0]" phase]]]]]) (def array::new (Unary Expression) @@ -55,22 +53,20 @@ (Binary Expression) (//runtime.array//write indexG _.nil arrayG)) -(def array - Bundle - (<| (/.prefix "array") - (|> /.empty - (/.install "new" (unary array::new)) - (/.install "length" (unary array::length)) - (/.install "read" (binary array::read)) - (/.install "write" (trinary array::write)) - (/.install "delete" (binary array::delete)) - ))) +(def with_array_extensions + (-> Bundle Bundle) + (|>> (dictionary.has "lua_array_new#|translation" (unary array::new)) + (dictionary.has "lua_array_length#|translation" (unary array::length)) + (dictionary.has "lua_array_read#|translation" (binary array::read)) + (dictionary.has "lua_array_write#|translation" (trinary array::write)) + (dictionary.has "lua_array_delete#|translation" (binary array::delete)) + )) (def object::get Handler (custom [(all <>.and .text .any) - (function (_ extension phase archive [fieldS objectS]) + (function (_ phase archive [fieldS objectS]) (do ////////phase.monad [objectG (phase archive objectS)] (in (_.the fieldS objectG))))])) @@ -79,7 +75,7 @@ Handler (custom [(all <>.and .text .any (<>.some .any)) - (function (_ extension phase archive [methodS objectS inputsS]) + (function (_ phase archive [methodS objectS inputsS]) (do [! ////////phase.monad] [objectG (phase archive objectS) inputsG (monad.each ! (phase archive) inputsS)] @@ -92,15 +88,13 @@ [object::nil object::nil? _.nil] ) -(def object - Bundle - (<| (/.prefix "object") - (|> /.empty - (/.install "get" object::get) - (/.install "do" object::do) - (/.install "nil" (nullary object::nil)) - (/.install "nil?" (unary object::nil?)) - ))) +(def with_object_extensions + (-> Bundle Bundle) + (|>> (dictionary.has "lua_object_get#|translation" object::get) + (dictionary.has "lua_object_do#|translation" object::do) + (dictionary.has "lua_object_nil#|translation" (nullary object::nil)) + (dictionary.has "lua_object_nil?#|translation" (unary object::nil?)) + )) (def $input (_.var "input")) @@ -108,7 +102,7 @@ (def utf8::encode (custom [.any - (function (_ extension phase archive inputS) + (function (_ phase archive inputS) (do [! ////////phase.monad] [inputG (phase archive inputS)] (in (<| (_.apply (list inputG)) @@ -120,31 +114,29 @@ (def utf8::decode (custom [.any - (function (_ extension phase archive inputS) + (function (_ phase archive inputS) (do [! ////////phase.monad] [inputG (phase archive inputS)] (in (_.apply (list (_.apply (list inputG) (_.var "table.unpack"))) (_.var "string.char")))))])) -(def utf8 - Bundle - (<| (/.prefix "utf8") - (|> /.empty - (/.install "encode" utf8::encode) - (/.install "decode" utf8::decode) - ))) +(def with_utf8_extensions + (-> Bundle Bundle) + (|>> (dictionary.has "lua_utf8_encoded#|translation" utf8::encode) + (dictionary.has "lua_utf8_decoded#|translation" utf8::decode) + )) (def lua::constant (custom [.text - (function (_ extension phase archive name) + (function (_ phase archive name) (at ////////phase.monad in (_.var name)))])) (def lua::apply (custom [(all <>.and .any (<>.some .any)) - (function (_ extension phase archive [abstractionS inputsS]) + (function (_ phase archive [abstractionS inputsS]) (do [! ////////phase.monad] [abstractionG (phase archive abstractionS) inputsG (monad.each ! (phase archive) inputsS)] @@ -153,7 +145,7 @@ (def lua::power (custom [(all <>.and .any .any) - (function (_ extension phase archive [powerS baseS]) + (function (_ phase archive [powerS baseS]) (do [! ////////phase.monad] [powerG (phase archive powerS) baseG (phase archive baseS)] @@ -162,14 +154,14 @@ (def lua::import (custom [.text - (function (_ extension phase archive module) + (function (_ phase archive module) (at ////////phase.monad in (_.require/1 (_.string module))))])) (def lua::function (custom [(all <>.and .i64 .any) - (function (_ extension phase archive [arity abstractionS]) + (function (_ phase archive [arity abstractionS]) (do [! ////////phase.monad] [abstractionG (phase archive abstractionS) .let [variable (is (-> Text (Operation Var)) @@ -187,16 +179,15 @@ (def .public bundle Bundle - (<| (/.prefix "lua") - (|> /.empty - (dictionary.composite ..array) - (dictionary.composite ..object) - (dictionary.composite ..utf8) - - (/.install "constant" lua::constant) - (/.install "apply" lua::apply) - (/.install "power" lua::power) - (/.install "import" lua::import) - (/.install "function" lua::function) - (/.install "script universe" (nullary (function.constant (_.boolean reference.universe)))) - ))) + (|> extension.empty + with_array_extensions + with_object_extensions + with_utf8_extensions + + (dictionary.has "lua_constant#|translation" lua::constant) + (dictionary.has "lua_apply#|translation" lua::apply) + (dictionary.has "lua_power#|translation" lua::power) + (dictionary.has "lua_import#|translation" lua::import) + (dictionary.has "lua_function#|translation" lua::function) + (dictionary.has "lua_script_universe#|translation" (nullary (function.constant (_.boolean reference.universe)))) + )) 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 7efaa9bc8..b39309d74 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 @@ -35,56 +35,55 @@ (exception.def .public cannot_recur_as_an_expression) -(def (expression archive synthesis) - Phase - (when synthesis - (^.with_template [ ] - [( value) - (//////phase#in ( value))]) - ([synthesis.bit /primitive.bit] - [synthesis.i64 /primitive.i64] - [synthesis.f64 /primitive.f64] - [synthesis.text /primitive.text]) +(def .public (expression extender lux) + (-> ///extension.Extender Lux Phase) + (function (expression archive synthesis) + (when synthesis + (^.with_template [ ] + [( @ value) + (//////phase#in ( value))]) + ([synthesis.bit /primitive.bit] + [synthesis.i64 /primitive.i64] + [synthesis.f64 /primitive.f64] + [synthesis.text /primitive.text]) - (synthesis.variant variantS) - (/structure.variant expression archive variantS) + (synthesis.variant @ variantS) + (/structure.variant expression archive variantS) - (synthesis.tuple members) - (/structure.tuple expression archive members) + (synthesis.tuple @ members) + (/structure.tuple expression archive members) - {synthesis.#Reference value} - (//reference.reference /reference.system archive value) + [@ {synthesis.#Reference value}] + (//reference.reference /reference.system archive value) - (synthesis.branch/when when) - (/when.when ///extension/common.statement expression archive when) + (synthesis.branch/when @ when) + (/when.when ///extension/common.statement expression archive when) - (synthesis.branch/exec it) - (/when.exec expression archive it) + (synthesis.branch/exec @ it) + (/when.exec expression archive it) - (synthesis.branch/let let) - (/when.let expression archive let) + (synthesis.branch/let @ let) + (/when.let expression archive let) - (synthesis.branch/if if) - (/when.if expression archive if) + (synthesis.branch/if @ if) + (/when.if expression archive if) - (synthesis.branch/get get) - (/when.get expression archive get) + (synthesis.branch/get @ get) + (/when.get expression archive get) - (synthesis.loop/scope scope) - (/loop.scope ///extension/common.statement expression archive scope) + (synthesis.loop/scope @ scope) + (/loop.scope ///extension/common.statement expression archive scope) - (synthesis.loop/again updates) - (//////phase.except ..cannot_recur_as_an_expression []) + (synthesis.loop/again @ updates) + (//////phase.except ..cannot_recur_as_an_expression []) - (synthesis.function/abstraction abstraction) - (/function.function ///extension/common.statement expression archive abstraction) + (synthesis.function/abstraction @ abstraction) + (/function.function ///extension/common.statement expression archive abstraction) - (synthesis.function/apply application) - (/function.apply expression archive application) + (synthesis.function/apply @ application) + (/function.apply expression archive application) - {synthesis.#Extension extension} - (///extension.apply archive expression extension))) - -(def .public translate - Phase - ..expression) + [@ {synthesis.#Extension [name parameters]}] + (///extension.application extender lux expression archive .Translation false name parameters + (|>>) + (function (_ _) {.#None}))))) 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 a9ed9d0fe..7e5de1fd3 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 @@ -1,6 +1,6 @@ (.require [library - [lux (.except Label function) + [lux (.except Label Analysis Synthesis function) [abstract ["[0]" monad (.only do)]] [data 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 5574b06a1..38fab4758 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 @@ -1,6 +1,6 @@ (.require [library - [lux (.except Label Scope) + [lux (.except Label Scope Synthesis) [abstract ["[0]" monad (.only do)]] [data 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 d9c24bbd8..9d8068bde 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 @@ -1,6 +1,6 @@ (.require [library - [lux (.except Tuple Variant) + [lux (.except Tuple Variant Synthesis) [abstract ["[0]" monad (.only do)]] [meta 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 d9ada6190..9545bee65 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 @@ -1,6 +1,6 @@ (.require [library - [lux (.except when exec let if) + [lux (.except Synthesis when exec let if) [abstract ["[0]" monad (.only do)]] [data diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/reference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/reference.lux index 4816ea1e5..325ec417a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/reference.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/reference.lux @@ -22,7 +22,7 @@ (def .public universe (for @.lua ... In the case of Lua, there is a limit of 200 locals in a function's scope. - (not ("lua script universe")) + (not (.lua_script_universe#)) @.ruby ... Cannot make all definitions be local variables because of limitations with JRuby. diff --git a/stdlib/source/library/lux/world/time/instant.lux b/stdlib/source/library/lux/world/time/instant.lux index a7b55a416..3c314db89 100644 --- a/stdlib/source/library/lux/world/time/instant.lux +++ b/stdlib/source/library/lux/world/time/instant.lux @@ -172,7 +172,7 @@ (as Frac) (f.* +1,000.0) .f64_int#)) - @.lua (|> ("lua apply" ("lua constant" "os.time") []) + @.lua (|> (.lua_apply# (.lua_constant# "os.time") []) (as Int) (i.* +1,000)) @.ruby (let [% ("ruby constant" "Time") diff --git a/stdlib/source/specification/lux/abstract/functor.lux b/stdlib/source/specification/lux/abstract/functor.lux index 232e9316a..d0f8327d5 100644 --- a/stdlib/source/specification/lux/abstract/functor.lux +++ b/stdlib/source/specification/lux/abstract/functor.lux @@ -15,49 +15,45 @@ [\\library ["[0]" / (.only Functor)]]) -(type .public (Injection f) - (All (_ a) (-> a (f a)))) +(type .public (Injection !) + (All (_ of) + (-> of + (! of)))) -(type .public (Comparison f) - (All (_ a) - (-> (Equivalence a) - (Equivalence (f a))))) +(type .public (Comparison !) + (All (_ of) + (-> (Equivalence of) + (Equivalence (! of))))) -(def (identity injection comparison (open "@//[0]")) - (All (_ f) (-> (Injection f) (Comparison f) (Functor f) Test)) - (do [! random.monad] - [sample (at ! each injection random.nat)] - (_.test "Identity." - ((comparison n.=) - (@//each function.identity sample) - sample)))) - -(def (homomorphism injection comparison (open "@//[0]")) - (All (_ f) (-> (Injection f) (Comparison f) (Functor f) Test)) - (do [! random.monad] - [sample random.nat - increase (at ! each n.+ random.nat)] - (_.test "Homomorphism." - ((comparison n.=) - (@//each increase (injection sample)) - (injection (increase sample)))))) +(def .public (spec injection comparison functor) + (All (_ !) + (-> (Injection !) (Comparison !) (Functor !) + Test)) + (<| (do [! random.monad] + [sample random.nat + increase (at ! each n.+ random.nat) + decrease (at ! each n.- random.nat)]) + (_.for [/.Functor]) + (_.coverage [/.each] + (let [(open "/#[0]") functor + + identity! + ((comparison n.=) + (/#each function.identity (injection sample)) + (injection sample)) -(def (composition injection comparison (open "@//[0]")) - (All (_ f) (-> (Injection f) (Comparison f) (Functor f) Test)) - (do [! random.monad] - [sample (at ! each injection random.nat) - increase (at ! each n.+ random.nat) - decrease (at ! each n.- random.nat)] - (_.test "Composition." - ((comparison n.=) - (|> sample (@//each increase) (@//each decrease)) - (|> sample (@//each (|>> increase decrease))))))) + homomorphism! + ((comparison n.=) + (/#each increase (injection sample)) + (injection (increase sample))) -(def .public (spec injection comparison functor) - (All (_ f) (-> (Injection f) (Comparison f) (Functor f) Test)) - (<| (_.for [/.Functor]) - (all _.and - (..identity injection comparison functor) - (..homomorphism injection comparison functor) - (..composition injection comparison functor) - ))) + composition! + ((comparison n.=) + (|> (injection sample) + (/#each increase) + (/#each decrease)) + (|> (injection sample) + (/#each (|>> increase decrease))))] + (and identity! + homomorphism! + composition!))))) diff --git a/stdlib/source/test/lux/debug.lux b/stdlib/source/test/lux/debug.lux index 17a0a1a31..bf54deb21 100644 --- a/stdlib/source/test/lux/debug.lux +++ b/stdlib/source/test/lux/debug.lux @@ -295,7 +295,9 @@ output _ (io.run! (sys::stdout old))] [(io/StringIO::getvalue buffer) - output]))])) + output]) + @.lua ["" + ])])) (def .public test Test @@ -330,7 +332,8 @@ /.inspection) true)) (_.coverage [/.log!] - (let [[actual_message _] (with_out (/.log! expected_message))] + (let [[actual_message _] (with_out + (/.log! expected_message))] (text#= (format expected_message text.\n) actual_message))) )))) diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index db993c324..6cee94642 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -29,7 +29,9 @@ ["[1][0]" random] ["[1][0]" logic ["[1]/[0]" continuous] - ["[1]/[0]" fuzzy]]]) + ["[1]/[0]" fuzzy]] + ["[1][0]" arithmetic + ["[1]/[0]" saturation]]]) (def ratio/0 Ratio @@ -145,4 +147,5 @@ /random.test /logic/continuous.test /logic/fuzzy.test + /arithmetic/saturation.test )))) diff --git a/stdlib/source/test/lux/math/arithmetic/saturation.lux b/stdlib/source/test/lux/math/arithmetic/saturation.lux new file mode 100644 index 000000000..3ef3adb94 --- /dev/null +++ b/stdlib/source/test/lux/math/arithmetic/saturation.lux @@ -0,0 +1,51 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [math + ["[0]" random (.only Random)] + [number + ["n" nat]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(def (within_boundaries? [min max] it) + (-> [Nat Nat] Nat + Bit) + (and (n.<= max it) + (n.>= min it))) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [left random.nat + right random.nat + .let [max (n.max left right) + min (n.min left right)] + + parameter (random.only (n.> 0) random.nat) + subject random.nat]) + (all _.and + (_.coverage [/.arithmetic] + (let [boundaries_are_respected! + (let [(open "/#[0]") (/.arithmetic n.order [min max] n.arithmetic)] + (and (within_boundaries? [min max] (/#+ parameter subject)) + (within_boundaries? [min max] (/#- parameter subject)) + (within_boundaries? [min max] (/#* parameter subject)) + (within_boundaries? [min max] (/#/ parameter subject)) + (within_boundaries? [min max] (/#% parameter subject)))) + + the_order_of_the_boundaries_does_not_matter! + (let [(open "/#[0]") (/.arithmetic n.order [max min] n.arithmetic)] + (and (within_boundaries? [min max] (/#+ parameter subject)) + (within_boundaries? [min max] (/#- parameter subject)) + (within_boundaries? [min max] (/#* parameter subject)) + (within_boundaries? [min max] (/#/ parameter subject)) + (within_boundaries? [min max] (/#% parameter subject))))] + (and boundaries_are_respected! + the_order_of_the_boundaries_does_not_matter!))) + ))) diff --git a/stdlib/source/unsafe/lux/data/collection/array.lux b/stdlib/source/unsafe/lux/data/collection/array.lux index 184be69cf..85294ce2e 100644 --- a/stdlib/source/unsafe/lux/data/collection/array.lux +++ b/stdlib/source/unsafe/lux/data/collection/array.lux @@ -47,7 +47,7 @@ (,, (.static @.js)) ("js array new" size) (,, (.static @.python)) (.python_array_new# size) - (,, (.static @.lua)) ("lua array new" size) + (,, (.static @.lua)) (.lua_array_new# size) (,, (.static @.ruby)) ("ruby array new" size) (,, (.static @.php)) ("php array new" size) (,, (.static @.scheme)) ("scheme array new" size))))) @@ -70,7 +70,7 @@ (,, (.static @.js)) ("js array length" array) (,, (.static @.python)) (.python_array_length# array) - (,, (.static @.lua)) ("lua array length" array) + (,, (.static @.lua)) (.lua_array_length# array) (,, (.static @.ruby)) ("ruby array length" array) (,, (.static @.php)) ("php array length" array) (,, (.static @.scheme)) ("scheme array length" array)))) @@ -97,7 +97,7 @@ (,, (.static @.js)) (,, (lacks?' "js array read" "js object undefined?" index array)) (,, (.static @.python)) (,, (lacks?' .python_array_read# .python_object_none?# index array)) - (,, (.static @.lua)) (,, (lacks?' "lua array read" "lua object nil?" index array)) + (,, (.static @.lua)) (,, (lacks?' .lua_array_read# .lua_object_nil?# index array)) (,, (.static @.ruby)) (,, (lacks?' "ruby array read" "ruby object nil?" index array)) (,, (.static @.php)) (,, (lacks?' "php array read" "php object null?" index array)) (,, (.static @.scheme)) (,, (lacks?' "scheme array read" "scheme object nil?" index array))) @@ -122,7 +122,7 @@ (,, (.static @.js)) ("js array read" index array) (,, (.static @.python)) (.python_array_read# index array) - (,, (.static @.lua)) ("lua array read" index array) + (,, (.static @.lua)) (.lua_array_read# index array) (,, (.static @.ruby)) ("ruby array read" index array) (,, (.static @.php)) ("php array read" index array) (,, (.static @.scheme)) ("scheme array read" index array))))) @@ -143,7 +143,7 @@ (,, (.static @.js)) ("js array write" index (.as_expected value) array) (,, (.static @.python)) (.python_array_write# index (.as_expected value) array) - (,, (.static @.lua)) ("lua array write" index (.as_expected value) array) + (,, (.static @.lua)) (.lua_array_write# index (.as_expected value) array) (,, (.static @.ruby)) ("ruby array write" index (.as_expected value) array) (,, (.static @.php)) ("php array write" index (.as_expected value) array) (,, (.static @.scheme)) ("scheme array write" index (.as_expected value) array)))) @@ -164,7 +164,7 @@ (,, (.static @.js)) ("js array delete" index array) (,, (.static @.python)) (.python_array_delete# index array) - (,, (.static @.lua)) ("lua array delete" index array) + (,, (.static @.lua)) (.lua_array_delete# index array) (,, (.static @.ruby)) ("ruby array delete" index array) (,, (.static @.php)) ("php array delete" index array) (,, (.static @.scheme)) ("scheme array delete" index array)) -- cgit v1.2.3