aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/library/lux.lux12
-rw-r--r--stdlib/source/library/lux/debug.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/default/init.lux122
-rw-r--r--stdlib/source/library/lux/tool/compiler/default/platform.lux37
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/generation.lux22
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux3
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python.lux101
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux33
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux101
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux6
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux51
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/structure.lux3
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/program.lux10
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/archive.lux113
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux68
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux5
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/cache/module.lux30
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/io/archive.lux134
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/packager.lux7
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/packager/script.lux2
-rw-r--r--stdlib/source/library/lux/type/implicit.lux2
-rw-r--r--stdlib/source/test/lux/extension.lux125
-rw-r--r--stdlib/source/test/lux/tool.lux4
-rw-r--r--stdlib/source/test/lux/tool/compiler/meta/archive/descriptor.lux56
-rw-r--r--stdlib/source/test/lux/type/check.lux106
28 files changed, 669 insertions, 492 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux
index bd3f36e3e..4cb5319cd 100644
--- a/stdlib/source/library/lux.lux
+++ b/stdlib/source/library/lux.lux
@@ -459,8 +459,9 @@
#0)
... (type: .public (Either l r)
-... {#Left l}
-... {#Right r})
+... (Variant
+... {#Left l}
+... {#Right r}))
("lux def type tagged" Either
{#Named [..prelude_module "Either"]
{#UnivQ {#End}
@@ -482,9 +483,10 @@
.public)
... (type: .public Module_State
-... #Active
-... #Compiled
-... #Cached)
+... (Variant
+... #Active
+... #Compiled
+... #Cached))
("lux def type tagged" Module_State
{#Named [..prelude_module "Module_State"]
{#Sum
diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux
index 923919c16..e042ad9d1 100644
--- a/stdlib/source/library/lux/debug.lux
+++ b/stdlib/source/library/lux/debug.lux
@@ -227,7 +227,7 @@
(^or "<type 'list'>" "<class 'list'>")
(tuple_inspection inspection value)
- (^or "<type 'tuple'>" "<type 'tuple'>")
+ (^or "<type 'tuple'>" "<class 'tuple'>")
(let [variant (:as (array.Array Any) value)]
(case (array.size variant)
3 (let [variant_tag ("python array read" 0 variant)
diff --git a/stdlib/source/library/lux/tool/compiler.lux b/stdlib/source/library/lux/tool/compiler.lux
index 7a9c40261..c4160aa3c 100644
--- a/stdlib/source/library/lux/tool/compiler.lux
+++ b/stdlib/source/library/lux/tool/compiler.lux
@@ -34,7 +34,7 @@
[#dependencies (List Module)
#process (-> s Archive
(Try [s (Either (Compilation s d o)
- [Descriptor (Document d) Output])]))]))
+ (archive.Entry Any))]))]))
(type: .public (Compiler s d o)
(-> Input (Compilation s d o)))
diff --git a/stdlib/source/library/lux/tool/compiler/default/init.lux b/stdlib/source/library/lux/tool/compiler/default/init.lux
index e7c3bae01..8f32b5108 100644
--- a/stdlib/source/library/lux/tool/compiler/default/init.lux
+++ b/stdlib/source/library/lux/tool/compiler/default/init.lux
@@ -1,60 +1,60 @@
(.using
- [library
- [lux {"-" Module}
- ["@" target {"+" Target}]
- [abstract
- ["[0]" monad {"+" do}]]
- [control
- ["[0]" try {"+" Try}]
- ["[0]" exception {"+" exception:}]]
- [data
- [binary {"+" Binary}]
- ["[0]" product]
- ["[0]" text ("[1]#[0]" hash)
- ["%" format {"+" format}]]
- [collection
- ["[0]" list ("[1]#[0]" functor)]
- ["[0]" dictionary]
- ["[0]" set]
- ["[0]" sequence ("[1]#[0]" functor)]]]
- ["[0]" meta]
- [world
- ["[0]" file]]]]
- ["[0]" // "_"
- ["/[1]" // {"+" Instancer}
- ["[1][0]" phase]
- [language
- [lux
- [program {"+" Program}]
- ["[1][0]" version]
- ["[1][0]" syntax {"+" Aliases}]
- ["[1][0]" synthesis]
- ["[1][0]" directive {"+" Requirements}]
- ["[1][0]" generation]
- ["[1][0]" analysis
- [macro {"+" Expander}]
- ["[1]/[0]" evaluation]]
- [phase
- ["[0]P" synthesis]
- ["[0]P" directive]
- ["[0]P" analysis
- ["[0]" module]]
- ["[0]" extension {"+" Extender}
- ["[0]E" analysis]
- ["[0]E" synthesis]
- [directive
- ["[0]D" lux]]]]]]
- [meta
- ["[0]" archive {"+" Archive}
- ["[0]" descriptor {"+" Module}]
- ["[0]" registry {"+" Registry}]
- ["[0]" document]]]]
- ])
+ [library
+ [lux "*"
+ ["@" target {"+" Target}]
+ [abstract
+ ["[0]" monad {"+" do}]]
+ [control
+ ["[0]" try {"+" Try}]
+ ["[0]" exception {"+" exception:}]]
+ [data
+ [binary {"+" Binary}]
+ ["[0]" product]
+ ["[0]" text ("[1]#[0]" hash)
+ ["%" format {"+" format}]]
+ [collection
+ ["[0]" list ("[1]#[0]" functor)]
+ ["[0]" dictionary]
+ ["[0]" set]
+ ["[0]" sequence ("[1]#[0]" functor)]]]
+ ["[0]" meta]
+ [world
+ ["[0]" file]]]]
+ ["[0]" // "_"
+ ["/[1]" // {"+" Instancer}
+ ["[1][0]" phase]
+ [language
+ [lux
+ [program {"+" Program}]
+ ["[1][0]" version]
+ ["[1][0]" syntax {"+" Aliases}]
+ ["[1][0]" synthesis]
+ ["[1][0]" directive {"+" Requirements}]
+ ["[1][0]" generation]
+ ["[1][0]" analysis
+ [macro {"+" Expander}]
+ ["[1]/[0]" evaluation]]
+ [phase
+ ["[0]P" synthesis]
+ ["[0]P" directive]
+ ["[0]P" analysis
+ ["[0]" module]]
+ ["[0]" extension {"+" Extender}
+ ["[0]E" analysis]
+ ["[0]E" synthesis]
+ [directive
+ ["[0]D" lux]]]]]]
+ [meta
+ ["[0]" archive {"+" Archive}
+ ["[0]" descriptor]
+ ["[0]" registry {"+" Registry}]
+ ["[0]" document]]]]
+ ])
(def: .public (state target module expander host_analysis host generate generation_bundle)
(All (_ anchor expression directive)
(-> Target
- Module
+ descriptor.Module
Expander
///analysis.Bundle
(///generation.Host expression directive)
@@ -92,7 +92,7 @@
(-> Source (Either [Source Text] [Source Code])))
(def: (reader current_module aliases [location offset source_code])
- (-> Module Aliases Source (///analysis.Operation Reader))
+ (-> descriptor.Module Aliases Source (///analysis.Operation Reader))
(function (_ [bundle state])
{try.#Success [[bundle state]
(///syntax.parse current_module aliases ("lux text size" source_code))]}))
@@ -120,7 +120,7 @@
Registry])
(def: (begin dependencies hash input)
- (-> (List Module) Nat ///.Input
+ (-> (List descriptor.Module) Nat ///.Input
(All (_ anchor expression directive)
(///directive.Operation anchor expression directive
[Source (Payload directive)])))
@@ -137,7 +137,7 @@
registry.empty]])))))
(def: (end module)
- (-> Module
+ (-> descriptor.Module
(All (_ anchor expression directive)
(///directive.Operation anchor expression directive [.Module (Payload directive)])))
(do ///phase.monad
@@ -200,7 +200,7 @@
(def: (iteration wrapper archive expander module source pre_payload aliases)
(All (_ directive)
- (-> ///phase.Wrapper Archive Expander Module Source (Payload directive) Aliases
+ (-> ///phase.Wrapper Archive Expander descriptor.Module Source (Payload directive) Aliases
(All (_ anchor expression)
(///directive.Operation anchor expression directive
(Maybe [Source Requirements (Payload directive)])))))
@@ -218,7 +218,7 @@
(exception.with ///.cannot_compile module {try.#Failure error}))))))
(def: (default_dependencies prelude input)
- (-> Module ///.Input (List Module))
+ (-> descriptor.Module ///.Input (List descriptor.Module))
(list& archive.runtime_module
(if (text#= prelude (value@ ///.#module input))
(list)
@@ -230,7 +230,7 @@
(def: .public (compiler wrapper expander prelude write_directive)
(All (_ anchor expression directive)
- (-> ///phase.Wrapper Expander Module (-> directive Binary)
+ (-> ///phase.Wrapper Expander descriptor.Module (-> directive Binary)
(Instancer (///directive.State+ anchor expression directive) .Module)))
(let [execute! (directiveP.phase wrapper expander)]
(function (_ key parameters input)
@@ -254,14 +254,14 @@
descriptor.#name module
descriptor.#file (value@ ///.#file input)
descriptor.#references (set.of_list text.hash dependencies)
- descriptor.#state {.#Compiled}
- descriptor.#registry final_registry]]]
+ descriptor.#state {.#Compiled}]]]
(in [state
{.#Right [descriptor
(document.document key analysis_module)
(sequence#each (function (_ [artifact_id custom directive])
[artifact_id custom (write_directive directive)])
- final_buffer)]}]))
+ final_buffer)
+ final_registry]}]))
{.#Some [source requirements temporary_payload]}
(let [[temporary_buffer temporary_registry] temporary_payload]
diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux
index fd852c4ce..b7fb40f56 100644
--- a/stdlib/source/library/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux
@@ -51,7 +51,7 @@
["[0]" module]]]]]
[meta
["[0]" archive {"+" Output Archive}
- [registry {"+" Registry}]
+ ["[0]" registry {"+" Registry}]
["[0]" artifact]
["[0]" descriptor {"+" Descriptor Module}]
["[0]" document {"+" Document}]]
@@ -89,13 +89,16 @@
<Bundle> (as_is (///generation.Bundle <type_vars>))]
(def: writer
- (Writer [Descriptor (Document .Module)])
- (_.and descriptor.writer
- (document.writer $.writer)))
-
- (def: (cache_module static platform module_id [descriptor document output])
+ (Writer [Descriptor (Document .Module) Registry])
+ ($_ _.and
+ descriptor.writer
+ (document.writer $.writer)
+ registry.writer
+ ))
+
+ (def: (cache_module static platform module_id [descriptor document output registry])
(All (_ <type_vars>)
- (-> Static <Platform> archive.ID [Descriptor (Document Any) Output]
+ (-> Static <Platform> archive.ID (archive.Entry Any)
(Async (Try Any))))
(let [system (value@ #&file_system platform)
write_artifact! (: (-> [artifact.ID (Maybe Text) Binary] (Action Any))
@@ -115,7 +118,7 @@
document (# async.monad in
(document.marked? $.key document))]
(ioW.cache system static module_id
- (_.result ..writer [descriptor document])))))
+ (_.result ..writer [descriptor document registry])))))
... TODO: Inline ASAP
(def: initialize_buffer!
@@ -131,14 +134,13 @@
[_ ..initialize_buffer!]
(value@ #runtime platform)))
- (def: (runtime_descriptor registry)
- (-> Registry Descriptor)
+ (def: runtime_descriptor
+ Descriptor
[descriptor.#hash 0
descriptor.#name archive.runtime_module
descriptor.#file ""
descriptor.#references (set.empty text.hash)
- descriptor.#state {.#Compiled}
- descriptor.#registry registry])
+ descriptor.#state {.#Compiled}])
(def: runtime_document
(Document .Module)
@@ -148,17 +150,16 @@
(All (_ <type_vars>)
(-> Archive <Platform>
(///directive.Operation <type_vars>
- [Archive [Descriptor (Document .Module) Output]])))
+ [Archive (archive.Entry .Module)])))
(do ///phase.monad
[[registry payload] (///directive.lifted_generation
(..compile_runtime! platform))
- .let [[descriptor document] [(..runtime_descriptor registry) ..runtime_document]]
archive (///phase.lifted (if (archive.reserved? archive archive.runtime_module)
- (archive.has archive.runtime_module [descriptor document payload] archive)
+ (archive.has archive.runtime_module [..runtime_descriptor ..runtime_document payload registry] archive)
(do try.monad
[[_ archive] (archive.reserve archive.runtime_module archive)]
- (archive.has archive.runtime_module [descriptor document payload] archive))))]
- (in [archive [descriptor document payload]])))
+ (archive.has archive.runtime_module [..runtime_descriptor ..runtime_document payload registry] archive))))]
+ (in [archive [..runtime_descriptor ..runtime_document payload registry]])))
(def: (initialize_state extender
[analysers
@@ -623,7 +624,7 @@
(All (_ <type_vars>)
(-> Module <Context> (///.Compilation <State+> .Module Any)
(Try [<State+> (Either (///.Compilation <State+> .Module Any)
- [Descriptor (Document .Module) Output])])))
+ (archive.Entry Any))])))
((value@ ///.#process compilation)
... TODO: The "///directive.set_current_module" below shouldn't be necessary. Remove it ASAP.
... TODO: The context shouldn't need to be re-set either.
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux
index 4a9efba50..077747e0d 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux
@@ -1,6 +1,6 @@
(.using
[library
- [lux {"-" Module symbol}
+ [lux {"-" symbol}
[abstract
[monad {"+" do}]]
[control
@@ -31,7 +31,7 @@
["[0]" phase]
[meta
["[0]" archive {"+" Archive}
- ["[0]" descriptor {"+" Module}]
+ ["[0]" descriptor]
["[0]" artifact]
["[0]" registry {"+" Registry}]]]]])
@@ -46,9 +46,9 @@
["Error" error]))
(template [<name>]
- [(exception: .public (<name> [artifact_id artifact.ID])
+ [(exception: .public (<name> [it artifact.ID])
(exception.report
- ["Artifact ID" (%.nat artifact_id)]))]
+ ["Artifact ID" (%.nat it)]))]
[cannot_overwrite_output]
[no_buffer_for_saving_code]
@@ -72,7 +72,7 @@
(type: .public (State anchor expression directive)
(Record
- [#module Module
+ [#module descriptor.Module
#anchor (Maybe anchor)
#host (Host expression directive)
#buffer (Maybe (Buffer directive))
@@ -97,7 +97,7 @@
(def: .public (state host module)
(All (_ anchor expression directive)
(-> (Host expression directive)
- Module
+ descriptor.Module
(..State anchor expression directive)))
[#module module
#anchor {.#None}
@@ -191,12 +191,12 @@
(def: .public (enter_module module)
(All (_ anchor expression directive)
- (-> Module (Operation anchor expression directive Any)))
+ (-> descriptor.Module (Operation anchor expression directive Any)))
(extension.update (with@ #module module)))
(def: .public module
(All (_ anchor expression directive)
- (Operation anchor expression directive Module))
+ (Operation anchor expression directive descriptor.Module))
(extension.read (value@ #module)))
(def: .public (evaluate! label code)
@@ -281,8 +281,8 @@
registry (if (text#= (value@ #module state) _module)
{try.#Success (value@ #registry state)}
(do try.monad
- [[descriptor document] (archive.find _module archive)]
- {try.#Success (value@ descriptor.#registry descriptor)}))]
+ [[descriptor document output registry] (archive.find _module archive)]
+ {try.#Success registry}))]
(case (registry.id _name registry)
{.#None}
(exception.except ..unknown_definition [name (registry.definitions registry)])
@@ -294,7 +294,7 @@
(def: .public (module_id module archive)
(All (_ anchor expression directive)
- (-> Module Archive (Operation anchor expression directive archive.ID)))
+ (-> descriptor.Module Archive (Operation anchor expression directive archive.ID)))
(function (_ (^@ stateE [bundle state]))
(do try.monad
[module_id (archive.id module archive)]
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux
index d1b051176..f1ea553f8 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux
@@ -76,7 +76,8 @@
(^template [<tag> <generator>]
[(^ (<tag> value))
(<generator> statement expression archive value)])
- ([synthesis.branch/let //case.let!]
+ ([synthesis.branch/exec //case.exec!]
+ [synthesis.branch/let //case.let!]
[synthesis.branch/if //case.if!]
[synthesis.loop/scope //loop.scope!]
[synthesis.loop/again //loop.again!])
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python.lux
index a6b233f4f..10a220018 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python.lux
@@ -1,34 +1,34 @@
(.using
- [library
- [lux "*"
- [abstract
- [monad {"+" do}]]
- [control
- ["[0]" exception {"+" exception:}]]
- [target
- ["_" python]]]]
- ["[0]" / "_"
- [runtime {"+" Phase}]
- ["[1][0]" primitive]
- ["[1][0]" structure]
+ [library
+ [lux "*"
+ [abstract
+ [monad {"+" do}]]
+ [control
+ ["[0]" exception {"+" exception:}]]
+ [target
+ ["_" python]]]]
+ ["[0]" / "_"
+ [runtime {"+" Phase}]
+ ["[1][0]" primitive]
+ ["[1][0]" structure]
+ ["[1][0]" reference]
+ ["[1][0]" function]
+ ["[1][0]" case]
+ ["[1][0]" loop]
+ ["/[1]" // "_"
["[1][0]" reference]
- ["[1][0]" function]
- ["[1][0]" case]
- ["[1][0]" loop]
["/[1]" // "_"
- ["[1][0]" reference]
+ ["[1][0]" extension
+ [generation
+ [python
+ ["[1]/[0]" common]]]]
["/[1]" // "_"
- ["[1][0]" extension
- [generation
- [python
- ["[1]/[0]" common]]]]
- ["/[1]" // "_"
- [analysis {"+" }]
- ["[1][0]" synthesis]
- ["//[1]" /// "_"
- ["[1][0]" phase ("[1]#[0]" monad)]
- [reference {"+"}
- [variable {"+"}]]]]]]])
+ [analysis {"+" }]
+ ["[1][0]" synthesis]
+ ["//[1]" /// "_"
+ ["[1][0]" phase ("[1]#[0]" monad)]
+ [reference {"+"}
+ [variable {"+"}]]]]]]])
(exception: .public cannot_recur_as_an_expression)
@@ -43,38 +43,31 @@
[////synthesis.f64 /primitive.f64]
[////synthesis.text /primitive.text])
- (^ (////synthesis.variant variantS))
- (/structure.variant expression archive variantS)
-
- (^ (////synthesis.tuple members))
- (/structure.tuple expression archive members)
-
- {////synthesis.#Reference value}
- (//reference.reference /reference.system archive value)
-
- (^ (////synthesis.branch/case case))
- (/case.case ///extension/common.statement expression archive case)
-
- (^ (////synthesis.branch/let let))
- (/case.let expression archive let)
-
- (^ (////synthesis.branch/if if))
- (/case.if expression archive if)
-
- (^ (////synthesis.branch/get get))
- (/case.get expression archive get)
+ (^template [<tag> <generator>]
+ [(^ (<tag> value))
+ (<generator> expression archive value)])
+ ([////synthesis.variant /structure.variant]
+ [////synthesis.tuple /structure.tuple]
+
+ [////synthesis.branch/exec /case.exec]
+ [////synthesis.branch/let /case.let]
+ [////synthesis.branch/if /case.if]
+ [////synthesis.branch/get /case.get]
+
+ [////synthesis.function/apply /function.apply])
- (^ (////synthesis.loop/scope scope))
- (/loop.scope ///extension/common.statement expression archive scope)
+ (^template [<tag> <generator>]
+ [(^ (<tag> value))
+ (<generator> ///extension/common.statement expression archive value)])
+ ([////synthesis.branch/case /case.case]
+ [////synthesis.loop/scope /loop.scope]
+ [////synthesis.function/abstraction /function.function])
(^ (////synthesis.loop/again updates))
(//////phase.except ..cannot_recur_as_an_expression [])
- (^ (////synthesis.function/abstraction abstraction))
- (/function.function ///extension/common.statement expression archive abstraction)
-
- (^ (////synthesis.function/apply application))
- (/function.apply expression archive application)
+ {////synthesis.#Reference value}
+ (//reference.reference /reference.system archive value)
{////synthesis.#Extension extension}
(///extension.apply archive expression extension)))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux
index d65324f5a..db2b87ba7 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux
@@ -1,6 +1,6 @@
(.using
[library
- [lux {"-" case let if symbol}
+ [lux {"-" case exec let if symbol}
[abstract
["[0]" monad {"+" do}]]
[data
@@ -32,8 +32,9 @@
["[1][0]" variable {"+" Register}]]
["[1][0]" phase ("[1]#[0]" monad)]
[meta
- [archive {"+" Archive}
- ["[0]" dependency]]]]]]]])
+ [archive {"+" Archive}]
+ ["[0]" cache "_"
+ ["[1]" artifact]]]]]]]])
(def: .public (symbol prefix)
(-> Text (Operation SVar))
@@ -46,7 +47,7 @@
(def: .public capture
(-> Register SVar)
- (|>> (///reference.foreign //reference.system) :expected))
+ (|>> (///reference.foreign //reference.system) :expected))
(def: .public (let expression archive [valueS register bodyS])
(Generator [Synthesis Register Synthesis])
@@ -67,6 +68,22 @@
(_.set (list (..register register)) valueO)
bodyO))))
+(def: .public (exec expression archive [pre post])
+ (Generator [Synthesis Synthesis])
+ (do ///////phase.monad
+ [pre (expression archive pre)
+ post (expression archive post)]
+ (in (_.item (_.int +1) (_.tuple (list pre post))))))
+
+(def: .public (exec! statement expression archive [pre post])
+ (Generator! [Synthesis Synthesis])
+ (do ///////phase.monad
+ [pre (expression archive pre)
+ post (statement expression archive post)]
+ (in ($_ _.then
+ (_.statement pre)
+ post))))
+
(def: .public (if expression archive [testS thenS elseS])
(Generator [Synthesis Synthesis Synthesis])
(do ///////phase.monad
@@ -207,8 +224,10 @@
..peek)])
(again then)))
{.#Item item})]
- (in {.#Some (_.cond clauses
- ..fail_pm!)}))])
+ (in {.#Some (list#mix (function (_ [when then] else)
+ (_.if when then else))
+ ..fail_pm!
+ clauses)}))])
([/////synthesis.#I64_Fork (<| //primitive.i64 .int)]
[/////synthesis.#F64_Fork (<| //primitive.f64)]
[/////synthesis.#Text_Fork (<| //primitive.text)])
@@ -324,7 +343,7 @@
(def: .public (case statement expression archive [valueS pathP])
(-> Phase! (Generator [Synthesis Path]))
(do ///////phase.monad
- [dependencies (dependency.path_dependencies archive pathP)
+ [dependencies (cache.path_dependencies archive pathP)
[[case_module case_artifact] pattern_matching!] (/////generation.with_new_context
archive
dependencies
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux
index 816353edd..4a1e1b205 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux
@@ -1,39 +1,40 @@
(.using
- [library
- [lux {"-" function}
- [abstract
- ["[0]" monad {"+" do}]]
- [data
- ["[0]" product]
- [text
- ["%" format {"+" format}]]
- [collection
- ["[0]" list ("[1]#[0]" functor mix)]]]
- [target
- ["_" python {"+" SVar Expression Statement}]]]]
- ["[0]" // "_"
- [runtime {"+" Operation Phase Generator Phase! Generator!}]
+ [library
+ [lux {"-" function}
+ [abstract
+ ["[0]" monad {"+" do}]]
+ [data
+ ["[0]" product]
+ [text
+ ["%" format {"+" format}]]
+ [collection
+ ["[0]" list ("[1]#[0]" functor mix)]]]
+ [target
+ ["_" python {"+" SVar Expression Statement}]]]]
+ ["[0]" // "_"
+ [runtime {"+" Operation Phase Generator Phase! Generator!}]
+ ["[1][0]" reference]
+ ["[1][0]" case]
+ ["[1][0]" loop]
+ ["/[1]" // "_"
["[1][0]" reference]
- ["[1][0]" case]
- ["[1][0]" loop]
- ["/[1]" // "_"
- ["[1][0]" reference]
+ ["//[1]" /// "_"
+ [analysis {"+" Environment Abstraction Reification Analysis}]
+ [synthesis {"+" Synthesis}]
+ ["[1][0]" generation {"+" Context}]
["//[1]" /// "_"
- [analysis {"+" Environment Abstraction Application Analysis}]
- [synthesis {"+" Synthesis}]
- ["[1][0]" generation {"+" Context}]
- ["//[1]" /// "_"
- [arity {"+" Arity}]
- ["[1][0]" phase]
- [reference
- [variable {"+" Register Variable}]]
- [meta
- [archive {"+" Archive}
- ["[0]" artifact]
- ["[0]" dependency]]]]]]])
+ [arity {"+" Arity}]
+ ["[1][0]" phase]
+ [reference
+ [variable {"+" Register Variable}]]
+ [meta
+ [archive {"+" Archive}
+ ["[0]" artifact]]
+ ["[0]" cache "_"
+ ["[1]" artifact]]]]]]])
(def: .public (apply expression archive [functionS argsS+])
- (Generator (Application Synthesis))
+ (Generator (Reification Synthesis))
(do [! ///////phase.monad]
[functionO (expression archive functionS)
argsO+ (monad.each ! (expression archive) argsS+)]
@@ -70,7 +71,7 @@
(def: .public (function statement expression archive [environment arity bodyS])
(-> Phase! (Generator (Abstraction Synthesis)))
(do [! ///////phase.monad]
- [dependencies (dependency.dependencies archive bodyS)
+ [dependencies (cache.dependencies archive bodyS)
[[function_module function_artifact] body!] (/////generation.with_new_context archive dependencies
(/////generation.with_anchor 1
(statement expression archive bodyS)))
@@ -92,23 +93,23 @@
(_.def @self (list (_.poly @curried))
($_ _.then
(_.set (list @num_args) (_.len/1 @curried))
- (_.cond (list [(|> @num_args (_.= arityO))
- (<| (_.then initialize!)
- //loop.set_scope
- body!)]
- [(|> @num_args (_.> arityO))
- (let [arity_inputs (_.slice (_.int +0) arityO @curried)
- extra_inputs (_.slice arityO @num_args @curried)]
- (_.return (|> @self
- (apply_poly arity_inputs)
- (apply_poly extra_inputs))))])
- ... (|> @num_args (_.< arityO))
- (let [@next (_.var "next")
- @missing (_.var "missing")]
- ($_ _.then
- (_.def @next (list (_.poly @missing))
- (_.return (|> @self (apply_poly (|> @curried (_.+ @missing))))))
- (_.return @next)
- )))
+ (<| (_.if (|> @num_args (_.= arityO))
+ (<| (_.then initialize!)
+ //loop.set_scope
+ body!))
+ (_.if (|> @num_args (_.> arityO))
+ (let [arity_inputs (_.slice (_.int +0) arityO @curried)
+ extra_inputs (_.slice arityO @num_args @curried)]
+ (_.return (|> @self
+ (apply_poly arity_inputs)
+ (apply_poly extra_inputs)))))
+ ... (|> @num_args (_.< arityO))
+ (let [@next (_.var "next")
+ @missing (_.var "missing")]
+ ($_ _.then
+ (_.def @next (list (_.poly @missing))
+ (_.return (|> @self (apply_poly (|> @curried (_.+ @missing))))))
+ (_.return @next)
+ )))
)))
))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux
index 163ce3b9d..57040b638 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux
@@ -29,8 +29,8 @@
["//[1]" /// "_"
["[1][0]" phase]
[meta
- [archive
- ["[0]" dependency]]]
+ ["[0]" cache "_"
+ ["[1]" artifact]]]
[reference
["[1][0]" variable {"+" Register}]]]]]]])
@@ -77,7 +77,7 @@
... true loop
_
(do [! ///////phase.monad]
- [dependencies (dependency.dependencies archive bodyS)
+ [dependencies (cache.dependencies archive bodyS)
initsO+ (monad.each ! (expression archive) initsS+)
[[loop_module loop_artifact] body!] (/////generation.with_new_context archive dependencies
(/////generation.with_anchor start
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 2f99ad62b..790853c23 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
@@ -38,7 +38,8 @@
[variable {"+" Register}]]
[meta
[archive {"+" Output Archive}
- ["[0]" artifact {"+" Registry}]]]]]])
+ ["[0]" registry {"+" Registry}]
+ ["[0]" artifact]]]]]])
(template [<name> <base>]
[(type: .public <name>
@@ -227,12 +228,12 @@
($_ _.then
(_.set (list last_index_right) (..last_index tuple))
(_.set (list right_index) (_.+ (_.int +1) lefts))
- (_.cond (list [(_.= last_index_right right_index)
- (_.return (_.item right_index tuple))]
- [(_.> last_index_right right_index)
- ... Needs recursion.
- <recur>])
- (_.return (_.slice_from right_index tuple))))
+ (<| (_.if (_.= last_index_right right_index)
+ (_.return (_.item right_index tuple)))
+ (_.if (_.> last_index_right right_index)
+ ... Needs recursion.
+ <recur>)
+ (_.return (_.slice_from right_index tuple))))
{.#None}))))
(runtime: (sum::get sum expected##right? expected##lefts)
@@ -246,23 +247,21 @@
(_.- (_.int +1))))
(_.set (list sum) actual##value))]
(_.while (_.bool true)
- (_.cond (list [(_.= expected##lefts actual##lefts)
- (_.if (_.= expected##right? actual##right?)
- (_.return actual##value)
- mismatch!)]
-
- [(_.< expected##lefts actual##lefts)
- (_.if (_.= ..unit actual##right?)
- recur!
- mismatch!)]
-
- [(_.= ..unit expected##right?)
- (_.return (variant' (|> actual##lefts
- (_.- expected##lefts)
- (_.- (_.int +1)))
- actual##right?
- actual##value))])
- mismatch!)
+ (<| (_.if (_.= expected##lefts actual##lefts)
+ (_.if (_.= expected##right? actual##right?)
+ (_.return actual##value)
+ mismatch!))
+ (_.if (_.< expected##lefts actual##lefts)
+ (_.if (_.= ..unit actual##right?)
+ recur!
+ mismatch!))
+ (_.if (_.= ..unit expected##right?)
+ (_.return (variant' (|> actual##lefts
+ (_.- expected##lefts)
+ (_.- (_.int +1)))
+ actual##right?
+ actual##value)))
+ mismatch!)
{.#None})))
(def: runtime::adt
@@ -452,8 +451,8 @@
(do ///////phase.monad
[_ (/////generation.execute! ..runtime)
_ (/////generation.save! ..module_id {.#None} ..runtime)]
- (in [(|> artifact.empty
- (artifact.resource true artifact.no_dependencies)
+ (in [(|> registry.empty
+ (registry.resource true artifact.no_dependencies)
product.right)
(sequence.sequence [..module_id
{.#None}
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/structure.lux
index 0b3183166..fc59e133d 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/structure.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/structure.lux
@@ -9,7 +9,8 @@
["[1][0]" runtime {"+" Operation Phase Generator}]
["[1][0]" primitive]
["///[1]" //// "_"
- [analysis {"+" Variant Tuple}]
+ [analysis
+ [complex {"+" Variant Tuple}]]
["[1][0]" synthesis {"+" Synthesis}]
["//[1]" /// "_"
["[1][0]" phase ("[1]#[0]" monad)]]]])
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/program.lux b/stdlib/source/library/lux/tool/compiler/language/lux/program.lux
index 4e1c9805d..6d10d0316 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/program.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/program.lux
@@ -1,6 +1,6 @@
(.using
[library
- [lux {"-" Module}
+ [lux "*"
[abstract
["[0]" monad {"+" do}]]
[control
@@ -18,7 +18,7 @@
[///
[meta
["[0]" archive {"+" Archive}
- ["[0]" descriptor {"+" Module}]
+ ["[0]" descriptor]
["[0]" registry {"+" Registry}]]]]])
(type: .public (Program expression directive)
@@ -28,7 +28,7 @@
Text
"")
-(exception: .public (cannot_find_program [modules (List Module)])
+(exception: .public (cannot_find_program [modules (List descriptor.Module)])
(exception.report
["Modules" (exception.listing %.text modules)]))
@@ -41,8 +41,8 @@
(function (_ module)
(do !
[id (archive.id module archive)
- [descriptor document] (archive.find module archive)]
- (in [[module id] (value@ descriptor.#registry descriptor)])))))]
+ [descriptor document output registry] (archive.find module archive)]
+ (in [[module id] registry])))))]
(case (list.one (function (_ [[module module_id] registry])
(do maybe.monad
[program_id (registry.id ..name registry)]
diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux
index 35e167067..faa7e8765 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux
@@ -1,6 +1,6 @@
(.using
[library
- [lux {"-" Module}
+ [lux "*"
[abstract
["[0]" equivalence {"+" Equivalence}]
["[0]" monad {"+" do}]]
@@ -13,7 +13,6 @@
["<[0]>" binary {"+" Parser}]]]
[data
[binary {"+" Binary}]
- ["[0]" bit]
["[0]" product]
["[0]" text
["%" format {"+" format}]]
@@ -31,9 +30,10 @@
abstract]]]
[/
["[0]" artifact]
+ ["[0]" registry {"+" Registry}]
["[0]" signature {"+" Signature}]
["[0]" key {"+" Key}]
- ["[0]" descriptor {"+" Module Descriptor}]
+ ["[0]" descriptor {"+" Descriptor}]
["[0]" document {"+" Document}]
[///
[version {"+" Version}]]])
@@ -41,13 +41,13 @@
(type: .public Output
(Sequence [artifact.ID (Maybe Text) Binary]))
-(exception: .public (unknown_document [module Module
- known_modules (List Module)])
+(exception: .public (unknown_document [module descriptor.Module
+ known_modules (List descriptor.Module)])
(exception.report
["Module" (%.text module)]
["Known Modules" (exception.listing %.text known_modules)]))
-(exception: .public (cannot_replace_document [module Module
+(exception: .public (cannot_replace_document [module descriptor.Module
old (Document Any)
new (Document Any)])
(exception.report
@@ -55,29 +55,34 @@
["Old key" (signature.description (document.signature old))]
["New key" (signature.description (document.signature new))]))
-(exception: .public (module_has_already_been_reserved [module Module])
- (exception.report
- ["Module" (%.text module)]))
-
-(exception: .public (module_must_be_reserved_before_it_can_be_added [module Module])
- (exception.report
- ["Module" (%.text module)]))
+(template [<name>]
+ [(exception: .public (<name> [it descriptor.Module])
+ (exception.report
+ ["Module" (%.text it)]))]
-(exception: .public (module_is_only_reserved [module Module])
- (exception.report
- ["Module" (%.text module)]))
+ [module_has_already_been_reserved]
+ [module_must_be_reserved_before_it_can_be_added]
+ [module_is_only_reserved]
+ )
(type: .public ID
Nat)
(def: .public runtime_module
- Module
+ descriptor.Module
"")
+(type: .public (Entry a)
+ (Record
+ [#descriptor Descriptor
+ #document (Document a)
+ #output Output
+ #registry Registry]))
+
(abstract: .public Archive
(Record
[#next ID
- #resolver (Dictionary Module [ID (Maybe [Descriptor (Document Any) Output])])])
+ #resolver (Dictionary descriptor.Module [ID (Maybe (Entry Any))])])
(def: next
(-> Archive ID)
@@ -89,52 +94,52 @@
#resolver (dictionary.empty text.hash)]))
(def: .public (id module archive)
- (-> Module Archive (Try ID))
- (let [(^open "_[0]") (:representation archive)]
- (case (dictionary.value module _#resolver)
+ (-> descriptor.Module Archive (Try ID))
+ (let [(^open "/[0]") (:representation archive)]
+ (case (dictionary.value module /#resolver)
{.#Some [id _]}
{try.#Success id}
{.#None}
(exception.except ..unknown_document [module
- (dictionary.keys _#resolver)]))))
+ (dictionary.keys /#resolver)]))))
(def: .public (reserve module archive)
- (-> Module Archive (Try [ID Archive]))
- (let [(^open "_[0]") (:representation archive)]
- (case (dictionary.value module _#resolver)
+ (-> descriptor.Module Archive (Try [ID Archive]))
+ (let [(^open "/[0]") (:representation archive)]
+ (case (dictionary.value module /#resolver)
{.#Some _}
(exception.except ..module_has_already_been_reserved [module])
{.#None}
- {try.#Success [_#next
+ {try.#Success [/#next
(|> archive
:representation
- (revised@ #resolver (dictionary.has module [_#next {.#None}]))
+ (revised@ #resolver (dictionary.has module [/#next {.#None}]))
(revised@ #next ++)
:abstraction)]})))
- (def: .public (has module [descriptor document output] archive)
- (-> Module [Descriptor (Document Any) Output] Archive (Try Archive))
- (let [(^open "_[0]") (:representation archive)]
- (case (dictionary.value module _#resolver)
+ (def: .public (has module entry archive)
+ (-> descriptor.Module (Entry Any) Archive (Try Archive))
+ (let [(^open "/[0]") (:representation archive)]
+ (case (dictionary.value module /#resolver)
{.#Some [id {.#None}]}
{try.#Success (|> archive
:representation
- (revised@ ..#resolver (dictionary.has module [id {.#Some [descriptor document output]}]))
+ (revised@ ..#resolver (dictionary.has module [id {.#Some entry}]))
:abstraction)}
{.#Some [id {.#Some [existing_descriptor existing_document existing_output]}]}
- (if (same? document existing_document)
+ (if (same? existing_document (value@ #document entry))
... TODO: Find out why this code allows for the same module to be added more than once. It looks fishy...
{try.#Success archive}
- (exception.except ..cannot_replace_document [module existing_document document]))
+ (exception.except ..cannot_replace_document [module existing_document (value@ #document entry)]))
{.#None}
(exception.except ..module_must_be_reserved_before_it_can_be_added [module]))))
(def: .public entries
- (-> Archive (List [Module [ID [Descriptor (Document Any) Output]]]))
+ (-> Archive (List [descriptor.Module [ID (Entry Any)]]))
(|>> :representation
(value@ #resolver)
dictionary.entries
@@ -142,9 +147,9 @@
(# maybe.monad each (|>> [module_id] [module]) entry)))))
(def: .public (find module archive)
- (-> Module Archive (Try [Descriptor (Document Any) Output]))
- (let [(^open "_[0]") (:representation archive)]
- (case (dictionary.value module _#resolver)
+ (-> descriptor.Module Archive (Try (Entry Any)))
+ (let [(^open "/[0]") (:representation archive)]
+ (case (dictionary.value module /#resolver)
{.#Some [id {.#Some entry}]}
{try.#Success entry}
@@ -152,19 +157,19 @@
(exception.except ..module_is_only_reserved [module])
{.#None}
- (exception.except ..unknown_document [module (dictionary.keys _#resolver)]))))
+ (exception.except ..unknown_document [module (dictionary.keys /#resolver)]))))
(def: .public (archived? archive module)
- (-> Archive Module Bit)
+ (-> Archive descriptor.Module Bit)
(case (..find module archive)
{try.#Success _}
- bit.yes
+ true
{try.#Failure _}
- bit.no))
+ false))
(def: .public archived
- (-> Archive (List Module))
+ (-> Archive (List descriptor.Module))
(|>> :representation
(value@ #resolver)
dictionary.entries
@@ -174,23 +179,23 @@
{.#None} {.#None})))))
(def: .public (reserved? archive module)
- (-> Archive Module Bit)
- (let [(^open "_[0]") (:representation archive)]
- (case (dictionary.value module _#resolver)
+ (-> Archive descriptor.Module Bit)
+ (let [(^open "/[0]") (:representation archive)]
+ (case (dictionary.value module /#resolver)
{.#Some [id _]}
- bit.yes
+ true
{.#None}
- bit.no)))
+ false)))
(def: .public reserved
- (-> Archive (List Module))
+ (-> Archive (List descriptor.Module))
(|>> :representation
(value@ #resolver)
dictionary.keys))
(def: .public reservations
- (-> Archive (List [Module ID]))
+ (-> Archive (List [descriptor.Module ID]))
(|>> :representation
(value@ #resolver)
dictionary.entries
@@ -216,7 +221,7 @@
:abstraction)))
(type: Reservation
- [Module ID])
+ [descriptor.Module ID])
(type: Frozen
[Version ID (List Reservation)])
@@ -237,14 +242,14 @@
(def: .public (export version archive)
(-> Version Archive Binary)
- (let [(^open "_[0]") (:representation archive)]
- (|> _#resolver
+ (let [(^open "/[0]") (:representation archive)]
+ (|> /#resolver
dictionary.entries
(list.all (function (_ [module [id descriptor+document]])
(case descriptor+document
{.#Some _} {.#Some [module id]}
{.#None} {.#None})))
- [version _#next]
+ [version /#next]
(binary.result ..writer))))
(exception: .public (version_mismatch [expected Version
diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux
index 11857d4be..f91f8375f 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux
@@ -1,19 +1,23 @@
(.using
[library
[lux {"-" Module}
+ [abstract
+ [equivalence {"+" Equivalence}]]
[control
["<>" parser
- ["<b>" binary {"+" Parser}]]]
+ ["<[0]>" binary {"+" Parser}]]]
[data
+ ["[0]" product]
["[0]" text]
[collection
- [set {"+" Set}]]
- [format
- ["[0]" binary {"+" Writer}]]]
+ ["[0]" set {"+" Set}]]
+ ["[0]" format "_"
+ ["[1]" binary {"+" Writer}]]]
+ [math
+ [number
+ ["[0]" nat]]]
[world
- [file {"+" Path}]]]]
- [//
- ["[0]" registry {"+" Registry}]])
+ [file {"+" Path}]]]])
(type: .public Module
Text)
@@ -24,27 +28,49 @@
#file Path
#hash Nat
#state Module_State
- #references (Set Module)
- #registry Registry]))
+ #references (Set Module)]))
+
+(implementation: module_state_equivalence
+ (Equivalence Module_State)
+
+ (def: (= left right)
+ (case [left right]
+ (^template [<tag>]
+ [[{<tag>} {<tag>}]
+ true])
+ ([.#Active]
+ [.#Compiled]
+ [.#Cached])
+
+ _
+ false)))
+
+(def: .public equivalence
+ (Equivalence Descriptor)
+ ($_ product.equivalence
+ text.equivalence
+ text.equivalence
+ nat.equivalence
+ ..module_state_equivalence
+ set.equivalence
+ ))
(def: .public writer
(Writer Descriptor)
- ($_ binary.and
- binary.text
- binary.text
- binary.nat
- binary.any
- (binary.set binary.text)
- registry.writer
+ ($_ format.and
+ format.text
+ format.text
+ format.nat
+ format.any
+ (format.set format.text)
))
(def: .public parser
(Parser Descriptor)
($_ <>.and
- <b>.text
- <b>.text
- <b>.nat
+ <binary>.text
+ <binary>.text
+ <binary>.nat
(# <>.monad in {.#Cached})
- (<b>.set text.hash <b>.text)
- registry.parser
+ (<binary>.set text.hash <binary>.text)
))
diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux
index 2a464b397..0716cae4e 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux
@@ -192,9 +192,8 @@
(Dictionary artifact.Dependency (Set artifact.Dependency))])
(|> archive
archive.entries
- (list#each (function (_ [module [module_id [descriptor document output]]])
- (|> descriptor
- (value@ descriptor.#registry)
+ (list#each (function (_ [module [module_id [descriptor document output registry]]])
+ (|> registry
registry.artifacts
sequence.list
(list#each (function (_ [artifact dependencies])
diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux
index e61b8cad2..9a3f9c9cb 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux
@@ -1,6 +1,6 @@
(.using
[library
- [lux {"-" Module}
+ [lux "*"
[abstract
["[0]" monad {"+" do}]]
[control
@@ -19,30 +19,30 @@
[///
["[0]" archive {"+" Output Archive}
[key {"+" Key}]
- ["[0]" descriptor {"+" Module Descriptor}]
+ ["[0]" descriptor {"+" Descriptor}]
["[0]" document {"+" Document}]]])
(type: .public Ancestry
- (Set Module))
+ (Set descriptor.Module))
(def: fresh
Ancestry
(set.empty text.hash))
(type: .public Graph
- (Dictionary Module Ancestry))
+ (Dictionary descriptor.Module Ancestry))
(def: empty
Graph
(dictionary.empty text.hash))
(def: .public modules
- (-> Graph (List Module))
+ (-> Graph (List descriptor.Module))
dictionary.keys)
(type: .public Dependency
(Record
- [#module Module
+ [#module descriptor.Module
#imports Ancestry]))
(def: .public graph
@@ -53,11 +53,11 @@
(def: (ancestry archive)
(-> Archive Graph)
- (let [memo (: (Memo Module Ancestry)
+ (let [memo (: (Memo descriptor.Module Ancestry)
(function (_ again module)
(do [! state.monad]
[.let [parents (case (archive.find module archive)
- {try.#Success [descriptor document]}
+ {try.#Success [descriptor document output registry]}
(value@ descriptor.#references descriptor)
{try.#Failure error}
@@ -74,17 +74,17 @@
(archive.archived archive))))
(def: (dependency? ancestry target source)
- (-> Graph Module Module Bit)
+ (-> Graph descriptor.Module descriptor.Module Bit)
(let [target_ancestry (|> ancestry
(dictionary.value target)
(maybe.else ..fresh))]
(set.member? target_ancestry source)))
-(type: .public Order
- (List [Module [archive.ID [Descriptor (Document .Module) Output]]]))
+(type: .public (Order a)
+ (List [descriptor.Module [archive.ID (archive.Entry a)]]))
(def: .public (load_order key archive)
- (-> (Key .Module) Archive (Try Order))
+ (All (_ a) (-> (Key a) Archive (Try (Order a))))
(let [ancestry (..ancestry archive)]
(|> ancestry
dictionary.keys
@@ -93,6 +93,6 @@
(function (_ module)
(do try.monad
[module_id (archive.id module archive)
- [descriptor document output] (archive.find module archive)
- document (document.marked? key document)]
- (in [module [module_id [descriptor document output]]])))))))
+ entry (archive.find module archive)
+ document (document.marked? key (value@ archive.#document entry))]
+ (in [module [module_id (with@ archive.#document document entry)]])))))))
diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
index 94e96ca26..79ff9881e 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
@@ -1,6 +1,6 @@
(.using
[library
- [lux {"-" Module}
+ [lux "*"
[target {"+" Target}]
[abstract
[predicate {"+" Predicate}]
@@ -36,8 +36,8 @@
["[1][0]" context]
["/[1]" //
["[0]" archive {"+" Output Archive}
- ["[0]" registry]
- ["[0]" descriptor {"+" Module Descriptor}]
+ ["[0]" registry {"+" Registry}]
+ ["[0]" descriptor {"+" Descriptor}]
["[0]" document {"+" Document}]
["[0]" artifact {"+" Artifact Dependency}
["[0]" category {"+" Category}]]]
@@ -158,9 +158,11 @@
(# fs read (..module_descriptor fs static module_id)))
(def: parser
- (Parser [Descriptor (Document .Module)])
- (<>.and descriptor.parser
- (document.parser $.parser)))
+ (Parser [Descriptor (Document .Module) Registry])
+ ($_ <>.and
+ descriptor.parser
+ (document.parser $.parser)
+ registry.parser))
(def: (fresh_analysis_state host)
(-> Target .Lux)
@@ -169,7 +171,7 @@
(def: (analysis_state host archive)
(-> Target Archive (Try .Lux))
(do [! try.monad]
- [modules (: (Try (List [Module .Module]))
+ [modules (: (Try (List [descriptor.Module .Module]))
(monad.each ! (function (_ module)
(do !
[[descriptor document output] (archive.find module archive)
@@ -350,20 +352,23 @@
(in [(document.document $.key (with@ .#definitions definitions content))
bundles])))
-(def: (load_definitions fs static module_id host_environment descriptor document)
+(def: (load_definitions fs static module_id host_environment descriptor document registry)
(All (_ expression directive)
(-> (file.System Async) Static archive.ID (generation.Host expression directive)
- Descriptor (Document .Module)
- (Async (Try [[Descriptor (Document .Module) Output]
- Bundles]))))
+ Descriptor (Document .Module) Registry
+ (Async (Try [(archive.Entry .Module) Bundles]))))
(do (try.with async.monad)
[actual (cached_artifacts fs static module_id)
- .let [expected (|> descriptor (value@ descriptor.#registry) registry.artifacts)]
+ .let [expected (registry.artifacts registry)]
[document bundles output] (async#in (loaded_document (value@ static.#artifact_extension static) host_environment module_id expected actual document))]
- (in [[descriptor document output] bundles])))
+ (in [[archive.#descriptor descriptor
+ archive.#document document
+ archive.#output output
+ archive.#registry registry]
+ bundles])))
(def: (purge! fs static [module_name module_id])
- (-> (file.System Async) Static [Module archive.ID] (Async (Try Any)))
+ (-> (file.System Async) Static [descriptor.Module archive.ID] (Async (Try Any)))
(do [! (try.with async.monad)]
[.let [cache (..module fs static module_id)]
_ (|> cache
@@ -381,11 +386,14 @@
(n.= (value@ descriptor.#hash expected)
(value@ ////.#hash actual))))
+(type: Cache
+ [descriptor.Module [archive.ID [Descriptor (Document .Module) Registry]]])
+
(type: Purge
- (Dictionary Module archive.ID))
+ (Dictionary descriptor.Module archive.ID))
(def: initial_purge
- (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module)]]]])
+ (-> (List [Bit Cache])
Purge)
(|>> (list.all (function (_ [valid_cache? [module_name [module_id _]]])
(if valid_cache?
@@ -394,11 +402,11 @@
(dictionary.of_list text.hash)))
(def: (full_purge caches load_order)
- (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module)]]]])
- cache/module.Order
+ (-> (List [Bit Cache])
+ (cache/module.Order .Module)
Purge)
(list#mix (function (_ [module_name [module_id [descriptor document]]] purge)
- (let [purged? (: (Predicate Module)
+ (let [purged? (: (Predicate descriptor.Module)
(dictionary.key? purge))]
(if (purged? module_name)
purge
@@ -415,49 +423,75 @@
Text
"(Lux Caching System)")
+(def: (valid_cache fs static import contexts [module_name module_id])
+ (-> (file.System Async) Static Import (List Context)
+ [descriptor.Module archive.ID]
+ (Async (Try [Bit Cache])))
+ (with_expansions [<cache> [module_name [module_id [descriptor document registry]]]]
+ (do [! (try.with async.monad)]
+ [data (..read_module_descriptor fs static module_id)
+ [descriptor document registry] (async#in (<binary>.result ..parser data))]
+ (if (text#= archive.runtime_module module_name)
+ (in [true <cache>])
+ (do !
+ [input (//context.read fs ..pseudo_module import contexts (value@ static.#host_module_extension static) module_name)]
+ (in [(..valid_cache? descriptor input) <cache>]))))))
+
+(def: (pre_loaded_caches fs static import contexts archive)
+ (-> (file.System Async) Static Import (List Context) Archive
+ (Async (Try (List [Bit Cache]))))
+ (do [! (try.with async.monad)]
+ [... TODO: Stop needing to wrap this expression in an unnecessary "do" expression.
+ it (|> archive
+ archive.reservations
+ (monad.each !
+ (..valid_cache fs static import contexts)))]
+ (in it)))
+
+(def: (load_order archive pre_loaded_caches)
+ (-> Archive (List [Bit Cache])
+ (Try (cache/module.Order .Module)))
+ (|> pre_loaded_caches
+ (monad.mix try.monad
+ (function (_ [_ [module [module_id [descriptor document registry]]]] archive)
+ (archive.has module [descriptor document (: Output sequence.empty) registry] archive))
+ archive)
+ (# try.monad each (cache/module.load_order $.key))
+ (# try.monad conjoint)))
+
+(def: (loaded_caches host_environment fs static purge load_order)
+ (All (_ expression directive)
+ (-> (generation.Host expression directive) (file.System Async) Static
+ Purge (cache/module.Order .Module)
+ (Async (Try (List [[descriptor.Module (archive.Entry .Module)] Bundles])))))
+ (do [! (try.with async.monad)]
+ [... TODO: Stop needing to wrap this expression in an unnecessary "do" expression.
+ it (|> load_order
+ (list.only (|>> product.left (dictionary.key? purge) not))
+ (monad.each ! (function (_ [module_name [module_id [descriptor document _ registry]]])
+ (do !
+ [[entry bundles] (..load_definitions fs static module_id host_environment descriptor document registry)]
+ (in [[module_name entry]
+ bundles])))))]
+ (in it)))
+
(def: (load_every_reserved_module host_environment fs static import contexts archive)
(All (_ expression directive)
(-> (generation.Host expression directive) (file.System Async) Static Import (List Context) Archive
(Async (Try [Archive .Lux Bundles]))))
(do [! (try.with async.monad)]
- [pre_loaded_caches (|> archive
- archive.reservations
- (monad.each ! (function (_ [module_name module_id])
- (do !
- [data (..read_module_descriptor fs static module_id)
- [descriptor document] (async#in (<binary>.result ..parser data))]
- (if (text#= archive.runtime_module module_name)
- (in [true
- [module_name [module_id [descriptor document]]]])
- (do !
- [input (//context.read fs ..pseudo_module import contexts (value@ static.#host_module_extension static) module_name)]
- (in [(..valid_cache? descriptor input)
- [module_name [module_id [descriptor document]]]])))))))
- load_order (|> pre_loaded_caches
- (list#each product.right)
- (monad.mix try.monad
- (function (_ [module [module_id [descriptor document]]] archive)
- (archive.has module [descriptor document (: Output sequence.empty)] archive))
- archive)
- (# try.monad each (cache/module.load_order $.key))
- (# try.monad conjoint)
- async#in)
+ [pre_loaded_caches (..pre_loaded_caches fs static import contexts archive)
+ load_order (async#in (load_order archive pre_loaded_caches))
.let [purge (..full_purge pre_loaded_caches load_order)]
_ (|> purge
dictionary.entries
(monad.each ! (..purge! fs static)))
- loaded_caches (|> load_order
- (list.only (|>> product.left (dictionary.key? purge) not))
- (monad.each ! (function (_ [module_name [module_id [descriptor document _]]])
- (do !
- [[descriptor,document,output bundles] (..load_definitions fs static module_id host_environment descriptor document)]
- (in [[module_name descriptor,document,output]
- bundles])))))]
+ loaded_caches (..loaded_caches host_environment fs static purge load_order)]
(async#in
(do [! try.monad]
[archive (monad.mix !
- (function (_ [[module descriptor,document,output] _bundle] archive)
- (archive.has module descriptor,document,output archive))
+ (function (_ [[module entry] _bundle] archive)
+ (archive.has module entry archive))
archive
loaded_caches)
analysis_state (..analysis_state (value@ static.#host static) archive)]
diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager.lux b/stdlib/source/library/lux/tool/compiler/meta/packager.lux
index 9f37fff18..741ee6591 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/packager.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/packager.lux
@@ -35,10 +35,9 @@
(List [archive.ID (List artifact.ID)]))
(def: .public order
- (-> cache/module.Order Order)
- (list#each (function (_ [module [module_id [descriptor document]]])
- (|> descriptor
- (value@ descriptor.#registry)
+ (-> (cache/module.Order Any) Order)
+ (list#each (function (_ [module [module_id [_descriptor _document _output registry]]])
+ (|> registry
registry.artifacts
sequence.list
(list#each (|>> product.left (value@ artifact.#id)))
diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux
index 594f14dd8..34e0cfd46 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux
@@ -257,7 +257,7 @@
order (cache/module.load_order $.key archive)
.let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi_byte))]
sink (|> order
- (list#each (function (_ [module [module_id [descriptor document output]]])
+ (list#each (function (_ [module [module_id [descriptor document output registry]]])
[module_id output]))
(monad.mix ! (..write_module static necessary_dependencies)
(java/util/jar/JarOutputStream::new buffer (..manifest program))))
diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux
index 4cc20607c..3009ce521 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux
@@ -123,7 +123,7 @@
imports (|> order
(list.only (|>> product.right product.left (set.member? included_modules)))
list.reversed
- (list#each (function (_ [module [module_id [descriptor document output]]])
+ (list#each (function (_ [module [module_id [descriptor document output registry]]])
(let [relative_path (_.do "gsub" (list (_.string main_file)
(_.string (..module_file module_id)))
{.#None}
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 c3f3e4867..2d61f9191 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux
@@ -71,7 +71,7 @@
[.let [necessary_dependencies (cache/artifact.necessary_dependencies archive)]
order (cache/module.load_order $.key archive)]
(|> order
- (list#each (function (_ [module [module_id [descriptor document output]]])
+ (list#each (function (_ [module [module_id [descriptor document output registry]]])
[module_id output]))
(monad.mix ! (..write_module necessary_dependencies sequence) header)
(# ! each (|>> scope
diff --git a/stdlib/source/library/lux/type/implicit.lux b/stdlib/source/library/lux/type/implicit.lux
index 1ad736172..bd4ac94b0 100644
--- a/stdlib/source/library/lux/type/implicit.lux
+++ b/stdlib/source/library/lux/type/implicit.lux
@@ -116,7 +116,7 @@
[idx tag_list sig_type] (meta.slot member)]
(in [idx sig_type])))
-(def: .public (compatible_type? interface candidate)
+(def: (compatible_type? interface candidate)
(-> Type Type Bit)
(with_expansions [<found?> (type#= interface candidate)]
(<| (or <found?>)
diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux
index a48460778..5537bc855 100644
--- a/stdlib/source/test/lux/extension.lux
+++ b/stdlib/source/test/lux/extension.lux
@@ -1,64 +1,66 @@
-(.using
- [library
- [lux "*"
- ["[0]" debug]
- ["@" target
- ["[0]" js]
- ["[0]" python]
- ["[0]" lua]
- ["[0]" ruby]
- ["[0]" php]
- ["[0]" scheme]
- ["[0]" jvm
- ["[0]" class]
- ["[0]" version]
- [encoding
- ["[0]" name]]]]
- [abstract
- ["[0]" monad {"+" do}]]
- [control
- ["[0]" try ("[1]#[0]" functor)]
- ["<>" parser
- ["<[0]>" code]
- ["<[0]>" analysis]
- ["<[0]>" synthesis]]]
- [data
- ["[0]" binary]
- ["[0]" product]
- ["[0]" text ("[1]#[0]" equivalence)
- ["%" format {"+" format}]]
- [collection
- ["[0]" sequence]
- ["[0]" list ("[1]#[0]" functor)]]
- [format
- ["[0]F" binary]]]
- [macro
- ["[0]" template]]
- [math
- ["[0]" random]
- [number
- ["n" nat]]]
- [tool
- [compiler
- ["[0]" phase]
- [meta
- [archive
- ["[0]" artifact]]]
- [language
- [lux
- ["[0]" analysis]
- ["[0]" synthesis]
- ["[0]" generation]
- ["[0]" directive]
- [phase
- [analysis
- ["[0]" type]]
- [generation
- ["[0]" jvm "_"
- ["[1]/[0]" runtime]]]]]]]]
- ["_" test {"+" Test}]]]
- [\\library
- ["[0]" / {"+" analysis: synthesis: generation: directive:}]])
+(.`` (.`` (.using
+ [library
+ [lux "*"
+ ["[0]" debug]
+ ["@" target
+ ["[0]" js]
+ ["[0]" python]
+ ["[0]" lua]
+ ["[0]" ruby]
+ ["[0]" php]
+ ["[0]" scheme]
+ ["[0]" jvm
+ (~~ (.for ["JVM" (~~ (.as_is ["[0]" class]
+ ["[0]" version]
+ [encoding
+ ["[0]" name]]))]
+ (~~ (.as_is))))]]
+ [abstract
+ ["[0]" monad {"+" do}]]
+ [control
+ ["[0]" try ("[1]#[0]" functor)]
+ ["<>" parser
+ ["<[0]>" code]
+ ["<[0]>" analysis]
+ ["<[0]>" synthesis]]]
+ [data
+ ["[0]" binary]
+ ["[0]" product]
+ ["[0]" text ("[1]#[0]" equivalence)
+ ["%" format {"+" format}]]
+ [collection
+ ["[0]" sequence]
+ ["[0]" list ("[1]#[0]" functor)]]
+ [format
+ ["[0]F" binary]]]
+ [macro
+ ["[0]" template]]
+ [math
+ ["[0]" random]
+ [number
+ ["n" nat]]]
+ [tool
+ [compiler
+ ["[0]" phase]
+ [meta
+ [archive
+ ["[0]" artifact]]]
+ [language
+ [lux
+ ["[0]" analysis]
+ ["[0]" synthesis]
+ ["[0]" generation]
+ ["[0]" directive]
+ [phase
+ [analysis
+ ["[0]" type]]
+ [generation
+ (~~ (.for ["JVM" (~~ (.as_is ["[0]" jvm "_"
+ ["[1]/[0]" runtime]]))]
+ (~~ (.as_is))))]]]]]]
+ ["_" test {"+" Test}]]]
+ [\\library
+ ["[0]" / {"+" analysis: synthesis: generation: directive:}]])))
(def: dummy_generation "dummy generation")
@@ -163,6 +165,7 @@
(try#each (binaryF.result class.writer))
(class.class version.v6_0 class.public
(name.internal $class)
+ {.#None}
(name.internal "java.lang.Object")
(list)
(list)
diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux
index 219151d6c..25f869808 100644
--- a/stdlib/source/test/lux/tool.lux
+++ b/stdlib/source/test/lux/tool.lux
@@ -24,7 +24,8 @@
["[1]/[0]" signature]
["[1]/[0]" key]
["[1]/[0]" document]
- ["[1]/[0]" registry]]]
+ ["[1]/[0]" registry]
+ ["[1]/[0]" descriptor]]]
]])
(def: .public test
@@ -40,6 +41,7 @@
/meta/archive/key.test
/meta/archive/document.test
/meta/archive/registry.test
+ /meta/archive/descriptor.test
/phase/extension.test
/phase/analysis/simple.test
... /syntax.test
diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/descriptor.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/descriptor.lux
new file mode 100644
index 000000000..d9d0e09a2
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/meta/archive/descriptor.lux
@@ -0,0 +1,56 @@
+(.using
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ [abstract
+ [monad {"+" do}]
+ [\\specification
+ ["$[0]" equivalence]]]
+ [control
+ ["[0]" try ("[1]#[0]" functor)]
+ [parser
+ ["<[0]>" binary]]]
+ [data
+ ["[0]" text]
+ [format
+ ["[0]" binary]]]
+ [math
+ ["[0]" random {"+" Random} ("[1]#[0]" monad)]]]]
+ [\\library
+ ["[0]" /]])
+
+(def: random_module_state
+ (Random Module_State)
+ ($_ random.or
+ (random#in [])
+ (random#in [])
+ (random#in [])
+ ))
+
+(def: .public (random imports)
+ (-> Nat (Random /.Descriptor))
+ ($_ random.and
+ (random.ascii/lower 1)
+ (random.ascii/lower 1)
+ random.nat
+ ..random_module_state
+ (random.set text.hash imports (random.ascii/lower 2))
+ ))
+
+(def: .public test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.Descriptor /.Module])
+ (do random.monad
+ [expected (..random 5)])
+ ($_ _.and
+ (_.for [/.equivalence]
+ ($equivalence.spec /.equivalence (..random 1)))
+
+ (_.cover [/.writer /.parser]
+ (|> expected
+ (binary.result /.writer)
+ (<binary>.result /.parser)
+ (try#each (|>> (# /.equivalence = (with@ /.#state {.#Cached} expected))))
+ (try.else false)))
+ )))
diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux
index 843dd01e4..9d38c6f6d 100644
--- a/stdlib/source/test/lux/type/check.lux
+++ b/stdlib/source/test/lux/type/check.lux
@@ -114,37 +114,84 @@
($monad.spec ..injection ..comparison /.monad))
))
+(def: (primitive_type parameters)
+ (-> Nat (Random Type))
+ (do random.monad
+ [primitive (random.ascii/upper 3)
+ parameters (random.list parameters (primitive_type (-- parameters)))]
+ (in {.#Primitive primitive parameters})))
+
+(def: clean_type
+ (Random Type)
+ (primitive_type 2))
+
(exception: yolo)
(def: error_handling
Test
- ($_ _.and
- (do random.monad
- [expected (random.ascii/upper 10)]
- (_.cover [/.failure]
+ (do random.monad
+ [left ..clean_type
+ right ..clean_type
+ ex random.nat]
+ ($_ _.and
+ (do random.monad
+ [expected (random.ascii/upper 10)]
+ (_.cover [/.failure]
+ (case (/.result /.fresh_context
+ (: (/.Check Any)
+ (/.failure expected)))
+ {try.#Success _} false
+ {try.#Failure actual} (same? expected actual))))
+ (do random.monad
+ [expected (random.ascii/upper 10)]
+ (_.cover [/.assertion]
+ (and (case (/.result /.fresh_context
+ (: (/.Check Any)
+ (/.assertion expected true)))
+ {try.#Success _} true
+ {try.#Failure actual} false)
+ (case (/.result /.fresh_context (/.assertion expected false))
+ {try.#Success _} false
+ {try.#Failure actual} (same? expected actual)))))
+ (_.cover [/.except]
(case (/.result /.fresh_context
(: (/.Check Any)
- (/.failure expected)))
+ (/.except ..yolo [])))
{try.#Success _} false
- {try.#Failure actual} (same? expected actual))))
- (do random.monad
- [expected (random.ascii/upper 10)]
- (_.cover [/.assertion]
- (and (case (/.result /.fresh_context
- (: (/.Check Any)
- (/.assertion expected true)))
- {try.#Success _} true
- {try.#Failure actual} false)
- (case (/.result /.fresh_context (/.assertion expected false))
- {try.#Success _} false
- {try.#Failure actual} (same? expected actual)))))
- (_.cover [/.except]
- (case (/.result /.fresh_context
- (: (/.Check Any)
- (/.except ..yolo [])))
- {try.#Success _} false
- {try.#Failure error} (exception.match? ..yolo error)))
- ))
+ {try.#Failure error} (exception.match? ..yolo error)))
+ (let [scenario (: (-> (-> Text Bit) Type Type Bit)
+ (function (_ ? <left> <right>)
+ (and (|> (/.check <left> <right>)
+ (: (/.Check Any))
+ (/.result /.fresh_context)
+ (case> {try.#Failure error} (? error)
+ {try.#Success _} false))
+ (|> (/.check <right> <left>)
+ (: (/.Check Any))
+ (/.result /.fresh_context)
+ (case> {try.#Failure error} (? error)
+ {try.#Success _} false)))))]
+ ($_ _.and
+ (_.cover [/.type_check_failed]
+ (let [scenario (scenario (exception.match? /.type_check_failed))]
+ (and (scenario (Tuple left right) left)
+ (scenario (Tuple left right) (Or left right))
+ (scenario (Tuple left right) (-> left right))
+ (scenario (Tuple left right) {.#Ex ex})
+
+ (scenario (Or left right) left)
+ (scenario (Or left right) (-> left right))
+ (scenario (Or left right) {.#Ex ex})
+
+ (scenario (-> left right) left)
+ (scenario (-> left right) {.#Ex ex})
+
+ (scenario {.#Ex ex} left)
+ )))
+ (_.cover [/.invalid_type_application]
+ (let [scenario (scenario (text.contains? (value@ exception.#label /.invalid_type_application)))]
+ (scenario {.#Apply left right} left)))))
+ )))
(def: var
Test
@@ -700,17 +747,6 @@
(try.else false))
))))
-(def: (primitive_type parameters)
- (-> Nat (Random Type))
- (do random.monad
- [primitive (random.ascii/upper 3)
- parameters (random.list parameters (primitive_type (-- parameters)))]
- (in {.#Primitive primitive parameters})))
-
-(def: clean_type
- (Random Type)
- (primitive_type 2))
-
(def: for_subsumption|ultimate
(Random Bit)
(do random.monad