From ab1829d77c7d12af344af68d6c50d391f1126640 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 5 Jan 2023 02:33:52 -0400 Subject: Compilation of simple literals in C++. --- .../source/library/lux/control/security/policy.lux | 12 ++- stdlib/source/library/lux/ffi.lux | 2 +- .../language/lux/phase/extension/analysis/lua.lux | 5 +- .../lux/phase/extension/translation/lua/common.lux | 5 +- .../lux/phase/extension/translation/lua/host.lux | 23 ++--- .../lux/phase/translation/c++/primitive.lux | 28 +++++ .../lux/phase/translation/jvm/primitive.lux | 30 ++++-- .../language/lux/phase/translation/lua.lux | 8 +- .../language/lux/phase/translation/lua/runtime.lux | 28 +++-- stdlib/source/library/lux/meta/target/c++.lux | 114 +++++++++++++++++++++ stdlib/source/library/lux/meta/target/lua.lux | 26 ++--- 11 files changed, 222 insertions(+), 59 deletions(-) create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/primitive.lux create mode 100644 stdlib/source/library/lux/meta/target/c++.lux (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux/control/security/policy.lux b/stdlib/source/library/lux/control/security/policy.lux index 517d60638..9d8059b01 100644 --- a/stdlib/source/library/lux/control/security/policy.lux +++ b/stdlib/source/library/lux/control/security/policy.lux @@ -13,10 +13,12 @@ value (type .public (Can_Upgrade brand label value) - (-> value (Policy brand value label))) + (-> value + (Policy brand value label))) (type .public (Can_Downgrade brand label value) - (-> (Policy brand value label) value)) + (-> (Policy brand value label) + value)) (type .public (Privilege brand label) (Record @@ -51,9 +53,11 @@ (context ..privilege)) (def (of_policy constructor) - (-> Type Type) + (-> Type + Type) (type_literal (All (_ brand label) - (constructor (All (_ value) (Policy brand value label)))))) + (constructor (All (_ value) + (Policy brand value label)))))) (def .public functor (, (..of_policy Functor)) diff --git a/stdlib/source/library/lux/ffi.lux b/stdlib/source/library/lux/ffi.lux index 0ad5a846f..261e555ba 100644 --- a/stdlib/source/library/lux/ffi.lux +++ b/stdlib/source/library/lux/ffi.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Symbol Alias Global Declaration global function type_of undefined) + [lux (.except Symbol Alias Global Declaration global function type_of undefined alias) [abstract ["[0]" monad (.only do)]] [control diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lua.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lua.lux index 06a60ef41..092ca0575 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lua.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lua.lux @@ -23,10 +23,9 @@ [/// ["[0]" extension] [// + ["[0]" phase] ["[0]" analysis (.only Analysis Operation Phase Handler Bundle) - ["[1]/[0]" type]] - [/// - ["[0]" phase]]]]]) + ["[1]/[0]" type]]]]]) (def Nil (for @.lua ffi.Nil diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/lua/common.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/lua/common.lux index 31f782b48..e9a458146 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/lua/common.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/lua/common.lux @@ -40,11 +40,10 @@ ["[1][0]" loop] ["[1][0]" function]]] [// + ["[0]" phase (.use "[1]#[0]" monad)] ["[0]" translation] ["[0]" synthesis (.only %synthesis) - ["?[1]" \\parser (.only Parser)]] - [/// - ["[0]" phase (.use "[1]#[0]" monad)]]]]) + ["?[1]" \\parser (.only Parser)]]]]) (def .public (custom [parser handler]) (All (_ s) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/lua/host.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/lua/host.lux index b69079a05..d27a45487 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/lua/host.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/lua/host.lux @@ -27,11 +27,10 @@ ["[1][0]" runtime (.only Operation Phase Handler Bundle with_vars)]]] ["/[1]" // + ["[0]" phase] ["[0]" translation] [synthesis - ["" \\parser (.only Parser)]] - ["//[1]" /// - ["[1][0]" phase]]]]]) + ["" \\parser (.only Parser)]]]]]) (def array::new (Unary Expression) @@ -67,7 +66,7 @@ (custom [(all <>.and .text .any) (function (_ phase archive [fieldS objectS]) - (do ////////phase.monad + (do phase.monad [objectG (phase archive objectS)] (in (_.the fieldS objectG))))])) @@ -76,7 +75,7 @@ (custom [(all <>.and .text .any (<>.some .any)) (function (_ phase archive [methodS objectS inputsS]) - (do [! ////////phase.monad] + (do [! phase.monad] [objectG (phase archive objectS) inputsG (monad.each ! (phase archive) inputsS)] (in (_.do methodS inputsG objectG))))])) @@ -103,7 +102,7 @@ (custom [.any (function (_ phase archive inputS) - (do [! ////////phase.monad] + (do [! phase.monad] [inputG (phase archive inputS)] (in (<| (_.apply (list inputG)) (_.closure (list $input)) @@ -115,7 +114,7 @@ (custom [.any (function (_ phase archive inputS) - (do [! ////////phase.monad] + (do [! phase.monad] [inputG (phase archive inputS)] (in (_.apply (list (_.apply (list inputG) (_.var "table.unpack"))) @@ -131,13 +130,13 @@ (custom [.text (function (_ phase archive name) - (of ////////phase.monad in (_.var name)))])) + (of phase.monad in (_.var name)))])) (def lua::apply (custom [(all <>.and .any (<>.some .any)) (function (_ phase archive [abstractionS inputsS]) - (do [! ////////phase.monad] + (do [! phase.monad] [abstractionG (phase archive abstractionS) inputsG (monad.each ! (phase archive) inputsS)] (in (_.apply inputsG abstractionG))))])) @@ -146,7 +145,7 @@ (custom [(all <>.and .any .any) (function (_ phase archive [powerS baseS]) - (do [! ////////phase.monad] + (do [! phase.monad] [powerG (phase archive powerS) baseG (phase archive baseS)] (in (_.^ powerG baseG))))])) @@ -155,14 +154,14 @@ (custom [.text (function (_ phase archive module) - (of ////////phase.monad in + (of phase.monad in (_.require/1 (_.string module))))])) (def lua::function (custom [(all <>.and .i64 .any) (function (_ phase archive [arity abstractionS]) - (do [! ////////phase.monad] + (do [! phase.monad] [abstractionG (phase archive abstractionS) .let [variable (is (-> Text (Operation Var)) (|>> translation.symbol diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/primitive.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/primitive.lux new file mode 100644 index 000000000..6deddbdd5 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/primitive.lux @@ -0,0 +1,28 @@ +(.require + [library + [lux (.except i64) + [meta + [target + ["_" c++ (.only Literal Expression)]]]]]) + +(def .public bit + (-> Bit + Literal) + _.bool) + +(def .public i64 + (-> (I64 Any) + Expression) + (|>> .int + _.int + _.int64_t)) + +(def .public f64 + (-> Frac + Literal) + _.double) + +(def .public text + (-> Text + Literal) + _.u32string) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux index 5c9677bb7..db64e3fa0 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux @@ -17,23 +17,23 @@ ["_" bytecode (.only Bytecode)] ["[0]" type] [encoding - ["[0]" signed]]]]]]] - ["[0]" // - ["[1][0]" runtime]]) + ["[0]" signed]]]]]]]) (def $Boolean (type.class "java.lang.Boolean" (list))) (def $Long (type.class "java.lang.Long" (list))) (def $Double (type.class "java.lang.Double" (list))) (def .public (bit value) - (-> Bit (Bytecode Any)) + (-> Bit + (Bytecode Any)) (_.getstatic $Boolean (if value "TRUE" "FALSE") $Boolean)) (def wrap_i64 (_.invokestatic $Long "valueOf" (type.method [(list) (list type.long) $Long (list)]))) (def .public (i64 value) - (-> (I64 Any) (Bytecode Any)) + (-> (I64 Any) + (Bytecode Any)) (when (.int value) (^.with_template [ ] [ @@ -83,14 +83,21 @@ (import java/lang/Double "[1]::[0]" - ("static" doubleToRawLongBits "manual" [double] int)) + ("static" doubleToRawLongBits [double] long)) + +(def double_bits + (-> Frac + Int) + (|>> java/lang/Double::doubleToRawLongBits + ffi.of_long)) (def d0_bits Int - (java/lang/Double::doubleToRawLongBits +0.0)) + (double_bits +0.0)) (def .public (f64 value) - (-> Frac (Bytecode Any)) + (-> Frac + (Bytecode Any)) (when value (^.with_template [ ] [ @@ -122,10 +129,11 @@ [+5.0 _.iconst_5]) _ - (let [constantI (if (i.= ..d0_bits - (java/lang/Double::doubleToRawLongBits (as java/lang/Double value))) + (let [constantI (if (|> value + ..double_bits + (i.= ..d0_bits)) _.dconst_0 - (_.double value))] + (_.double (as java/lang/Double value)))] (do _.monad [_ constantI] ..wrap_f64)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua.lux index b39309d74..3f428775f 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua.lux @@ -27,9 +27,9 @@ ["[1]/[0]" common]]]] ["/[1]" // [analysis (.only)] + ["[0]" phase (.use "[1]#[0]" monad)] ["[0]" synthesis] - ["//[1]" /// - ["[1][0]" phase (.use "[1]#[0]" monad)] + [/// [reference (.only) [variable (.only)]]]]]]]) @@ -41,7 +41,7 @@ (when synthesis (^.with_template [ ] [( @ value) - (//////phase#in ( value))]) + (phase#in ( value))]) ([synthesis.bit /primitive.bit] [synthesis.i64 /primitive.i64] [synthesis.f64 /primitive.f64] @@ -75,7 +75,7 @@ (/loop.scope ///extension/common.statement expression archive scope) (synthesis.loop/again @ updates) - (//////phase.except ..cannot_recur_as_an_expression []) + (phase.except ..cannot_recur_as_an_expression []) (synthesis.function/abstraction @ abstraction) (/function.function ///extension/common.statement expression archive abstraction) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux index 2ff224e3b..78741fe06 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/lua/runtime.lux @@ -250,14 +250,26 @@ (runtime (lux//try risky) - (with_vars [success value] - (all _.then - (_.let (list success value) (|> risky (_.apply (list ..unit)) - _.return (_.closure (list)) - list _.apply (|> (_.var "pcall")))) - (_.if success - (_.return (..right value)) - (_.return (..left value)))))) + (let [closure (|> risky + (_.apply (list ..unit)) + _.return + (_.closure (list))) + $debug (_.var "debug") + $xpcall (_.var "xpcall")] + (with_vars [success value] + (_.if (_.and $debug $xpcall) + (all _.then + (_.let (list success value) (_.apply (list closure (_.the "traceback" $debug)) + $xpcall)) + (_.if success + (_.return (..right value)) + (_.return (..left value)))) + (all _.then + (_.let (list success value) (_.apply (list closure) + (_.var "pcall"))) + (_.if success + (_.return (..right value)) + (_.return (..left value)))))))) (runtime (lux//program_args raw) diff --git a/stdlib/source/library/lux/meta/target/c++.lux b/stdlib/source/library/lux/meta/target/c++.lux new file mode 100644 index 000000000..b8c2414f4 --- /dev/null +++ b/stdlib/source/library/lux/meta/target/c++.lux @@ -0,0 +1,114 @@ +(.require + [library + [lux (.except Code Type int) + [control + ["|" pipe]] + [data + ["[0]" text (.only) + ["%" \\format]] + [collection + ["[0]" list (.use "[1]#[0]" functor)]]] + [math + [number + ["f" frac]]] + [meta + [macro + ["[0]" template]] + [type + ["[0]" nominal]]]]]) + +(nominal.def .public (Code of) + Text + + (def .public code + (-> (Code Any) + Text) + (|>> nominal.representation)) + + (with_template [ +] + [(with_expansions [ (template.symbol [ "'"])] + (nominal.def ( of) + Any) + (`` (type .public + (|> Any (,, (template.spliced +))))))] + + [Type [Code]] + [Expression [Code]] + [Computation [Expression' Code]] + ) + + (with_template [ +] + [(with_expansions [ (template.symbol [ "'"])] + (nominal.def Any) + (`` (type .public (|> (,, (template.spliced +))))))] + + [Literal [Computation' Expression' Code]] + ) + + (def .public bool + (-> Bit + Literal) + (|>> (|.when + .false "false" + .true "true") + nominal.abstraction)) + + (def .public double + (-> Frac + Literal) + (|>> (|.cond [(f.= f.positive_infinity)] + [(|.new "(+1.0/0.0)" [])] + + [(f.= f.negative_infinity)] + [(|.new "(-1.0/0.0)" [])] + + [(f.= f.not_a_number)] + [(|.new "(0.0/0.0)" [])] + + ... else + [%.frac]) + nominal.abstraction)) + + (def .public (cast type term) + (-> Type Expression + Computation) + (nominal.abstraction + (%.format "(" (nominal.representation type) ")" + " " (nominal.representation term)))) + + (def .public int + (-> Int + Literal) + (|>> %.int + nominal.abstraction)) + + (def .public (on parameters function) + (-> (List Expression) Expression + Expression) + (nominal.abstraction + (%.format (nominal.representation function) + "(" + (|> parameters + (list#each (|>> nominal.representation)) + (text.interposed ", ")) + ")"))) + + ... https://en.cppreference.com/w/cpp/types/integer + (with_template [] + [(def .public ( it) + (-> Expression + Expression) + (..on (list it) + (nominal.abstraction (template.text []))))] + + [int64_t] + ) + + ... https://en.cppreference.com/w/cpp/string/basic_string + (def .public u32string + (-> Text + Literal) + (|>> %.text + (%.format "U") + nominal.abstraction)) + ) diff --git a/stdlib/source/library/lux/meta/target/lua.lux b/stdlib/source/library/lux/meta/target/lua.lux index 84a566839..bc5ead9aa 100644 --- a/stdlib/source/library/lux/meta/target/lua.lux +++ b/stdlib/source/library/lux/meta/target/lua.lux @@ -6,7 +6,7 @@ [hash (.only Hash)] ["[0]" enum]] [control - ["[0]" pipe]] + ["|" pipe]] [data ["[0]" text (.only) ["%" \\format (.only format)]] @@ -91,7 +91,7 @@ (def .public boolean (-> Bit Literal) - (|>> (pipe.when + (|>> (|.when #0 "false" #1 "true") abstraction)) @@ -108,17 +108,17 @@ (def .public float (-> Frac Literal) - (|>> (pipe.cond [(f.= f.positive_infinity)] - [(pipe.new "(1.0/0.0)" [])] - - [(f.= f.negative_infinity)] - [(pipe.new "(-1.0/0.0)" [])] - - [(f.= f.not_a_number)] - [(pipe.new "(0.0/0.0)" [])] - - ... else - [%.frac (text.replaced "+" "")]) + (|>> (|.cond [(f.= f.positive_infinity)] + [(|.new "(1.0/0.0)" [])] + + [(f.= f.negative_infinity)] + [(|.new "(-1.0/0.0)" [])] + + [(f.= f.not_a_number)] + [(|.new "(0.0/0.0)" [])] + + ... else + [%.frac (text.replaced "+" "")]) abstraction)) (def safe -- cgit v1.2.3