aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/lux/data/binary.lux2
-rw-r--r--stdlib/source/test/lux/ffi.jvm.lux101
-rw-r--r--stdlib/source/test/lux/math/number/frac.lux4
-rw-r--r--stdlib/source/test/lux/target/jvm.lux2
-rw-r--r--stdlib/source/test/lux/tool.lux13
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux20
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux980
-rw-r--r--stdlib/source/test/lux/tool/compiler/meta/archive/artifact/category.lux14
-rw-r--r--stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux132
-rw-r--r--stdlib/source/test/lux/world/file.lux39
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
))))