aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/library/lux.lux26
-rw-r--r--stdlib/source/library/lux/meta.lux8
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux26
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/archive/document.lux45
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/archive/key.lux14
-rw-r--r--stdlib/source/test/lux/meta.lux142
-rw-r--r--stdlib/source/test/lux/tool.lux4
-rw-r--r--stdlib/source/test/lux/tool/compiler/meta/archive/key.lux27
8 files changed, 183 insertions, 109 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux
index d65fa7bcb..3fafb38f5 100644
--- a/stdlib/source/library/lux.lux
+++ b/stdlib/source/library/lux.lux
@@ -825,19 +825,6 @@
(failure "Wrong syntax for $'")}
tokens))
-... (def:'' .private (list#each f xs)
-... {#UnivQ {#End}
-... {#UnivQ {#End}
-... {#Function {#Function {#Parameter 3} {#Parameter 1}}
-... {#Function ($' List {#Parameter 3})
-... ($' List {#Parameter 1})}}}}
-... ({{#End}
-... {#End}
-
-... {#Item x xs'}
-... {#Item (f x) (list#each f xs')}}
-... xs))
-
(def:'' .private (list#mix f init xs)
... (All (_ a b) (-> (-> b a a) a (List b) a))
{#UnivQ {#End} {#UnivQ {#End} {#Function {#Function {#Parameter 1}
@@ -1320,12 +1307,9 @@
(def:''' .private (list#composite xs ys)
(All (_ a) (-> ($' List a) ($' List a) ($' List a)))
- ({{#Item x xs'}
- {#Item x (list#composite xs' ys)}
-
- {#End}
- ys}
- xs))
+ (list#mix (function' [head tail] {#Item head tail})
+ ys
+ (list#reversed xs)))
(def:''' .private (right_associativity op a1 a2)
(-> Code Code Code Code)
@@ -3993,7 +3977,7 @@
(def: (referral_definitions module_name [r_defs r_opens])
(-> Text Refer (Meta (List Code)))
(do meta_monad
- [current_module current_module_name
+ [current_module ..current_module_name
.let [test_referrals (: (-> Text (List Text) (List Text) (Meta (List Any)))
(function (_ module_name all_defs referred_defs)
(monad#each meta_monad
@@ -4804,7 +4788,7 @@
(macro: .public (using _imports)
(do meta_monad
- [current_module current_module_name
+ [current_module ..current_module_name
imports (imports_parser #0 current_module {#End} _imports)
.let [=imports (|> imports
(list#each (: (-> Importation Code)
diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux
index a32be80ad..d16ca46b9 100644
--- a/stdlib/source/library/lux/meta.lux
+++ b/stdlib/source/library/lux/meta.lux
@@ -550,10 +550,10 @@
..current_module))
(template [<name> <tag> <description>]
- [(def: .public (<name> tag_name)
+ [(def: .public (<name> label_name)
(-> Symbol (Meta [Nat (List Symbol) Type]))
(do ..monad
- [.let [[module name] tag_name]
+ [.let [[module name] label_name]
=module (..module module)
this_module_name ..current_module_name]
(case (plist.value name (value@ .#definitions =module))
@@ -561,11 +561,11 @@
(if (or (text#= this_module_name module)
exported?)
(in [idx (list#each (|>> [module]) group) type])
- (..failure ($_ text#composite "Cannot access " <description> ": " (symbol#encoded tag_name) " from module " this_module_name)))
+ (..failure ($_ text#composite "Cannot access " <description> ": " (symbol#encoded label_name) " from module " this_module_name)))
_
(..failure ($_ text#composite
- "Unknown " <description> ": " (symbol#encoded tag_name))))))]
+ "Unknown " <description> ": " (symbol#encoded label_name))))))]
[tag .#Tag "tag"]
[slot .#Slot "slot"]
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux
index 110b76a3d..23123a8c5 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux
@@ -17,7 +17,7 @@
["[1][0]" analysis
["[1]/[0]" type]]
["/[1]" // "_"
- ["/" directive {"+" Phase}]
+ ["/" directive {"+" Operation Phase}]
["[1][0]" analysis
["[0]" evaluation]
["[1]/[0]" macro {"+" Expander}]]
@@ -54,6 +54,26 @@
{try.#Failure error}
{try.#Failure error})))
+(def: (requiring phase archive expansion)
+ (All (_ anchor expression directive)
+ (-> (Phase anchor expression directive) Archive (List Code)
+ (Operation anchor expression directive /.Requirements)))
+ (function (_ state)
+ (loop [state state
+ input expansion
+ output /.no_requirements]
+ (case input
+ {.#End}
+ {try.#Success [state output]}
+
+ {.#Item head tail}
+ (case (phase archive head state)
+ {try.#Success [state' head']}
+ (again state' tail (/.merge_requirements head' output))
+
+ {try.#Failure error}
+ {try.#Failure error})))))
+
(with_expansions [<lux_def_module> (as_is [|form_location| {.#Form (list& [|text_location| {.#Text "lux def module"}] annotations)}])]
(def: .public (phase wrapper expander)
(-> //.Wrapper Expander Phase)
@@ -99,9 +119,7 @@
(# ! each (revised@ /.#referrals (list#composite referrals))))
_
- (|> expansion
- (monad.each ! (again archive))
- (# ! each (list#mix /.merge_requirements /.no_requirements)))))
+ (..requiring again archive expansion)))
_
(//.except ..not_a_directive code)))))))
diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux
index b9b2ec192..1171852cb 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux
@@ -1,24 +1,24 @@
(.using
- [library
- [lux {"-" Module}
- [abstract
- [monad {"+" do}]]
- [control
- ["[0]" try {"+" Try}]
- ["[0]" exception {"+" exception:}]
- ["<>" parser
- [binary {"+" Parser}]]]
- [data
- [collection
- ["[0]" dictionary {"+" Dictionary}]]
- [format
- ["[0]" binary {"+" Writer}]]]
- [type {"+" :sharing}
- abstract]]]
- [//
- ["[0]" signature {"+" Signature}]
- ["[0]" key {"+" Key}]
- [descriptor {"+" Module}]])
+ [library
+ [lux {"-" Module}
+ [abstract
+ [monad {"+" do}]]
+ [control
+ ["[0]" try {"+" Try}]
+ ["[0]" exception {"+" exception:}]
+ ["<>" parser
+ [binary {"+" Parser}]]]
+ [data
+ [collection
+ ["[0]" dictionary {"+" Dictionary}]]
+ [format
+ ["[0]" binary {"+" Writer}]]]
+ [type {"+" :sharing}
+ abstract]]]
+ [//
+ ["[0]" signature {"+" Signature}]
+ ["[0]" key {"+" Key}]
+ [descriptor {"+" Module}]])
(exception: .public (invalid_signature [expected Signature
actual Signature])
@@ -63,8 +63,9 @@
(def: .public (writer content)
(All (_ d) (-> (Writer d) (Writer (Document d))))
- (let [writer (binary.and signature.writer
- content)]
+ (let [writer ($_ binary.and
+ signature.writer
+ content)]
(|>> :representation writer)))
(def: .public parser
diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/key.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/key.lux
index 7c3be5e1b..a124fae6a 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/archive/key.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/archive/key.lux
@@ -1,16 +1,16 @@
(.using
- [library
- [lux "*"
- [type
- abstract]]]
- [//
- [signature {"+" Signature}]])
+ [library
+ [lux "*"
+ [type
+ abstract]]]
+ [//
+ [signature {"+" Signature}]])
(abstract: .public (Key k)
Signature
(def: .public signature
- (-> (Key Any) Signature)
+ (All (_ ?) (-> (Key ?) Signature))
(|>> :representation))
(def: .public (key signature sample)
diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux
index f950abaa0..914e02d92 100644
--- a/stdlib/source/test/lux/meta.lux
+++ b/stdlib/source/test/lux/meta.lux
@@ -1,38 +1,38 @@
(.using
- [library
- [lux "*"
- ["_" test {"+" Test}]
- ["[0]" type ("[1]#[0]" equivalence)]
- [abstract
- [equivalence {"+" Equivalence}]
- [monad {"+" do}]
- [\\specification
- ["$[0]" functor {"+" Injection Comparison}]
- ["$[0]" apply]
- ["$[0]" monad]]]
- [control
- ["[0]" maybe]
- ["[0]" try {"+" Try} ("[1]#[0]" functor)]]
- [data
- ["[0]" product]
- ["[0]" bit ("[1]#[0]" equivalence)]
- ["[0]" text ("[1]#[0]" equivalence)
- ["%" format {"+" format}]]
- [collection
- ["[0]" list ("[1]#[0]" functor monoid)]
- ["[0]" set]]]
- [meta
- ["[0]" location]
- ["[0]" symbol ("[1]#[0]" equivalence)]]
- [math
- ["[0]" random {"+" Random}]
- [number
- ["n" nat]]]]]
- [\\library
- ["[0]" /]]
- ["[0]" / "_"
- ["[1][0]" location]
- ["[1][0]" symbol]])
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ ["[0]" type ("[1]#[0]" equivalence)]
+ [abstract
+ [equivalence {"+" Equivalence}]
+ [monad {"+" do}]
+ [\\specification
+ ["$[0]" functor {"+" Injection Comparison}]
+ ["$[0]" apply]
+ ["$[0]" monad]]]
+ [control
+ ["[0]" maybe]
+ ["[0]" try {"+" Try} ("[1]#[0]" functor)]]
+ [data
+ ["[0]" product]
+ ["[0]" bit ("[1]#[0]" equivalence)]
+ ["[0]" text ("[1]#[0]" equivalence)
+ ["%" format {"+" format}]]
+ [collection
+ ["[0]" list ("[1]#[0]" functor monoid)]
+ ["[0]" set]]]
+ [meta
+ ["[0]" location]
+ ["[0]" symbol ("[1]#[0]" equivalence)]]
+ [math
+ ["[0]" random {"+" Random}]
+ [number
+ ["n" nat]]]]]
+ [\\library
+ ["[0]" /]]
+ ["[0]" / "_"
+ ["[1][0]" location]
+ ["[1][0]" symbol]])
(template: (!expect <pattern> <value>)
[(case <value>
@@ -159,6 +159,16 @@
(!expect (^multi {try.#Success actual}
(n.= expected actual))))
))
+ (_.cover [/.try]
+ (and (|> (/.try (/.failure expected_error))
+ (/.result expected_lux)
+ (!expect (^multi {try.#Success {try.#Failure actual_error}}
+ (text#= (location.with location.dummy expected_error)
+ actual_error))))
+ (|> (/.try (# /.monad in expected))
+ (/.result expected_lux)
+ (!expect (^multi {try.#Success {try.#Success actual}}
+ (same? expected actual))))))
)))
(def: module_related
@@ -310,6 +320,11 @@
.#eval (:as (-> Type Code (Meta Any)) [])
.#host []]]]
($_ _.and
+ (_.cover [/.target]
+ (|> /.target
+ (/.result expected_lux)
+ (try#each (same? target))
+ (try.else false)))
(_.cover [/.seed]
(|> (do /.monad
[pre /.seed
@@ -623,18 +638,18 @@
alias!)))
)))
-(def: tags_related
+(def: label_related
Test
(do [! random.monad]
[current_module (random.ascii/upper 1)
- tag_module (random.only (|>> (text#= current_module) not)
- (random.ascii/upper 1))
+ label_module (random.only (|>> (text#= current_module) not)
+ (random.ascii/upper 1))
name_0 (random.ascii/upper 1)
name_1 (random.only (|>> (text#= name_0) not)
(random.ascii/upper 1))
- .let [random_tag (# ! each (|>> [tag_module])
+ .let [random_tag (# ! each (|>> [label_module])
(random.ascii/upper 1))
random_labels (: (Random [Text (List Text)])
(do !
@@ -665,18 +680,18 @@
[.#module_hash 0
.#module_aliases (list)
.#definitions (list)
- .#imports (list tag_module)
+ .#imports (list label_module)
.#module_state {.#Active}]]
- [tag_module
+ [label_module
[.#module_hash 0
.#module_aliases (list)
- .#definitions (list& [name_0 {.#Type [false type_0 {.#Left tags_0}]}]
+ .#definitions (list& [name_0 {.#Type [true type_0 {.#Left tags_0}]}]
[name_1 {.#Type [true type_1 {.#Right tags_1}]}]
($_ list#composite
(|> {.#Item tags_0}
list.enumeration
(list#each (function (_ [index short])
- [short {.#Tag [false type_0 {.#Item tags_0} index]}])))
+ [short {.#Tag [true type_0 {.#Item tags_0} index]}])))
(|> {.#Item tags_1}
list.enumeration
(list#each (function (_ [index short])
@@ -699,21 +714,47 @@
(product.equivalence
(list.equivalence symbol.equivalence)
type.equivalence))]
- (|> (/.tag_lists tag_module)
+ (|> (/.tag_lists label_module)
(/.result expected_lux)
- (try#each (# equivalence = (list [(list#each (|>> [tag_module]) {.#Item tags_1})
+ (try#each (# equivalence = (list [(list#each (|>> [label_module]) {.#Item tags_0})
+ type_0]
+ [(list#each (|>> [label_module]) {.#Item tags_1})
type_1])))
(try.else false))))
(_.cover [/.tags_of]
- (|> (/.tags_of [tag_module name_1])
+ (|> (/.tags_of [label_module name_1])
(/.result expected_lux)
- (try#each (# (maybe.equivalence (list.equivalence symbol.equivalence)) = {.#Some (list#each (|>> [tag_module]) {.#Item tags_1})}))
+ (try#each (# (maybe.equivalence (list.equivalence symbol.equivalence)) = {.#Some (list#each (|>> [label_module]) {.#Item tags_1})}))
(try.else false)))
+ (_.cover [/.tag]
+ (|> {.#Item tags_0}
+ list.enumeration
+ (list.every? (function (_ [expected_index label])
+ (|> [label_module label]
+ /.tag
+ (/.result expected_lux)
+ (!expect (^multi {try.#Success [actual_index actual_tags actual_type]}
+ (let [correct_index!
+ (n.= expected_index
+ actual_index)
+
+ correct_tags!
+ (# (list.equivalence symbol.equivalence) =
+ (list#each (|>> [label_module]) {.#Item tags_0})
+ actual_tags)
+
+ correct_type!
+ (type#= type_0
+ actual_type)]
+ (and correct_index!
+ correct_tags!
+ correct_type!))))
+ )))))
(_.cover [/.slot]
(|> {.#Item tags_1}
list.enumeration
- (list.every? (function (_ [expected_index tag])
- (|> [tag_module tag]
+ (list.every? (function (_ [expected_index label])
+ (|> [label_module label]
/.slot
(/.result expected_lux)
(!expect (^multi {try.#Success [actual_index actual_tags actual_type]}
@@ -723,7 +764,7 @@
correct_tags!
(# (list.equivalence symbol.equivalence) =
- (list#each (|>> [tag_module]) {.#Item tags_1})
+ (list#each (|>> [label_module]) {.#Item tags_1})
actual_tags)
correct_type!
@@ -943,8 +984,9 @@
..context_related
..definition_related
..search_related
- ..tags_related
..locals_related
+ (_.for [.Label]
+ ..label_related)
))
/location.test
diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux
index 761192245..c60d3ba2d 100644
--- a/stdlib/source/test/lux/tool.lux
+++ b/stdlib/source/test/lux/tool.lux
@@ -20,7 +20,8 @@
]]
["[1][0]" meta "_"
["[1]/[0]" archive "_"
- ["[1]/[0]" signature]]]
+ ["[1]/[0]" signature]
+ ["[1]/[0]" key]]]
]])
(def: .public test
@@ -33,6 +34,7 @@
/analysis/composite.test
/analysis/pattern.test
/meta/archive/signature.test
+ /meta/archive/key.test
... /syntax.test
... /analysis.test
... /synthesis.test
diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/key.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/key.lux
new file mode 100644
index 000000000..45d29931d
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/meta/archive/key.lux
@@ -0,0 +1,27 @@
+(.using
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ [abstract
+ [monad {"+" do}]]
+ [math
+ ["[0]" random]]]]
+ [\\library
+ ["[0]" /]]
+ ["[0]" // "_"
+ ["[1][0]" signature]])
+
+(def: .public test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.Key])
+ (do random.monad
+ [expected //signature.random
+ document random.nat]
+ ($_ _.and
+ (_.cover [/.key /.signature]
+ (|> document
+ (/.key expected)
+ /.signature
+ (same? expected)))
+ ))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-24 02:39:21 +0000