From 3b2d67a9679499b6ec9cbd781d2bf55396719136 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 17 Aug 2022 17:15:18 -0400 Subject: Less needless re-compilation in the caching system. --- stdlib/source/library/lux/abstract/algebra.lux | 17 -- stdlib/source/library/lux/data/store.lux | 54 ------ stdlib/source/library/lux/data/trace.lux | 40 ----- stdlib/source/library/lux/ffi/node_js.js.lux | 35 +++- .../library/lux/meta/compiler/default/platform.lux | 197 +++++++++++---------- .../lux/phase/extension/generation/jvm/host.lux | 10 +- .../language/lux/phase/generation/jvm/runtime.lux | 17 +- 7 files changed, 152 insertions(+), 218 deletions(-) delete mode 100644 stdlib/source/library/lux/abstract/algebra.lux delete mode 100644 stdlib/source/library/lux/data/store.lux delete mode 100644 stdlib/source/library/lux/data/trace.lux (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux/abstract/algebra.lux b/stdlib/source/library/lux/abstract/algebra.lux deleted file mode 100644 index 7db1d3887..000000000 --- a/stdlib/source/library/lux/abstract/algebra.lux +++ /dev/null @@ -1,17 +0,0 @@ -(.require - [library - [lux (.except) - [control - [functor (.only Fix)]]]]) - -(type .public (Algebra f a) - (-> (f a) a)) - -(type .public (CoAlgebra f a) - (-> a (f a))) - -(type .public (RAlgebra f a) - (-> (f (Tuple (Fix f) a)) a)) - -(type .public (RCoAlgebra f a) - (-> a (f (Or (Fix f) a)))) diff --git a/stdlib/source/library/lux/data/store.lux b/stdlib/source/library/lux/data/store.lux deleted file mode 100644 index 8f09fd0df..000000000 --- a/stdlib/source/library/lux/data/store.lux +++ /dev/null @@ -1,54 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [functor (.only Functor)] - comonad] - [type - implicit]]]) - -(type .public (Store s a) - (Record - [#cursor s - #peek (-> s a)])) - -(def (extend f wa) - (All (_ s a b) (-> (-> (Store s a) b) (Store s a) (Store s b))) - [#cursor (the #cursor wa) - #peek (function (_ s) (f (has #cursor s wa)))]) - -(def .public functor - (All (_ s) (Functor (Store s))) - (implementation - (def (each f fa) - (extend (function (_ store) - (f (at store peek (at store cursor)))) - fa)))) - -(def .public comonad - (All (_ s) (CoMonad (Store s))) - (implementation - (def functor - ..functor) - - (def (out wa) - (a/an peek (a/an cursor))) - - (def disjoint - (extend id)))) - -(def .public (peeks trans store) - (All (_ s a) (-> (-> s s) (Store s a) a)) - (|> (a/an cursor) trans (a/an peek))) - -(def .public (seek cursor store) - (All (_ s a) (-> s (Store s a) (Store s a))) - (at (a/an disjoint store) peek cursor)) - -(def .public (seeks change store) - (All (_ s a) (-> (-> s s) (Store s a) (Store s a))) - (|> store (a/an disjoint) (peeks change))) - -(def .public (experiment Functor change store) - (All (_ f s a) (-> (Functor f) (-> s (f s)) (Store s a) (f a))) - (at Functor each (a/an peek) (change (a/an cursor)))) diff --git a/stdlib/source/library/lux/data/trace.lux b/stdlib/source/library/lux/data/trace.lux deleted file mode 100644 index af741e922..000000000 --- a/stdlib/source/library/lux/data/trace.lux +++ /dev/null @@ -1,40 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - ["[0]" monoid (.only Monoid)] - [functor (.only Functor)] - comonad]]]) - -(type .public (Trace t a) - (Record - [#monoid (Monoid t) - #trace (-> t a)])) - -(def .public functor - (All (_ t) (Functor (Trace t))) - (implementation - (def (each f fa) - (revised #trace (composite f) fa)))) - -(def .public comonad - (All (_ t) (CoMonad (Trace t))) - (implementation - (def functor ..functor) - - (def (out wa) - ((the #trace wa) - (the [#monoid monoid.#identity] wa))) - - (def (disjoint wa) - (let [monoid (the #monoid wa)] - [#monoid monoid - #trace (function (_ t1) - [#monoid monoid - #trace (function (_ t2) - ((the #trace wa) - (at monoid composite t1 t2)))])])))) - -(def .public (result context tracer) - (All (_ t a) (-> t (Trace t a) a)) - (at tracer trace context)) diff --git a/stdlib/source/library/lux/ffi/node_js.js.lux b/stdlib/source/library/lux/ffi/node_js.js.lux index 3ee4c8d33..0dc797489 100644 --- a/stdlib/source/library/lux/ffi/node_js.js.lux +++ b/stdlib/source/library/lux/ffi/node_js.js.lux @@ -2,9 +2,12 @@ [library [lux (.except require) ["[0]" ffi] + [abstract + [monad (.only do)]] [control - ["[0]" function] - ["[0]" maybe (.use "[1]#[0]" monoid functor)]]]]) + ["[0]" maybe (.use "[1]#[0]" monoid)] + ["[0]" try (.only Try)] + ["[0]" exception (.only Exception)]]]]) (with_template [ ] [(def @@ -16,10 +19,26 @@ [process_load [global process mainModule constructor _load]] ) +(exception.def .public cannot_require_anything) + +(exception.def .public (cannot_require module) + (Exception Text) + (exception.report + (list ["Module" module]))) + (def .public (require module) - (-> Text (Maybe Any)) - (maybe#each (function.on module) - (all maybe#composite - ..normal_require - ..global_require - ..process_load))) + (-> Text (Try Any)) + (when (all maybe#composite + ..normal_require + ..global_require + ..process_load) + {.#Some require} + (when (try (require module)) + {try.#Failure error} + (exception.except ..cannot_require [module]) + + success + success) + + {.#None} + (exception.except ..cannot_require_anything []))) diff --git a/stdlib/source/library/lux/meta/compiler/default/platform.lux b/stdlib/source/library/lux/meta/compiler/default/platform.lux index e91468af4..1d60192d3 100644 --- a/stdlib/source/library/lux/meta/compiler/default/platform.lux +++ b/stdlib/source/library/lux/meta/compiler/default/platform.lux @@ -14,6 +14,7 @@ ["[0]" stm (.only Var STM)]]] [data ["[0]" bit] + ["[0]" sum] ["[0]" product] ["[0]" binary (.only Binary) ["_" \\format (.only Format)]] @@ -261,7 +262,7 @@ [Type Type Type] (-> ///phase.Wrapper Extender) Import (List _io.Context) Configuration (Async (Try [ Archive ///phase.Wrapper])))) - (do [! (try.with async.monad)] + (do [! ..monad] [.let [state (//init.state (the context.#host context) module compilation_configuration @@ -646,40 +647,48 @@ new_dependencies))] [all_dependencies duplicates])) - (def (any|after_imports customs import! module duplicates new_dependencies archive) + (def (after_imports customs import! module duplicates new_dependencies archive) (All (_ state document object) (-> (List ///.Custom) (..Importer state) descriptor.Module (Set descriptor.Module) (List descriptor.Module) Archive - (Async (Try [Archive (List state)])))) - (do [! (try.with async.monad)] - [] - (if (set.empty? duplicates) - (when new_dependencies - {.#End} - (in [archive (list)]) - - {.#Item _} - (do ! - [archive,state/* (|> new_dependencies - (list#each (import! customs module)) - (monad.all ..monad))] - (in [(|> archive,state/* - (list#each product.left) - (list#mix archive.composite archive)) - (list#each product.right archive,state/*)]))) - (async#in (exception.except ..cannot_import_twice [module duplicates]))))) - - (def (lux|after_imports customs import! module duplicates new_dependencies [archive state]) + (Async (Try [Archive (List state) (List Text)])))) + (if (set.empty? duplicates) + (when new_dependencies + {.#End} + (at ..monad in [archive (list) (list)]) + + {.#Item _} + (do [! async.monad] + [attempts (|> new_dependencies + (list#each (import! customs module)) + (monad.all !)) + .let [[failures successes] (sum.partition attempts)]] + (in {try.#Success [(|> successes + (list#each product.left) + (list#mix archive.composite archive)) + (list#each product.right successes) + failures]}))) + (async#in (exception.except ..cannot_import_twice [module duplicates])))) + + (def (after_lux_imports customs import! module duplicates new_dependencies [archive state]) (All (_ ) - (-> (List ///.Custom) Lux_Importer descriptor.Module (Set descriptor.Module) (List descriptor.Module) Lux_Context Lux_Return)) - (do (try.with async.monad) - [[archive state/*] (any|after_imports customs import! module duplicates new_dependencies archive)] - (in [archive (when state/* - {.#End} - state - - {.#Item _} - (try.trusted (..updated_state archive state/* state)))]))) + (-> (List ///.Custom) Lux_Importer descriptor.Module (Set descriptor.Module) (List descriptor.Module) Lux_Context + (..Return [ (List Text)]))) + (do ..monad + [[archive state/* errors] (after_imports customs import! module duplicates new_dependencies archive)] + (when errors + (list.partial error _) + (async#in {try.#Failure error}) + + _ + (in [archive + (when state/* + {.#End} + state + + {.#Item _} + (try.trusted (..updated_state archive state/* state))) + errors])))) (def (next_compilation module [archive state] compilation) (All (_ ) @@ -715,34 +724,34 @@ compilation custom_compilation all_dependencies (is (Set descriptor.Module) (set.of_list text.hash (list)))]) - (do [! (try.with async.monad)] + (do [! ..monad] [.let [new_dependencies (the ///.#dependencies compilation) [all_dependencies duplicates] (with_new_dependencies new_dependencies all_dependencies)] - [archive _] (any|after_imports customs import! module duplicates new_dependencies archive)] - (when ((the ///.#process compilation) state archive) - {try.#Success [state more|done]} - (when more|done - {.#Left more} - (let [continue! (sharing [state document object] - (is (///.Compilation state document object) - custom_compilation) - (is (-> (..Context state) (///.Compilation state document object) (Set descriptor.Module) - (..Return state)) - (as_expected again)))] - (continue! [archive state] more all_dependencies)) - - {.#Right entry} - (do ! - [.let [entry (has [archive.#module module.#descriptor descriptor.#references] all_dependencies entry)] - _ (..cache_module context platform @module custom_key custom_format entry)] - (async#in (do try.monad - [archive (archive.has module entry archive)] - (in [archive state]))))) + [archive _ errors] (after_imports customs import! module duplicates new_dependencies archive)] + (with_expansions [ (these (do ! + [_ (cache/archive.cache! (the #file_system platform) configuration context archive)] + (async#in {try.#Failure error})))] + (when errors + (list.partial error _) + + + _ + (when ((the ///.#process compilation) state archive) + {try.#Success [state more|done]} + (when more|done + {.#Left more} + (again [archive state] more all_dependencies) + + {.#Right entry} + (do ! + [.let [entry (has [archive.#module module.#descriptor descriptor.#references] all_dependencies entry)] + _ (..cache_module context platform @module custom_key custom_format entry)] + (async#in (do try.monad + [archive (archive.has module entry archive)] + (in [archive state]))))) - {try.#Failure error} - (do ! - [_ (cache/archive.cache! (the #file_system platform) configuration context archive)] - (async#in {try.#Failure error}))))))) + {try.#Failure error} + ))))))) (def (lux_compiler import context platform compilation_sources configuration compiler compilation) (All (_ ) @@ -754,45 +763,45 @@ compilation compilation all_dependencies (is (Set descriptor.Module) (set.of_list text.hash (list)))]) - (do [! (try.with async.monad)] + (do [! ..monad] [.let [new_dependencies (the ///.#dependencies compilation) [all_dependencies duplicates] (with_new_dependencies new_dependencies all_dependencies)] - [archive state] (lux|after_imports customs import! module duplicates new_dependencies [archive state])] - (when (next_compilation module [archive state] compilation) - {try.#Success [state more|done]} - (when more|done - {.#Left more} - (let [continue! (sharing [] - (is - platform) - (is (-> Lux_Context (///.Compilation .Module Any) (Set descriptor.Module) - (Action [Archive ])) - (as_expected again)))] - (continue! [archive state] more all_dependencies)) - - {.#Right entry} - (do ! - [_ (let [report (..module_compilation_log module state)] - (with_expansions [ (in (debug.log! report))] - (for @.js (is (Async (Try Any)) - (when console.default - {.#None} - - - {.#Some console} - (console.write_line report console))) - ))) - .let [entry (has [archive.#module module.#descriptor descriptor.#references] all_dependencies entry)] - _ (..cache_module context platform @module $.key $.format (as (archive.Entry .Module) entry))] - (async#in (do try.monad - [archive (archive.has module entry archive)] - (in [archive - (..with_reset_log state)]))))) - - {try.#Failure error} - (do ! - [_ (cache/archive.cache! (the #file_system platform) configuration context archive)] - (async#in {try.#Failure error}))))))) + [archive state errors] (after_lux_imports customs import! module duplicates new_dependencies [archive state])] + (with_expansions [ (these (do ! + [_ (cache/archive.cache! (the #file_system platform) configuration context archive)] + (async#in {try.#Failure error})))] + (when errors + (list.partial error _) + + + _ + (when (next_compilation module [archive state] compilation) + {try.#Success [state more|done]} + (when more|done + {.#Left more} + (again [archive state] more all_dependencies) + + {.#Right entry} + (do ! + [_ (let [report (..module_compilation_log module state)] + (with_expansions [ (in (debug.log! report))] + (for @.js (is (Async (Try Any)) + (when console.default + {.#None} + + + {.#Some console} + (console.write_line report console))) + ))) + .let [entry (has [archive.#module module.#descriptor descriptor.#references] all_dependencies entry)] + _ (..cache_module context platform @module $.key $.format (as (archive.Entry .Module) entry))] + (async#in (do try.monad + [archive (archive.has module entry archive)] + (in [archive + (..with_reset_log state)]))))) + + {try.#Failure error} + ))))))) (for @.old (these (def Fake_State Type @@ -812,7 +821,7 @@ (-> Import context.Context (List _io.Context) Configuration (///.Compiler .Module Any) Lux_Compiler)) (function (_ all_customs importer import! @module [archive lux_state] module) - (do [! (try.with async.monad)] + (do [! ..monad] [input (io.read (the #file_system platform) importer import diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/host.lux index 88906a74f..ecb42ed93 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/host.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/host.lux @@ -571,11 +571,16 @@ _.swap _.monitorexit)) +(def unitG + (_.string synthesis.unit)) + (def (object::throw exceptionG) (Unary (Bytecode Any)) (all _.composite exceptionG - _.athrow)) + (_.checkcast (type.class "java.lang.Throwable" (list))) + ///runtime.throw + unitG)) (def $Class (type.class "java.lang.Class" (list))) (def $String (type.class "java.lang.String" (list))) @@ -654,9 +659,6 @@ (function (_ extension_name generate archive [class field :unboxed:]) (at //////.monad in (_.getstatic (type.class class (list)) field :unboxed:)))])) -(def unitG - (_.string synthesis.unit)) - (def put::static Handler (..custom diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/runtime.lux index 2a0d2c994..d3592f33b 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -478,6 +478,10 @@ (def try::type (type.method [(list) (list //function.class) //type.variant (list)])) (def .public try (..procedure ..try::name ..try::type)) +(def throw::name "throw") +(def throw::type (type.method [(list) (list (type.class "java.lang.Throwable" (list))) type.void (list)])) +(def .public throw (..procedure ..throw::name ..throw::type)) + (def false _.iconst_0) (def true _.iconst_1) @@ -531,6 +535,16 @@ _.areturn ))})) +(def throw::method + (method.method ..modifier ..throw::name + .false ..throw::type + (list) + {.#Some + (all _.composite + _.aload_0 + _.athrow + )})) + (def reflection (All (_ category) (-> (Type (<| Return' Value' category)) Text)) @@ -564,7 +578,8 @@ left_projection::method right_projection::method - ..try::method)) + ..try::method + ..throw::method)) sequence.empty))] (do ////.monad [_ (generation.execute! [class bytecode]) -- cgit v1.2.3