From 2ac6926be617bf764c4c18a4f6fbba199f6be697 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 7 Mar 2022 04:16:47 -0400 Subject: Compilers for scripting languages now only depend on new JVM compiler. --- .../source/library/lux/data/collection/array.lux | 2 +- stdlib/source/library/lux/ffi.old.lux | 67 +++++----- stdlib/source/library/lux/target/ruby.lux | 8 +- .../language/lux/phase/extension/analysis/jvm.lux | 38 +++--- .../language/lux/phase/extension/directive/jvm.lux | 36 +----- .../lux/phase/extension/generation/jvm/host.lux | 22 +--- .../language/lux/phase/generation/ruby/runtime.lux | 14 +- .../library/lux/tool/compiler/meta/cache/purge.lux | 82 ++++++++++++ .../library/lux/tool/compiler/meta/io/archive.lux | 83 ++---------- stdlib/source/test/lux/data/collection/array.lux | 18 +++ .../test/lux/tool/compiler/meta/archive/module.lux | 20 ++- .../source/test/lux/tool/compiler/meta/cache.lux | 2 + .../test/lux/tool/compiler/meta/cache/purge.lux | 141 +++++++++++++++++++++ stdlib/source/unsafe/lux/data/collection/array.lux | 3 + 14 files changed, 358 insertions(+), 178 deletions(-) create mode 100644 stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux create mode 100644 stdlib/source/test/lux/tool/compiler/meta/cache/purge.lux (limited to 'stdlib') diff --git a/stdlib/source/library/lux/data/collection/array.lux b/stdlib/source/library/lux/data/collection/array.lux index cef8b64c0..f3a0efe41 100644 --- a/stdlib/source/library/lux/data/collection/array.lux +++ b/stdlib/source/library/lux/data/collection/array.lux @@ -51,7 +51,7 @@ (def: .public (contains? index array) (All (_ a) (-> Nat (Array a) Bit)) - (not (!.lacks? index array))) + (!.has? index array)) (def: .public (update! index $ array) (All (_ a) diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux index ec3693ece..0a6acfa83 100644 --- a/stdlib/source/library/lux/ffi.old.lux +++ b/stdlib/source/library/lux/ffi.old.lux @@ -1,30 +1,30 @@ (.using - [library - [lux {"-" type} - ["[0]" type ("[1]#[0]" equivalence)] - [abstract - ["[0]" monad {"+" Monad do}] - ["[0]" enum]] - [control - ["[0]" function] - ["[0]" io] - ["[0]" maybe] - ["[0]" try {"+" Try}] - ["<>" parser - ["<[0]>" code {"+" Parser}]]] - [data - ["[0]" product] - ["[0]" bit ("[1]#[0]" codec)] - ["[0]" text ("[1]#[0]" equivalence monoid) - ["%" format {"+" format}]] - [collection - ["[0]" array {"+" Array}] - ["[0]" list ("[1]#[0]" monad mix monoid)]]] - ["[0]" macro {"+" with_symbols} - [syntax {"+" syntax:}] - ["[0]" code] - ["[0]" template]] - ["[0]" meta]]]) + [library + [lux {"-" :as type} + ["[0]" type ("[1]#[0]" equivalence)] + [abstract + ["[0]" monad {"+" Monad do}] + ["[0]" enum]] + [control + ["[0]" function] + ["[0]" io] + ["[0]" maybe] + ["[0]" try {"+" Try}] + ["<>" parser + ["<[0]>" code {"+" Parser}]]] + [data + ["[0]" product] + ["[0]" bit ("[1]#[0]" codec)] + ["[0]" text ("[1]#[0]" equivalence monoid) + ["%" format {"+" format}]] + [collection + ["[0]" array {"+" Array}] + ["[0]" list ("[1]#[0]" monad mix monoid)]]] + ["[0]" macro {"+" with_symbols} + [syntax {"+" syntax:}] + ["[0]" code] + ["[0]" template]] + ["[0]" meta]]]) (template [ ] [(def: .public ( value) @@ -64,10 +64,10 @@ (template [ ] [(template: .public ( it) - [(|> it (: ) (:as (Primitive )))]) + [(|> it (: ) (.:as (Primitive )))]) (template: .public ( it) - [(|> it (: (Primitive )) (:as ))])] + [(|> it (: (Primitive )) (.:as ))])] [as_boolean .Bit "java.lang.Boolean" of_boolean] [as_long .Int "java.lang.Long" of_long] @@ -77,10 +77,10 @@ (template [ <$> <$'> ] [(template: .public ( it) - [(|> it (: ) (:as (Primitive )) <$> (: (Primitive )))]) + [(|> it (: ) (.:as (Primitive )) <$> (: (Primitive )))]) (template: .public ( it) - [(|> it (: (Primitive )) <$'> (: (Primitive )) (:as ))])] + [(|> it (: (Primitive )) <$'> (: (Primitive )) (.:as ))])] [as_byte .Int ..long_to_byte "java.lang.Long" ..byte_to_long "java.lang.Byte" of_byte] [as_short .Int ..long_to_short "java.lang.Long" ..short_to_long "java.lang.Short" of_short] @@ -1378,8 +1378,8 @@ (` (??? (~ return_term))) (let [g!temp (` ((~' ~') (~ (code.symbol ["" " Ω "]))))] (` (let [(~ g!temp) (~ return_term)] - (if (not (..null? (:as (Primitive "java.lang.Object") - (~ g!temp)))) + (if (not (..null? (.:as (Primitive "java.lang.Object") + (~ g!temp)))) (~ g!temp) (panic! (~ (code.text (format "Cannot produce null references from method calls @ " (value@ #class_name class) @@ -1733,3 +1733,6 @@ (syntax: .public (type [type (..generic_type^ (list))]) (in (list (..class_type {#ManualPrM} (list) type)))) + +(template: .public (:as type term) + [(.:as type term)]) diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux index b81be8aab..c197f6a64 100644 --- a/stdlib/source/library/lux/target/ruby.lux +++ b/stdlib/source/library/lux/target/ruby.lux @@ -208,16 +208,16 @@ (def: .public array (-> (List Expression) Computation) - (|>> (list#each (|>> :representation)) - (text.interposed ..input_separator) + (|>> (list#each (|>> :representation (text.suffix ..input_separator))) + text.together (text.enclosed ["[" "]"]) :abstraction)) (def: .public hash (-> (List [Expression Expression]) Computation) (|>> (list#each (.function (_ [k v]) - (format (:representation k) " => " (:representation v)))) - (text.interposed ..input_separator) + (format (:representation k) " => " (:representation v) ..input_separator))) + text.together (text.enclosed ["{" "}"]) :abstraction)) 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 132ceca10..df3c8bd71 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 @@ -2172,26 +2172,28 @@ bodyA 2 - {/////analysis.#Case (/////analysis.unit) - [[/////analysis.#when - {pattern.#Bind 2} - - /////analysis.#then - bodyA] - (list)]} + (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices arity)))] + {/////analysis.#Case (/////analysis.unit) + [[/////analysis.#when + {pattern.#Bind 2} + + /////analysis.#then + (/////analysis.tuple (list forced_refencing bodyA))] + (list)]}) _ - {/////analysis.#Case (/////analysis.unit) - [[/////analysis.#when - {pattern.#Complex - {complex.#Tuple - (|> (-- arity) - list.indices - (list#each (|>> (n.+ 2) {pattern.#Bind})))}} - - /////analysis.#then - bodyA] - (list)]}))) + (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices arity)))] + {/////analysis.#Case (/////analysis.unit) + [[/////analysis.#when + {pattern.#Complex + {complex.#Tuple + (|> (-- arity) + list.indices + (list#each (|>> (n.+ 2) {pattern.#Bind})))}} + + /////analysis.#then + (/////analysis.tuple (list forced_refencing bodyA))] + (list)]})))) (def: .public (analyse_overriden_method analyse archive selfT mapping supers method) (-> Phase Archive .Type Mapping (List (Type Class)) (Overriden_Method Code) (Operation Analysis)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux index 8a2acf43e..27b3cf9d2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux @@ -79,6 +79,9 @@ ["[0]" bundle] [analysis ["[0]" jvm]] + [generation + [jvm + ["[0]" host]]] [directive ["/" lux]]]]]]]] [type @@ -278,37 +281,6 @@ (.Parser (Typed Synthesis)) (.tuple (<>.and ..value_type_synthesis .any))) -(def: (hidden_method_body arity body) - (-> Nat Synthesis Synthesis) - (case [arity body] - [0 _] body - [1 _] body - - [2 {synthesis.#Control {synthesis.#Branch {synthesis.#Let _ 2 hidden}}}] - hidden - - [_ {synthesis.#Control {synthesis.#Branch {synthesis.#Case _ path}}}] - (loop [path (: synthesis.Path path)] - (case path - (^or {synthesis.#Pop} - {synthesis.#Access _} - {synthesis.#Bind _} - {synthesis.#Bit_Fork _} - {synthesis.#I64_Fork _} - {synthesis.#F64_Fork _} - {synthesis.#Text_Fork _} - {synthesis.#Alt _}) - body - - {synthesis.#Seq _ next} - (again next) - - {synthesis.#Then hidden} - hidden)) - - _ - body)) - (def: (method_body arity) (-> Nat (.Parser Synthesis)) (<| (<>#each (function (_ [env offset inits it]) it)) @@ -317,7 +289,7 @@ .tuple ($_ <>.either (<| (<>.after (.text! "")) - (<>#each (..hidden_method_body arity)) + (<>#each (host.hidden_method_body arity)) .any) .any))) 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 cbcfac6ec..296f0394b 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 @@ -853,31 +853,23 @@ [1 _]) body - (^or [2 {//////synthesis.#Control {//////synthesis.#Branch {//////synthesis.#Let _ 2 hidden}}}] - [2 {//////synthesis.#Control {//////synthesis.#Branch {//////synthesis.#Exec _ hidden}}}]) + (^ [2 {//////synthesis.#Control {//////synthesis.#Branch {//////synthesis.#Let _ 2 (//////synthesis.tuple (list _ hidden))}}}]) hidden [_ {//////synthesis.#Control {//////synthesis.#Branch {//////synthesis.#Case _ path}}}] (loop [path (: Path path)] (case path - (^or {//////synthesis.#Pop} - {//////synthesis.#Access _} - {//////synthesis.#Bind _} - {//////synthesis.#Bit_Fork _} - {//////synthesis.#I64_Fork _} - {//////synthesis.#F64_Fork _} - {//////synthesis.#Text_Fork _} - {//////synthesis.#Alt _}) - body - {//////synthesis.#Seq _ next} (again next) - {//////synthesis.#Then hidden} - hidden)) + (^ {//////synthesis.#Then (//////synthesis.tuple (list _ hidden))}) + hidden + + _ + (undefined))) _ - body)) + (undefined))) (def: overriden_method_definition (Parser [(Environment Synthesis) (/.Overriden_Method Synthesis)]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux index f6a61ca8c..99a2784cb 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux @@ -22,7 +22,8 @@ ["[0]" code]] [math [number {"+" hex} - ["[0]" i64]]] + ["[0]" i64] + ["[0]" int ("[1]#[0]" interval)]]] ["@" target ["_" ruby {"+" Expression LVar Computation Literal Statement}]]]] ["[0]" /// "_" @@ -393,10 +394,13 @@ (|> input i32##high (_.bit_shr (_.- (_.int +32) shift))))))))) (runtime: (i64##/ parameter subject) - (let [extra (_.do "remainder" (list parameter) {.#None} subject)] - (_.return (|> subject - (_.- extra) - (_./ parameter))))) + (_.return (_.? (_.and (_.= (_.int -1) parameter) + (_.= (_.int int#bottom) subject)) + subject + (let [extra (_.do "remainder" (list parameter) {.#None} subject)] + (|> subject + (_.- extra) + (_./ parameter)))))) (runtime: (i64##+ parameter subject) [..normal_ruby? (_.return (i64##i64 (_.+ parameter subject)))] diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux new file mode 100644 index 000000000..c5f2f577a --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux @@ -0,0 +1,82 @@ +(.using + [library + [lux "*" + [abstract + [predicate {"+" Predicate}] + ["[0]" monad {"+" Monad do}]] + [control + ["[0]" try {"+" Try} ("[1]#[0]" functor)] + [concurrency + ["[0]" async {"+" Async}]]] + [data + ["[0]" text ("[1]#[0]" equivalence)] + [collection + ["[0]" list ("[1]#[0]" mix functor)] + ["[0]" dictionary {"+" Dictionary}] + ["[0]" set]]] + [math + [number + ["n" nat]]] + [world + ["[0]" file]]]] + ["[0]" // "_" + ["[1][0]" module] + ["[0]" dependency "_" + ["[1]" module]] + ["/[1]" // "_" + [context {"+" Context}] + ["/[1]" // {"+" Input}] + ["[0]" archive + [registry {"+" Registry}] + ["[0]" module + ["[0]" descriptor {"+" Descriptor}]]]]]) + +(type: .public Cache + [Bit descriptor.Module module.ID (module.Module Any) Registry]) + +(type: .public Purge + (Dictionary descriptor.Module module.ID)) + +... TODO: Make the monad parameterizable. +(def: .public (purge! fs context @module) + (-> (file.System Async) Context module.ID (Async (Try Any))) + (do [! (try.with async.monad)] + [.let [cache (//module.path fs context @module)] + _ (|> cache + (# fs directory_files) + (# ! each (monad.each ! (# fs delete))) + (# ! conjoint))] + (# fs delete cache))) + +(def: .public (valid? expected actual) + (-> Descriptor Input Bit) + (and (text#= (value@ descriptor.#name expected) + (value@ ////.#module actual)) + (text#= (value@ descriptor.#file expected) + (value@ ////.#file actual)) + (n.= (value@ descriptor.#hash expected) + (value@ ////.#hash actual)))) + +(def: initial + (-> (List Cache) Purge) + (|>> (list.all (function (_ [valid? module_name @module _]) + (if valid? + {.#None} + {.#Some [module_name @module]}))) + (dictionary.of_list text.hash))) + +(def: .public (purge caches load_order) + (-> (List Cache) (dependency.Order Any) Purge) + (list#mix (function (_ [module_name [@module entry]] purge) + (let [purged? (: (Predicate descriptor.Module) + (dictionary.key? purge))] + (if (purged? module_name) + purge + (if (|> entry + (value@ [archive.#module module.#descriptor descriptor.#references]) + set.list + (list.any? purged?)) + (dictionary.has module_name @module purge) + purge)))) + (..initial caches) + load_order)) 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 346a05e56..f625ba952 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -3,8 +3,7 @@ [lux "*" [target {"+" Target}] [abstract - [predicate {"+" Predicate}] - ["[0]" monad {"+" do}]] + ["[0]" monad {"+" Monad do}]] [control ["[0]" try {"+" Try}] [concurrency @@ -17,13 +16,10 @@ ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" format}]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + [set {"+" Set}] + ["[0]" list ("[1]#[0]" mix)] ["[0]" dictionary {"+" Dictionary}] - ["[0]" sequence {"+" Sequence}] - ["[0]" set {"+" Set}]]] - [math - [number - ["n" nat]]] + ["[0]" sequence {"+" Sequence}]]] [meta ["[0]" configuration {"+" Configuration}] ["[0]" version]] @@ -45,9 +41,10 @@ ["[0]" cache ["[1]/[0]" archive] ["[1]/[0]" module] + ["[1]/[0]" purge {"+" Cache Purge}] ["[0]" dependency "_" ["[1]" module]]] - ["/[1]" // {"+" Input} + [// [language ["$" lux ["[0]" analysis] @@ -261,58 +258,6 @@ (with@ archive.#output output)) bundles]))) -(def: (purge! fs context [module_name @module]) - (-> (file.System Async) Context [descriptor.Module module.ID] (Async (Try Any))) - (do [! (try.with async.monad)] - [.let [cache (cache/module.path fs context @module)] - _ (|> cache - (# fs directory_files) - (# ! each (monad.each ! (# fs delete))) - (# ! conjoint))] - (# fs delete cache))) - -(def: (valid_cache? expected actual) - (-> Descriptor Input Bit) - (and (text#= (value@ descriptor.#name expected) - (value@ ////.#module actual)) - (text#= (value@ descriptor.#file expected) - (value@ ////.#file actual)) - (n.= (value@ descriptor.#hash expected) - (value@ ////.#hash actual)))) - -(type: Cache - [descriptor.Module [module.ID [(module.Module .Module) Registry]]]) - -(type: Purge - (Dictionary descriptor.Module module.ID)) - -(def: initial_purge - (-> (List [Bit Cache]) - Purge) - (|>> (list.all (function (_ [valid_cache? [module_name [@module _]]]) - (if valid_cache? - {.#None} - {.#Some [module_name @module]}))) - (dictionary.of_list text.hash))) - -(def: (full_purge caches load_order) - (-> (List [Bit Cache]) - (dependency.Order .Module) - Purge) - (list#mix (function (_ [module_name [@module entry]] purge) - (let [purged? (: (Predicate descriptor.Module) - (dictionary.key? purge))] - (if (purged? module_name) - purge - (if (|> entry - (value@ [archive.#module module.#descriptor descriptor.#references]) - set.list - (list.any? purged?)) - (dictionary.has module_name @module purge) - purge)))) - (..initial_purge caches) - load_order)) - (def: pseudo_module Text "(Lux Caching System)") @@ -320,8 +265,8 @@ (def: (valid_cache fs context import contexts [module_name @module]) (-> (file.System Async) Context Import (List //.Context) [descriptor.Module module.ID] - (Async (Try [Bit Cache]))) - (with_expansions [ [module_name [@module [module registry]]]] + (Async (Try Cache))) + (with_expansions [ (as_is module_name @module module registry)] (do [! (try.with async.monad)] [data (: (Async (Try Binary)) (cache/module.cache fs context @module)) @@ -330,11 +275,11 @@ (in [true ]) (do ! [input (//context.read fs ..pseudo_module import contexts (value@ context.#host_module_extension context) module_name)] - (in [(..valid_cache? (value@ module.#descriptor module) input) ])))))) + (in [(cache/purge.valid? (value@ module.#descriptor module) input) ])))))) (def: (pre_loaded_caches fs context import contexts archive) (-> (file.System Async) Context Import (List //.Context) Archive - (Async (Try (List [Bit Cache])))) + (Async (Try (List Cache)))) (do [! (try.with async.monad)] [... TODO: Stop needing to wrap this expression in an unnecessary "do" expression. it (|> archive @@ -344,11 +289,11 @@ (in it))) (def: (load_order archive pre_loaded_caches) - (-> Archive (List [Bit Cache]) + (-> Archive (List Cache) (Try (dependency.Order .Module))) (|> pre_loaded_caches (monad.mix try.monad - (function (_ [_ [module [@module [|module| registry]]]] archive) + (function (_ [_ [module @module |module| registry]] archive) (archive.has module [archive.#module |module| archive.#output (: Output sequence.empty) @@ -381,10 +326,10 @@ (do [! (try.with async.monad)] [pre_loaded_caches (..pre_loaded_caches fs context import contexts archive) load_order (async#in (load_order archive pre_loaded_caches)) - .let [purge (..full_purge pre_loaded_caches load_order)] + .let [purge (cache/purge.purge pre_loaded_caches load_order)] _ (|> purge dictionary.entries - (monad.each ! (..purge! fs context))) + (monad.each ! (|>> product.right (cache/purge.purge! fs context)))) loaded_caches (..loaded_caches host_environment fs context purge load_order)] (async#in (do [! try.monad] diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index b0daba12a..2e2904b3d 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -181,6 +181,18 @@ (!.has! 0 expected) (!.lacks! 0) (!.lacks? 0))) + (_.cover [!.lacks?] + (let [the_array (|> (!.empty 2) + (: (Array Nat)) + (!.has! 0 expected))] + (and (not (!.lacks? 0 the_array)) + (!.lacks? 1 the_array)))) + (_.cover [!.has?] + (let [the_array (|> (!.empty 2) + (: (Array Nat)) + (!.has! 0 expected))] + (and (!.has? 0 the_array) + (not (!.has? 1 the_array))))) (_.cover [!.revised!] (|> (!.empty 1) (: (Array Nat)) @@ -342,6 +354,12 @@ _ false))) + (_.cover [/.lacks?] + (let [the_array (|> (/.empty 2) + (: (Array Nat)) + (/.write! 0 expected))] + (and (not (/.lacks? 0 the_array)) + (/.lacks? 1 the_array)))) (_.cover [/.contains?] (let [the_array (|> (/.empty 2) (: (Array Nat)) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux index 311f1f80d..2a98f38be 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux @@ -5,15 +5,31 @@ [abstract [monad {"+" do}]] [math - ["[0]" random] + ["[0]" random {"+" Random}] [number ["n" nat]]]]] [\\library - ["[0]" /]] + ["[0]" / + ["[0]" document] + [// + ["[0]" key] + ["[0]" signature "_" + ["$[1]" \\test]]]]] ["[0]" / "_" ["[1][0]" document] ["[1][0]" descriptor]]) +(def: .public (random it) + (All (_ a) (-> (Random a) (Random (/.Module a)))) + ($_ random.and + random.nat + (/descriptor.random 0) + (do random.monad + [signature $signature.random + example it] + (in (document.document (key.key signature example) + example))))) + (def: .public test Test (<| (_.covering /._) diff --git a/stdlib/source/test/lux/tool/compiler/meta/cache.lux b/stdlib/source/test/lux/tool/compiler/meta/cache.lux index 66d5cfc9c..d48c3297e 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cache.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cache.lux @@ -18,6 +18,7 @@ ["[1][0]" archive] ["[1][0]" module] ["[1][0]" artifact] + ["[1][0]" purge] ["$/[1]" // "_" ["[1][0]" context]]]) @@ -49,4 +50,5 @@ /archive.test /module.test /artifact.test + /purge.test )))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/cache/purge.lux b/stdlib/source/test/lux/tool/compiler/meta/cache/purge.lux new file mode 100644 index 000000000..9a190448a --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/meta/cache/purge.lux @@ -0,0 +1,141 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + ["[0]" try] + ["[0]" exception] + [concurrency + ["[0]" async]]] + [data + ["[0]" text + ["%" format]] + ["[0]" binary + ["$[1]" \\test]] + [collection + ["[0]" dictionary] + ["[0]" sequence] + ["[0]" set]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]] + [world + ["[0]" file]]]] + [\\library + ["[0]" / + ["/[1]" // "_" + ["[1][0]" module] + ["[0]" dependency "_" + ["[1]" module]] + ["/[1]" // "_" + ["[0]" context + ["$[1]" \\test]] + ["[0]" archive + ["[0]" registry] + ["[0]" module + ["$[1]" \\test] + ["[0]" descriptor + ["$[1]" \\test]]]] + ["/[1]" //]]]]]) + +(def: .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [descriptor ($descriptor.random 0) + source_code (random.ascii/upper 1) + name/0 (random.ascii/lower 1) + module/0 ($module.random random.nat) + content/0 ($binary.random 1) + name/1 (random.ascii/lower 2) + module/1 (|> ($module.random random.nat) + (# ! each (with@ [module.#descriptor descriptor.#references] + (set.of_list text.hash (list name/0))))) + content/1 ($binary.random 2) + .let [id/0 (value@ module.#id module/0) + id/1 (value@ module.#id module/1) + input [////.#module (value@ descriptor.#name descriptor) + ////.#file (value@ descriptor.#file descriptor) + ////.#hash (value@ descriptor.#hash descriptor) + ////.#code source_code] + / "/" + fs (file.mock /)] + context $context.random] + ($_ _.and + (_.for [/.Cache] + ($_ _.and + (_.cover [/.valid?] + (and (/.valid? descriptor input) + (not (/.valid? descriptor (with@ ////.#module source_code input))) + (not (/.valid? descriptor (with@ ////.#file source_code input))) + (not (/.valid? descriptor (revised@ ////.#hash ++ input))))) + )) + (_.for [/.Purge] + ($_ _.and + (_.cover [/.purge] + (and (dictionary.empty? (/.purge (list) (list))) + (let [order (: (dependency.Order Nat) + (list [name/0 id/0 + [archive.#module module/0 + archive.#output (sequence.sequence) + archive.#registry registry.empty]]))] + (and (let [cache (: (List /.Cache) + (list [#1 name/0 id/0 module/0 registry.empty]))] + (dictionary.empty? (/.purge cache order))) + (let [cache (: (List /.Cache) + (list [#0 name/0 id/0 module/0 registry.empty]))] + (dictionary.key? (/.purge cache order) name/0)))) + (let [order (: (dependency.Order Nat) + (list [name/0 id/0 + [archive.#module module/0 + archive.#output (sequence.sequence) + archive.#registry registry.empty]] + [name/1 id/1 + [archive.#module module/1 + archive.#output (sequence.sequence) + archive.#registry registry.empty]]))] + (and (let [cache (: (List /.Cache) + (list [#1 name/0 id/0 module/0 registry.empty] + [#1 name/1 id/1 module/1 registry.empty])) + purge (/.purge cache order)] + (dictionary.empty? purge)) + (let [cache (: (List /.Cache) + (list [#1 name/0 id/0 module/0 registry.empty] + [#0 name/1 id/1 module/1 registry.empty])) + purge (/.purge cache order)] + (and (not (dictionary.key? (/.purge cache order) name/0)) + (dictionary.key? (/.purge cache order) name/1))) + (let [cache (: (List /.Cache) + (list [#0 name/0 id/0 module/0 registry.empty] + [#1 name/1 id/1 module/1 registry.empty])) + purge (/.purge cache order)] + (and (dictionary.key? (/.purge cache order) name/0) + (dictionary.key? (/.purge cache order) name/1))))))) + (in (do [! async.monad] + [_ (//module.enable! ! fs context id/0) + .let [dir (//module.path fs context id/0) + file/0 (%.format dir / name/0) + file/1 (%.format dir / name/1)] + _ (# fs write content/0 file/0) + _ (# fs write content/1 file/1) + pre (# fs directory_files dir) + _ (/.purge! fs context id/0) + post (# fs directory_files dir)] + (_.cover' [/.purge!] + (<| (try.else false) + (do try.monad + [pre pre] + (in (and (# set.equivalence = + (set.of_list text.hash pre) + (set.of_list text.hash (list file/0 file/1))) + (case post + {try.#Failure error} + (exception.match? file.cannot_find_directory error) + + success + false)))))))) + )) + )))) diff --git a/stdlib/source/unsafe/lux/data/collection/array.lux b/stdlib/source/unsafe/lux/data/collection/array.lux index cd6bebf63..83b7e5202 100644 --- a/stdlib/source/unsafe/lux/data/collection/array.lux +++ b/stdlib/source/unsafe/lux/data/collection/array.lux @@ -95,6 +95,9 @@ .true)))) )])) + (template: .public (has? index array) + [(.not (..lacks? index array))]) + (`` (template: .public (item ) [((.: (.All (_ a) (.-> .Nat (..Array a) a)) -- cgit v1.2.3