From 8ca6fcf3f147cae24f385423e84ae1ab0821293f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 16 Jan 2023 14:31:15 -0400 Subject: Added compilation of references for C++. --- .../library/lux/control/function/predicate.lux | 41 ++++++++------ .../language/lux/phase/extension/analysis/js.lux | 4 +- .../lux/phase/extension/analysis/python.lux | 4 +- .../language/lux/phase/translation/c++.lux | 24 ++++---- .../language/lux/phase/translation/c++/complex.lux | 20 +++---- .../lux/phase/translation/c++/primitive.lux | 25 +++++--- .../lux/phase/translation/c++/reference.lux | 66 ++++++++++++++++++++++ .../language/lux/phase/translation/c++/runtime.lux | 9 +-- .../lux/phase/translation/jvm/reference.lux | 51 +++++++++-------- .../library/lux/world/finance/market/price.lux | 30 +++++++--- stdlib/source/library/lux/world/finance/money.lux | 23 +++++++- 11 files changed, 207 insertions(+), 90 deletions(-) create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/reference.lux (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux/control/function/predicate.lux b/stdlib/source/library/lux/control/function/predicate.lux index 1bd289e4d..593878eef 100644 --- a/stdlib/source/library/lux/control/function/predicate.lux +++ b/stdlib/source/library/lux/control/function/predicate.lux @@ -10,27 +10,31 @@ ["[0]" contravariant]]]]] ["[0]" //]) -(type .public (Predicate a) - (-> a Bit)) +(type .public (Predicate of) + (-> of + Bit)) -(with_template [ ] +(with_template [ ] [(def .public Predicate (//.constant )) (def .public ( left right) - (All (_ a) (-> (Predicate a) (Predicate a) (Predicate a))) + (All (_ of) + (-> (Predicate of) (Predicate of) + (Predicate of))) (function (_ value) ( (left value) (right value))))] - [none #0 or .or] - [all #1 and .and] + [#0 none or .or] + [#1 all and .and] ) (with_template [ ] [(def .public - (All (_ a) (Monoid (Predicate a))) + (All (_ of) + (Monoid (Predicate of))) (implementation (def identity ) (def composite )))] @@ -40,28 +44,31 @@ ) (def .public (complement predicate) - (All (_ a) (-> (Predicate a) (Predicate a))) + (All (_ of) + (-> (Predicate of) + (Predicate of))) (|>> predicate .not)) -(def .public not - (All (_ a) (-> (Predicate a) (Predicate a))) - ..complement) +(alias [not] + ..complement) (def .public (difference sub base) - (All (_ a) (-> (Predicate a) (Predicate a) (Predicate a))) + (All (_ of) + (-> (Predicate of) (Predicate of) + (Predicate of))) (function (_ value) (.and (base value) (.not (sub value))))) (def .public (rec predicate) - (All (_ a) - (-> (-> (Predicate a) (Predicate a)) - (Predicate a))) + (All (_ of) + (-> (-> (Predicate of) (Predicate of)) + (Predicate of))) (function (again input) (predicate again input))) (def .public functor (contravariant.Functor Predicate) (implementation - (def (each f fb) - (|>> f fb)))) + (def (each $ it) + (|>> $ it)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/js.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/js.lux index eb9d64c20..640cfdd6c 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/js.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/js.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Analysis) + [lux (.except) ["[0]" ffi] [abstract ["[0]" monad (.only do)]] @@ -28,7 +28,7 @@ ["[0]" extension] [// ["[0]" phase] - ["[0]" analysis (.only Analysis Operation Phase Handler Bundle) + ["[0]" analysis (.only Operation Phase Handler Bundle) ["[1]/[0]" type]]]]]) (def array::new diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/python.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/python.lux index e3ef6d16c..5c69be1ae 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/python.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/python.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Analysis) + [lux (.except) ["[0]" ffi] [abstract ["[0]" monad (.only do)]] @@ -27,7 +27,7 @@ ["/[1]" // (.only) [/// ["[0]" phase] - ["[0]" analysis (.only Analysis Operation Phase Handler Bundle) + ["[0]" analysis (.only Operation Phase Handler Bundle) ["[1]/[0]" type]]]]]) (def array::new diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++.lux index 519863128..395d31e39 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Synthesis) + [lux (.except) [abstract [monad (.only do)]] [control @@ -27,15 +27,15 @@ [runtime (.only Operation Phase Handler)] ["[1][0]" primitive] ["[1][0]" complex] - ... ["[1][0]" reference] + ["[1][0]" reference] ... ["[1][0]" function] ... ["[1][0]" when] ... ["[1][0]" loop] - ["//[1]" /// + [/// ["[0]" extension] [// ["[0]" phase (.use "[1]#[0]" monad)] - ["[0]" synthesis (.only Synthesis)] + ["[0]" synthesis] ["[0]" translation] [/// ["[0]" reference]]]]]) @@ -59,13 +59,13 @@ (synthesis.tuple @ it) (/complex.tuple phase archive it) - ... [@ {synthesis.#Reference reference}] - ... (when reference - ... {reference.#Variable variable} - ... (/reference.variable archive variable) - - ... {reference.#Constant constant} - ... (/reference.constant archive constant)) + [@ {synthesis.#Reference reference}] + (when reference + {reference.#Variable it} + (/reference.variable it) + + {reference.#Constant it} + (/reference.constant archive it)) ... (synthesis.branch/when @ [valueS pathS]) ... (/when.when phase archive [valueS pathS]) @@ -100,5 +100,5 @@ ... (function (_ _) {.#None})) _ - (undefined) + (panic! (synthesis.%synthesis it)) ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/complex.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/complex.lux index 0b0dfe292..57c12d5dc 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/complex.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/complex.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Variant Tuple Synthesis Translation) + [lux (.except Variant Tuple) [abstract ["[0]" monad (.only do)]] [meta @@ -11,32 +11,32 @@ [target ["_" c++]]]]]] [// - ["[0]" runtime (.only Translation)] + ["[0]" runtime (.only Term)] [//// ["[0]" phase] - [synthesis (.only Synthesis)] + ["[0]" synthesis] [analysis [complex (.only Variant Tuple)]]]]) -(def .public (variant phase archive [lefts right? value]) - (Translation (Variant Synthesis)) +(def .public (variant next archive [lefts right? value]) + (Term Variant) (do phase.monad - [value (phase archive value)] + [value (next archive value)] (in (runtime.variant (_.int (.int lefts)) (_.bool right?) value)))) -(def .public (tuple phase archive values) - (Translation (Tuple Synthesis)) +(def .public (tuple next archive values) + (Term Tuple) (let [! phase.monad] (when values {.#End} (of ! in runtime.unit) {.#Item it {.#End}} - (phase archive it) + (next archive it) _ (|> values - (monad.each ! (phase archive)) + (monad.each ! (next archive)) (of ! each runtime.tuple))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/primitive.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/primitive.lux index 302a38d57..6b45145c1 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/primitive.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/primitive.lux @@ -7,26 +7,33 @@ [meta [compiler [target - ["_" c++ (.only Literal Expression)]]]]]]) + ["_" c++]]]]]] + [// + ["[0]" runtime] + ["[0]" type]]) (def .public bit (-> Bit - Literal) - _.bool) + _.Expression) + (|>> _.bool + (runtime.simple type.bit))) (def .public i64 (-> (I64 Any) - Expression) + _.Expression) (|>> .int _.int - _.int64_t)) + _.int64_t + (runtime.simple type.i64))) (def .public f64 (-> Frac - Literal) - _.double) + _.Expression) + (|>> _.double + (runtime.simple type.f64))) (def .public text (-> Text - Literal) - _.u32_string) + _.Expression) + (|>> _.u32_string + (runtime.simple type.text))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/reference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/reference.lux new file mode 100644 index 000000000..b43340b91 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/reference.lux @@ -0,0 +1,66 @@ +... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. + +(.require + [library + [lux (.except local) + [abstract + [monad (.only do)]] + [control + ["|" pipe]] + [data + ["[0]" product] + [text + ["%" \\format]]] + [meta + [compiler + [target + ["_" c++]]]]]] + [// + ["/" runtime (.only Operation)] + [// + ["[0]" reference] + [/// + ["[0]" phase (.use "[1]#[0]" monad)] + ["[0]" translation] + [/// + [reference + ["[0]" variable (.only Register Variable)]] + [meta + [archive (.only Archive)]]]]]]) + +(with_template [ ] + [(def .public + (-> Register + /.Value) + (|>> %.nat + (%.format ) + _.local))] + + ["l" local] + ["f" foreign] + ["p" partial] + ) + +(def .public this + /.Value + (..local 0)) + +(def .public variable + (-> Variable + (Operation /.Value)) + (|>> (|.when + {variable.#Local it} + (..local it) + + {variable.#Foreign it} + (..foreign it)) + phase#in)) + +(def .public (constant archive it) + (-> Archive Symbol + (Operation /.Value)) + (phase#each (|>> product.left + reference.artifact + _.local) + (translation.definition archive it))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/runtime.lux index 461b0ead8..47719dab3 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/runtime.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except Declaration Translation) + [lux (.except Declaration) [abstract ["[0]" monad (.only do)]] [data @@ -27,6 +27,7 @@ ["[1][0]" type]] [///// ["[0]" phase] + ["[0]" synthesis] ["[0]" translation] [/// [meta @@ -56,8 +57,8 @@ (type .public Host (translation.Host Value Declaration)) -(type .public (Translation of) - (-> Phase Archive of +(type .public (Term it) + (-> Phase Archive (it synthesis.Term) (Operation Value))) (def .public (host_value of it) @@ -122,7 +123,7 @@ (let [arity (_.int (.int (list.size values))) type (_.type (_.global [..namespace ] (list)))] (lux_value type - (_.new (_.structure type (list arity (_.new (_.array type arity values)))))))) + (_.new (_.structure type (list arity (_.new (_.array //type.value arity values)))))))) (def .public declaration _.Declaration diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/reference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/reference.lux index 214979718..582147ac9 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/reference.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/reference.lux @@ -21,51 +21,54 @@ ["[1][0]" runtime (.only Operation)] ["[1][0]" value] ["[1][0]" type] - ["//[1]" /// - [// - ["[0]" phase (.use "[1]#[0]" monad)] - ["[0]" translation] - [/// - [reference - ["[0]" variable (.only Register Variable)]] - [meta - [archive (.only Archive)]]]]]]) + [//// + ["[0]" phase (.use "[1]#[0]" monad)] + ["[0]" translation] + [/// + [reference + ["[0]" variable (.only Register Variable)]] + [meta + [archive (.only Archive)]]]]]) (def .public this (Bytecode Any) _.aload_0) -(with_template [ ] +(with_template [ ] [(def .public - (-> Register Text) + (-> Register + Text) (|>> %.nat (format )))] - [foreign_name "f"] - [partial_name "p"] + ["f" foreign_name] + ["p" partial_name] ) -(def (foreign archive variable) - (-> Archive Register (Operation (Bytecode Any))) +(def (foreign archive it) + (-> Archive Register + (Operation (Bytecode Any))) (do [! phase.monad] [bytecode_name (of ! each //runtime.class_name (translation.context archive))] (in (all _.composite ..this (_.getfield (type.class bytecode_name (list)) - (..foreign_name variable) + (..foreign_name it) //type.value))))) -(def .public (variable archive variable) - (-> Archive Variable (Operation (Bytecode Any))) - (when variable - {variable.#Local variable} - (phase#in (_.aload variable)) +(def .public (variable archive it) + (-> Archive Variable + (Operation (Bytecode Any))) + (when it + {variable.#Local it} + (phase#in (_.aload it)) - {variable.#Foreign variable} - (..foreign archive variable))) + {variable.#Foreign it} + (..foreign archive it))) (def .public (constant archive name) - (-> Archive Symbol (Operation (Bytecode Any))) + (-> Archive Symbol + (Operation (Bytecode Any))) (do phase.monad [[@definition |abstraction|] (translation.definition archive name) .let [:definition: (type.class (//runtime.class_name @definition) (list))]] diff --git a/stdlib/source/library/lux/world/finance/market/price.lux b/stdlib/source/library/lux/world/finance/market/price.lux index b669147a8..041ce59d7 100644 --- a/stdlib/source/library/lux/world/finance/market/price.lux +++ b/stdlib/source/library/lux/world/finance/market/price.lux @@ -123,17 +123,31 @@ [- i.-] ) + (def too_negative + (of i.interval bottom)) + (def .public (format it) (All (_ $) (%.Format (Action $))) - (let [[currency movement] (nominal.representation it) - [macro micro] (i./% (.int (currency.sub_divisions currency)) - movement)] - (%.format (%.int macro) - (when micro - +0 "" - _ (%.format "." (%.nat (.nat (i.abs micro))))) - " " (currency.alphabetic_code currency)))) + (when (..movement it) + ..too_negative + (|> ..too_negative + ++ + i.abs + .nat + ++ + (money.money (..currency it)) + money.format + (%.format "-")) + + amount + (let [-|+ (if (i.< +0 amount) + "-" + "+")] + (|> (.nat (i.abs amount)) + (money.money (..currency it)) + money.format + (%.format -|+))))) ) (with_template [ ] diff --git a/stdlib/source/library/lux/world/finance/money.lux b/stdlib/source/library/lux/world/finance/money.lux index 3d5903c8c..d53ccd80e 100644 --- a/stdlib/source/library/lux/world/finance/money.lux +++ b/stdlib/source/library/lux/world/finance/money.lux @@ -118,15 +118,34 @@ #amount (n.- (the #amount parameter) (the #amount subject))])}))) + (def (padded range it) + (-> Nat Nat + Text) + (let [range (%.nat (-- range)) + it (%.nat it) + + expected_digits (text.size range) + actual_digits (text.size it)] + (if (n.= expected_digits + actual_digits) + it + (loop (next [leading_zeroes (n.- actual_digits expected_digits) + it it]) + (when leading_zeroes + 0 it + _ (next (-- leading_zeroes) + (%.format "0" it))))))) + (def .public (format it) (All (_ currency) (%.Format (Money currency))) (let [[currency amount] (nominal.representation it) - [macro micro] (n./% (/.sub_divisions currency) amount)] + range (/.sub_divisions currency) + [macro micro] (n./% range amount)] (%.format (%.nat macro) (when micro 0 "" - _ (%.format "." (%.nat micro))) + _ (%.format "." (padded range micro))) " " (/.alphabetic_code currency)))) ) -- cgit v1.2.3