diff options
| author | Eduardo Julian | 2022-02-22 16:29:17 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2022-02-22 16:29:17 -0400 |
| commit | f07effd9faf3fdaa677f659d6bbccf98931c5e5a (patch) | |
| tree | 0b51a4b8492d06db6b3eca38a3b9143de1c1d735 /stdlib/source/test | |
| parent | 2d1348a73159ec87fa0da2bd3768d641236693fb (diff) | |
No more automatic conversions of primitive types in JVM FFI.
Diffstat (limited to 'stdlib/source/test')
| -rw-r--r-- | stdlib/source/test/lux/data/binary.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux/ffi.jvm.lux | 101 | ||||
| -rw-r--r-- | stdlib/source/test/lux/math/number/frac.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/lux/target/jvm.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux/tool.lux | 13 | ||||
| -rw-r--r-- | stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux | 20 | ||||
| -rw-r--r-- | stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux | 980 | ||||
| -rw-r--r-- | stdlib/source/test/lux/tool/compiler/meta/archive/artifact/category.lux | 14 | ||||
| -rw-r--r-- | stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux | 132 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world/file.lux | 39 |
10 files changed, 1149 insertions, 158 deletions
diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index c9e821229..e2072944f 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -152,7 +152,7 @@ sample (..random size) value random.nat .let [gen_idx (|> random.nat (# ! each (n.% size)))] - offset gen_idx + offset (# ! each (n.max 1) gen_idx) length (# ! each (n.% (n.- offset size)) random.nat)] ($_ _.and (_.for [/.equivalence] diff --git a/stdlib/source/test/lux/ffi.jvm.lux b/stdlib/source/test/lux/ffi.jvm.lux index 7684d7b96..765ea00e3 100644 --- a/stdlib/source/test/lux/ffi.jvm.lux +++ b/stdlib/source/test/lux/ffi.jvm.lux @@ -75,13 +75,13 @@ (def: for_conversions Test (do [! random.monad] - [long (# ! each (|>> (:as /.Long)) random.int) - integer (# ! each (|>> (:as /.Long) /.long_to_int) random.int) - byte (# ! each (|>> (:as /.Long) /.long_to_byte) random.int) - short (# ! each (|>> (:as /.Long) /.long_to_short) random.int) + [long (# ! each (|>> /.as_long) random.int) + integer (# ! each (|>> /.as_int) random.int) + byte (# ! each (|>> /.as_byte) random.int) + short (# ! each (|>> /.as_short) random.int) float (|> random.frac (random.only (|>> f.not_a_number? not)) - (# ! each (|>> (:as /.Double) /.double_to_float)))] + (# ! each (|>> /.as_float)))] (`` ($_ _.and (~~ (template [<sample> <=> <to> <from>] [(_.cover [<to> <from>] @@ -112,7 +112,7 @@ (do [! random.monad] [size (|> random.nat (# ! each (|>> (n.% 100) (n.max 1)))) idx (|> random.nat (# ! each (n.% size))) - value (# ! each (|>> (:as java/lang/Long)) random.int)] + value (# ! each (|>> /.as_long) random.int)] ($_ _.and (_.cover [/.array /.length] (|> size @@ -123,8 +123,8 @@ (|> (/.array java/lang/Long size) (/.write! idx value) (/.read! idx) - (:as Int) - (i.= (:as Int value)))) + /.of_long + (i.= (/.of_long value)))) (_.cover [/.cannot_convert_to_jvm_type] (let [array (:as (Array Nothing) (array.empty 1))] @@ -138,19 +138,19 @@ (`` (do [! random.monad] [sample (# ! each (|>> (:as java/lang/Object)) (random.ascii 1)) - boolean (# ! each (|>> (:as /.Boolean)) random.bit) - byte (# ! each (|>> (:as /.Long) /.long_to_byte) random.int) - short (# ! each (|>> (:as /.Long) /.long_to_short) random.int) - integer (# ! each (|>> (:as /.Long) /.long_to_int) random.int) - long (# ! each (|>> (:as /.Long)) random.int) + boolean (# ! each (|>> /.as_boolean) random.bit) + byte (# ! each (|>> /.as_byte) random.int) + short (# ! each (|>> /.as_short) random.int) + integer (# ! each (|>> /.as_int) random.int) + long (# ! each (|>> /.as_long) random.int) float (|> random.frac (random.only (|>> f.not_a_number? not)) - (# ! each (|>> (:as /.Double) /.double_to_float))) + (# ! each (|>> /.as_float))) double (|> random.frac (random.only (|>> f.not_a_number? not)) - (# ! each (|>> (:as /.Double)))) - character (# ! each (|>> (:as /.Long) /.long_to_int /.int_to_char) random.int) - string (# ! each (|>> (:as java/lang/String)) + (# ! each (|>> /.as_double))) + character (# ! each (|>> /.as_int /.int_to_char) random.int) + string (# ! each (|>> /.as_string) (random.ascii 1))] ($_ _.and (_.cover [/.check] @@ -161,7 +161,7 @@ (_.cover [/.synchronized] (/.synchronized sample #1)) (_.cover [/.class_for] - (text#= "java.lang.Class" (java/lang/Class::getName (/.class_for java/lang/Class)))) + (text#= "java.lang.Class" (/.of_string (java/lang/Class::getName (/.class_for java/lang/Class))))) (_.cover [/.null /.null?] (and (/.null? (/.null)) (not (/.null? sample)))) @@ -273,8 +273,7 @@ (test/TestInterface0 [] (actual0 self []) java/lang/Long - (:as java/lang/Long - expected))) + (/.as_long (.int expected)))) example/0! (same? (: Any expected) (: Any (test/TestInterface0::actual0 object/0))) @@ -285,19 +284,18 @@ [] (actual1 self [throw? java/lang/Boolean]) java/lang/Long "throws" [java/lang/Throwable] - (if (:as Bit throw?) + (if (/.of_boolean throw?) (panic! "YOLO") - (:as java/lang/Long - expected)))) + (/.as_long (.int expected))))) example/1! - (and (case (test/TestInterface1::actual1 false object/1) + (and (case (test/TestInterface1::actual1 (/.as_boolean false) object/1) {try.#Success actual} (same? (: Any expected) (: Any actual)) {try.#Failure error} false) - (case (test/TestInterface1::actual1 true object/1) + (case (test/TestInterface1::actual1 (/.as_boolean true) object/1) {try.#Success actual} false @@ -312,15 +310,14 @@ input)) example/2! (same? (: Any expected) - (: Any (test/TestInterface2::actual2 (:as java/lang/Long expected) object/2))) + (: Any (test/TestInterface2::actual2 (/.as_long (.int expected)) object/2))) object/3 (/.object [] [(test/TestInterface3 java/lang/Long)] [] ((test/TestInterface3 a) [] (actual3 self []) a - (:as java/lang/Long - expected))) + (/.as_long (.int expected)))) example/3! (same? (: Any expected) (: Any (test/TestInterface3::actual3 object/3))) @@ -333,18 +330,16 @@ [] (actual4 self [actual_left long actual_right long]) long - (:as java/lang/Long - (i.+ (:as Int actual_left) - (:as Int actual_right)))))] + (/.as_long (i.+ (/.of_long actual_left) + (/.of_long actual_right)))))] (i.= expected - (test/TestInterface4::actual4 left right object/4)))]] + (/.of_long (test/TestInterface4::actual4 left right object/4))))]] (_.cover [/.interface: /.object] (and example/0! example/1! example/2! example/3! - example/4! - )))) + example/4!)))) (/.class: "final" test/TestClass0 [test/TestInterface0] ... Fields @@ -371,7 +366,7 @@ (test/TestInterface1 [] (actual1 self [throw? java/lang/Boolean]) java/lang/Long "throws" [java/lang/Throwable] - (if (:as Bit throw?) + (if (/.of_boolean throw?) (panic! "YOLO") ::value))) @@ -470,9 +465,9 @@ [] (actual4 self [actual_left long actual_right long]) long - (:as java/lang/Long - (i.+ (:as Int actual_left) - (:as Int actual_right))))) + (/.as_long + (i.+ (/.of_long actual_left) + (/.of_long actual_right))))) (/.import: test/TestClass8 ["[1]::[0]" @@ -503,21 +498,21 @@ left random.int right random.int - .let [object/0 (test/TestClass0::new (.int expected)) + .let [object/0 (test/TestClass0::new (/.as_long (.int expected))) example/0! (n.= expected - (:as Nat (test/TestInterface0::actual0 object/0))) + (.nat (/.of_long (test/TestInterface0::actual0 object/0)))) - object/1 (test/TestClass1::new (.int expected)) + object/1 (test/TestClass1::new (/.as_long (.int expected))) example/1! - (and (case (test/TestInterface1::actual1 false object/1) + (and (case (test/TestInterface1::actual1 (/.as_boolean false) object/1) {try.#Success actual} (n.= expected - (:as Nat actual)) + (.nat (/.of_long actual))) {try.#Failure error} false) - (case (test/TestInterface1::actual1 true object/1) + (case (test/TestInterface1::actual1 (/.as_boolean true) object/1) {try.#Success actual} false @@ -527,36 +522,36 @@ object/2 (test/TestClass2::new) example/2! (n.= expected - (: Nat (test/TestInterface2::actual2 (:as java/lang/Long expected) object/2))) + (.nat (/.of_long (test/TestInterface2::actual2 (/.as_long (.int expected)) object/2)))) object/3 (: (test/TestClass3 java/lang/Long) - (test/TestClass3::new (:as java/lang/Long expected))) + (test/TestClass3::new (/.as_long (.int expected)))) example/3! (n.= expected - (: Nat (test/TestInterface3::actual3 object/3))) + (.nat (/.of_long (test/TestInterface3::actual3 object/3)))) object/4 (test/TestClass4::new) example/4! (n.= expected - (.nat (test/TestClass4::actual4 (.int expected) object/4))) + (.nat (/.of_long (test/TestClass4::actual4 (/.as_long (.int expected)) object/4)))) example/5! (n.= expected - (.nat (test/TestClass5::actual5 (.int expected)))) + (.nat (/.of_long (test/TestClass5::actual5 (/.as_long (.int expected)))))) object/7 (test/TestClass7::new) example/7! (n.= expected - (.nat (test/TestClass6::actual6 (.int expected) object/7))) + (.nat (/.of_long (test/TestClass6::actual6 (/.as_long (.int expected)) object/7)))) example/8! (let [expected (i.+ left right) object/8 (test/TestClass8::new)] (i.= expected - (test/TestInterface4::actual4 left right object/8)))] + (/.of_long (test/TestInterface4::actual4 (/.as_long left) (/.as_long right) object/8))))] .let [random_long (: (Random java/lang/Long) - (# ! each (|>> (:as java/lang/Long)) + (# ! each (|>> /.as_long) random.int))] dummy/0 random_long dummy/1 random_long @@ -569,7 +564,7 @@ example/9! (|> object/9 test/TestClass9::get_actual9 - (:as java/lang/Long) + /.as_long (same? dummy/2))]] ($_ _.and (_.cover [/.class: /.import:] diff --git a/stdlib/source/test/lux/math/number/frac.lux b/stdlib/source/test/lux/math/number/frac.lux index bc77f1f32..b74a80786 100644 --- a/stdlib/source/test/lux/math/number/frac.lux +++ b/stdlib/source/test/lux/math/number/frac.lux @@ -190,7 +190,7 @@ (with_expansions [<jvm> ($_ _.and (let [test (: (-> Frac Bit) (function (_ value) - (n.= (.nat (java/lang/Double::doubleToRawLongBits value)) + (n.= (.nat (ffi.of_long (java/lang/Double::doubleToRawLongBits (ffi.as_double value)))) (/.bits value))))] (do random.monad [sample random.frac] @@ -204,7 +204,7 @@ (do random.monad [sample random.i64] (_.cover [/.of_bits] - (let [expected (java/lang/Double::longBitsToDouble sample) + (let [expected (ffi.of_double (java/lang/Double::longBitsToDouble (ffi.as_long sample))) actual (/.of_bits sample)] (or (/.= expected actual) (and (/.not_a_number? expected) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 6a85e0354..a10c0e0e1 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -96,7 +96,7 @@ (def: (get_method name class) (-> Text (java/lang/Class java/lang/Object) java/lang/reflect/Method) - (java/lang/Class::getDeclaredMethod name + (java/lang/Class::getDeclaredMethod (ffi.as_string name) (ffi.array (java/lang/Class java/lang/Object) 0) class)) diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index ed089e095..265f0a0c6 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -14,12 +14,7 @@ ["[1][0]" analysis] ["[1][0]" phase "_" ["[1]/[0]" extension] - ["[1]/[0]" analysis "_" - ["[1]/[0]" simple] - ["[1]/[0]" complex] - ["[1]/[0]" reference] - ["[1]/[0]" function] - ["[1]/[0]" case]] + ["[1]/[0]" analysis] ... ["[1]/[0]" synthesis] ]]] ["[1][0]" meta "_" @@ -46,11 +41,7 @@ /meta/context.test /meta/cache.test /phase/extension.test - /phase/analysis/simple.test - /phase/analysis/complex.test - /phase/analysis/reference.test - /phase/analysis/function.test - /phase/analysis/case.test + /phase/analysis.test ... /syntax.test ... /synthesis.test )) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux index ab856f9a1..d8ae7a32e 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux @@ -218,18 +218,29 @@ (n.= expected_maximum (/.maximum [{.#Some expected_maximum} cases])))) )))) +(def: random_value_pattern + (Random [/.Coverage Pattern]) + (random.only (function (_ [coverage pattern]) + (case coverage + (^or {/.#Alt _} {/.#Seq _}) + false + + _ + true)) + ..random_partial_pattern)) + (def: test|composite Test (<| (let [(^open "/#[0]") /.equivalence]) (do [! random.monad] - [[expected/0 pattern/0] ..random_partial_pattern + [[expected/0 pattern/0] ..random_value_pattern [expected/1 pattern/1] (random.only (|>> product.left (/#= expected/0) not) - ..random_partial_pattern) + ..random_value_pattern) [expected/2 pattern/2] (random.only ($_ predicate.and (|>> product.left (/#= expected/0) not) (|>> product.left (/#= expected/1) not) (|>> product.left (case> {/.#Variant _} false _ true))) - ..random_partial_pattern) + ..random_value_pattern) bit random.bit nat random.nat @@ -414,8 +425,7 @@ [{/.#Text (set.of_list text.hash (list text))}] [{/.#Variant {.#None} (dictionary.of_list n.hash (list [tag/0 expected/0]))}] [{/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))}] - [{/.#Seq expected/0 expected/1}] - )) + [{/.#Seq expected/0 expected/1}])) (redundant? (/.composite {/.#Seq expected/0 expected/1} expected/0)))))) (_.cover [/.variant_mismatch] (let [mismatch? (..failure? /.variant_mismatch)] diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux index d710f4fad..e2ee0a546 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux @@ -1,24 +1,966 @@ (.using + [library [lux "*" - ["_" test {"+" Test}]] - ["[0]" / "_" - ["[1][0]" primitive] - ["[1][0]" structure] - ["[1][0]" reference] - ["[1][0]" case] - ["[1][0]" function] - ["/[1]" // "_" - [extension - [analysis - ["[1][0]" lux]]]]]) + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + ["[0]" try] + ["[0]" exception]] + [data + ["[0]" product] + ["[0]" text] + [collection + ["[0]" list]]] + [macro + ["[0]" code]] + [math + ["[0]" random] + [number + ["n" nat]]] + ["[0]" type ("[1]#[0]" equivalence) + ["[0]" check]]]] + [\\library + ["[0]" / + [// + ["[0]" extension + ["[1]/[0]" analysis "_" + ["[1]" lux]]] + [// + ["/[1]" analysis {"+" Analysis Operation} + [evaluation {"+" Eval}] + ["[1][0]" macro] + ["[1][0]" scope] + ["[1][0]" module] + ["[1][0]" pattern] + ["[1][0]" type + ["$[1]" \\test]]] + [/// + ["[0]" phase ("[1]#[0]" monad)] + [meta + ["[0]" archive]]]]]]] + ["[0]" / "_" + ["[1][0]" simple] + ["[1][0]" complex] + ["[1][0]" reference] + ["[1][0]" function] + ["[1][0]" case]]) + +(def: (eval archive type term) + Eval + (phase#in [])) + +(def: (expander macro inputs state) + //macro.Expander + {try.#Success ((.macro macro) inputs state)}) + +(def: (can_analyse_unit! lux module/0) + (-> Lux Text Bit) + (let [state [extension.#bundle (extension/analysis.bundle ..eval) + extension.#state lux]] + (|> (do phase.monad + [[:it: it] (|> (' []) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= .Any :it:) + (case it + (^ (//.unit)) + true + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false)))) + +(def: (can_analyse_simple_literal_or_singleton_tuple! lux module/0 [bit/0 nat/0 int/0 rev/0 frac/0 text/0]) + (-> Lux Text [.Bit .Nat .Int .Rev .Frac .Text] Bit) + (let [state [extension.#bundle (extension/analysis.bundle ..eval) + extension.#state lux]] + (`` (and (~~ (template [<expected> <code> <type> <analysis>] + [(|> (do phase.monad + [[:it: it] (|> <expected> + <code> + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= <type> :it:) + (case it + (^ (<analysis> it)) + (same? <expected> it) + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false))] + + [bit/0 code.bit .Bit //.bit] + [nat/0 code.nat .Nat //.nat] + [int/0 code.int .Int //.int] + [rev/0 code.rev .Rev //.rev] + [frac/0 code.frac .Frac //.frac] + [text/0 code.text .Text //.text] + + ... Singleton tuple + [bit/0 (<| code.tuple list code.bit) .Bit //.bit] + [nat/0 (<| code.tuple list code.nat) .Nat //.nat] + [int/0 (<| code.tuple list code.int) .Int //.int] + [rev/0 (<| code.tuple list code.rev) .Rev //.rev] + [frac/0 (<| code.tuple list code.frac) .Frac //.frac] + [text/0 (<| code.tuple list code.text) .Text //.text] + )) + )))) + +(def: (can_analyse_sum! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] [@left @right]) + (-> Lux Text [.Text .Text .Text .Text .Text .Text .Text] [.Bit .Nat .Int .Rev .Frac .Text] [.Text .Text] Bit) + (let [state [extension.#bundle (extension/analysis.bundle ..eval) + extension.#state lux] + :record: (And .Any .Bit .Nat .Int .Rev .Frac .Text) + :variant: (Or .Any .Bit .Nat .Int .Rev .Frac .Text) + + can_analyse_unary! + (`` (and (|> (do phase.monad + [it (|> (code.variant (list (code.nat 0) (code.bit #0) (` []))) + (/.phase ..expander archive.empty) + (//type.expecting :variant:))] + (in (case it + (^ (//.variant [0 #0 (//.unit)])) + true + + _ + false))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false)) + (~~ (template [<lefts> <right> <expected> <tag> <code> <analysis>] + [(|> (do phase.monad + [it (|> (code.variant (list (code.nat <lefts>) (code.bit <right>) (<code> <expected>))) + (/.phase ..expander archive.empty) + (//type.expecting :variant:))] + (in (case it + (^ (//.variant [<lefts> <right> (<analysis> actual)])) + (same? <expected> actual) + + _ + false))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false))] + + [1 #0 bit/0 @bit code.bit //.bit] + [2 #0 nat/0 @nat code.nat //.nat] + [3 #0 int/0 @int code.int //.int] + [4 #0 rev/0 @rev code.rev //.rev] + [5 #0 frac/0 @frac code.frac //.frac] + [5 #1 text/0 @text code.text //.text] + )))) + + can_analyse_nullary! + (|> (do phase.monad + [.let [:either: (Or .Any :record:)] + it (|> (code.variant (list (code.nat 0) (code.bit #0))) + (/.phase ..expander archive.empty) + (//type.expecting :either:))] + (in (case it + (^ (//.variant [0 #0 (//.unit)])) + true + + _ + false))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false)) + + can_analyse_multiary! + (|> (do phase.monad + [.let [:either: (Or .Any :record:)] + it (|> (code.variant (list (code.nat 0) + (code.bit #1) + (` []) + (code.bit bit/0) + (code.nat nat/0) + (code.int int/0) + (code.rev rev/0) + (code.frac frac/0) + (code.text text/0))) + (/.phase ..expander archive.empty) + (//type.expecting :either:))] + (in (case it + (^ (//.variant [0 #1 (//.tuple (list (//.unit) + (//.bit bit/?) + (//.nat nat/?) + (//.int int/?) + (//.rev rev/?) + (//.frac frac/?) + (//.text text/?)))])) + (and (same? bit/0 bit/?) + (same? nat/0 nat/?) + (same? int/0 int/?) + (same? rev/0 rev/?) + (same? frac/0 frac/?) + (same? text/0 text/?)) + + _ + false))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false))] + (and can_analyse_unary! + can_analyse_nullary! + can_analyse_multiary! + ))) + +(def: (can_analyse_variant! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] [@left @right]) + (-> Lux Text [.Text .Text .Text .Text .Text .Text .Text] [.Bit .Nat .Int .Rev .Frac .Text] [.Text .Text] Bit) + (let [state [extension.#bundle (extension/analysis.bundle ..eval) + extension.#state lux] + :record: {.#Named [module/0 @text] + (type [.Any .Bit .Nat .Int .Rev .Frac .Text])} + slots/* (list @any @bit @nat @int @rev @frac @text) + :variant: {.#Named [module/0 @text] + (type (Or .Any .Bit .Nat .Int .Rev .Frac .Text))} + tags/* (list @any @bit @nat @int @rev @frac @text) + + can_analyse_unary! + (`` (and (|> (do phase.monad + [_ (//module.declare_labels false tags/* false :variant:) + [:it: it] (|> (code.variant (list (code.local_symbol @any) (` []))) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= :variant: + :it:) + (case it + (^ (//.variant [0 #0 (//.unit)])) + true + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false)) + (~~ (template [<lefts> <right> <expected> <tag> <code> <analysis>] + [(|> (do phase.monad + [_ (//module.declare_labels false tags/* false :variant:) + [:it: it] (|> (code.variant (list (code.local_symbol <tag>) (<code> <expected>))) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= :variant: + :it:) + (case it + (^ (//.variant [<lefts> <right> (<analysis> actual)])) + (same? <expected> actual) + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false))] + + [1 #0 bit/0 @bit code.bit //.bit] + [2 #0 nat/0 @nat code.nat //.nat] + [3 #0 int/0 @int code.int //.int] + [4 #0 rev/0 @rev code.rev //.rev] + [5 #0 frac/0 @frac code.frac //.frac] + [5 #1 text/0 @text code.text //.text] + )))) + + can_analyse_nullary! + (|> (do phase.monad + [_ (//module.declare_labels true slots/* false :record:) + .let [:either: {.#Named [module/0 module/0] + (type (Or .Any :record:))}] + _ (//module.declare_labels false (list @left @right) false :either:) + [:it: it] (|> (code.variant (list (code.local_symbol @left))) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= :either: + :it:) + (case it + (^ (//.variant [0 #0 (//.unit)])) + true + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false)) + + can_analyse_multiary! + (|> (do phase.monad + [_ (//module.declare_labels true slots/* false :record:) + .let [:either: {.#Named [module/0 module/0] + (type (Or .Any :record:))}] + _ (//module.declare_labels false (list @left @right) false :either:) + [:it: it] (|> (code.variant (list (code.local_symbol @right) + (` []) + (code.bit bit/0) + (code.nat nat/0) + (code.int int/0) + (code.rev rev/0) + (code.frac frac/0) + (code.text text/0))) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= :either: + :it:) + (case it + (^ (//.variant [0 #1 (//.tuple (list (//.unit) + (//.bit bit/?) + (//.nat nat/?) + (//.int int/?) + (//.rev rev/?) + (//.frac frac/?) + (//.text text/?)))])) + (and (same? bit/0 bit/?) + (same? nat/0 nat/?) + (same? int/0 int/?) + (same? rev/0 rev/?) + (same? frac/0 frac/?) + (same? text/0 text/?)) + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false))] + (and can_analyse_unary! + can_analyse_nullary! + can_analyse_multiary!))) + +(def: (can_analyse_tuple! lux module/0 [bit/0 nat/0 int/0 rev/0 frac/0 text/0]) + (-> Lux Text [.Bit .Nat .Int .Rev .Frac .Text] Bit) + (let [state [extension.#bundle (extension/analysis.bundle ..eval) + extension.#state lux]] + (|> (do phase.monad + [[:it: it] (|> (code.tuple (list (` []) + (code.bit bit/0) + (code.nat nat/0) + (code.int int/0) + (code.rev rev/0) + (code.frac frac/0) + (code.text text/0))) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= (type [.Any .Bit .Nat .Int .Rev .Frac .Text]) + :it:) + (case it + (^ (//.tuple (list (//.unit) + (//.bit bit/?) + (//.nat nat/?) + (//.int int/?) + (//.rev rev/?) + (//.frac frac/?) + (//.text text/?)))) + (and (same? bit/0 bit/?) + (same? nat/0 nat/?) + (same? int/0 int/?) + (same? rev/0 rev/?) + (same? frac/0 frac/?) + (same? text/0 text/?)) + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false)))) + +(def: (can_analyse_record! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0]) + (-> Lux Text [.Text .Text .Text .Text .Text .Text .Text] [.Bit .Nat .Int .Rev .Frac .Text] Bit) + (let [state [extension.#bundle (extension/analysis.bundle ..eval) + extension.#state lux] + :record: {.#Named [module/0 @text] + (type [.Any .Bit .Nat .Int .Rev .Frac .Text])} + slots/* (list @any @bit @nat @int @rev @frac @text)] + (|> (do phase.monad + [_ (//module.declare_labels true slots/* false :record:) + [:it: it] (|> (code.tuple (list (code.local_symbol @text) (code.text text/0) + (code.local_symbol @bit) (code.bit bit/0) + (code.local_symbol @rev) (code.rev rev/0) + (code.local_symbol @int) (code.int int/0) + (code.local_symbol @nat) (code.nat nat/0) + (code.local_symbol @frac) (code.frac frac/0) + (code.local_symbol @any) (` []))) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= :record: + :it:) + (case it + (^ (//.tuple (list (//.unit) + (//.bit bit/?) + (//.nat nat/?) + (//.int int/?) + (//.rev rev/?) + (//.frac frac/?) + (//.text text/?)))) + (and (same? bit/0 bit/?) + (same? nat/0 nat/?) + (same? int/0 int/?) + (same? rev/0 rev/?) + (same? frac/0 frac/?) + (same? text/0 text/?)) + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false)))) + +(def: (can_analyse_function! lux module/0 nat/0 [$abstraction/0 $parameter/0 $abstraction/1 $parameter/1]) + (-> Lux Text Nat [Code Code Code Code] Bit) + (let [state [extension.#bundle (extension/analysis.bundle ..eval) + extension.#state lux] + + can_make_abstraction! + (|> (do phase.monad + [[:it: it] (|> (` ([(~ $abstraction/0) (~ $parameter/0)] (~ (code.nat nat/0)))) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= (All (_ a) (-> a .Nat)) + :it:) + (case it + (^ {//.#Function (list) (//.nat nat/?)}) + (same? nat/0 nat/?) + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false)) + + can_nest_abstraction! + (|> (do phase.monad + [[:it: it] (|> (` ([(~ $abstraction/0) (~ $parameter/0)] + ([(~ $abstraction/1) (~ $parameter/1)] + (~ (code.nat nat/0))))) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= (All (_ a) (-> a (All (_ b) (-> b .Nat)))) + :it:) + (case it + (^ {//.#Function (list) {//.#Function (list) (//.nat nat/?)}}) + (same? nat/0 nat/?) + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false)) + + can_refer_to_parameter! + (|> (do phase.monad + [[:it: it] (|> (` ([(~ $abstraction/0) (~ $parameter/0)] + ([(~ $abstraction/1) (~ $parameter/1)] + (~ $parameter/1)))) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= (All (_ a) (-> a (All (_ b) (-> b b)))) + :it:) + (case it + (^ {//.#Function (list) {//.#Function (list) (//.local 1)}}) + true + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false)) + + can_refer_to_closure! + (|> (do phase.monad + [[:it: it] (|> (` ([(~ $abstraction/0) (~ $parameter/0)] + ([(~ $abstraction/1) (~ $parameter/1)] + (~ $parameter/0)))) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (case it + (^ {//.#Function (list) {//.#Function (list (//.local 1)) (//.foreign 0)}}) + true + + _ + false) + ... TODO: Un-comment + ... (type#= (All (_ a) (-> a (All (_ b) (-> b a)))) + ... :it:) + ))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false))] + (and can_make_abstraction! + can_nest_abstraction! + can_refer_to_parameter! + can_refer_to_closure! + ... TODO: Un-comment + ... (|> (do phase.monad + ... [[:it: it] (|> (` ([(~ $abstraction/0) (~ $parameter/0)] + ... ([(~ $abstraction/1) (~ $parameter/1)] + ... (~ $abstraction/1)))) + ... (/.phase ..expander archive.empty) + ... //type.inferring)] + ... (in (case it + ... (^ {//.#Function (list) {//.#Function (list) (//.local 0)}}) + ... true + + ... _ + ... false))) + ... //scope.with + ... (//module.with 0 module/0) + ... (phase#each (|>> product.right product.right)) + ... (phase.result state) + ... (try.else false)) + ... TODO: Un-comment + ... (|> (do phase.monad + ... [[:it: it] (|> (` ([(~ $abstraction/0) (~ $parameter/0)] + ... ([(~ $abstraction/1) (~ $parameter/1)] + ... (~ $abstraction/0)))) + ... (/.phase ..expander archive.empty) + ... //type.inferring)] + ... (in (case it + ... (^ {//.#Function (list) {//.#Function (list (//.local 0)) (//.foreign 0)}}) + ... true + + ... _ + ... false))) + ... //scope.with + ... (//module.with 0 module/0) + ... (phase#each (|>> product.right product.right)) + ... (phase.result state) + ... (try.else false)) + ))) + +(def: (can_analyse_apply! lux module/0 bit/0 nat/0 [$abstraction/0 $parameter/0 $abstraction/1 $parameter/1]) + (-> Lux Text Bit Nat [Code Code Code Code] Bit) + (let [state [extension.#bundle (extension/analysis.bundle ..eval) + extension.#state lux] + + constant! + (|> (do phase.monad + [[:it: it] (|> (` (([(~ $abstraction/0) (~ $parameter/0)] (~ (code.bit bit/0))) + (~ (code.nat nat/0)))) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= .Bit :it:) + (case it + (^ {//.#Apply (//.nat nat/?) + {//.#Function (list) (//.bit bit/?)}}) + (and (same? bit/0 bit/?) + (same? nat/0 nat/?)) + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false)) + + variable! + (|> (do phase.monad + [[:it: it] (|> (` (([(~ $abstraction/0) (~ $parameter/0)] (~ $parameter/0)) + (~ (code.nat nat/0)))) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= .Nat :it:) + (case it + (^ {//.#Apply (//.nat nat/?) + {//.#Function (list) (//.local 1)}}) + (same? nat/0 nat/?) + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false)) + + partial! + (|> (do phase.monad + [[:it: it] (|> (` (([(~ $abstraction/0) (~ $parameter/0)] + ([(~ $abstraction/1) (~ $parameter/1)] + (~ (code.bit bit/0)))) + (~ (code.nat nat/0)))) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (check.subsumes? (All (_ a) (-> a Bit)) :it:) + (case it + (^ {//.#Apply (//.nat nat/?) + {//.#Function (list) + {//.#Function (list) (//.bit bit/?)}}}) + (and (same? bit/0 bit/?) + (same? nat/0 nat/?)) + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false))] + (and constant! + variable! + partial!))) + +(def: (can_analyse_extension! lux module/0 text/0) + (-> Lux Text Text Bit) + (let [state [extension.#bundle (extension/analysis.bundle ..eval) + extension.#state lux]] + (|> (do phase.monad + [[:it: it] (|> (` ("lux text concat" (~ (code.text text/0)) (~ (code.text text/0)))) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= .Text :it:) + (case it + (^ {//.#Extension "lux text concat" (list (//.text left) (//.text right))}) + (and (same? text/0 left) + (same? text/0 right)) + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false)))) + +(def: (can_analyse_pattern_matching! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] $parameter/0) + (-> Lux Text [.Text .Text .Text .Text .Text .Text .Text] [.Bit .Nat .Int .Rev .Frac .Text] Code Bit) + (let [state [extension.#bundle (extension/analysis.bundle ..eval) + extension.#state lux] + + :variant: {.#Named [module/0 module/0] + (type (Or .Any .Bit .Nat .Int .Rev .Frac .Text))} + tags/* (list @any @bit @nat @int @rev @frac @text) + + :record: {.#Named [module/0 module/0] + (type (And .Any .Bit .Nat .Int .Rev .Frac .Text))} + slots/* (list @any @bit @nat @int @rev @frac @text) + + simple! + (`` (and (~~ (template [<input> <code> <analysis> <pattern>] + [(|> (do phase.monad + [[:it: it] (|> (` ({(~ $parameter/0) (~ (code.frac frac/0))} (~ (<code> <input>)))) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= .Frac :it:) + (case it + (^ {//.#Case (<analysis> input/?) + [[//.#when (//pattern.bind 0) + //.#then (//.frac frac/?)] + (list)]}) + (and (same? <input> input/?) + (same? frac/0 frac/?)) + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false)) + (|> (do phase.monad + [[:it: it] (|> (` ({(~ (<code> <input>)) + (~ (code.frac frac/0)) + + (~ $parameter/0) + (~ (code.frac frac/0))} + (~ (<code> <input>)))) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= .Frac :it:) + (case it + (^ {//.#Case (<analysis> input/?) + [[//.#when (<pattern> pattern/?) + //.#then (//.frac frac/?)] + (list [//.#when (//pattern.bind 0) + //.#then (//.frac frac/?)])]}) + (and (same? <input> input/?) + (same? <input> pattern/?) + (same? frac/0 frac/?)) + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false))] + + [bit/0 code.bit //.bit //pattern.bit] + [nat/0 code.nat //.nat //pattern.nat] + [int/0 code.int //.int //pattern.int] + [rev/0 code.rev //.rev //pattern.rev] + [frac/0 code.frac //.frac //pattern.frac] + [text/0 code.text //.text //pattern.text] + )))) + + bit! + (|> (do phase.monad + [[:it: it] (|> (` ({#0 + (~ (code.frac frac/0)) + + #1 + (~ (code.frac frac/0))} + (~ (code.bit bit/0)))) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= .Frac :it:) + (case it + (^ {//.#Case (//.bit bit/?) + [[//.#when (//pattern.bit #0) + //.#then (//.frac false/?)] + (list [//.#when (//pattern.bit #1) + //.#then (//.frac true/?)])]}) + (and (same? bit/0 bit/?) + (same? frac/0 false/?) + (same? frac/0 true/?)) + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false)) + + variant! + (`` (and (~~ (template [<lefts> <right?> <expected> <tag> <code> <analysis> <pattern>] + [(|> (do phase.monad + [_ (//module.declare_labels false tags/* false :variant:) + [:it: it] (|> (` ({{(~ (code.local_symbol <tag>)) (~ (<code> <expected>))} + (~ (code.frac frac/0)) + + (~ $parameter/0) + (~ (code.frac frac/0))} + {(~ (code.local_symbol <tag>)) (~ (<code> <expected>))})) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= .Frac :it:) + (case it + (^ {//.#Case (//.variant [<lefts> <right?> (<analysis> analysis/?)]) + [[//.#when (//pattern.variant [<lefts> <right?> (<pattern> pattern/?)]) + //.#then (//.frac match/?)] + (list [//.#when (//pattern.bind 0) + //.#then (//.frac mismatch/?)])]}) + (and (same? <expected> analysis/?) + (same? <expected> pattern/?) + (same? frac/0 match/?) + (same? frac/0 mismatch/?)) + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false))] + + [1 #0 bit/0 @bit code.bit //.bit //pattern.bit] + [2 #0 nat/0 @nat code.nat //.nat //pattern.nat] + [3 #0 int/0 @int code.int //.int //pattern.int] + [4 #0 rev/0 @rev code.rev //.rev //pattern.rev] + [5 #0 frac/0 @frac code.frac //.frac //pattern.frac] + [5 #1 text/0 @text code.text //.text //pattern.text] + )))) + + tuple! + (|> (do phase.monad + [[:it: it] (|> (` ({[#0 (~ $parameter/0)] + (~ (code.frac frac/0)) + + [#1 (~ $parameter/0)] + (~ (code.frac frac/0))} + [(~ (code.bit bit/0)) + (~ (code.nat nat/0))])) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= .Frac :it:) + (case it + (^ {//.#Case (//.tuple (list (//.bit bit/?) (//.nat nat/?))) + [[//.#when (//pattern.tuple (list (//pattern.bit #0) (//pattern.bind 0))) + //.#then (//.frac false/?)] + (list [//.#when (//pattern.tuple (list (//pattern.bit #1) (//pattern.bind 0))) + //.#then (//.frac true/?)])]}) + (and (same? bit/0 bit/?) + (same? nat/0 nat/?) + (same? frac/0 false/?) + (same? frac/0 true/?)) + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false)) + + record! + (|> (do phase.monad + [_ (//module.declare_labels true slots/* false :record:) + [:it: it] (|> (` ({[(~ (code.symbol [module/0 @any])) [] + (~ (code.symbol [module/0 @bit])) (~ (code.bit bit/0)) + (~ (code.symbol [module/0 @nat])) (~ (code.nat nat/0)) + (~ (code.symbol [module/0 @int])) (~ (code.int int/0)) + (~ (code.symbol [module/0 @rev])) (~ (code.rev rev/0)) + (~ (code.symbol [module/0 @frac])) (~ (code.frac frac/0)) + (~ (code.symbol [module/0 @text])) (~ (code.text text/0))] + (~ (code.frac frac/0)) + + (~ $parameter/0) + (~ (code.frac frac/0))} + [(~ (code.local_symbol @any)) [] + (~ (code.local_symbol @bit)) (~ (code.bit bit/0)) + (~ (code.local_symbol @nat)) (~ (code.nat nat/0)) + (~ (code.local_symbol @int)) (~ (code.int int/0)) + (~ (code.local_symbol @rev)) (~ (code.rev rev/0)) + (~ (code.local_symbol @frac)) (~ (code.frac frac/0)) + (~ (code.local_symbol @text)) (~ (code.text text/0))])) + (/.phase ..expander archive.empty) + //type.inferring)] + (in (and (type#= .Frac :it:) + (case it + (^ {//.#Case (//.tuple (list (//.unit) + (//.bit bit/?) + (//.nat nat/?) + (//.int int/?) + (//.rev rev/?) + (//.frac frac/?) + (//.text text/?))) + [[//.#when (//pattern.tuple (list (//pattern.unit) + (//pattern.bit bit/?') + (//pattern.nat nat/?') + (//pattern.int int/?') + (//pattern.rev rev/?') + (//pattern.frac frac/?') + (//pattern.text text/?'))) + //.#then (//.frac match/?)] + (list [//.#when (//pattern.bind 0) + //.#then (//.frac mismatch/?)])]}) + (and (same? bit/0 bit/?) (same? bit/0 bit/?') + (same? nat/0 nat/?) (same? nat/0 nat/?') + (same? int/0 int/?) (same? int/0 int/?') + (same? rev/0 rev/?) (same? rev/0 rev/?') + (same? frac/0 frac/?) (same? frac/0 frac/?') + (same? text/0 text/?) (same? text/0 text/?') + (same? frac/0 match/?) + (same? frac/0 mismatch/?)) + + _ + false)))) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (try.else false))] + (and simple! + bit! + variant! + tuple! + record!))) (def: .public test Test - ($_ _.and - /primitive.test - /structure.test - /reference.test - /case.test - /function.test - //lux.test - )) + (<| (_.covering /._) + (do [! random.monad] + [lux $//type.random_state + .let [state [extension.#bundle (extension/analysis.bundle ..eval) + extension.#state lux]] + + .let [[module/0 _] (symbol ._)] + + bit/0 random.bit + nat/0 random.nat + int/0 random.int + rev/0 random.rev + frac/0 random.frac + text/0 (random.ascii/lower 1) + + @any (random.ascii/lower 2) + @bit (random.ascii/lower 3) + @nat (random.ascii/lower 4) + @int (random.ascii/lower 5) + @rev (random.ascii/lower 6) + @frac (random.ascii/lower 7) + @text (random.ascii/lower 8) + + @left (random.ascii/lower 9) + @right (random.ascii/lower 10) + + $abstraction/0 (# ! each code.local_symbol (random.ascii/lower 11)) + $parameter/0 (# ! each code.local_symbol (random.ascii/lower 12)) + $abstraction/1 (# ! each code.local_symbol (random.ascii/lower 13)) + $parameter/1 (# ! each code.local_symbol (random.ascii/lower 14))]) + ($_ _.and + (_.cover [/.phase] + (and (..can_analyse_unit! lux module/0) + (..can_analyse_simple_literal_or_singleton_tuple! lux module/0 [bit/0 nat/0 int/0 rev/0 frac/0 text/0]) + (..can_analyse_sum! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] [@left @right]) + (..can_analyse_variant! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] [@left @right]) + (..can_analyse_tuple! lux module/0 [bit/0 nat/0 int/0 rev/0 frac/0 text/0]) + (..can_analyse_record! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0]) + (..can_analyse_function! lux module/0 nat/0 [$abstraction/0 $parameter/0 $abstraction/1 $parameter/1]) + (..can_analyse_apply! lux module/0 bit/0 nat/0 [$abstraction/0 $parameter/0 $abstraction/1 $parameter/1]) + (..can_analyse_extension! lux module/0 text/0) + (..can_analyse_pattern_matching! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] $parameter/0) + )) + (_.cover [/.invalid] + (`` (and (~~ (template [<syntax>] + [(|> (do phase.monad + [_ (|> <syntax> + (/.phase ..expander archive.empty) + (//type.expecting .Any))] + (in false)) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (exception.otherwise (text.contains? (value@ exception.#label /.invalid))))] + + [(` ({#0} (~ (code.bit bit/0))))] + [(` ({#0 [] #1} (~ (code.bit bit/0))))] + [(` {(~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0))})] + [(` {(~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0))})] + [(` {(~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0))})] + [(` {(~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0))})] + [(` {(~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0))})] + [(` {(~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0))})] + )) + ))) + + /simple.test + /complex.test + /reference.test + /function.test + /case.test + ))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/artifact/category.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/artifact/category.lux index 8f31cca51..358f35350 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/artifact/category.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/artifact/category.lux @@ -10,11 +10,23 @@ [\\library ["[0]" /]]) +(def: random_definition + (Random /.Definition) + ($_ random.and + (random.ascii/lower 1) + (random.maybe + ($_ random.and + random.nat + random.nat + random.nat + )) + )) + (def: .public random (Random /.Category) ($_ random.or (random#in []) - (random.ascii/lower 1) + ..random_definition (random.ascii/lower 2) (random.ascii/lower 3) (random.ascii/lower 4) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux index f9499d442..893f1da72 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux @@ -15,7 +15,7 @@ [collection ["[0]" sequence {"+" Sequence}] ["[0]" set {"+" Set}] - ["[0]" list ("[1]#[0]" mix)]] + ["[0]" list ("[1]#[0]" mix functor)]] [format ["[0]" binary]]] [math @@ -78,97 +78,103 @@ _ false))) - (~~ (template [<new> <query> <tag> <wrong_new>] + (~~ (template [<new> <expected>' <query> <tag> <wrong_new> <wrong_expected>'] [(_.cover [<new> <query>] - (and (let [[@it registry] (<new> expected_name mandatory? expected_dependencies /.empty)] - (and (case (<query> registry) - (^ (list actual_name)) - (same? expected_name actual_name) + (let [<expected> <expected>' + <wrong_expected> <wrong_expected>'] + (and (let [[@it registry] (<new> <expected> mandatory? expected_dependencies /.empty)] + (and (case (<query> registry) + (^ (list actual_name)) + (same? <expected> actual_name) - _ - false) - (case (sequence.list (/.artifacts registry)) - (^ (list [artifact actual_dependencies])) - (and (same? @it (value@ artifact.#id artifact)) - (same? mandatory? (value@ artifact.#mandatory? artifact)) - (case (value@ artifact.#category artifact) - {<tag> actual_name} - (same? expected_name actual_name) + _ + false) + (case (sequence.list (/.artifacts registry)) + (^ (list [artifact actual_dependencies])) + (and (same? @it (value@ artifact.#id artifact)) + (same? mandatory? (value@ artifact.#mandatory? artifact)) + (case (value@ artifact.#category artifact) + {<tag> actual_name} + (same? <expected> actual_name) - _ - false) - (same? expected_dependencies actual_dependencies)) + _ + false) + (same? expected_dependencies actual_dependencies)) - _ - false))) - (let [[@it registry] (<wrong_new> expected_name mandatory? expected_dependencies /.empty)] - (case (<query> registry) - (^ (list)) - true + _ + false))) + (let [[@it registry] (<wrong_new> <wrong_expected> mandatory? expected_dependencies /.empty)] + (case (<query> registry) + (^ (list)) + true - _ - false))))] + _ + false)))))] - [/.definition /.definitions category.#Definition /.analyser] - [/.analyser /.analysers category.#Analyser /.synthesizer] - [/.synthesizer /.synthesizers category.#Synthesizer /.generator] - [/.generator /.generators category.#Generator /.directive] - [/.directive /.directives category.#Directive /.custom] - [/.custom /.customs category.#Custom /.definition] + [/.definition (: category.Definition [expected_name {.#None}]) /.definitions category.#Definition /.analyser expected_name] + [/.analyser expected_name /.analysers category.#Analyser /.synthesizer expected_name] + [/.synthesizer expected_name /.synthesizers category.#Synthesizer /.generator expected_name] + [/.generator expected_name /.generators category.#Generator /.directive expected_name] + [/.directive expected_name /.directives category.#Directive /.custom expected_name] + [/.custom expected_name /.customs category.#Custom /.definition (: category.Definition [expected_name {.#None}])] )) (_.cover [/.id] - (and (~~ (template [<new>] - [(let [[@expected registry] (<new> expected_name mandatory? expected_dependencies /.empty)] - (|> (/.id expected_name registry) + (and (~~ (template [<new> <expected>' <name>] + [(let [<expected> <expected>' + [@expected registry] (<new> <expected> mandatory? expected_dependencies /.empty)] + (|> (/.id (<name> <expected>) registry) (maybe#each (same? @expected)) (maybe.else false)))] - [/.definition] - [/.analyser] - [/.synthesizer] - [/.generator] - [/.directive] - [/.custom] + [/.definition (: category.Definition [expected_name {.#None}]) product.left] + [/.analyser expected_name |>] + [/.synthesizer expected_name |>] + [/.generator expected_name |>] + [/.directive expected_name |>] + [/.custom expected_name |>] )))) (_.cover [/.artifacts] - (and (~~ (template [<new> <query>] - [(let [[ids registry] (: [(Sequence artifact.ID) /.Registry] - (list#mix (function (_ name [ids registry]) - (let [[@new registry] (<new> name mandatory? expected_dependencies registry)] + (and (~~ (template [<new> <query> <equivalence> <$>] + [(let [expected/* (list#each <$> expected_names) + [ids registry] (: [(Sequence artifact.ID) /.Registry] + (list#mix (function (_ expected [ids registry]) + (let [[@new registry] (<new> expected mandatory? expected_dependencies registry)] [(sequence.suffix @new ids) registry])) [sequence.empty /.empty] - expected_names)) + expected/*)) it (/.artifacts registry)] (and (n.= expected_amount (sequence.size it)) - (n.= expected_amount (sequence.size it)) (list.every? (function (_ [@it [it dependencies]]) (same? @it (value@ artifact.#id it))) (list.zipped/2 (sequence.list ids) (sequence.list it))) - (# (list.equivalence text.equivalence) = expected_names (<query> registry))))] + (# (list.equivalence <equivalence>) = expected/* (<query> registry))))] - [/.definition /.definitions] - [/.analyser /.analysers] - [/.synthesizer /.synthesizers] - [/.generator /.generators] - [/.directive /.directives] - [/.custom /.customs] + [/.definition /.definitions category.definition_equivalence (: (-> Text category.Definition) + (function (_ it) + [it {.#None}]))] + [/.analyser /.analysers text.equivalence (|>>)] + [/.synthesizer /.synthesizers text.equivalence (|>>)] + [/.generator /.generators text.equivalence (|>>)] + [/.directive /.directives text.equivalence (|>>)] + [/.custom /.customs text.equivalence (|>>)] )))) (_.cover [/.writer /.parser] - (and (~~ (template [<new>] - [(let [[@expected before] (<new> expected_name mandatory? expected_dependencies /.empty)] + (and (~~ (template [<new> <expected>' <name>] + [(let [<expected> <expected>' + [@expected before] (<new> <expected> mandatory? expected_dependencies /.empty)] (|> before (binary.result /.writer) (<binary>.result /.parser) - (try#each (|>> (/.id expected_name) + (try#each (|>> (/.id (<name> <expected>)) (maybe#each (same? @expected)) (maybe.else false))) (try.else false)))] - [/.definition] - [/.analyser] - [/.synthesizer] - [/.generator] - [/.directive] - [/.custom] + [/.definition (: category.Definition [expected_name {.#None}]) product.left] + [/.analyser expected_name |>] + [/.synthesizer expected_name |>] + [/.generator expected_name |>] + [/.directive expected_name |>] + [/.custom expected_name |>] )))) ))))) diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index ee313599f..5c05b5437 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -7,8 +7,9 @@ [control ["[0]" io {"+" IO}] ["[0]" try {"+" Try}] + ["[0]" exception] [concurrency - [async {"+" Async}] + ["[0]" async {"+" Async}] ["[0]" atom {"+" Atom}]]] [data ["[0]" binary {"+" Binary} ("[1]#[0]" monoid)] @@ -239,12 +240,46 @@ Test (<| (_.covering /._) (do [! random.monad] - [/ (random.ascii/upper 1)] + [/ (random.ascii/upper 1) + file (random.ascii/lower 1)] ($_ _.and (_.for [/.mock] ($/.spec (io.io (/.mock /)))) (_.for [/.async] ($/.spec (io.io (/.async (..fs /))))) + + (in (do async.monad + [.let [fs (/.mock /)] + ? (# fs delete file)] + (_.cover' [/.cannot_delete] + (case ? + {try.#Failure error} + (exception.match? /.cannot_delete error) + + _ + false)))) + (in (do async.monad + [.let [fs (/.mock /)] + ? (# fs read file)] + (_.cover' [/.cannot_find_file] + (case ? + {try.#Failure error} + (exception.match? /.cannot_find_file error) + + _ + false)))) + (in (do async.monad + [.let [fs (/.mock /)] + ?/0 (# fs directory_files file) + ?/1 (# fs sub_directories file)] + (_.cover' [/.cannot_find_directory] + (case [?/0 ?/1] + [{try.#Failure error/0} {try.#Failure error/1}] + (and (exception.match? /.cannot_find_directory error/0) + (exception.match? /.cannot_find_directory error/1)) + + _ + false)))) /watch.test )))) |