From 4ec923fe46f66ba8731fc4b7334e724d63dec73e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 21 Jan 2023 19:12:00 -0400 Subject: Can now extract values from the C++ interpreter for evaluation. --- stdlib/source/library/lux/math/number/ratio.lux | 8 +- .../lux/phase/translation/c++/primitive.lux | 8 +- .../language/lux/phase/translation/c++/runtime.lux | 310 +++++++++++++++++---- .../language/lux/phase/translation/c++/type.lux | 4 - .../language/lux/phase/translation/c++/when.lux | 7 +- .../phase/translation/jvm/function/abstract.lux | 11 +- .../language/lux/phase/translation/jvm/runtime.lux | 11 +- .../lux/meta/compiler/language/lux/synthesis.lux | 4 +- .../library/lux/meta/compiler/target/c++.lux | 42 ++- .../library/lux/meta/compiler/target/c++/type.lux | 40 +-- .../lux/meta/compiler/target/jvm/modifier.lux | 16 +- 11 files changed, 342 insertions(+), 119 deletions(-) (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux/math/number/ratio.lux b/stdlib/source/library/lux/math/number/ratio.lux index 9fafc9911..15135ceb7 100644 --- a/stdlib/source/library/lux/math/number/ratio.lux +++ b/stdlib/source/library/lux/math/number/ratio.lux @@ -56,10 +56,10 @@ (def .public (= parameter subject) (-> Ratio Ratio Bit) - (and (n.= (the #numerator parameter) - (the #numerator subject)) - (n.= (the #denominator parameter) - (the #denominator subject)))) + (n.= (n.* (the #numerator parameter) + (the #denominator subject)) + (n.* (the #denominator parameter) + (the #numerator subject)))) (def .public equivalence (Equivalence Ratio) 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 6b45145c1..b4c7a811c 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 @@ -16,7 +16,7 @@ (-> Bit _.Expression) (|>> _.bool - (runtime.simple type.bit))) + (runtime.simple runtime.Bit))) (def .public i64 (-> (I64 Any) @@ -24,16 +24,16 @@ (|>> .int _.int _.int64_t - (runtime.simple type.i64))) + (runtime.simple runtime.I64))) (def .public f64 (-> Frac _.Expression) (|>> _.double - (runtime.simple type.f64))) + (runtime.simple runtime.F64))) (def .public text (-> Text _.Expression) (|>> _.u32_string - (runtime.simple type.text))) + (runtime.simple runtime.Text))) 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 47719dab3..aff1774a1 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,8 @@ (.require [library - [lux (.except Declaration) + [lux (.except Type Declaration + Bit I64 F64 Text Variant Tuple) [abstract ["[0]" monad (.only do)]] [data @@ -33,6 +34,7 @@ [meta [archive (.only Output Archive) ["[0]" registry (.only Registry)] + ["[0]" artifact] ["[0]" unit]]]]]) (type .public Anchor @@ -61,13 +63,6 @@ (-> Phase Archive (it synthesis.Term) (Operation Value))) -(def .public (host_value of it) - (-> _.Type _.Expression - _.Expression) - (|> it - (_.do "get" (list) (list)) - (_.as (_.* of)))) - (def .public namespace _.Namespace "lux") @@ -82,104 +77,299 @@ (with_expansions [ (..name) - (..name) + (..name) (..name) (..name) (..name) - (..name) + (..name) (..name) (..name) - (..name)] + (..name) + (..name) + (..name) + (..name) + (..name) + (..name) + (..name) + (..name) + + (..name) + (..name) + (..name) + + (..name) + + (..name) + (..name) + (..name) + (..name) + + (..name) + (..name) + (..name) + + (..name) + (..name)] + (with_template [ ] + [(def .public + Nat + )] + + [0 bit_tag] + [1 i64_tag] + [2 f64_tag] + [3 text_tag] + [4 variant_tag] + [5 tuple_tag] + [6 function_tag] + ) + + (with_template [ ] + [(def .public + .Text + )] + + [object_tag ] + [lux_bit ] + [lux_i64 ] + [lux_text ] + + [variant_lefts ] + [variant_right? ] + [variant_choice ] + + [tuple_arity ] + [tuple_member ] + ) + + (def object_type + _.Type + (_.type (_.global [(list ..namespace) ] (list)))) + + (def .public value_type + _.Type + (type.shared_ptr object_type)) + (def .public clean_up (-> _.Type _.Expression) (|>> (list) - (_.global [..namespace ]))) + (_.global [(list ..namespace) ]))) - (def .public (lux_value of it) - (-> _.Type _.Expression + (type .public Type + [_.Expression _.Type]) + + (def variant_type + (_.type (_.global [(list ..namespace) ] (list)))) + + (def tuple_type + (_.type (_.global [(list ..namespace) ] (list)))) + + (with_template [ ] + [(def .public + ..Type + [(_.global [(list ..namespace ) ] (list)) + ])] + + [Bit //type.bit] + [I64 //type.i64] + [F64 //type.f64] + [Text //type.text] + [Variant ..variant_type] + [Tuple ..tuple_type] + ) + + (def (lux_value [tag of] it) + (-> ..Type _.Expression _.Expression) - (_.on (list it (clean_up of)) - (_.global [_.standard "shared_ptr"] (list type.void)))) + (_.on (list (_.new (_.structure object_type (list tag it))) + (clean_up of)) + (_.global [(list _.standard) "shared_ptr"] (list object_type)))) - (def .public (simple of it) + (def .public (host_value of it) (-> _.Type _.Expression _.Expression) - (lux_value of + (|> it + (_.the* ) + (_.is (_.* of)))) + + (def .public (simple [tag of] it) + (-> ..Type _.Expression + _.Expression) + (lux_value [tag of] (_.new (_.of (list it) of)))) (def .public (variant lefts right? choice) (-> _.Expression _.Expression _.Expression _.Expression) - (let [type (_.type (_.global [..namespace ] (list)))] - (lux_value type - (_.new (_.structure type (list lefts right? choice)))))) + (|> (list lefts + right? + choice) + (_.structure ..variant_type) + _.new + (lux_value ..Variant))) (def .public (tuple values) (-> (List _.Expression) _.Expression) - (let [arity (_.int (.int (list.size values))) - type (_.type (_.global [..namespace ] (list)))] - (lux_value type - (_.new (_.structure type (list arity (_.new (_.array //type.value arity values)))))))) + (let [arity (_.int (.int (list.size values)))] + (|> (list arity + (_.new (_.array value_type arity values))) + (_.structure ..tuple_type) + _.new + (lux_value ..Tuple)))) (def .public declaration _.Declaration - (let [clean_up (let [of (_.type_name "Of") - it (_.local "it")] - (_.function (_.local ) - (list of) - (list [(_.* of) it]) - type.void - (_.delete it))) - - $variant (_.local ) - $tuple (_.local ) + (let [$Variant (_.local ) + $Tuple (_.local ) $values (_.local ) - :variant (_.type $variant) - :tuple (_.type $tuple)] + $Type (_.local ) + $bit? (_.local ) + $i64? (_.local ) + $f64? (_.local ) + $text? (_.local ) + $variant? (_.local ) + $tuple? (_.local ) + $function? (_.local ) + + $Object (_.local ) + $value (_.local ) + :Object (_.type $Object)] (all _.also (_.include "memory") + (_.include "codecvt") + (_.include "locale") (<| (_.namespace ..namespace) - (all _.also - clean_up - - (_.constant (_.local ) - //type.value - (..simple //type.text (_.u32_string ""))) - - (<| (_.structure_definition $variant) - [(list [(_.local ) //type.lefts] - [(_.local ) //type.right?] - [(_.local ) //type.value]) - (list)]) - - (<| (_.structure_definition $tuple) - [(list [(_.local ) //type.arity] - [$values (_.* //type.value)]) - (list (<| (_.destructor $tuple) - (_.delete_array $values)))]) - ))))) + (`` (all _.also + (<| (_.enum_definition $Type) + (list $bit? + $i64? + $f64? + $text? + $variant? + $tuple? + $function?)) + + (<| (_.structure_definition $Object) + [(list [(_.local ) (_.type $Type)] + [(_.local ) (_.* type.void)]) + (list)]) + + (<| (_.structure_definition $Variant) + [(list [(_.local ) //type.lefts] + [(_.local ) //type.right?] + [(_.local ) value_type]) + (list)]) + + (<| (_.structure_definition $Tuple) + [(list [(_.local ) //type.arity] + [$values (_.* value_type)]) + (list (<| (_.destructor $Tuple) + (_.delete_array $values)))]) + + (let [of (_.type_name "Of") + it (_.local "it")] + (_.function (_.local ) + (list of) + (list [(_.* :Object) it]) + type.void + (all _.then + (_.delete (host_value of it)) + (_.delete it) + ))) + + (_.constant (_.local ) + value_type + (..simple ..Text (_.u32_string ""))) + + ... Out functions + (let [it (_.local "it")] + (_.function (_.local ) + (list) + (list [..value_type it]) + //type.i64 + (_.return (_.the* it)))) + + (,, (with_template [ ] + [(let [it (_.local "it")] + (_.function (_.local ) + (list) + (list [..value_type it]) + + (_.return (_.deref (host_value it)))))] + + [ //type.bit] + [ //type.i64] + )) + + (let [it (_.local "it") + converter (_.local "converter") + converter_type (_.type (_.global [(list _.standard) "wstring_convert"] + (list (_.type (_.global [(list _.standard) "codecvt_utf8"] + (list type.char32))) + type.char32)))] + (_.function (_.local ) + (list) + (list [..value_type it]) + type.string + (all _.then + (_.var_declaration converter converter_type) + (_.return (_.do "to_bytes" + (list) + (list (_.deref (host_value //type.text it))) + converter))))) + + (,, (with_template [ ] + [(let [it (_.local "it")] + (_.function (_.local ) + (list) + (list [..value_type it]) + + (_.return (_.the* (host_value ..variant_type it)))))] + + [ //type.i64] + [ //type.bit] + [ ..value_type] + )) + + (let [it (_.local "it")] + (_.function (_.local ) + (list) + (list [..value_type it]) + //type.i64 + (_.return (_.the* (host_value ..tuple_type it))))) + + (let [item (_.local "item") + it (_.local "it")] + (_.function (_.local ) + (list) + (list [//type.i64 item] + [..value_type it]) + ..value_type + (_.return (_.item item (_.the* (host_value ..tuple_type it)))))) + )))))) (def .public unit _.Expression - (_.global [..namespace ] (list))) + (_.global [(list ..namespace) ] (list))) ) -(def artifact_id +(def .public id + artifact.ID 0) (def .public translation (Operation [Registry Output]) (do phase.monad [_ (translation.execute! ..declaration) - _ (translation.save! ..artifact_id {.#None} ..declaration)] + _ (translation.save! ..id {.#None} ..declaration)] (in [(|> registry.empty (registry.resource .true unit.none) product.right) - (sequence.sequence [..artifact_id {.#None} + (sequence.sequence [..id {.#None} (of utf8.codec encoded (_.code ..declaration))])]))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/type.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/type.lux index 378105897..500452fed 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/type.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/type.lux @@ -26,10 +26,6 @@ _.Type type.u32_string) -(def .public value - _.Type - (type.shared_ptr type.void)) - (def .public lefts _.Type type.char) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/when.lux index 7dda901f2..5d694d973 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/when.lux @@ -24,7 +24,6 @@ [target ["_" c++]]]]]] ["[0]" // - ["[1][0]" type] ["[1][0]" reference] ["[1][0]" runtime (.only Operation Phase Term)] [//// @@ -53,7 +52,7 @@ bindings (monad.each ! (function (_ [binding value]) (do ! [value (next archive value)] - (in (_.variable (//reference.local binding) //type.value value)))) + (in (_.variable (//reference.local binding) //runtime.value_type value)))) (list.partial context tail)) body (next archive body)] @@ -62,7 +61,7 @@ [0 _] (list) [_ _] (list _.all_by_value)) (list) - {.#Some //type.value} + {.#Some //runtime.value_type} (list#mix _.then (_.return body) (list.reversed bindings)) @@ -79,7 +78,7 @@ (in (_.on (list) (_.lambda (list _.all_by_value) (list) - {.#Some //type.value} + {.#Some //runtime.value_type} (list#mix _.then (_.return after) (list.reversed all_before))))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/abstract.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/abstract.lux index b02273a95..8b3e56817 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/abstract.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/abstract.lux @@ -12,14 +12,19 @@ [target [jvm ["[0]" type (.only Type) - [category (.only Method)]]]]]]]] + [category (.only Method)]]]] + [meta + [archive + ["[0]" artifact]]]]]]] [// [field [constant ["[0]" arity]]]]) -... (def .public artifact_id -... 1) +(def .public id + artifact.ID + ... (++ runtime.id) + 1) (def .public class ... (type.class (%.nat artifact_id) (list)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux index e842eb060..be90a4867 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux @@ -106,11 +106,12 @@ "." (%.nat module) "." (%.nat id))) -(def artifact_id +(def .public id + artifact.ID 0) (def .public class - (type.class (class_name [0 ..artifact_id]) (list))) + (type.class (class_name [0 ..id]) (list))) (def procedure (-> Text (Type category.Method) (Bytecode Any)) @@ -593,8 +594,8 @@ (list)))] (do phase.monad [_ (translation.execute! [class bytecode]) - _ (translation.save! ..artifact_id {.#None} [class bytecode])] - (in [..artifact_id {.#None} bytecode])))) + _ (translation.save! ..id {.#None} [class bytecode])] + (in [..id {.#None} bytecode])))) (def translate_function (Operation Any) @@ -655,7 +656,7 @@ (list)))] (do phase.monad [_ (translation.execute! [class bytecode]) - ... _ (translation.save! //function.artifact_id {.#None} [class bytecode]) + ... _ (translation.save! //function.id {.#None} [class bytecode]) ] (in [])))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux index d10fdd654..81f4e5393 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux @@ -106,9 +106,9 @@ (type .public (If of) (Record - [##if_when of + [#if_when of #if_then of - ##if_else of])) + #if_else of])) (type .public (Branch of) (Variant diff --git a/stdlib/source/library/lux/meta/compiler/target/c++.lux b/stdlib/source/library/lux/meta/compiler/target/c++.lux index 014bf887a..dc080c656 100644 --- a/stdlib/source/library/lux/meta/compiler/target/c++.lux +++ b/stdlib/source/library/lux/meta/compiler/target/c++.lux @@ -4,7 +4,7 @@ (.require [library [lux (.except Code Type Global Declaration Definition - int as function template local global type also of) + int as function template local global type also of is) [abstract [equivalence (.only Equivalence)]] [control @@ -29,6 +29,8 @@ (def statement_separator ";") (def parameter_separator (%.format "," " ")) +(def namespace_separator "::") + (def term_delimiters ["(" ")"]) (def template_delimiters ["<" ">"]) (def initialization_delimiters ["{" "}"]) @@ -149,13 +151,15 @@ (text.interposed ..parameter_separator) (text.enclosed ..template_delimiters))))) - (def .public (global [ns name] parameters) - (-> [Namespace Text] (List Type) + (def .public (global [ns/* name] parameters) + (-> [(List Namespace) Text] (List Type) Global) (<% (let [instance (%.format name (instantiation parameters))] - (when ns - "" instance - _ (%.format ns "::" instance))))) + (when ns/* + (list) instance + _ (%.format (text.interposed ..namespace_separator ns/*) + ..namespace_separator + instance))))) (def .public type (-> Reference @@ -181,10 +185,12 @@ (text.prefix "*") <%)) - (def .public (as type term) + (def .public (is type term) (-> Type Expression Computation) - (<% (%.format "(" (%> type) ")" + (<| <% + (text.enclosed ..term_delimiters) + (%.format "(" (%> type) ")" " " (%> term)))) (def .public int @@ -418,6 +424,16 @@ methods)) (text.interposed \n)))))) + (def .public (enum_definition name options) + (-> Local (List Local) + Definition) + (..statement + (%.format "enum" + " " (%> name) + " " (block (|> options + (list#each ..code) + (text.interposed ..parameter_separator)))))) + (def captures (-> (List Capture) Text) @@ -453,4 +469,14 @@ (%.format (%> when) " ? " (%> then) " : " (%> else)))) + + (def .public (the* field owner) + (-> Text Expression + Expression) + (<% (%.format (%> owner) "->" field))) + + (def .public (item index array) + (-> Expression Expression + Expression) + (<% (%.format (%> array) "[" (%> index) "]"))) ) diff --git a/stdlib/source/library/lux/meta/compiler/target/c++/type.lux b/stdlib/source/library/lux/meta/compiler/target/c++/type.lux index 0227ed9a5..e8365ff52 100644 --- a/stdlib/source/library/lux/meta/compiler/target/c++/type.lux +++ b/stdlib/source/library/lux/meta/compiler/target/c++/type.lux @@ -9,30 +9,26 @@ ["[0]" template]]]]] ["/" //]) -(with_template [ /*] - [(`` (with_template [] - [(def .public - /.Type - (/.type (/.global [ (template.text [])] (list))))] - - (,, (template.spliced /*))))] - - ["" - [[void] - [bool] - [char] - [short] - [int] - [long] - [float] - [double]]] +(with_template [] + [(def .public + /.Type + (/.type (/.global [(list) (template.text [])] (list))))] + + [void] + [bool] + [char] + [short] + [int] + [long] + [float] + [double] ) (with_template [ /*] [(`` (with_template [ ] [(def .public /.Type - (/.type (/.global [ ] (list))))] + (/.type (/.global [(list ) ] (list))))] (,, (template.spliced /*))))] @@ -48,7 +44,11 @@ (with_template [ ] [(def .public /.Type - (/.type (/.global ["" ] (list))))] + (/.type (/.global [(list) ] (list))))] + + [char08 "char8_t"] + [char16 "char16_t"] + [char32 "char32_t"] [int_08 "int8_t"] [int_16 "int16_t"] @@ -91,5 +91,5 @@ (-> /.Type /.Type) (|>> list - (/.global [/.standard "shared_ptr"]) + (/.global [(list /.standard) "shared_ptr"]) /.type)) diff --git a/stdlib/source/library/lux/meta/compiler/target/jvm/modifier.lux b/stdlib/source/library/lux/meta/compiler/target/jvm/modifier.lux index 5308b33f7..b3f78693a 100644 --- a/stdlib/source/library/lux/meta/compiler/target/jvm/modifier.lux +++ b/stdlib/source/library/lux/meta/compiler/target/jvm/modifier.lux @@ -31,11 +31,13 @@ //unsigned.U2 (def .public code - (-> (Modifier Any) //unsigned.U2) + (-> (Modifier Any) + //unsigned.U2) (|>> representation)) (def .public equivalence - (All (_ of) (Equivalence (Modifier of))) + (All (_ of) + (Equivalence (Modifier of))) (implementation (def (= reference sample) (of //unsigned.equivalence = @@ -56,14 +58,17 @@ //unsigned.value)])) (def .public (has? sub super) - (All (_ of) (-> (Modifier of) (Modifier of) Bit)) + (All (_ of) + (-> (Modifier of) (Modifier of) + Bit)) (let [sub (!representation sub)] (|> (!representation super) (i64.and sub) (of i64.equivalence = sub)))) (def .public monoid - (All (_ of) (Monoid (Modifier of))) + (All (_ of) + (Monoid (Modifier of))) (implementation (def identity (!abstraction (hex "0000"))) @@ -77,7 +82,8 @@ (of ..monoid identity)) (def .public format - (All (_ of) (Format (Modifier of))) + (All (_ of) + (Format (Modifier of))) (|>> representation //unsigned.format/2)) ) -- cgit v1.2.3