From 3ca054b6b992e2233d763aabc5c938ee10d116a4 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 4 Jan 2023 18:37:14 -0400 Subject: Added simple machinery for aliasing of definitions. --- stdlib/source/library/lux.lux | 30 ++++++++++++++---- stdlib/source/library/lux/math/number/ratio.lux | 20 ++++++------ .../meta/compiler/language/lux/analysis/module.lux | 37 ++++++++++++++-------- .../lux/phase/extension/translation/jvm/host.lux | 2 +- .../library/lux/meta/compiler/meta/packager.lux | 10 +++--- .../source/library/lux/meta/compiler/version.lux | 12 ++++--- stdlib/source/library/lux/test/benchmark.lux | 13 ++++++-- stdlib/source/library/lux/web/css/value.lux | 2 +- .../library/lux/world/finance/market/price.lux | 25 ++++++++++----- 9 files changed, 100 insertions(+), 51 deletions(-) (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 763b1b25f..e6108721f 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -3292,7 +3292,7 @@ _ ... TODO: Figure out why this doesn't work: - ... (of meta#monad in token) + ... (meta#in token) (meta#in token)} token)))) @@ -5479,14 +5479,15 @@ (again &rest (property#with var_name expansion map))) {#End} - (of meta#monad #in (list#conjoint (list#each normal bodies)))))) + (meta#in (list#conjoint (list#each normal bodies)))))) {#None} (failure (..wrong_syntax_error (symbol ..with_expansions))))))) (def .public (same? reference sample) - (All (_ a) - (-> a a Bit)) + (All (_ of) + (-> of of + Bit)) (.is?# reference sample)) (def .public as_expected @@ -5878,5 +5879,22 @@ [Declaration] ) -(type .public F64 Frac) -(type .public Double Frac) +(def .public alias + (macro (_ tokens) + (when (parsed (andP (tupleP (manyP localP)) + symbolP) + tokens) + {#Some [alias/+ original]} + (meta#in (list#each (function (_ it) + (` (def .public (, (local$ it)) + (, (symbol$ original))))) + alias/+)) + + {#None} + (failure (..wrong_syntax_error (symbol ..alias)))))) + +(alias [F64 Double] + ..Frac) + +(alias [alias?] + ..same?) diff --git a/stdlib/source/library/lux/math/number/ratio.lux b/stdlib/source/library/lux/math/number/ratio.lux index 4877d65da..d1a8cc3a6 100644 --- a/stdlib/source/library/lux/math/number/ratio.lux +++ b/stdlib/source/library/lux/math/number/ratio.lux @@ -37,12 +37,12 @@ 1 {.#Some (the #numerator value)} _ {.#None})) -(def .public (normal (open "_[0]")) +(def .public (normal (open "/[0]")) (-> Ratio Ratio) - (let [common (n.gcd _#numerator _#denominator)] - [..#numerator (n./ common _#numerator) - ..#denominator (n./ common _#denominator)])) + (let [common (n.gcd /#numerator /#denominator)] + [..#numerator (n./ common /#numerator) + ..#denominator (n./ common /#denominator)])) (def .public ratio (syntax (_ [numerator .any @@ -146,21 +146,21 @@ (def * ..*) (def / ../))) -(def .public (reciprocal (open "_[0]")) +(def .public (reciprocal (open "/[0]")) (-> Ratio Ratio) - [..#numerator _#denominator - ..#denominator _#numerator]) + [..#numerator /#denominator + ..#denominator /#numerator]) (def separator ":") (def .public codec (Codec Text Ratio) (implementation - (def (encoded (open "_[0]")) + (def (encoded (open "/[0]")) (all text#composite - (n#encoded _#numerator) - ..separator (n#encoded _#denominator))) + (n#encoded /#numerator) + ..separator (n#encoded /#denominator))) (def (decoded input) (when (text.split_by ..separator input) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux index 29dad85d1..f5f9a5ecb 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except with) + [lux (.except with alias) ["[0]" meta] [abstract ["[0]" monad (.only do)]] @@ -47,7 +47,8 @@ {.#Cached} "Cached")]))) (def .public (empty hash) - (-> Nat Module) + (-> Nat + Module) [.#module_hash hash .#module_aliases (list) .#definitions (list) @@ -55,7 +56,8 @@ .#module_state {.#Active}]) (def .public (import module) - (-> Text (Operation Any)) + (-> Text + (Operation Any)) (do phase.monad [self_name meta.current_module_name] (function (_ state) @@ -68,19 +70,21 @@ state) []]}))) -(def .public (alias alias module) - (-> Text Text (Operation Any)) +(def .public (alias it module) + (-> Text Text + (Operation Any)) (do phase.monad [self_name meta.current_module_name] (function (_ state) {try.#Success [(revised .#modules (property.revised self_name (revised .#module_aliases (is (-> (List [Text Text]) (List [Text Text])) - (|>> {.#Item [alias module]})))) + (|>> {.#Item [it module]})))) state) []]}))) (def .public (exists? module) - (-> Text (Operation Bit)) + (-> Text + (Operation Bit)) (function (_ state) (|> state (the .#modules) @@ -95,7 +99,8 @@ {try.#Success}))) (def .public (define name exported?,definition) - (-> Text [Bit Global] (Operation Any)) + (-> Text [Bit Global] + (Operation Any)) (do phase.monad [self_name meta.current_module_name self meta.current_module] @@ -117,7 +122,8 @@ state))))) (def .public (override_definition [module short] exported?,definition) - (-> Symbol [Bit Global] (Operation Any)) + (-> Symbol [Bit Global] + (Operation Any)) (function (_ state) {try.#Success [(revised .#modules (property.revised module @@ -127,7 +133,8 @@ []]})) (def .public (create hash name) - (-> Nat Text (Operation Any)) + (-> Nat Text + (Operation Any)) (function (_ state) {try.#Success [(revised .#modules (property.has name (..empty hash)) @@ -135,7 +142,9 @@ []]})) (def .public (with hash name action) - (All (_ a) (-> Nat Text (Operation a) (Operation [Module a]))) + (All (_ of) + (-> Nat Text (Operation of) + (Operation [Module of]))) (do phase.monad [_ (..create hash name) output (/.with_current_module name @@ -145,7 +154,8 @@ (with_template [ ] [(def .public ( module_name) - (-> Text (Operation Any)) + (-> Text + (Operation Any)) (function (_ state) (when (|> state (the .#modules) (property.value module_name)) {.#Some module} @@ -168,7 +178,8 @@ state)))) (def .public ( module_name) - (-> Text (Operation Bit)) + (-> Text + (Operation Bit)) (function (_ state) (when (|> state (the .#modules) (property.value module_name)) {.#Some module} diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/host.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/host.lux index fb9ee9327..522cf231b 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/host.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/host.lux @@ -318,7 +318,7 @@ (def with_double_extensions (-> Bundle Bundle) - (let [type (reflection.reflection reflection.float)] + (let [type (reflection.reflection reflection.double)] (|>> (dictionary.has (%.format "jvm_" type "_" "+" "#" "|translation") (binary double::+)) (dictionary.has (%.format "jvm_" type "_" "-" "#" "|translation") (binary double::-)) (dictionary.has (%.format "jvm_" type "_" "*" "#" "|translation") (binary double::*)) diff --git a/stdlib/source/library/lux/meta/compiler/meta/packager.lux b/stdlib/source/library/lux/meta/compiler/meta/packager.lux index a7e8a095c..68edb9e16 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/packager.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/packager.lux @@ -20,13 +20,10 @@ ["[0]" artifact] ["[0]" registry] ["[0]" unit] - ["[0]" module (.only) - ["[0]" descriptor]]]]) + ["[0]" module]]]) (type .public Packager - (-> (Dictionary file.Path Binary) - Archive - (Maybe unit.ID) + (-> (Dictionary file.Path Binary) Archive (Maybe unit.ID) (Try (Either Binary (List [Text Binary]))))) @@ -34,7 +31,8 @@ (List [module.ID (List artifact.ID)])) (def .public order - (-> (cache/module.Order Any) Order) + (-> (cache/module.Order Any) + Order) (list#each (function (_ [module [module_id entry]]) (|> entry (the archive.#registry) diff --git a/stdlib/source/library/lux/meta/compiler/version.lux b/stdlib/source/library/lux/meta/compiler/version.lux index e576a7c29..ece4e5098 100644 --- a/stdlib/source/library/lux/meta/compiler/version.lux +++ b/stdlib/source/library/lux/meta/compiler/version.lux @@ -21,22 +21,26 @@ (n./ ..range)) (def .public patch - (-> Version Nat) + (-> Version + Nat) (|>> ..level)) (def .public minor - (-> Version Nat) + (-> Version + Nat) (|>> ..next ..level)) (def .public major - (-> Version Nat) + (-> Version + Nat) (|>> ..next ..next)) (def separator ".") (def (padded value) - (-> Nat Text) + (-> Nat + Text) (if (n.< 10 value) (%.format "0" (%.nat value)) (%.nat value))) diff --git a/stdlib/source/library/lux/test/benchmark.lux b/stdlib/source/library/lux/test/benchmark.lux index 427e62822..f25975015 100644 --- a/stdlib/source/library/lux/test/benchmark.lux +++ b/stdlib/source/library/lux/test/benchmark.lux @@ -9,6 +9,9 @@ [data [collection ["[0]" list (.use "[1]#[0]" mix)]]] + [math + [number + ["[0]" int]]] [world [time ["[0]" instant] @@ -30,6 +33,12 @@ #maximum Duration #average Duration])) +(def minimum_duration + duration.empty) + +(def maximum_duration + (duration.of_millis (of int.interval top))) + (def empty Benchmark [#times 0 @@ -47,8 +56,8 @@ (list.repeated times) (monad.each ! ..time))] (in [#times times - #minimum (list#mix (order.min duration.order) duration.empty durations) - #maximum (list#mix (order.max duration.order) duration.empty durations) + #minimum (list#mix (order.min duration.order) ..maximum_duration durations) + #maximum (list#mix (order.max duration.order) ..minimum_duration durations) #average (|> durations (list#mix duration.composite duration.empty) (duration.down times))])))) diff --git a/stdlib/source/library/lux/web/css/value.lux b/stdlib/source/library/lux/web/css/value.lux index 2ff369bc7..31e19b316 100644 --- a/stdlib/source/library/lux/web/css/value.lux +++ b/stdlib/source/library/lux/web/css/value.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Label All Location and static false true all) + [lux (.except Label All Location and static false true all alias) [control ["[0]" maybe]] [data diff --git a/stdlib/source/library/lux/world/finance/market/price.lux b/stdlib/source/library/lux/world/finance/market/price.lux index 58c4216d8..c7b6e8e8c 100644 --- a/stdlib/source/library/lux/world/finance/market/price.lux +++ b/stdlib/source/library/lux/world/finance/market/price.lux @@ -9,39 +9,48 @@ ["%" \\format]]] [math [number + ["n" nat] ["i" int]]] [meta [type ["[0]" nominal]]]]] [/// - [money (.only Money) + ["[0]" money (.only Money) ["[0]" currency (.only Currency)]]]) (type .public (Price $) (Money $)) +(def .public (free $) + (All (_ $) + (-> (Currency $) + (Price $))) + (money.money $ 0)) + ... https://en.wikipedia.org/wiki/Price_action_trading (nominal.def .public (Action $) (Record [#currency (Currency $) #movement Int]) - (def .public (action currency movement) + (def .public (action from to) (All (_ $) - (-> (Currency $) Int + (-> (Price $) (Price $) (Action $))) (nominal.abstraction - [#currency currency - #movement movement])) + [#currency (money.currency from) + #movement (.int (n.- (money.amount from) + (money.amount to)))])) (with_template [<*> ] [(def .public ( currency it) (All (_ $) (-> (Currency $) Int (Action $))) - (action currency - (<*> (.int (currency.sub_divisions currency)) - it)))] + (nominal.abstraction + [#currency currency + #movement (<*> (.int (currency.sub_divisions currency)) + it)]))] [i.* of_units] [i.% of_sub_units] -- cgit v1.2.3