From dfe09eb7a90dbf164bc0c78085b2d340e0928190 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 17 Jan 2023 01:14:08 -0400 Subject: Added compilation of (almost all non-loop) control structures for C++. --- stdlib/source/library/lux.lux | 156 +++++++++++---------- .../language/lux/phase/translation/c++.lux | 18 +-- .../lux/phase/translation/c++/reference.lux | 8 +- .../language/lux/phase/translation/c++/when.lux | 124 ++++++++++++++++ .../jvm/function/field/variable/count.lux | 18 +-- .../translation/jvm/function/method/apply.lux | 2 + .../library/lux/meta/compiler/target/c++.lux | 55 +++++++- stdlib/source/test/lux/math/number/ratio.lux | 30 +++- .../lux/phase/translation/jvm/function.lux | 5 +- .../jvm/function/field/variable/count.lux | 139 ++++++++++++++++++ stdlib/source/test/lux/world/time/series.lux | 2 +- 11 files changed, 448 insertions(+), 109 deletions(-) create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/when.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/field/variable/count.lux (limited to 'stdlib/source') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index bf922ec17..6046012c7 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -89,10 +89,10 @@ {2 #0 Text Text}}) #1) -... (type .public (List a) +... (type .public (List of) ... (Variant ... {#End} -... {#Item a (List a)})) +... {#Item of (List of)})) (.def# List (.is_type# {9 #1 @@ -110,59 +110,22 @@ {4 #0 0}}}}}}) #1) -... (type .public Tag -... (Nominal "#Tag")) -(.def# Tag - (.is_type# - {9 #1 [..prelude "Tag"] - {0 #0 "#Tag" {0 #0}}}) - #1) - -... (type .public Slot -... (Nominal "#Slot")) -(.def# Slot - (.is_type# - {9 #1 [..prelude "Slot"] - {0 #0 "#Slot" {0 #0}}}) - #1) - -(.def# Label' - (.is_type# - {1 #0 [Any {2 #0 [Nat {2 #0 [Bit {9 #0 Symbol List}]}]}]}) - #0) - -(.def# list_tags - (.is# {9 #0 Symbol List} - {0 #1 [[..prelude "#End"] - {0 #1 [[..prelude "#Item"] - {0 #0}]}]}) - #0) -(.def# #End (.as# Tag [(.is# Label' {0 #1 [0 #0 ..list_tags]}) List]) #1) -(.def# #Item (.as# Tag [(.is# Label' {0 #1 [0 #1 ..list_tags]}) List]) #1) - -... (type .public (Maybe a) -... {#None} -... {#Some a}) +... (type .public (Maybe of) +... (Variant +... {#None} +... {#Some of})) (.def# Maybe (.is_type# {9 #1 [..prelude "Maybe"] {7 #0 - {#End} + {0 #0} {1 #0 ... None Any ... Some {4 #0 1}}}}) #1) -(.def# maybe_tags - (.is# {9 #0 Symbol List} - {0 #1 [[..prelude "#None"] - {0 #1 [[..prelude "#Some"] - {0 #0}]}]}) - #0) -(.def# #None (.as# Tag [(.is# Label' {0 #1 [0 #0 ..maybe_tags]}) Maybe]) #1) -(.def# #Some (.as# Tag [(.is# Label' {0 #1 [0 #1 ..maybe_tags]}) Maybe]) #1) ... (type .public Type ... (Rec Type @@ -185,9 +148,9 @@ ({Type_List ({Type_Pair {9 #0 - {0 #0 ["" {#End}]} + {0 #0 ["" {0 #0}]} {7 #0 - {#End} + {0 #0} {1 #0 ... Nominal {2 #0 Text Type_List} @@ -222,9 +185,67 @@ {2 #0 Symbol Type}}}}}}}}}}}}}} (.is_type# {2 #0 Type Type}))} (.is_type# {9 #0 Type List}))} - (.is_type# {9 #0 {0 #0 ["" {#End}]} {4 #0 0}}))}) + (.is_type# {9 #0 {0 #0 ["" {0 #0}]} {4 #0 0}}))}) + #1) + +... (type .public Label +... [(Maybe [Nat Bit (List Symbol)]) +... Type]) +(.def# Label + (.is_type# + {9 #1 [..prelude "Label"] + {2 #0 + {9 #0 {2 #0 Nat + {2 #0 Bit + {9 #0 Symbol List}}} + Maybe} + Type}}) + #1) + +... (type .public Tag +... (Nominal "#Tag")) +(.def# Tag + (.is_type# + {9 #1 [..prelude "Tag"] + {0 #0 "#Tag" {0 #0}}}) + #1) + +... (type .public Slot +... (Nominal "#Slot")) +(.def# Slot + (.is_type# + {9 #1 [..prelude "Slot"] + {0 #0 "#Slot" {0 #0}}}) #1) +(.def# tag + (.is# {3 #0 Label Tag} + ([_ it] (.as# Tag it))) + #0) + +(.def# slot + (.is# {3 #0 Label Slot} + ([_ it] (.as# Slot it))) + #0) + +(.def# list_tags + (.is# {9 #0 Symbol List} + {0 #1 [[..prelude "#End"] + {0 #1 [[..prelude "#Item"] + {0 #0}]}]}) + #0) +(.def# #End (..tag [{0 #1 [0 #0 ..list_tags]} List]) #1) +(.def# #Item (..tag [{0 #1 [0 #1 ..list_tags]} List]) #1) + +(.def# maybe_tags + (.is# {9 #0 Symbol List} + {0 #1 [[..prelude "#None"] + {0 #1 [[..prelude "#Some"] + {0 #0}]}]}) + #0) +(.def# #None (..tag [{0 #1 [0 #0 ..maybe_tags]} Maybe]) #1) +(.def# #Some (..tag [{0 #1 [0 #1 ..maybe_tags]} Maybe]) #1) + (.def# type_tags (.is# {9 #0 Symbol List} {0 #1 [[..prelude "#Nominal"] @@ -240,36 +261,17 @@ {0 #1 [[..prelude "#Named"] {0 #0}]}]}]}]}]}]}]}]}]}]}]}) #0) -(.def# #Nominal (.as# Tag [(.is# Label' {#Some [0 #0 ..type_tags]}) Type]) #1) -(.def# #Sum (.as# Tag [(.is# Label' {#Some [1 #0 ..type_tags]}) Type]) #1) -(.def# #Product (.as# Tag [(.is# Label' {#Some [2 #0 ..type_tags]}) Type]) #1) -(.def# #Function (.as# Tag [(.is# Label' {#Some [3 #0 ..type_tags]}) Type]) #1) -(.def# #Parameter (.as# Tag [(.is# Label' {#Some [4 #0 ..type_tags]}) Type]) #1) -(.def# #Var (.as# Tag [(.is# Label' {#Some [5 #0 ..type_tags]}) Type]) #1) -(.def# #Ex (.as# Tag [(.is# Label' {#Some [6 #0 ..type_tags]}) Type]) #1) -(.def# #UnivQ (.as# Tag [(.is# Label' {#Some [7 #0 ..type_tags]}) Type]) #1) -(.def# #ExQ (.as# Tag [(.is# Label' {#Some [8 #0 ..type_tags]}) Type]) #1) -(.def# #Apply (.as# Tag [(.is# Label' {#Some [9 #0 ..type_tags]}) Type]) #1) -(.def# #Named (.as# Tag [(.is# Label' {#Some [9 #1 ..type_tags]}) Type]) #1) - -... (type .public Label -... [(Maybe [Nat Bit (List Symbol)]) Type]) -(.def# Label - (.is# Type - {#Named [..prelude "Label"] - {#Product {#Apply {#Product Nat {#Product Bit {#Apply Symbol List}}} Maybe} - Type}}) - #1) - -(.def# tag - (.is# {#Function Label Tag} - ([_ it] (.as# Tag it))) - #0) - -(.def# slot - (.is# {#Function Label Slot} - ([_ it] (.as# Slot it))) - #0) +(.def# #Nominal (..tag [{#Some [0 #0 ..type_tags]} Type]) #1) +(.def# #Sum (..tag [{#Some [1 #0 ..type_tags]} Type]) #1) +(.def# #Product (..tag [{#Some [2 #0 ..type_tags]} Type]) #1) +(.def# #Function (..tag [{#Some [3 #0 ..type_tags]} Type]) #1) +(.def# #Parameter (..tag [{#Some [4 #0 ..type_tags]} Type]) #1) +(.def# #Var (..tag [{#Some [5 #0 ..type_tags]} Type]) #1) +(.def# #Ex (..tag [{#Some [6 #0 ..type_tags]} Type]) #1) +(.def# #UnivQ (..tag [{#Some [7 #0 ..type_tags]} Type]) #1) +(.def# #ExQ (..tag [{#Some [8 #0 ..type_tags]} Type]) #1) +(.def# #Apply (..tag [{#Some [9 #0 ..type_tags]} Type]) #1) +(.def# #Named (..tag [{#Some [9 #1 ..type_tags]} Type]) #1) ... (type .public Location ... (Record 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 395d31e39..6b1423ba0 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 @@ -29,7 +29,7 @@ ["[1][0]" complex] ["[1][0]" reference] ... ["[1][0]" function] - ... ["[1][0]" when] + ["[1][0]" when] ... ["[1][0]" loop] [/// ["[0]" extension] @@ -59,8 +59,8 @@ (synthesis.tuple @ it) (/complex.tuple phase archive it) - [@ {synthesis.#Reference reference}] - (when reference + [@ {synthesis.#Reference it}] + (when it {reference.#Variable it} (/reference.variable it) @@ -70,14 +70,14 @@ ... (synthesis.branch/when @ [valueS pathS]) ... (/when.when phase archive [valueS pathS]) - ... (synthesis.branch/exec @ [this that]) - ... (/when.exec phase archive [this that]) + (synthesis.branch/exec @ it) + (/when.exec phase archive it) - ... (synthesis.branch/let @ [inputS register bodyS]) - ... (/when.let phase archive [inputS register bodyS]) + (synthesis.branch/let @ it) + (/when.let phase archive it) - ... (synthesis.branch/if @ [conditionS thenS elseS]) - ... (/when.if phase archive [conditionS thenS elseS]) + (synthesis.branch/if @ it) + (/when.if phase archive it) ... (synthesis.branch/get @ [path recordS]) ... (/when.get phase archive [path recordS]) 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 index b43340b91..f449c76bf 100644 --- 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 @@ -32,7 +32,7 @@ (with_template [ ] [(def .public (-> Register - /.Value) + _.Local) (|>> %.nat (%.format ) _.local))] @@ -43,12 +43,12 @@ ) (def .public this - /.Value + _.Local (..local 0)) (def .public variable (-> Variable - (Operation /.Value)) + (Operation _.Local)) (|>> (|.when {variable.#Local it} (..local it) @@ -59,7 +59,7 @@ (def .public (constant archive it) (-> Archive Symbol - (Operation /.Value)) + (Operation _.Reference)) (phase#each (|>> product.left reference.artifact _.local) 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 new file mode 100644 index 000000000..1f58294e5 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/when.lux @@ -0,0 +1,124 @@ +... 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 Type Label if let exec when int) + [abstract + ["[0]" monad (.only do)]] + [control + ["[0]" function]] + [data + [collection + ["[0]" list (.use "[1]#[0]" mix)]] + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format (.only format)]]] + [math + [number + ["n" nat] + ["[0]" i32]]] + [meta + [macro + ["^" pattern]] + [compiler + [target + ["_" c++]]]]]] + ["[0]" // + ["[1][0]" type] + ["[1][0]" reference] + ["[1][0]" runtime (.only Operation Phase Term)] + [//// + ["[0]" phase (.use "[1]#[0]" functor)] + ["[0]" translation] + ["[0]" synthesis (.only Path Fork) + [access + ["[0]" member (.only Member)]]] + [/// + [reference + [variable (.only Register)]]]]]) + +(type (If of) + (Record + [#when of + #then of + #else of])) + +(def .public (if next archive it) + (Term If) + (do phase.monad + [when (next archive (the #when it)) + then (next archive (the #then it)) + else (next archive (the #else it))] + (in (_.? when then else)))) + +(type (Let of) + (Record + [#input of + #register Register + #body of])) + +(def (sub_bindings body) + (-> synthesis.Term + [(List [Register synthesis.Term]) synthesis.Term]) + (.when body + (synthesis.branch/let @ [input register body]) + (.let [[tail body] (sub_bindings body)] + [(list.partial [register input] tail) body]) + + _ + [(list) body])) + +(def .public (let next archive it) + (Term Let) + (do [! phase.monad] + [.let [[tail body] (sub_bindings (the #body it)) + head_binding (the #register it)] + bindings (monad.each ! (function (_ [binding value]) + (do ! + [value (next archive value)] + (in (_.variable (//reference.local binding) //type.value value)))) + (list.partial [head_binding (the #input it)] + tail)) + body (next archive body)] + (in (_.on (list) + (_.lambda (.when head_binding + 0 (list) + _ (list _.all_by_value)) + (list) + {.#Some //type.value} + (list#mix _.then + (_.return body) + (list.reversed bindings)) + ))))) + +(type (Exec of) + (Record + [#before of + #after of])) + +(def (sub_statements after) + (-> synthesis.Term + [(List synthesis.Term) synthesis.Term]) + (.when after + (synthesis.branch/exec @ [before after]) + (.let [[tail after] (sub_statements after)] + [(list.partial before tail) after]) + + _ + [(list) after])) + +(def .public (exec next archive it) + (Term Exec) + (do [! phase.monad] + [.let [[tail after] (sub_statements (the #after it))] + all_before (monad.each ! (|>> (next archive) + (phase#each _.;)) + (list.partial (the #before it) tail)) + after (next archive after)] + (in (_.on (list) + (_.lambda (list _.all_by_value) + (list) + {.#Some //type.value} + (list#mix _.then + (_.return after) + (list.reversed all_before))))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/field/variable/count.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/field/variable/count.lux index 2080ea9c5..3f26f3b5f 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/field/variable/count.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/field/variable/count.lux @@ -13,13 +13,15 @@ ["_" bytecode (.only Bytecode)] ["[0]" type] [encoding - [name (.only External)] ["[0]" signed]]]]]]]] - ["[0]" //// - ["[1][0]" abstract]]) + [/// + [constant + ["[0]" arity]] + [// + ["[0]" abstract]]]) (def .public field "partials") -(def .public type type.int) +(def .public type arity.type) (def .public initial (Bytecode Any) @@ -28,12 +30,6 @@ try.trusted _.bipush)) -(def this - _.aload_0) - (def .public value (Bytecode Any) - (all _.composite - ..this - (_.getfield ////abstract.class ..field ..type) - )) + (_.getfield abstract.class ..field ..type)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/apply.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/apply.lux index ceb7ee756..c18822e3c 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/apply.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/apply.lux @@ -153,6 +153,7 @@ (_.new class) _.dup current_environment + ////reference.this ///count.value (..increment apply_arity) current_partials @@ -162,6 +163,7 @@ _.areturn))))))) (monad.all _.monad))]] (all _.composite + ////reference.this ///count.value (_.tableswitch (try.trusted (signed.s4 +0)) @default [@labelsH @labelsT]) cases)))}))) diff --git a/stdlib/source/library/lux/meta/compiler/target/c++.lux b/stdlib/source/library/lux/meta/compiler/target/c++.lux index eda5a1440..014bf887a 100644 --- a/stdlib/source/library/lux/meta/compiler/target/c++.lux +++ b/stdlib/source/library/lux/meta/compiler/target/c++.lux @@ -8,7 +8,8 @@ [abstract [equivalence (.only Equivalence)]] [control - ["|" pipe]] + ["|" pipe] + ["[0]" maybe (.use "[1]#[0]" functor)]] [data ["[0]" text (.only \n \t) (.use "[1]#[0]" equivalence) ["%" \\format]] @@ -31,6 +32,7 @@ (def term_delimiters ["(" ")"]) (def template_delimiters ["<" ">"]) (def initialization_delimiters ["{" "}"]) +(def capture_delimiters ["[" "]"]) (nominal.def .public (Code of) Text @@ -68,7 +70,8 @@ (,, (template.spliced +))))] [Code - [[Type [of]] + [[Capture []] + [Type [of]] [Expression [of]] [Statement [of]]]] @@ -268,6 +271,13 @@ (|>> %> ..statement)) + (def .public return + (-> Expression + Statement) + (|>> %> + (%.format "return ") + ..statement)) + (with_template [ ] [(def .public (-> Expression @@ -389,6 +399,11 @@ Definition) (..statement (%.format (%> type) " const " (%> name) " = " (%> value)))) + (def .public (variable name type value) + (-> Local Type Expression + Definition) + (..statement (%.format (%> type) " " (%> name) " = " (%> value)))) + (def .public (structure_definition name [fields methods]) (-> Local [(List [Local Type]) (List Method)] Definition) @@ -402,4 +417,40 @@ (list#each ..code methods)) (text.interposed \n)))))) + + (def captures + (-> (List Capture) + Text) + (|>> (list#each ..code) + (text.interposed ..parameter_separator) + (text.enclosed ..capture_delimiters))) + + (with_template [ ] + [(def .public + Capture + (<% ))] + + ["=" all_by_value] + ["&" all_by_reference] + ) + + (def .public (lambda captures inputs output body) + (-> (List Capture) (List Argument) (Maybe Type) Statement + Expression) + (<| <% + (text.enclosed ..term_delimiters) + (%.format (..captures captures) (..arguments inputs) + (|> output + (maybe#each (|>> %> (%.format " -> "))) + (maybe.else "")) + " " (..block (%> body))))) + + (def .public (? when then else) + (-> Expression Expression Expression + Expression) + (<| <% + (text.enclosed ..term_delimiters) + (%.format (%> when) + " ? " (%> then) + " : " (%> else)))) ) diff --git a/stdlib/source/test/lux/math/number/ratio.lux b/stdlib/source/test/lux/math/number/ratio.lux index 9ace5ca49..f350168d6 100644 --- a/stdlib/source/test/lux/math/number/ratio.lux +++ b/stdlib/source/test/lux/math/number/ratio.lux @@ -43,10 +43,24 @@ ..part)] (in (/.ratio numerator denominator)))) +(def (identical? reference exemplar) + (-> /.Ratio /.Ratio + Bit) + (and (n.= (the /.#numerator reference) + (the /.#numerator exemplar)) + (n.= (the /.#denominator reference) + (the /.#denominator exemplar)))) + +(def (normal? it) + (-> /.Ratio + Bit) + (identical? it (/.normal it))) + (def .public test Test (<| (_.covering /._) - (_.for [/.Ratio]) + (_.for [/.Ratio + /.#numerator /.#denominator]) (`` (all _.and (_.for [/.equivalence /.=] (equivalenceT.spec /.equivalence ..random)) @@ -65,12 +79,20 @@ (arithmeticT.spec /.equivalence /.arithmetic ..random)) (do random.monad - [.let [(open "#[0]") /.equivalence] + [.let [(open "/#[0]") /.equivalence] denom/0 ..part denom/1 ..part] (_.coverage [/.ratio] - (#= (/.ratio 0 denom/0) - (/.ratio 0 denom/1)))) + (/#= (/.ratio 0 denom/0) + (/.ratio 0 denom/1)))) + (do [! random.monad] + [.let [(open "/#[0]") /.equivalence] + before_normal (random.and ..part ..part)] + (_.coverage [/.normal] + (or (normal? before_normal) + (let [it (/.normal before_normal)] + (and (normal? it) + (/#= before_normal it)))))) (do random.monad [numerator ..part denominator (random.only (|>> (n#= 1) not) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux index 4571d75d3..81cfb675e 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux @@ -40,7 +40,9 @@ [/ [field [constant - ["[0]T" arity]]] + ["[0]T" arity]] + [variable + ["[0]T" count]]] [// ["[0]T" complex]]]) @@ -143,4 +145,5 @@ multiple_applications!))) arityT.test + countT.test ))) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/field/variable/count.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/field/variable/count.lux new file mode 100644 index 000000000..974851bfd --- /dev/null +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/field/variable/count.lux @@ -0,0 +1,139 @@ +... 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) + [abstract + [monad (.only do)]] + [control + ["[0]" io] + ["[0]" try (.use "[1]#[0]" functor)] + ["[0]" function]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)] + [collection + ["[0]" list]]] + [math + ["[0]" random (.only Random)] + [number + ["n" nat (.use "[1]#[0]" equivalence)]]] + [meta + ["[0]" location] + [compiler + [target + [jvm + ["!" bytecode] + ["[0]" type]]] + [meta + ["[0]" archive]]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / (.only) + [/// + [constant + ["[0]" arity]] + [// + ["[0]" abstract] + [/// + ["[0]" jvm (.only) + ["[0]" host] + ["[0]" runtime] + ["[0]" value] + ["[0]" complex + ["[1]T" \\test]] + [/// + ["[0]" extension] + [// + ["[0]" phase] + ["[0]" synthesis] + ["[0]" translation]]]]]]]]]) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [module (random.lower_cased 1) + + expected_bit random.bit + expected_i64 random.i64 + + .let [extender (is extension.Extender + (function (_ _) + (undefined))) + next (jvm.translate extender complexT.lux) + @ [module 0 0] + $unit [(-- 0) (-- 0)]] + + arity (of ! each (|>> (n.% arity.maximum) (n.max arity.minimum)) random.nat) + partial_application (of ! each (n.% arity) random.nat)]) + (all _.and + (_.coverage [/.field] + (when /.field + "" false + _ true)) + (_.coverage [/.type] + (same? arity.type /.type)) + (_.coverage [/.initial] + (let [[_ host] (io.run! host.host)] + (|> (all !.composite + /.initial + !.i2l + (value.boxed type.long)) + [{.#None}] + (of host evaluate $unit) + (try#each (|>> (as Nat) (n#= 0))) + (try.else false)))) + (_.coverage [/.value] + (let [fresh_abstraction! + (|> (do try.monad + [[_ archive] (archive.reserve "" archive.empty) + [_ archive] (archive.reserve module archive) + .let [[_ host] (io.run! host.host) + state (is runtime.State + (translation.state host module))]] + (<| (phase.result state) + (do phase.monad + [_ (translation.set_buffer translation.empty_buffer) + it (next archive (<| (synthesis.function/abstraction @) + [(list) arity (synthesis.i64 @ expected_i64)]))] + (in (|> (all !.composite + it + /.value + !.i2l + (value.boxed type.long)) + [{.#None}] + (of host evaluate $unit) + (try#each (|>> (as Nat) (n#= 0))) + (try.else false)))))) + (try.else false)) + + partial_application! + (|> (do try.monad + [[_ archive] (archive.reserve "" archive.empty) + [_ archive] (archive.reserve module archive) + .let [[_ host] (io.run! host.host) + state (is runtime.State + (translation.state host module))]] + (<| (phase.result state) + (do phase.monad + [_ (translation.set_buffer translation.empty_buffer) + it (next archive (<| (synthesis.function/apply @) + [(<| (synthesis.function/abstraction @) + [(list) arity (synthesis.i64 @ expected_i64)]) + (list.repeated partial_application (synthesis.bit @ expected_bit))]))] + (in (|> (all !.composite + it + (!.checkcast abstract.class) + /.value + !.i2l + (value.boxed type.long)) + [{.#None}] + (of host evaluate $unit) + (try#each (|>> (as Nat) (n#= partial_application))) + (try.else false)))))) + (try.else false))] + (and fresh_abstraction! + partial_application!))) + ))) diff --git a/stdlib/source/test/lux/world/time/series.lux b/stdlib/source/test/lux/world/time/series.lux index f0aa57216..248403d75 100644 --- a/stdlib/source/test/lux/world/time/series.lux +++ b/stdlib/source/test/lux/world/time/series.lux @@ -66,7 +66,7 @@ Test (<| (_.covering /._) (do [! random.monad] - [expected_size (of ! each (|>> (n.% 10) ++) random.nat) + [expected_size (of ! each (|>> (n.% 10) (n.+ 2)) random.nat) expected_series (..random expected_size random.nat) before random.nat -- cgit v1.2.3