aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/library/lux/control/parser/type.lux52
-rw-r--r--stdlib/source/library/lux/target/python.lux4
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux169
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux13
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux127
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux18
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/packager/script.lux3
-rw-r--r--stdlib/source/library/lux/type/poly.lux50
-rw-r--r--stdlib/source/test/lux/control/parser/type.lux18
-rw-r--r--stdlib/source/test/lux/tool.lux4
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux822
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux4
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux1
-rw-r--r--stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux2
15 files changed, 896 insertions, 393 deletions
diff --git a/stdlib/source/library/lux/control/parser/type.lux b/stdlib/source/library/lux/control/parser/type.lux
index 03483c788..3f4da5ee2 100644
--- a/stdlib/source/library/lux/control/parser/type.lux
+++ b/stdlib/source/library/lux/control/parser/type.lux
@@ -1,26 +1,26 @@
(.using
- [library
- [lux {"-" function local}
- [abstract
- ["[0]" monad {"+" do}]]
- [control
- ["[0]" try {"+" Try}]
- ["[0]" exception {"+" exception:}]
- ["[0]" function]]
- [data
- ["[0]" text ("[1]#[0]" monoid)
- ["%" format {"+" format}]]
- [collection
- ["[0]" list ("[1]#[0]" functor)]
- ["[0]" dictionary {"+" Dictionary}]]]
- [macro
- ["[0]" code]]
- [math
- [number
- ["n" nat ("[1]#[0]" decimal)]]]
- ["[0]" type ("[1]#[0]" equivalence)
- ["[0]" check]]]]
- ["[0]" //])
+ [library
+ [lux {"-" function local}
+ [abstract
+ ["[0]" monad {"+" do}]]
+ [control
+ ["[0]" try {"+" Try}]
+ ["[0]" exception {"+" exception:}]
+ ["[0]" function]]
+ [data
+ ["[0]" text ("[1]#[0]" monoid)
+ ["%" format {"+" format}]]
+ [collection
+ ["[0]" list ("[1]#[0]" functor)]
+ ["[0]" dictionary {"+" Dictionary}]]]
+ [macro
+ ["[0]" code]]
+ [math
+ [number
+ ["n" nat ("[1]#[0]" decimal)]]]
+ ["[0]" type ("[1]#[0]" equivalence)
+ ["[0]" check]]]]
+ ["[0]" //])
(template: (|recursion_dummy|)
[{.#Primitive "" {.#End}}])
@@ -245,7 +245,7 @@
[super (function.flipped check.subsumes?)]
)
-(def: .public (adjusted_idx env idx)
+(def: .public (argument env idx)
(-> Env Nat Nat)
(let [env_level (n./ 2 (dictionary.size env))
parameter_level (n./ 2 idx)
@@ -259,7 +259,7 @@
headT any]
(case headT
{.#Parameter idx}
- (case (dictionary.value (adjusted_idx env idx) env)
+ (case (dictionary.value (..argument env idx) env)
{.#Some [poly_type poly_code]}
(in poly_code)
@@ -276,7 +276,7 @@
headT any]
(case headT
{.#Parameter idx}
- (if (n.= id (adjusted_idx env idx))
+ (if (n.= id (..argument env idx))
(in [])
(//.failure (exception.error ..wrong_parameter [{.#Parameter id} headT])))
@@ -328,7 +328,7 @@
headT any]
(case (type.anonymous headT)
(^multi (^ {.#Apply (|recursion_dummy|) {.#Parameter funcT_idx}})
- (n.= 0 (adjusted_idx env funcT_idx))
+ (n.= 0 (..argument env funcT_idx))
[(dictionary.value 0 env) {.#Some [self_type self_call]}])
(in self_call)
diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux
index b574b6688..1e0d3a59b 100644
--- a/stdlib/source/library/lux/target/python.lux
+++ b/stdlib/source/library/lux/target/python.lux
@@ -211,13 +211,13 @@
)
(def: .public (slice from to list)
- (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any))
+ (-> (Expression Any) (Expression Any) (Expression Any) Access)
(<| :abstraction
... ..expression
(format (:representation list) "[" (:representation from) ":" (:representation to) "]")))
(def: .public (slice_from from list)
- (-> (Expression Any) (Expression Any) (Computation Any))
+ (-> (Expression Any) (Expression Any) Access)
(<| :abstraction
... ..expression
(format (:representation list) "[" (:representation from) ":]")))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux
index 3e81c08b8..2c957abe7 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux
@@ -20,7 +20,7 @@
[macro
["[0]" code]]
["[0]" type
- ["[0]" check]]]]
+ ["[0]" check {"+" Check}]]]]
["[0]" / "_"
["/[1]" // "_"
["[1][0]" complex]
@@ -37,8 +37,8 @@
[///
["[1]" phase]]]]]])
-(exception: .public (cannot_match_with_pattern [type Type
- pattern Code])
+(exception: .public (mismatch [type Type
+ pattern Code])
(exception.report
["Type" (%.type type)]
["Pattern" (%.code pattern)]))
@@ -49,15 +49,15 @@
["Case" (%.nat case)]
["Type" (%.type type)]))
-(exception: .public (not_a_pattern [code Code])
- (exception.report ["Code" (%.code code)]))
+(exception: .public (invalid [it Code])
+ (exception.report ["Pattern" (%.code it)]))
-(exception: .public (cannot_simplify_for_pattern_matching [type Type])
+(exception: .public (non_tuple [type Type])
(exception.report ["Type" (%.type type)]))
-(exception: .public (non_exhaustive_pattern_matching [input Code
- branches (List [Code Code])
- coverage Coverage])
+(exception: .public (non_exhaustive [input Code
+ branches (List [Code Code])
+ coverage Coverage])
(exception.report
["Input" (%.code input)]
["Branches" (%.code (code.tuple (|> branches
@@ -66,17 +66,16 @@
list#conjoint)))]
["Coverage" (/coverage.format coverage)]))
-(exception: .public (cannot_have_empty_branches [message Text])
- message)
+(exception: .public empty_branches)
-(def: (re_quantify envs baseT)
+(def: (quantified envs baseT)
(-> (List (List Type)) Type Type)
(.case envs
{.#End}
baseT
{.#Item head tail}
- (re_quantify tail {.#UnivQ head baseT})))
+ (quantified tail {.#UnivQ head baseT})))
... Type-checking on the input value is done during the analysis of a
... "case" expression, to ensure that the patterns being used make
@@ -85,21 +84,21 @@
... type-variables or quantifications.
... This function makes it easier for "case" analysis to properly
... type-check the input with respect to the patterns.
-(def: (simplify_case caseT)
- (-> Type (Operation Type))
+(def: .public (tuple :it:)
+ (-> Type (Check [(List check.Var) Type]))
(loop [envs (: (List (List Type))
(list))
- caseT caseT]
- (.case caseT
+ :it: :it:]
+ (.case :it:
{.#Var id}
- (do ///.monad
- [?caseT' (/type.check (check.peek id))]
- (.case ?caseT'
- {.#Some caseT'}
- (again envs caseT')
+ (do check.monad
+ [?:it:' (check.peek id)]
+ (.case ?:it:'
+ {.#Some :it:'}
+ (again envs :it:')
_
- (/.except ..cannot_simplify_for_pattern_matching caseT)))
+ (check.except ..non_tuple :it:)))
{.#Named name unnamedT}
(again envs unnamedT)
@@ -108,44 +107,46 @@
(again {.#Item env envs} unquantifiedT)
{.#ExQ _}
- (do ///.monad
- [[var_id varT] (/type.check check.var)]
- (again envs (maybe.trusted (type.applied (list varT) caseT))))
-
- {.#Apply inputT funcT}
- (.case funcT
- {.#Var funcT_id}
- (do ///.monad
- [funcT' (/type.check
- (do check.monad
- [?funct' (check.peek funcT_id)]
- (.case ?funct'
- {.#Some funct'}
- (in funct')
-
- _
- (check.except ..cannot_simplify_for_pattern_matching caseT))))]
- (again envs {.#Apply inputT funcT'}))
-
- _
- (.case (type.applied (list inputT) funcT)
- {.#Some outputT}
- (again envs outputT)
+ (do check.monad
+ [[@head :head:] check.var
+ [tail :tuple:] (again envs (maybe.trusted (type.applied (list :head:) :it:)))]
+ (in [(list& @head tail) :tuple:]))
+
+ {.#Apply _}
+ (do [! check.monad]
+ [.let [[:abstraction: :parameters:] (type.flat_application :it:)]
+ :abstraction: (.case :abstraction:
+ {.#Var @abstraction}
+ (do !
+ [?:abstraction: (check.peek @abstraction)]
+ (.case ?:abstraction:
+ {.#Some :abstraction:}
+ (in :abstraction:)
+
+ _
+ (check.except ..non_tuple :it:)))
+
+ _
+ (in :abstraction:))]
+ (.case (type.applied :parameters: :abstraction:)
+ {.#Some :it:}
+ (again envs :it:)
{.#None}
- (/.except ..cannot_simplify_for_pattern_matching caseT)))
+ (check.except ..non_tuple :it:)))
{.#Product _}
- (|> caseT
+ (|> :it:
type.flat_tuple
- (list#each (re_quantify envs))
+ (list#each (..quantified envs))
type.tuple
- (# ///.monad in))
+ [(list)]
+ (# check.monad in))
_
- (# ///.monad in (re_quantify envs caseT)))))
+ (# check.monad in [(list) (..quantified envs :it:)]))))
-(def: (analyse_simple type inputT location output next)
+(def: (simple_pattern_analysis type inputT location output next)
(All (_ a) (-> Type Type Location Pattern (Operation a) (Operation [Pattern a])))
(/.with_location location
(do ///.monad
@@ -153,12 +154,12 @@
outputA next]
(in [output outputA]))))
-(def: (analyse_tuple_pattern analyse_pattern inputT sub_patterns next)
+(def: (tuple_pattern_analysis pattern_analysis inputT sub_patterns next)
(All (_ a)
(-> (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))
Type (List Code) (Operation a) (Operation [Pattern a])))
(do [! ///.monad]
- [inputT' (simplify_case inputT)]
+ [[@ex_var+ inputT'] (/type.check (..tuple inputT))]
(.case inputT'
{.#Product _}
(let [matches (loop [types (type.flat_tuple inputT')
@@ -190,18 +191,19 @@
(function (_ [memberT memberC] then)
(do !
[[memberP [memberP+ thenA]] ((:as (All (_ a) (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a])))
- analyse_pattern)
+ pattern_analysis)
{.#None} memberT memberC then)]
(in [(list& memberP memberP+) thenA]))))
(do !
[nextA next]
(in [(list) nextA]))
- matches)]
+ matches)
+ _ (/type.check (monad.each check.monad check.forget! @ex_var+))]
(in [(/pattern.tuple memberP+)
thenA])))
_
- (/.except ..cannot_match_with_pattern [inputT' (code.tuple sub_patterns)]))))
+ (/.except ..mismatch [inputT' (code.tuple sub_patterns)]))))
... This function handles several concerns at once, but it must be that
... way because those concerns are interleaved when doing
@@ -219,7 +221,7 @@
... body expressions.
... That is why the body must be analysed in the context of the
... pattern, and not separately.
-(def: (analyse_pattern num_tags inputT pattern next)
+(def: (pattern_analysis num_tags inputT pattern next)
(All (_ a) (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a])))
(.case pattern
[location {.#Symbol ["" name]}]
@@ -232,7 +234,7 @@
(^template [<type> <input> <output>]
[[location <input>]
- (analyse_simple <type> inputT location {/pattern.#Simple <output>} next)])
+ (simple_pattern_analysis <type> inputT location {/pattern.#Simple <output>} next)])
([Bit {.#Bit pattern_value} {/simple.#Bit pattern_value}]
[Nat {.#Nat pattern_value} {/simple.#Nat pattern_value}]
[Int {.#Int pattern_value} {/simple.#Int pattern_value}]
@@ -242,12 +244,12 @@
[Any {.#Tuple {.#End}} {/simple.#Unit}])
(^ [location {.#Tuple (list singleton)}])
- (analyse_pattern {.#None} inputT singleton next)
+ (pattern_analysis {.#None} inputT singleton next)
[location {.#Tuple sub_patterns}]
(/.with_location location
(do [! ///.monad]
- [record (//complex.normal sub_patterns)
+ [record (//complex.normal true sub_patterns)
record_size,members,recordT (: (Operation (Maybe [Nat (List Code) Type]))
(.case record
{.#Some record}
@@ -266,18 +268,18 @@
(in []))]
(.case members
(^ (list singleton))
- (analyse_pattern {.#None} inputT singleton next)
+ (pattern_analysis {.#None} inputT singleton next)
_
- (analyse_tuple_pattern analyse_pattern inputT members next)))
+ (..tuple_pattern_analysis pattern_analysis inputT members next)))
{.#None}
- (analyse_tuple_pattern analyse_pattern inputT sub_patterns next))))
+ (..tuple_pattern_analysis pattern_analysis inputT sub_patterns next))))
(^ [location {.#Variant (list& [_ {.#Nat lefts}] [_ {.#Bit right?}] values)}])
(/.with_location location
(do ///.monad
- [inputT' (simplify_case inputT)]
+ [[@ex_var+ inputT'] (/type.check (..tuple inputT))]
(.case inputT'
{.#Sum _}
(let [flat_sum (type.flat_variant inputT')
@@ -290,11 +292,12 @@
(do ///.monad
[[testP nextA] (if (and (n.> num_cases size_sum)
(n.= (-- num_cases) idx))
- (analyse_pattern {.#None}
- (type.variant (list.after (-- num_cases) flat_sum))
- (` [(~+ values)])
- next)
- (analyse_pattern {.#None} caseT (` [(~+ values)]) next))]
+ (pattern_analysis {.#None}
+ (type.variant (list.after (-- num_cases) flat_sum))
+ (` [(~+ values)])
+ next)
+ (pattern_analysis {.#None} caseT (` [(~+ values)]) next))
+ _ (/type.check (monad.each check.monad check.forget! @ex_var+))]
(in [(/pattern.variant [lefts right? testP])
nextA]))
@@ -303,14 +306,16 @@
{.#UnivQ _}
(do ///.monad
- [[ex_id exT] (/type.check check.existential)]
- (analyse_pattern num_tags
- (maybe.trusted (type.applied (list exT) inputT'))
- pattern
- next))
+ [[ex_id exT] (/type.check check.existential)
+ it (pattern_analysis num_tags
+ (maybe.trusted (type.applied (list exT) inputT'))
+ pattern
+ next)
+ _ (/type.check (monad.each check.monad check.forget! @ex_var+))]
+ (in it))
_
- (/.except ..cannot_match_with_pattern [inputT' pattern]))))
+ (/.except ..mismatch [inputT' pattern]))))
(^ [location {.#Variant (list& [_ {.#Symbol tag}] values)}])
(/.with_location location
@@ -319,10 +324,10 @@
[idx group variantT] (///extension.lifted (meta.tag tag))
_ (/type.check (check.check inputT variantT))
.let [[lefts right?] (/complex.choice (list.size group) idx)]]
- (analyse_pattern {.#Some (list.size group)} inputT (` {(~ (code.nat lefts)) (~ (code.bit right?)) (~+ values)}) next)))
+ (pattern_analysis {.#Some (list.size group)} inputT (` {(~ (code.nat lefts)) (~ (code.bit right?)) (~+ values)}) next)))
_
- (/.except ..not_a_pattern pattern)
+ (/.except ..invalid [pattern])
))
(def: .public (case analyse branches archive inputC)
@@ -332,16 +337,16 @@
(do [! ///.monad]
[[inputT inputA] (/type.inferring
(analyse archive inputC))
- outputH (analyse_pattern {.#None} inputT patternH (analyse archive bodyH))
+ outputH (pattern_analysis {.#None} inputT patternH (analyse archive bodyH))
outputT (monad.each !
(function (_ [patternT bodyT])
- (analyse_pattern {.#None} inputT patternT (analyse archive bodyT)))
+ (pattern_analysis {.#None} inputT patternT (analyse archive bodyT)))
branchesT)
outputHC (|> outputH product.left /coverage.coverage /.of_try)
outputTC (monad.each ! (|>> product.left /coverage.coverage /.of_try) outputT)
_ (.case (monad.mix try.monad /coverage.composite outputHC outputTC)
{try.#Success coverage}
- (///.assertion ..non_exhaustive_pattern_matching [inputC branches coverage]
+ (///.assertion ..non_exhaustive [inputC branches coverage]
(/coverage.exhaustive? coverage))
{try.#Failure error}
@@ -349,4 +354,4 @@
(in {/.#Case inputA [outputH outputT]}))
{.#End}
- (/.except ..cannot_have_empty_branches "")))
+ (/.except ..empty_branches [])))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux
index cce7b1f00..1bf6a48b9 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux
@@ -286,12 +286,19 @@
... records, so they must be normalized for further analysis.
... Normalization just means that all the tags get resolved to their
... canonical form (with their corresponding module identified).
-(def: .public (normal record)
- (-> (List Code) (Operation (Maybe (List [Symbol Code]))))
+(def: .public (normal pattern_matching? record)
+ (-> Bit (List Code) (Operation (Maybe (List [Symbol Code]))))
(loop [input record
output (: (List [Symbol Code])
{.#End})]
(case input
+ (^ (list& [_ {.#Symbol ["" slotH]}] valueH tail))
+ (if pattern_matching?
+ (///#in {.#None})
+ (do ///.monad
+ [slotH (///extension.lifted (meta.normal ["" slotH]))]
+ (again tail {.#Item [slotH valueH] output})))
+
(^ (list& [_ {.#Symbol slotH}] valueH tail))
(do ///.monad
[slotH (///extension.lifted (meta.normal slotH))]
@@ -398,7 +405,7 @@
_
(do [! ///.monad]
- [?members (normal members)]
+ [?members (..normal false members)]
(case ?members
{.#None}
(..product analyse archive members)
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
index 2338824c4..540e38eb0 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
@@ -142,7 +142,9 @@
(getDeclaredField [java/lang/String] "try" java/lang/reflect/Field)
(getConstructors [] [(java/lang/reflect/Constructor java/lang/Object)])
(getDeclaredMethods [] [java/lang/reflect/Method])
- (getDeclaredAnnotations [] [java/lang/annotation/Annotation])])
+ (getDeclaredAnnotations [] [java/lang/annotation/Annotation])
+ (getSuperclass [] "?" (java/lang/Class java/lang/Object))
+ (getInterfaces [] [(java/lang/Class java/lang/Object)])])
(template [<name>]
[(exception: .public (<name> [class External
@@ -456,15 +458,16 @@
(function (_ extension_name analyse archive args)
(case args
(^ (list arrayC))
- (do phase.monad
- [_ (typeA.inference ..int)
- [var_id varT] (typeA.check check.var)
- arrayA (<| (typeA.expecting (.type (array.Array varT)))
- (analyse archive arrayC))
- varT (typeA.check (check.clean (list) varT))
- arrayJT (jvm_array_type (.type (array.Array varT)))]
- (in {/////analysis.#Extension extension_name (list (/////analysis.text (..signature arrayJT))
- arrayA)}))
+ (<| typeA.with_var
+ (function (_ [@var :var:]))
+ (do phase.monad
+ [_ (typeA.inference ..int)
+ arrayA (<| (typeA.expecting (.type (array.Array :var:)))
+ (analyse archive arrayC))
+ :var: (typeA.check (check.clean (list) :var:))
+ arrayJT (jvm_array_type (.type (array.Array :var:)))]
+ (in {/////analysis.#Extension extension_name (list (/////analysis.text (..signature arrayJT))
+ arrayA)})))
_
(/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)]))))
@@ -662,18 +665,19 @@
(function (_ extension_name analyse archive args)
(case args
(^ (list idxC arrayC))
- (do phase.monad
- [[var_id varT] (typeA.check check.var)
- _ (typeA.inference varT)
- arrayA (<| (typeA.expecting (.type (array.Array varT)))
- (analyse archive arrayC))
- varT (typeA.check (check.clean (list) varT))
- arrayJT (jvm_array_type (.type (array.Array varT)))
- idxA (<| (typeA.expecting ..int)
- (analyse archive idxC))]
- (in {/////analysis.#Extension extension_name (list (/////analysis.text (..signature arrayJT))
- idxA
- arrayA)}))
+ (<| typeA.with_var
+ (function (_ [@var :var:]))
+ (do phase.monad
+ [_ (typeA.inference :var:)
+ arrayA (<| (typeA.expecting (.type (array.Array :var:)))
+ (analyse archive arrayC))
+ :var: (typeA.check (check.clean (list) :var:))
+ arrayJT (jvm_array_type (.type (array.Array :var:)))
+ idxA (<| (typeA.expecting ..int)
+ (analyse archive idxC))]
+ (in {/////analysis.#Extension extension_name (list (/////analysis.text (..signature arrayJT))
+ idxA
+ arrayA)})))
_
(/////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)]))))
@@ -705,21 +709,22 @@
(function (_ extension_name analyse archive args)
(case args
(^ (list idxC valueC arrayC))
- (do phase.monad
- [[var_id varT] (typeA.check check.var)
- _ (typeA.inference (.type (array.Array varT)))
- arrayA (<| (typeA.expecting (.type (array.Array varT)))
- (analyse archive arrayC))
- varT (typeA.check (check.clean (list) varT))
- arrayJT (jvm_array_type (.type (array.Array varT)))
- idxA (<| (typeA.expecting ..int)
- (analyse archive idxC))
- valueA (<| (typeA.expecting varT)
- (analyse archive valueC))]
- (in {/////analysis.#Extension extension_name (list (/////analysis.text (..signature arrayJT))
- idxA
- valueA
- arrayA)}))
+ (<| typeA.with_var
+ (function (_ [@var :var:]))
+ (do phase.monad
+ [_ (typeA.inference (.type (array.Array :var:)))
+ arrayA (<| (typeA.expecting (.type (array.Array :var:)))
+ (analyse archive arrayC))
+ :var: (typeA.check (check.clean (list) :var:))
+ arrayJT (jvm_array_type (.type (array.Array :var:)))
+ idxA (<| (typeA.expecting ..int)
+ (analyse archive idxC))
+ valueA (<| (typeA.expecting :var:)
+ (analyse archive valueC))]
+ (in {/////analysis.#Extension extension_name (list (/////analysis.text (..signature arrayJT))
+ idxA
+ valueA
+ arrayA)})))
_
(/////analysis.except ///.incorrect_arity [extension_name 3 (list.size args)]))))
@@ -1608,13 +1613,45 @@
(list (/////analysis.text argument)
(value_analysis argumentJT))))
-(template [<name> <only>]
+(def: (family_tree' it)
+ (-> (java/lang/Class java/lang/Object)
+ (List (java/lang/Class java/lang/Object)))
+ (let [interfaces (array.list {.#None} (java/lang/Class::getInterfaces it))
+ supers (case (java/lang/Class::getSuperclass it)
+ {.#Some class}
+ (list& class interfaces)
+
+ {.#None}
+ interfaces)]
+ (|> supers
+ (list#each family_tree')
+ list#conjoint
+ (list& it))))
+
+(def: family_tree
+ (-> (java/lang/Class java/lang/Object)
+ (List (java/lang/Class java/lang/Object)))
+ (|>> ..family_tree'
+ ... De-duplication
+ (list#mix (function (_ class all)
+ (dictionary.has (java/lang/Class::getName class) class all))
+ (dictionary.empty text.hash))
+ dictionary.values))
+
+(def: (all_declared_methods it)
+ (-> (java/lang/Class java/lang/Object)
+ (List java/lang/reflect/Method))
+ (|> it
+ ..family_tree
+ (list#each (|>> java/lang/Class::getDeclaredMethods (array.list {.#None})))
+ list#conjoint))
+
+(template [<name> <only> <methods>]
[(def: (<name> [type class])
(-> [(Type Class) (java/lang/Class java/lang/Object)]
(Try (List [(Type Class) Text (Type Method)])))
(|> class
- java/lang/Class::getDeclaredMethods
- (array.list {.#None})
+ <methods>
(list.only (|>> java/lang/reflect/Method::getModifiers
(predicate.or (|>> java/lang/reflect/Modifier::isPublic)
(|>> java/lang/reflect/Modifier::isProtected))))
@@ -1640,8 +1677,10 @@
concrete_exceptions
generic_exceptions)])]))))))]
- [abstract_methods (list.only (|>> java/lang/reflect/Method::getModifiers java/lang/reflect/Modifier::isAbstract))]
- [methods (<|)]
+ [abstract_methods (list.only (|>> java/lang/reflect/Method::getModifiers java/lang/reflect/Modifier::isAbstract))
+ (<| (array.list {.#None}) java/lang/Class::getDeclaredMethods)]
+ [methods (<|)
+ ..all_declared_methods]
)
(def: jvm_package_separator ".")
@@ -2089,8 +2128,8 @@
[[_ exT] (typeA.check check.existential)]
(in [var exT])))
vars)]
- (in (list#mix (function (_ [varJ varT] mapping)
- (dictionary.has (parser.name varJ) varT mapping))
+ (in (list#mix (function (_ [varJ :var:] mapping)
+ (dictionary.has (parser.name varJ) :var: mapping))
mapping
pairings))))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
index 4b4956d82..23a64f59c 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
@@ -4,7 +4,7 @@
[abstract
["[0]" monad {"+" do}]]
[control
- ["[0]" maybe]
+ ["[0]" maybe ("[1]#[0]" functor)]
["[0]" exception {"+" exception:}]
["<>" parser
["<[0]>" text]
@@ -917,14 +917,24 @@
[//////synthesis.#Seq])
(^template [<tag>]
- [(^ {<tag> _})
+ [{<tag> _}
path])
([//////synthesis.#Pop]
[//////synthesis.#Bind]
[//////synthesis.#Access])
- _
- (undefined))))
+ {//////synthesis.#Bit_Fork when then else}
+ {//////synthesis.#Bit_Fork when (again then) (maybe#each again else)}
+
+ (^template [<tag>]
+ [{<tag> [[exampleH nextH] tail]}
+ {<tag> [[exampleH (again nextH)]
+ (list#each (function (_ [example next])
+ [example (again next)])
+ tail)]}])
+ ([//////synthesis.#I64_Fork]
+ [//////synthesis.#F64_Fork]
+ [//////synthesis.#Text_Fork]))))
(type: Mapping
(Dictionary Synthesis Variable))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
index ebe9f4e75..7449d550b 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
@@ -174,7 +174,7 @@
(runtime: (lux::exec code globals)
($_ _.then
- (_.exec code {.#Some globals})
+ (_.exec {.#Some globals} code)
(_.return ..unit)))
(def: runtime::lux
diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux
index 67b7250c3..5843f0670 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux
@@ -17,9 +17,6 @@
["[0]" sequence]
["[0]" set {"+" Set}]
["[0]" list ("[1]#[0]" functor)]]]]]
- [program
- [compositor
- ["[0]" static {"+" Static}]]]
["[0]" // {"+" Packager}
[//
["[0]" archive {"+" Output}
diff --git a/stdlib/source/library/lux/type/poly.lux b/stdlib/source/library/lux/type/poly.lux
index 10070fc6a..f2cecab1e 100644
--- a/stdlib/source/library/lux/type/poly.lux
+++ b/stdlib/source/library/lux/type/poly.lux
@@ -1,27 +1,27 @@
(.using
- [library
- [lux "*"
- ["[0]" meta]
- ["[0]" type]
- [abstract
- ["[0]" monad {"+" do}]]
- [control
- ["[0]" maybe]
- ["<>" parser ("[1]#[0]" monad)
- ["<[0]>" type {"+" Env}]
- ["<[0]>" code {"+" Parser}]]]
- [data
- ["[0]" product]
- ["[0]" text]
- [collection
- ["[0]" list ("[1]#[0]" functor)]
- ["[0]" dictionary]]]
- [macro {"+" with_symbols}
- ["[0]" code]
- [syntax {"+" syntax:}]]
- [math
- [number
- ["n" nat]]]]])
+ [library
+ [lux "*"
+ ["[0]" meta]
+ ["[0]" type]
+ [abstract
+ ["[0]" monad {"+" do}]]
+ [control
+ ["[0]" maybe]
+ ["<>" parser ("[1]#[0]" monad)
+ ["<[0]>" type {"+" Env}]
+ ["<[0]>" code {"+" Parser}]]]
+ [data
+ ["[0]" product]
+ ["[0]" text]
+ [collection
+ ["[0]" list ("[1]#[0]" functor)]
+ ["[0]" dictionary]]]
+ [macro {"+" with_symbols}
+ ["[0]" code]
+ [syntax {"+" syntax:}]]
+ [math
+ [number
+ ["n" nat]]]]])
(def: polyP
(Parser [Code Text Code])
@@ -61,14 +61,14 @@
([.#Var] [.#Ex])
{.#Parameter idx}
- (let [idx (<type>.adjusted_idx env idx)]
+ (let [idx (<type>.argument env idx)]
(if (n.= 0 idx)
(|> (dictionary.value idx env) maybe.trusted product.left (code env))
(` (.$ (~ (code.nat (-- idx)))))))
{.#Apply {.#Primitive "" {.#End}}
{.#Parameter idx}}
- (case (<type>.adjusted_idx env idx)
+ (case (<type>.argument env idx)
0 (|> env (dictionary.value 0) maybe.trusted product.left (code env))
idx (undefined))
diff --git a/stdlib/source/test/lux/control/parser/type.lux b/stdlib/source/test/lux/control/parser/type.lux
index 39656a32c..6476f9e30 100644
--- a/stdlib/source/test/lux/control/parser/type.lux
+++ b/stdlib/source/test/lux/control/parser/type.lux
@@ -6,6 +6,7 @@
[abstract
[monad {"+" do}]]
[control
+ [pipe {"+" case>}]
["[0]" try]
["[0]" exception]]
[data
@@ -150,6 +151,23 @@
/.parameter)
{.#Parameter 0})
(!expect {try.#Success [quantification##binding argument##binding _]})))
+ (_.cover [/.argument]
+ (let [argument? (: (-> Nat Nat Bit)
+ (function (_ @ expected)
+ (|> (/.result (<| (/.with_extension quantification)
+ (/.with_extension argument)
+ (/.with_extension quantification)
+ (/.with_extension argument)
+ (do //.monad
+ [env /.env
+ _ /.any]
+ (in (/.argument env @))))
+ not_parameter)
+ (!expect (^multi {try.#Success [_ _ _ _ actual]}
+ (n.= expected actual))))))]
+ (and (argument? 0 2)
+ (argument? 1 3)
+ (argument? 2 0))))
(_.cover [/.wrong_parameter]
(|> (/.result (<| (/.with_extension quantification)
(/.with_extension argument)
diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux
index 07824362b..22267936f 100644
--- a/stdlib/source/test/lux/tool.lux
+++ b/stdlib/source/test/lux/tool.lux
@@ -18,7 +18,8 @@
["[1]/[0]" simple]
["[1]/[0]" complex]
["[1]/[0]" reference]
- ["[1]/[0]" function]]
+ ["[1]/[0]" function]
+ ["[1]/[0]" case]]
... ["[1]/[0]" synthesis]
]]]
["[1][0]" meta "_"
@@ -47,6 +48,7 @@
/phase/analysis/complex.test
/phase/analysis/reference.test
/phase/analysis/function.test
+ /phase/analysis/case.test
... /syntax.test
... /synthesis.test
))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux
index c85e3896e..8ade96d8a 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux
@@ -1,210 +1,636 @@
(.using
+ [library
[lux "*"
- [abstract
- ["[0]" monad {"+" do}]]
- [data
- ["%" text/format {"+" format}]]
- ["r" math/random {"+" Random} ("[1]#[0]" monad)]
["_" test {"+" Test}]
+ [abstract
+ [monad {"+" do}]]
[control
- pipe
- ["[0]" maybe]]
+ [pipe {"+" case>}]
+ ["[0]" try {"+" Try} ("[1]#[0]" functor)]
+ ["[0]" exception]]
[data
["[0]" product]
- ["[0]" text ("[1]#[0]" equivalence)]
- [number
- ["n" nat]]
- [collection
- ["[0]" list ("[1]#[0]" monad)]
- ["[0]" set]]]
- ["[0]" type
- ["[0]" check]]
+ ["[0]" text
+ ["%" format]]]
[macro
["[0]" code]]
- [meta
- ["[0]" symbol]]]
- [//
- ["_[0]" primitive]
- ["_[0]" structure]]
- [\\
- ["[0]" /
- ["/[1]" //
- ["[1][0]" module]
- ["[1][0]" type]
- ["/[1]" // "_"
- ["/[1]" //
- ["[1][0]" analysis {"+" Analysis Variant Tag Operation}]
- [///
- ["[0]" phase]
- [meta
- ["[0]" archive]]]]]]]])
-
-(def: (exhaustive_weaving branchings)
- (-> (List (List Code)) (List (List Code)))
- (case branchings
- {.#End}
- {.#End}
-
- {.#Item head+ {.#End}}
- (list#each (|>> list) head+)
-
- {.#Item head+ tail++}
- (do list.monad
- [tail+ (exhaustive_weaving tail++)
- head head+]
- (in {.#Item head tail+}))))
-
-(def: .public (exhaustive_branches allow_literals? variantTC inputC)
- (-> Bit (List [Code Code]) Code (Random (List Code)))
- (case inputC
- [_ {.#Bit _}]
- (r#in (list (' #0) (' #1)))
-
- (^template [<tag> <gen> <wrapper>]
- [[_ {<tag> _}]
- (if allow_literals?
- (do [! r.monad]
- [?sample (r.maybe <gen>)]
- (case ?sample
- {.#Some sample}
- (do !
- [else (exhaustive_branches allow_literals? variantTC inputC)]
- (in (list& (<wrapper> sample) else)))
-
- {.#None}
- (in (list (' _)))))
- (r#in (list (' _))))])
- ([.#Nat r.nat code.nat]
- [.#Int r.int code.int]
- [.#Rev r.rev code.rev]
- [.#Frac r.frac code.frac]
- [.#Text (r.unicode 5) code.text])
-
- (^ [_ {.#Tuple (list)}])
- (r#in (list (' [])))
-
- [_ {.#Tuple members}]
- (do [! r.monad]
- [member_wise_patterns (monad.each ! (exhaustive_branches allow_literals? variantTC) members)]
- (in (|> member_wise_patterns
- exhaustive_weaving
- (list#each code.tuple))))
-
- (^ [_ {.#Record (list)}])
- (r#in (list (' {})))
-
- [_ {.#Record kvs}]
- (do [! r.monad]
- [.let [ks (list#each product.left kvs)
- vs (list#each product.right kvs)]
- member_wise_patterns (monad.each ! (exhaustive_branches allow_literals? variantTC) vs)]
- (in (|> member_wise_patterns
- exhaustive_weaving
- (list#each (|>> (list.zipped/2 ks) code.record)))))
-
- (^ [_ {.#Form (list [_ {.#Tag _}] _)}])
- (do [! r.monad]
- [bundles (monad.each !
- (function (_ [_tag _code])
- (do !
- [v_branches (exhaustive_branches allow_literals? variantTC _code)]
- (in (list#each (function (_ pattern) (` ((~ _tag) (~ pattern))))
- v_branches))))
- variantTC)]
- (in (list#conjoint bundles)))
-
- _
- (r#in (list))
- ))
-
-(def: .public (input variant_tags record_tags primitivesC)
- (-> (List Code) (List Code) (List Code) (Random Code))
- (r.rec
- (function (_ input)
- ($_ r.either
- (r#each product.right _primitive.primitive)
- (do [! r.monad]
- [choice (|> r.nat (# ! each (n.% (list.size variant_tags))))
- .let [choiceT (maybe.trusted (list.item choice variant_tags))
- choiceC (maybe.trusted (list.item choice primitivesC))]]
- (in (` ((~ choiceT) (~ choiceC)))))
- (do [! r.monad]
- [size (|> r.nat (# ! each (n.% 3)))
- elems (r.list size input)]
- (in (code.tuple elems)))
- (r#in (code.record (list.zipped/2 record_tags primitivesC)))
- ))))
-
-(def: (branch body pattern)
- (-> Code Code [Code Code])
- [pattern body])
+ [math
+ ["[0]" random]]
+ ["[0]" type ("[1]#[0]" equivalence)
+ ["[0]" check]]]]
+ [\\library
+ ["[0]" /
+ ["/[1]" //
+ [//
+ ["[1][0]" extension
+ ["[1]/[0]" analysis "_"
+ ["[1]" lux]]]
+ [//
+ ["[1][0]" analysis
+ [evaluation {"+" Eval}]
+ ["[2][0]" macro]
+ ["[2][0]" scope]
+ ["[2][0]" module]
+ ["[2][0]" coverage]
+ ["[2][0]" type
+ ["$[1]" \\test]]
+ ["[2][0]" inference "_"
+ ["$[1]" \\test]]]
+ [///
+ ["[1][0]" phase ("[1]#[0]" monad)]
+ [meta
+ ["[0]" archive]]]]]]]])
+
+(def: (eval archive type term)
+ Eval
+ (//phase#in []))
+
+(def: (expander macro inputs state)
+ //macro.Expander
+ {try.#Success ((.macro macro) inputs state)})
+
+(def: analysis
+ //analysis.Phase
+ (//.phase ..expander))
+
+(def: test|tuple
+ Test
+ (do [! random.monad]
+ [lux $//type.random_state
+ .let [state [//extension.#bundle (//extension/analysis.bundle ..eval)
+ //extension.#state lux]]
+ module/0 (random.ascii/lower 1)
+ name/0 (# ! each (|>> [module/0]) (random.ascii/lower 2))
+ [input/0 simple/0] $//inference.simple_parameter
+ [input/1 simple/1] $//inference.simple_parameter
+ [input/2 simple/2] $//inference.simple_parameter
+ $binding/0 (# ! each code.local_symbol (random.ascii/lower 3))
+ $binding/1 (# ! each code.local_symbol (random.ascii/lower 4))
+ $binding/2 (# ! each code.local_symbol (random.ascii/lower 5))]
+ ($_ _.and
+ (_.cover [/.tuple]
+ (let [tuple? (: (-> Type Type Bit)
+ (function (_ :input: :expected:)
+ (and (|> :input:
+ /.tuple
+ (check.result check.fresh_context)
+ (try#each (|>> product.right (type#= :expected:)))
+ (try.else false))
+ (|> (do check.monad
+ [[@var :var:] check.var
+ _ (check.check :var: :input:)]
+ (/.tuple :var:))
+ (check.result check.fresh_context)
+ (try#each (|>> product.right (type#= :expected:)))
+ (try.else false)))))]
+ (and (tuple? input/0
+ (type.anonymous input/0))
+ (tuple? (Tuple input/0 input/1 input/2)
+ (Tuple input/0 input/1 input/2))
+ (tuple? {.#Named name/0 (Tuple input/0 input/1 input/2)}
+ (Tuple input/0 input/1 input/2))
+ (tuple? (All (_ a b c) (Tuple input/0 input/1 input/2))
+ (Tuple (All (_ a b c) input/0)
+ (All (_ a b c) input/1)
+ (All (_ a b c) input/2)))
+ (tuple? (type ((All (_ a b c) (Tuple a b c)) input/0 input/1 input/2))
+ (Tuple input/0 input/1 input/2))
+ (|> (do check.monad
+ [[@var :var:] check.var
+ _ (check.bind (All (_ a b c) (Tuple a b c)) @var)]
+ (/.tuple (type (:var: input/0 input/1 input/2))))
+ (check.result check.fresh_context)
+ (try#each (|>> product.right (type#= (Tuple input/0 input/1 input/2))))
+ (try.else false))
+ (|> (do check.monad
+ [[@0 :0:] check.existential
+ [@1 :1:] check.existential
+ [_ :tuple:] (/.tuple (Ex (_ a b c) (Tuple a input/1 c)))
+ context check.context
+ _ (check.with context)
+ _ (check.check (Tuple :0: input/1 :1:) :tuple:)
+ _ (check.with context)
+ _ (check.check :tuple: (Tuple :0: input/1 :1:))]
+ (in true))
+ (check.result check.fresh_context)
+ (try.else false)))))
+ (_.cover [/.non_tuple]
+ (and (|> (do check.monad
+ [[@var :var:] check.var
+ _ (/.tuple :var:)]
+ (in false))
+ (check.result check.fresh_context)
+ (exception.otherwise (text.contains? (value@ exception.#label /.non_tuple))))
+ (|> (do check.monad
+ [[@var :var:] check.var
+ _ (/.tuple (type (:var: input/0 input/1 input/2)))]
+ (in false))
+ (check.result check.fresh_context)
+ (exception.otherwise (text.contains? (value@ exception.#label /.non_tuple))))
+ (|> (do check.monad
+ [_ (/.tuple (type (input/0 input/1 input/2)))]
+ (in false))
+ (check.result check.fresh_context)
+ (exception.otherwise (text.contains? (value@ exception.#label /.non_tuple))))
+ (|> (do check.monad
+ [[@var :var:] check.var
+ _ (check.bind input/0 @var)
+ _ (/.tuple (type (:var: input/1 input/2)))]
+ (in false))
+ (check.result check.fresh_context)
+ (exception.otherwise (text.contains? (value@ exception.#label /.non_tuple))))))
+ )))
+
+(def: (test|case lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0])
+ (-> Lux Symbol [Type Code] [Type Code] [Type Code] [Code Code Code] [Type Code] [Type Code] [Bit Nat] Bit)
+ (let [state [//extension.#bundle (//extension/analysis.bundle ..eval)
+ //extension.#state lux]
+ case? (: (-> Code (List [Code Code]) Bit)
+ (function (_ input branches)
+ (|> (do //phase.monad
+ [analysis (|> (/.case ..analysis branches archive.empty input)
+ (//type.expecting output/0))]
+ (in true))
+ //scope.with
+ (//module.with 0 module/0)
+ (//phase#each (|>> product.right product.right))
+ (//phase.result state)
+ (try.else false))))
+
+ body_types_mismatch!
+ (and (not (case? (code.bit bit/0) (list [(` #0) body/1]
+ [(` #1) body/1])))
+ (not (case? (code.bit bit/0) (list [(` #0) body/0]
+ [(` #1) body/1]))))
+
+ input_types_mismatch!
+ (and (not (case? (code.nat nat/0) (list [(` #0) body/0]
+ [(` #1) body/0])))
+ (not (case? (code.bit bit/0) (list [(code.nat nat/0) body/0]
+ [$binding/0 body/0]))))
+
+ handles_singletons!
+ (and (case? simple/0 (list [(` [(~ $binding/0)]) body/0]))
+ (case? simple/0 (list [(` [(~ simple/0)]) body/0]
+ [(` [(~ $binding/0)]) body/0]))
+ (case? (code.bit bit/0) (list [(` [#0]) body/0]
+ [(` [#1]) body/0])))
+
+ can_infer_body!
+ (|> (do //phase.monad
+ [[:actual: analysis] (|> (code.bit bit/0)
+ (/.case ..analysis
+ (list [(` #0) body/0]
+ [(` #1) body/0])
+ archive.empty)
+ //type.inferring)]
+ (in (type#= output/0 :actual:)))
+ //scope.with
+ (//module.with 0 module/0)
+ (//phase#each (|>> product.right product.right))
+ (//phase.result state)
+ (try.else false))
+
+ ensures_consistent_bodies!
+ (|> (do //phase.monad
+ [[:actual: analysis] (|> (code.bit bit/0)
+ (/.case ..analysis
+ (list [(` #0) body/0]
+ [(` #1) body/1])
+ archive.empty)
+ //type.inferring)]
+ (in false))
+ //scope.with
+ (//module.with 0 module/0)
+ (//phase#each (|>> product.right product.right))
+ (//phase.result state)
+ (try.else true))]
+ (and body_types_mismatch!
+ input_types_mismatch!
+ handles_singletons!
+ can_infer_body!
+ ensures_consistent_bodies!
+
+ (case? (` [])
+ (list [(` []) body/0]))
+ (case? (` [])
+ (list [$binding/0 body/0]))
+
+ (case? (code.bit bit/0) (list [(` #0) body/0]
+ [(` #1) body/0]))
+ (case? (code.bit bit/0) (list [(` #1) body/0]
+ [(` #0) body/0]))
+
+ (case? simple/0 (list [$binding/0 body/0]))
+ (case? simple/0 (list [simple/0 body/0]
+ [$binding/0 body/0]))
+
+ (case? (` [(~ simple/0) (~ simple/1) (~ simple/2)])
+ (list [$binding/0 body/0]))
+ (case? (` [(~ simple/0) (~ simple/1) (~ simple/2)])
+ (list [(` [(~ $binding/0) (~ $binding/1)]) body/0]))
+ (case? (` [(~ simple/0) (~ simple/1) (~ simple/2)])
+ (list [(` [(~ simple/0) (~ simple/1) (~ simple/2)]) body/0]
+ ... 000
+ [(` [(~ $binding/0) (~ simple/1) (~ simple/2)]) body/0]
+ ... 001
+ [(` [(~ simple/0) (~ $binding/1) (~ simple/2)]) body/0]
+ ... 010
+ [(` [(~ $binding/0) (~ $binding/1) (~ simple/2)]) body/0]
+ ... 011
+ [(` [(~ simple/0) (~ simple/1) (~ $binding/2)]) body/0]
+ ... 100
+ [(` [(~ $binding/0) (~ simple/1) (~ $binding/2)]) body/0]
+ ... 101
+ [(` [(~ simple/0) (~ $binding/1) (~ $binding/2)]) body/0]
+ ... 110
+ [(` [(~ $binding/0) (~ $binding/1) (~ $binding/2)]) body/0]
+ ... 111
+ )))))
+
+(def: (test|redundancy lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] bit/0)
+ (-> Lux Symbol [Type Code] [Type Code] [Type Code] [Code Code Code] [Type Code] Bit Bit)
+ (let [state [//extension.#bundle (//extension/analysis.bundle ..eval)
+ //extension.#state lux]
+ redundant? (: (-> Code (List [Code Code]) Bit)
+ (function (_ input branches)
+ (|> (do //phase.monad
+ [analysis (|> (/.case ..analysis branches archive.empty input)
+ (//type.expecting output/0))]
+ (in true))
+ //scope.with
+ (//module.with 0 module/0)
+ (//phase#each (|>> product.right product.right))
+ (//phase.result state)
+ (exception.otherwise (text.contains? (value@ exception.#label //coverage.redundancy))))))]
+ (and (redundant? (` [])
+ (list [(` []) body/0]
+ [(` []) body/0]))
+ (redundant? (` [])
+ (list [$binding/0 body/0]
+ [$binding/0 body/0]))
+ (redundant? (code.bit bit/0) (list [(` #0) body/0]
+ [(` #1) body/0]
+ [(` #0) body/0]))
+ (redundant? (code.bit bit/0) (list [(` #0) body/0]
+ [(` #1) body/0]
+ [(` #1) body/0]))
+ (redundant? (code.bit bit/0) (list [(` #0) body/0]
+ [(` #1) body/0]
+ [$binding/0 body/0]))
+ (redundant? simple/0 (list [$binding/0 body/0]
+ [$binding/0 body/0]))
+ (redundant? simple/0 (list [simple/0 body/0]
+ [$binding/0 body/0]
+ [$binding/0 body/0]))
+ (redundant? simple/0 (list [$binding/0 body/0]
+ [simple/0 body/0]))
+ (redundant? (` [(~ simple/0) (~ simple/1) (~ simple/2)])
+ (list [$binding/0 body/0]
+ [$binding/0 body/0]))
+ (redundant? (` [(~ simple/0) (~ simple/1) (~ simple/2)])
+ (list [(` [(~ $binding/0) (~ $binding/1)]) body/0]
+ [(` [(~ $binding/0) (~ $binding/1)]) body/0]))
+ (redundant? (` [(~ simple/0) (~ simple/1) (~ simple/2)])
+ (list [(` [(~ $binding/0) (~ $binding/1)]) body/0]
+ [$binding/0 body/0]))
+ (redundant? (` [(~ simple/0) (~ simple/1) (~ simple/2)])
+ (list [$binding/0 body/0]
+ [(` [(~ $binding/0) (~ $binding/1)]) body/0])))))
+
+(def: (test|variant lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0])
+ (-> Lux Symbol [Type Code] [Type Code] [Type Code] [Code Code Code] [Type Code] [Type Code] [Bit Nat] Bit)
+ (let [state [//extension.#bundle (//extension/analysis.bundle ..eval)
+ //extension.#state lux]
+
+ tag/0 (%.code $binding/0)
+ tag/1 (%.code $binding/1)
+ tag/2 (%.code $binding/2)
+
+ tags/* (list tag/0 tag/1 tag/2)
+ :variant: {.#Named [module/0 name/0] (type.variant (list input/0 input/1 input/2))}
+
+ tag/0 (code.symbol [module/0 tag/0])
+ tag/1 (code.symbol [module/0 tag/1])
+ tag/2 (code.symbol [module/0 tag/2])
+
+ variant? (: (-> Code (List [Code Code]) Bit)
+ (function (_ input branches)
+ (|> (do //phase.monad
+ [_ (//module.declare_labels false tags/* false :variant:)
+ analysis (|> (/.case ..analysis branches archive.empty input)
+ (//type.expecting output/0))]
+ (in true))
+ //scope.with
+ (//module.with 0 module/0)
+ (//phase#each (|>> product.right product.right))
+ (//phase.result state)
+ (try.else false))))
+
+ can_bind!
+ (and (variant? (` {(~ tag/0) (~ simple/0)})
+ (list [$binding/0 body/0]))
+ (variant? (` {(~ tag/1) (~ simple/1)})
+ (list [$binding/0 body/0]))
+ (variant? (` {(~ tag/2) (~ simple/2)})
+ (list [$binding/0 body/0])))
+
+ can_bind_variant!
+ (variant? (` {(~ tag/0) (~ simple/0)})
+ (list [(` {(~ tag/0) (~ $binding/0)}) body/0]
+ [(` {(~ tag/1) (~ $binding/1)}) body/0]
+ [(` {(~ tag/2) (~ $binding/2)}) body/0]))
+
+ can_bind_sum!
+ (variant? (` {(~ tag/0) (~ simple/0)})
+ (list [(` {0 #0 (~ $binding/0)}) body/0]
+ [(` {1 #0 (~ $binding/1)}) body/0]
+ [(` {1 #1 (~ $binding/2)}) body/0]))
+
+ can_check_exhaustiveness!
+ (variant? (` {(~ tag/0) (~ simple/0)})
+ (list [(` {(~ tag/0) (~ simple/0)}) body/0]
+ [(` {(~ tag/0) (~ $binding/0)}) body/0]
+
+ [(` {(~ tag/1) (~ simple/1)}) body/0]
+ [(` {(~ tag/1) (~ $binding/1)}) body/0]
+
+ [(` {(~ tag/2) (~ simple/2)}) body/0]
+ [(` {(~ tag/2) (~ $binding/2)}) body/0]))
+
+ can_bind_partial_variant!
+ (variant? (` {(~ tag/0) (~ simple/0)})
+ (list [(` {(~ tag/0) (~ $binding/0)}) body/0]
+ [(` {0 #1 (~ $binding/1)}) body/0]))]
+ (and can_bind!
+ can_bind_variant!
+ can_bind_sum!
+ can_check_exhaustiveness!
+ can_bind_partial_variant!
+ )))
+
+(def: (test|record lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0])
+ (-> Lux Symbol [Type Code] [Type Code] [Type Code] [Code Code Code] [Type Code] [Type Code] [Bit Nat] Bit)
+ (let [state [//extension.#bundle (//extension/analysis.bundle ..eval)
+ //extension.#state lux]
+
+ slot/0 (%.code $binding/0)
+ slot/1 (%.code $binding/1)
+ slot/2 (%.code $binding/2)
+
+ slots/* (list slot/0 slot/1 slot/2)
+ :record: {.#Named [module/0 name/0] (type.tuple (list input/0 input/1 input/2))}
+
+ slot/0 (code.symbol [module/0 slot/0])
+ slot/1 (code.symbol [module/0 slot/1])
+ slot/2 (code.symbol [module/0 slot/2])
+
+ record? (: (-> Code (List [Code Code]) Bit)
+ (function (_ input branches)
+ (|> (do //phase.monad
+ [_ (//module.declare_labels true slots/* false :record:)
+ analysis (|> (/.case ..analysis branches archive.empty input)
+ (//type.expecting output/0))]
+ (in true))
+ //scope.with
+ (//module.with 0 module/0)
+ (//phase#each (|>> product.right product.right))
+ (//phase.result state)
+ (try.else false))))
+
+ can_bind!
+ (record? (` [(~ slot/0) (~ simple/0)
+ (~ slot/1) (~ simple/1)
+ (~ slot/2) (~ simple/2)])
+ (list [$binding/0 body/0]))
+
+ can_bind_record!
+ (record? (` [(~ slot/0) (~ simple/0)
+ (~ slot/1) (~ simple/1)
+ (~ slot/2) (~ simple/2)])
+ (list [(` [(~ slot/0) (~ $binding/0)
+ (~ slot/1) (~ $binding/1)
+ (~ slot/2) (~ $binding/2)]) body/0]))
+
+ can_bind_tuple!
+ (record? (` [(~ slot/0) (~ simple/0)
+ (~ slot/1) (~ simple/1)
+ (~ slot/2) (~ simple/2)])
+ (list [(` [(~ $binding/0) (~ $binding/1) (~ $binding/2)]) body/0]))
+
+ can_deduce_record!
+ (record? (` [(~ simple/0)
+ (~ simple/1)
+ (~ simple/2)])
+ (list [(` [(~ slot/0) (~ $binding/0)
+ (~ slot/1) (~ $binding/1)
+ (~ slot/2) (~ $binding/2)]) body/0]))
+
+ can_check_exhaustiveness!
+ (record? (` [(~ slot/0) (~ simple/0)
+ (~ slot/1) (~ simple/1)
+ (~ slot/2) (~ simple/2)])
+ (list [(` [(~ slot/0) (~ simple/0)
+ (~ slot/1) (~ simple/1)
+ (~ slot/2) (~ simple/2)]) body/0]
+ ... 000
+ [(` [(~ slot/0) (~ $binding/0)
+ (~ slot/1) (~ simple/1)
+ (~ slot/2) (~ simple/2)]) body/0]
+ ... 001
+ [(` [(~ slot/0) (~ simple/0)
+ (~ slot/1) (~ $binding/1)
+ (~ slot/2) (~ simple/2)]) body/0]
+ ... 010
+ [(` [(~ slot/0) (~ $binding/0)
+ (~ slot/1) (~ $binding/1)
+ (~ slot/2) (~ simple/2)]) body/0]
+ ... 011
+ [(` [(~ slot/0) (~ simple/0)
+ (~ slot/1) (~ simple/1)
+ (~ slot/2) (~ $binding/2)]) body/0]
+ ... 100
+ [(` [(~ slot/0) (~ $binding/0)
+ (~ slot/1) (~ simple/1)
+ (~ slot/2) (~ $binding/2)]) body/0]
+ ... 101
+ [(` [(~ slot/0) (~ simple/0)
+ (~ slot/1) (~ $binding/1)
+ (~ slot/2) (~ $binding/2)]) body/0]
+ ... 110
+ [(` [(~ slot/0) (~ $binding/0)
+ (~ slot/1) (~ $binding/1)
+ (~ slot/2) (~ $binding/2)]) body/0]
+ ... 111
+ ))
+
+ cannot_repeat_slot!
+ (not (record? (` [(~ slot/0) (~ simple/0)
+ (~ slot/1) (~ simple/1)
+ (~ slot/2) (~ simple/2)])
+ (list [(` [(~ slot/0) (~ $binding/0)
+ (~ slot/1) (~ $binding/1)
+ (~ slot/2) (~ $binding/2)
+ (~ slot/2) (~ $binding/2)]) body/0])))
+
+ cannot_omit_slot!
+ (not (record? (` [(~ slot/0) (~ simple/0)
+ (~ slot/1) (~ simple/1)
+ (~ slot/2) (~ simple/2)])
+ (list [(` [(~ slot/0) (~ $binding/0)
+ (~ slot/1) (~ $binding/1)]) body/0])))
+
+ can_bind_partial_tuple!
+ (record? (` [(~ slot/0) (~ simple/0)
+ (~ slot/1) (~ simple/1)
+ (~ slot/2) (~ simple/2)])
+ (list [(` [(~ $binding/0) (~ $binding/1)]) body/0]))]
+ (and can_bind!
+ can_bind_record!
+ can_bind_tuple!
+ can_deduce_record!
+ can_check_exhaustiveness!
+ cannot_repeat_slot!
+ cannot_omit_slot!
+ can_bind_partial_tuple!)))
(def: .public test
- (<| (_.context (symbol.module (symbol /._)))
- (do [! r.monad]
- [module_name (r.unicode 5)
- variant_name (r.unicode 5)
- record_name (|> (r.unicode 5) (r.only (|>> (text#= variant_name) not)))
- size (|> r.nat (# ! each (|>> (n.% 10) (n.max 2))))
- variant_tags (|> (r.set text.hash size (r.unicode 5)) (# ! each set.list))
- record_tags (|> (r.set text.hash size (r.unicode 5)) (# ! each set.list))
- primitivesTC (r.list size _primitive.primitive)
- .let [primitivesT (list#each product.left primitivesTC)
- primitivesC (list#each product.right primitivesTC)
- code_tag (|>> [module_name] code.tag)
- variant_tags+ (list#each code_tag variant_tags)
- record_tags+ (list#each code_tag record_tags)
- variantTC (list.zipped/2 variant_tags+ primitivesC)]
- inputC (input variant_tags+ record_tags+ primitivesC)
- [outputT outputC] (r.only (|>> product.left (same? Any) not)
- _primitive.primitive)
- .let [analyse_pm (function (_ branches)
- (|> (/.case _primitive.phase branches archive.empty inputC)
- (//type.with_type outputT)
- ////analysis.with_scope
- (do phase.monad
- [_ (//module.declare_tags variant_tags false
- {.#Named [module_name variant_name]
- (type.variant primitivesT)})
- _ (//module.declare_tags record_tags false
- {.#Named [module_name record_name]
- (type.tuple primitivesT)})])
- (//module.with_module 0 module_name)))]
- exhaustive_patterns (exhaustive_branches true variantTC inputC)
- .let [exhaustive_branchesC (list#each (branch outputC)
- exhaustive_patterns)]]
+ Test
+ (<| (_.covering /._)
+ (do [! random.monad]
+ [lux $//type.random_state
+ .let [state [//extension.#bundle (//extension/analysis.bundle ..eval)
+ //extension.#state lux]]
+ module/0 (random.ascii/lower 1)
+ name/0 (random.ascii/lower 2)
+ [input/0 simple/0] $//inference.simple_parameter
+ [input/1 simple/1] $//inference.simple_parameter
+ [input/2 simple/2] $//inference.simple_parameter
+ [output/0 body/0] $//inference.simple_parameter
+ [output/1 body/1] (random.only (|>> product.left (same? output/0) not)
+ $//inference.simple_parameter)
+ $binding/0 (# ! each code.local_symbol (random.ascii/lower 3))
+ $binding/1 (# ! each code.local_symbol (random.ascii/lower 4))
+ $binding/2 (# ! each code.local_symbol (random.ascii/lower 5))
+ extension/0 (# ! each code.text (random.ascii/lower 6))
+ bit/0 random.bit
+ nat/0 random.nat]
($_ _.and
- (_.test "Will reject empty pattern-matching (no branches)."
- (|> (analyse_pm (list))
- _structure.check_fails))
- (_.test "Can analyse exhaustive pattern-matching."
- (|> (analyse_pm exhaustive_branchesC)
- _structure.check_succeeds))
- (let [non_exhaustive_branchesC (list.first (-- (list.size exhaustive_branchesC))
- exhaustive_branchesC)]
- (_.test "Will reject non-exhaustive pattern-matching."
- (|> (analyse_pm non_exhaustive_branchesC)
- _structure.check_fails)))
- (do !
- [redundant_patterns (exhaustive_branches false variantTC inputC)
- redundancy_idx (|> r.nat (# ! each (n.% (list.size redundant_patterns))))
- .let [redundant_branchesC (<| (list!each (branch outputC))
- list.together
- (list (list.first redundancy_idx redundant_patterns)
- (list (maybe.trusted (list.item redundancy_idx redundant_patterns)))
- (list.after redundancy_idx redundant_patterns)))]]
- (_.test "Will reject redundant pattern-matching."
- (|> (analyse_pm redundant_branchesC)
- _structure.check_fails)))
- (do !
- [[heterogeneousT heterogeneousC] (r.only (|>> product.left (check.subsumes? outputT) not)
- _primitive.primitive)
- heterogeneous_idx (|> r.nat (# ! each (n.% (list.size exhaustive_patterns))))
- .let [heterogeneous_branchesC (list.together (list (list.first heterogeneous_idx exhaustive_branchesC)
- (list (let [[_pattern _body] (maybe.trusted (list.item heterogeneous_idx exhaustive_branchesC))]
- [_pattern heterogeneousC]))
- (list.after (++ heterogeneous_idx) exhaustive_branchesC)))]]
- (_.test "Will reject pattern-matching if the bodies of the branches do not all have the same type."
- (|> (analyse_pm heterogeneous_branchesC)
- _structure.check_fails)))
+ (_.cover [/.case]
+ (and (test|case lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0])
+ (test|redundancy lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/1] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [bit/0])
+ (test|variant lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0])
+ (test|record lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0])))
+ (_.cover [/.empty_branches]
+ (|> (do //phase.monad
+ [analysis (|> (/.case ..analysis (list) archive.empty simple/0)
+ (//type.expecting output/0))]
+ (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 /.empty_branches)))))
+ (_.cover [/.non_exhaustive]
+ (let [non_exhaustive? (: (-> (List [Code Code]) Bit)
+ (function (_ branches)
+ (|> (do //phase.monad
+ [analysis (|> (/.case ..analysis branches archive.empty simple/0)
+ (//type.expecting output/0))]
+ (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 /.non_exhaustive))))))]
+ (and (non_exhaustive? (list [simple/0 body/0]))
+ (not (non_exhaustive? (list [simple/0 body/0]
+ [$binding/0 body/0]))))))
+ (_.cover [/.invalid]
+ (let [invalid? (: (-> (List [Code Code]) Bit)
+ (function (_ branches)
+ (|> (do //phase.monad
+ [analysis (|> (/.case ..analysis branches archive.empty simple/0)
+ (//type.expecting output/0))]
+ (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))))))]
+ (and (invalid? (list [(` ((~ extension/0) (~ $binding/0) (~ $binding/1) (~ $binding/2)))
+ body/0]))
+ (invalid? (list [(` {(~ extension/0) (~ $binding/0) (~ $binding/1) (~ $binding/2)})
+ body/0]))
+ (invalid? (list [(` {[] (~ $binding/0) (~ $binding/1) (~ $binding/2)})
+ body/0])))))
+ (_.cover [/.sum_has_no_case]
+ (let [tag/0 (%.code $binding/0)
+ tag/1 (%.code $binding/1)
+ tag/2 (%.code $binding/2)
+
+ tags/* (list tag/0 tag/1 tag/2)
+ :variant: {.#Named [module/0 name/0] (type.variant (list input/0 input/1 input/2))}
+
+ tag/0 (code.symbol [module/0 tag/0])
+ tag/1 (code.symbol [module/0 tag/1])
+ tag/2 (code.symbol [module/0 tag/2])]
+ (|> (do //phase.monad
+ [_ (//module.declare_labels false tags/* false :variant:)
+ analysis (|> (` {(~ tag/0) (~ simple/0)})
+ (/.case ..analysis
+ (list [(` {0 #0 (~ $binding/0)}) body/0]
+ [(` {1 #0 (~ $binding/1)}) body/0]
+ [(` {2 #0 (~ $binding/2)}) body/0]
+ [(` {2 #1 (~ $binding/2)}) body/0])
+ archive.empty)
+ (//type.expecting output/0))]
+ (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 /.sum_has_no_case))))))
+ (_.cover [/.mismatch]
+ (let [slot/0 (%.code $binding/0)
+ slot/1 (%.code $binding/1)
+ slot/2 (%.code $binding/2)
+
+ slots/* (list slot/0 slot/1 slot/2)
+ :record: {.#Named [module/0 name/0] (type.tuple (list input/0 input/1 input/2))}
+
+ slot/0 (code.symbol [module/0 slot/0])
+ slot/1 (code.symbol [module/0 slot/1])
+ slot/2 (code.symbol [module/0 slot/2])]
+ (and (|> (do //phase.monad
+ [analysis (|> (` (~ simple/0))
+ (/.case ..analysis
+ (list [(` {0 #0 (~ $binding/0)}) body/0]
+ [(` {1 #0 (~ $binding/1)}) body/0]
+ [(` {1 #1 (~ $binding/2)}) body/0])
+ archive.empty)
+ (//type.expecting output/0))]
+ (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 /.mismatch))))
+ (|> (do //phase.monad
+ [_ (//module.declare_labels true slots/* false :record:)
+ analysis (|> (` (~ simple/0))
+ (/.case ..analysis
+ (list [(` [(~ slot/0) (~ $binding/0)
+ (~ slot/1) (~ $binding/1)
+ (~ slot/2) (~ $binding/2)]) body/0])
+ archive.empty)
+ (//type.expecting output/0))]
+ (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 /.mismatch)))))))
+
+ ..test|tuple
))))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux
index ed111c5e4..21813bb01 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux
@@ -471,7 +471,7 @@
(function (_ expected input)
(|> (do //phase.monad
[_ (//module.declare_labels true slots/0 false :record:)]
- (/.normal input))
+ (/.normal false input))
(//module.with 0 module)
(//phase#each product.right)
(//phase.result state)
@@ -484,7 +484,7 @@
(and (normal? (list) (list))
(normal? expected_record global_record)
(normal? expected_record local_record)
- (|> (/.normal tuple)
+ (|> (/.normal false tuple)
(//phase.result state)
(case> {try.#Success {.#None}}
true
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux
index b5f2e4fc4..a5f5953e6 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux
@@ -38,7 +38,6 @@
["[1][0]" analysis {"+" Analysis}
[evaluation {"+" Eval}]
["[2][0]" macro]
- ["[2][0]" scope]
["[2][0]" module]
["[2][0]" type
["$[1]" \\test]]
diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux
index a73bf751d..a99e8eccf 100644
--- a/stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux
+++ b/stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux
@@ -80,7 +80,7 @@
(|> expected
(/.document key/0)
(binaryF.result (/.writer binaryF.nat))
- (<binary>.result (/.parser <binary>.nat))
+ (<binary>.result (/.parser key/0 <binary>.nat))
(case> {try.#Success it}
(and (/signature#= signature/0 (/.signature it))
(|> it