From 52806bc618b7eee43bb1aa1300247c92e05b7ab1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 17 Aug 2022 13:26:39 -0400 Subject: Made the compiler's caching system sensitive to the build configuration. --- stdlib/source/library/lux/control/maybe.lux | 13 ++---- stdlib/source/library/lux/control/try.lux | 53 ++++++++++++---------- stdlib/source/library/lux/data/collection/list.lux | 13 ++---- stdlib/source/library/lux/ffi.lux | 4 +- .../library/lux/meta/compiler/default/platform.lux | 26 +++++------ .../library/lux/meta/compiler/meta/archive.lux | 35 +++++++++----- .../lux/meta/compiler/meta/cache/archive.lux | 8 ++-- .../library/lux/meta/compiler/meta/io/archive.lux | 2 +- stdlib/source/program/compositor.lux | 2 +- stdlib/source/test/lux.lux | 22 ++++----- stdlib/source/test/lux/control/try.lux | 12 +++++ .../source/test/lux/meta/compiler/meta/archive.lux | 13 ++++-- .../test/lux/meta/compiler/meta/cache/archive.lux | 9 ++-- 13 files changed, 121 insertions(+), 91 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/library/lux/control/maybe.lux b/stdlib/source/library/lux/control/maybe.lux index f760d517d..6ce448249 100644 --- a/stdlib/source/library/lux/control/maybe.lux +++ b/stdlib/source/library/lux/control/maybe.lux @@ -156,12 +156,7 @@ (.list))) (def .public when - (macro (_ tokens state) - (.when tokens - (.list test then) - {.#Right [state (.list (` (.if (, test) - (, then) - {.#None})))]} - - _ - {.#Left "Wrong syntax for 'when'"}))) + (template (_ ) + [(if + + {.#None})])) diff --git a/stdlib/source/library/lux/control/try.lux b/stdlib/source/library/lux/control/try.lux index a27c466a6..419f3525d 100644 --- a/stdlib/source/library/lux/control/try.lux +++ b/stdlib/source/library/lux/control/try.lux @@ -135,35 +135,40 @@ {#Success value} {.#None} - {#Failure (`` (("lux in-module" (,, (static .prelude)) .symbol#encoded) - (symbol ..of_maybe)))})) + {#Failure (`` (("lux in-module" (,, (static .prelude)) .symbol#encoded) (symbol ..of_maybe)))})) -(def .public else +(def generated_symbol (macro (_ tokens compiler) (.when tokens - (list else try) - {#Success [compiler (list (` (.when (, try) - {..#Success (,' g!temp)} - (,' g!temp) + (list [_ {.#Text prefix}]) + (let [generated_symbol (`` ("lux in-module" (,, (static .prelude)) .generated_symbol))] + (.when (generated_symbol prefix compiler) + {#Success [compiler g!_]} + {#Success [compiler (list g!_)]} - ... {..#Failure (,' g!temp)} - (,' g!temp) - (, else))))]} + {#Failure error} + {#Failure error})) _ - {#Failure "Wrong syntax for 'else'"}))) + (undefined)))) -(def .public when - (macro (_ tokens state) - (.when tokens - (.list test then) - (let [code#encoded ("lux in-module" "library/lux" .code#encoded) - text$ ("lux in-module" "library/lux" .text$)] - {.#Right [state (.list (` (.if (, test) - (, then) - {..#Failure (, (text$ (all "lux text concat" - "[" (code#encoded (` .when)) "]" - " " "Invalid condition:")))})))]}) +(def .public else + (with_expansions [g!then (generated_symbol "g!then") + g!failure (generated_symbol "g!failure")] + (template (_ ) + [(.when + {..#Success g!then} + g!then - _ - {.#Left "Wrong syntax for 'when'"}))) + ... {..#Failure g!failure} + g!failure + )]))) + +(def .public when + (template (_ ) + [(if + + {..#Failure (let [symbol#encoded (`` ("lux in-module" (,, (static .prelude)) .symbol#encoded))] + (all "lux text concat" + "[" (symbol#encoded (symbol ..when)) "]" + " " "Invalid condition!"))})])) diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux index cddf68036..f6850e380 100644 --- a/stdlib/source/library/lux/data/collection/list.lux +++ b/stdlib/source/library/lux/data/collection/list.lux @@ -629,15 +629,10 @@ {.#Item [idx x] (again (++ idx) xs')}))) (def .public when - (macro (_ tokens state) - (.when tokens - (list test then) - {.#Right [state (.list (` (.if (, test) - (, then) - (.list))))]} - - _ - {.#Left (wrong_syntax_error ..when)}))) + (template (_ ) + [(if + + (list))])) (def .public (revised item revision it) (All (_ a) (-> Nat (-> a a) (List a) (List a))) diff --git a/stdlib/source/library/lux/ffi.lux b/stdlib/source/library/lux/ffi.lux index bac9d29bd..ce459e663 100644 --- a/stdlib/source/library/lux/ffi.lux +++ b/stdlib/source/library/lux/ffi.lux @@ -182,7 +182,9 @@ value .any object .any]) (in (list (` (.as .Any ( (, field) (, value) (, object)))))))) - ))) + )) + ... else + (these)) (with_expansions [ (for @.js "js constant" @.python "python constant" diff --git a/stdlib/source/library/lux/meta/compiler/default/platform.lux b/stdlib/source/library/lux/meta/compiler/default/platform.lux index d3a60d7b4..e91468af4 100644 --- a/stdlib/source/library/lux/meta/compiler/default/platform.lux +++ b/stdlib/source/library/lux/meta/compiler/default/platform.lux @@ -703,11 +703,11 @@ (let [instancer (//init.compiler program global phase_wrapper expander syntax.prelude (the #write platform) program_module program_definition)] (instancer $.key (list)))) - (def (custom_compiler import context platform compilation_sources compiler - custom_key custom_format custom_compilation) + (def (custom_compiler import context platform compilation_sources configuration + compiler custom_key custom_format custom_compilation) (All (_ state document object) - (-> Import context.Context (List _io.Context) (///.Compiler .Module Any) + (-> Import context.Context (List _io.Context) Configuration (///.Compiler .Module Any) (Key document) (Format document) (///.Compilation state document object) (-> (List ///.Custom) descriptor.Module Lux_Importer module.ID (..Context state) descriptor.Module (..Return state)))) (function (_ customs importer import! @module [archive state] module) @@ -741,12 +741,12 @@ {try.#Failure error} (do ! - [_ (cache/archive.cache! (the #file_system platform) context archive)] + [_ (cache/archive.cache! (the #file_system platform) configuration context archive)] (async#in {try.#Failure error}))))))) - (def (lux_compiler import context platform compilation_sources compiler compilation) + (def (lux_compiler import context platform compilation_sources configuration compiler compilation) (All (_ ) - (-> Import context.Context (List _io.Context) (///.Compiler .Module Any) + (-> Import context.Context (List _io.Context) Configuration (///.Compiler .Module Any) (///.Compilation .Module Any) Lux_Compiler)) (function (_ customs importer import! @module [archive state] module) @@ -791,7 +791,7 @@ {try.#Failure error} (do ! - [_ (cache/archive.cache! (the #file_system platform) context archive)] + [_ (cache/archive.cache! (the #file_system platform) configuration context archive)] (async#in {try.#Failure error}))))))) (for @.old (these (def Fake_State @@ -807,9 +807,9 @@ {.#Primitive (%.nat (static.random_nat)) (list)})) (these)) - (def (serial_compiler import context platform compilation_sources compiler) + (def (serial_compiler import context platform compilation_sources configuration compiler) (All (_ ) - (-> Import context.Context (List _io.Context) (///.Compiler .Module Any) + (-> 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)] @@ -824,7 +824,7 @@ all_customs)]) (when customs {.#End} - ((..lux_compiler import context platform compilation_sources compiler (compiler input)) + ((..lux_compiler import context platform compilation_sources configuration compiler (compiler input)) all_customs importer import! @module [archive lux_state] module) {.#Item [custom_state custom_key custom_format custom_parser custom_compiler] tail} @@ -834,8 +834,8 @@ {try.#Success custom_compilation} (do ! - [[archive' custom_state'] ((..custom_compiler import context platform compilation_sources compiler - custom_key custom_format custom_compilation) + [[archive' custom_state'] ((..custom_compiler import context platform compilation_sources configuration + compiler custom_key custom_format custom_compilation) all_customs importer import! @module [archive custom_state] module)] (in [archive' lux_state])))))))) @@ -878,7 +878,7 @@ Lux_Return)) (let [[host_dependencies libraries compilers sources target program_module program_definition configuration] compilation import! (|> (..compiler program global phase_wrapper expander platform program_module program_definition) - (serial_compiler import file_context platform sources) + (serial_compiler import file_context platform sources configuration) (..parallel context))] (do [! ..monad] [customs (|> compilers diff --git a/stdlib/source/library/lux/meta/compiler/meta/archive.lux b/stdlib/source/library/lux/meta/compiler/meta/archive.lux index f492ed908..994b6cd4b 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/archive.lux @@ -26,6 +26,7 @@ [number ["n" nat (.use "[1]#[0]" equivalence)]]] [meta + ["[0]" configuration (.only Configuration)] [type [primitive (.except)]]]]] [/ @@ -216,14 +217,15 @@ (type Reservation [descriptor.Module module.ID]) - + (type Frozen - [Version module.ID (List Reservation)]) + [Version Configuration module.ID (List Reservation)]) - (def reader + (def parser (Parser ..Frozen) (all <>.and .nat + (.list (<>.and .text .text)) .nat (.list (<>.and .text .nat)))) @@ -231,11 +233,12 @@ (Format ..Frozen) (all \\format.and \\format.nat + (\\format.list (\\format.and \\format.text \\format.text)) \\format.nat (\\format.list (\\format.and \\format.text \\format.nat)))) - (def .public (export version archive) - (-> Version Archive Binary) + (def .public (export version configuration archive) + (-> Version Configuration Archive Binary) (let [(open "/[0]") (representation archive)] (|> /#resolver dictionary.entries @@ -243,7 +246,7 @@ (when descriptor+document {.#Some _} {.#Some [module id]} {.#None} {.#None}))) - [version /#next] + [version configuration /#next] (\\format.result ..format)))) (exception.def .public (version_mismatch [expected actual]) @@ -252,12 +255,22 @@ (list ["Expected" (%.nat expected)] ["Actual" (%.nat actual)]))) - (def .public (import expected binary) - (-> Version Binary (Try Archive)) + (exception.def .public (configuration_mismatch [expected actual]) + (Exception [Configuration Configuration]) + (exception.report + (list ["Expected" (configuration.format expected)] + ["Actual" (configuration.format actual)]))) + + (def .public (import expected_version expected_configuration binary) + (-> Version Configuration Binary (Try Archive)) (do try.monad - [[actual next reservations] (.result ..reader binary) - _ (exception.assertion ..version_mismatch [expected actual] - (n#= expected actual))] + [[actual_version actual_configuration next reservations] (.result ..parser binary) + _ (exception.assertion ..version_mismatch [expected_version actual_version] + (n#= expected_version actual_version)) + _ (exception.assertion ..configuration_mismatch [expected_configuration actual_configuration] + (at configuration.equivalence = + expected_configuration + actual_configuration))] (in (abstraction [#next next #resolver (list#mix (function (_ [module id] archive) diff --git a/stdlib/source/library/lux/meta/compiler/meta/cache/archive.lux b/stdlib/source/library/lux/meta/compiler/meta/cache/archive.lux index 4174ebbe6..214aeffd6 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/cache/archive.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/cache/archive.lux @@ -6,6 +6,8 @@ [data [text ["%" \\format]]] + [meta + ["[0]" configuration (.only Configuration)]] [world ["[0]" file]]]] ["[0]" // (.only) @@ -19,6 +21,6 @@ (at fs separator) "descriptor")) -(def .public (cache! fs context it) - (All (_ !) (-> (file.System !) Context Archive (! (Try Any)))) - (at fs write (..descriptor fs context) (archive.export ///.version it))) +(def .public (cache! fs configuration context it) + (All (_ !) (-> (file.System !) Configuration Context Archive (! (Try Any)))) + (at fs write (..descriptor fs context) (archive.export ///.version configuration it))) diff --git a/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux b/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux index 40e32ad80..29b8539ac 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux @@ -383,7 +383,7 @@ (when binary {try.#Success binary} (do (try.with async.monad) - [archive (async#in (archive.import ///.version binary))] + [archive (async#in (archive.import ///.version configuration binary))] (..load_every_reserved_module customs configuration host_environment fs context import contexts archive)) {try.#Failure error} diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 313939963..99d36a8f9 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -191,7 +191,7 @@ platform compilation [archive state])))) - _ (cache.cache! (the platform.#file_system platform) file_context archive) + _ (cache.cache! (the platform.#file_system platform) (the cli.#configuration compilation) file_context archive) host_dependencies (..load_host_dependencies (the platform.#file_system platform) (the cli.#host_dependencies compilation)) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 53d699818..03ec5b64f 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -1196,21 +1196,21 @@ (_.in_parallel (list ..test|lux - /abstract.test - /control.test - /data.test - /debug.test + ... /abstract.test + ... /control.test + ... /data.test + ... /debug.test - /documentation.test - /math.test + ... /documentation.test + ... /math.test - /meta.test - /program.test - /test/property.test + ... /meta.test + ... /program.test + ... /test/property.test - /world.test + ... /world.test - /ffi.test + ... /ffi.test )))) (def _ diff --git a/stdlib/source/test/lux/control/try.lux b/stdlib/source/test/lux/control/try.lux index 00aac612f..ff8fe9455 100644 --- a/stdlib/source/test/lux/control/try.lux +++ b/stdlib/source/test/lux/control/try.lux @@ -80,6 +80,18 @@ (/.else alternative {/.#Success expected})) (n.= alternative (/.else alternative (is (Try Nat) {/.#Failure error}))))) + (_.coverage [/.when] + (`` (and (,, (with_template [] + [(at (/.equivalence n.equivalence) = + + (/.when true ))] + + [{/.#Success expected}] + [{/.#Failure error}] + )) + (at (/.equivalence n.equivalence) = + (/.when false {/.#Success expected}) + (/.when false {/.#Failure error}))))) (_.coverage [/.with /.lifted] (let [lifted (/.lifted io.monad)] (|> (do (/.with io.monad) diff --git a/stdlib/source/test/lux/meta/compiler/meta/archive.lux b/stdlib/source/test/lux/meta/compiler/meta/archive.lux index 0f1db62b4..44b3961ea 100644 --- a/stdlib/source/test/lux/meta/compiler/meta/archive.lux +++ b/stdlib/source/test/lux/meta/compiler/meta/archive.lux @@ -34,7 +34,9 @@ ["[1][0]" artifact] ["[1][0]" registry] ["[1][0]" module] - ["[1][0]" unit]]) + ["[1][0]" unit] + [//// + ["[1][0]" configuration]]]) (def .public (descriptor module hash) (-> /descriptor.Module Nat /descriptor.Descriptor) @@ -55,6 +57,7 @@ content/0 random.nat content/1 (random.only (|>> (n.= content/0) not) random.nat) hash random.nat + configuration ($/configuration.random 1) .let [key (/key.key signature content/0)]] (all _.and (_.coverage [/.has /.find] @@ -177,8 +180,8 @@ archive (/.has module/1 entry/1 archive) .let [pre (/.reserved archive)] archive (|> archive - (/.export version) - (/.import version)) + (/.export version configuration) + (/.import version configuration)) .let [post (/.reserved archive)]] (in (set#= (set.of_list text.hash pre) (set.of_list text.hash post)))) @@ -186,8 +189,8 @@ (_.coverage [/.version_mismatch] (|> (do try.monad [archive (|> /.empty - (/.export version) - (/.import fake_version))] + (/.export version configuration) + (/.import fake_version configuration))] (in false)) (exception.otherwise (exception.match? /.version_mismatch)))) ))) diff --git a/stdlib/source/test/lux/meta/compiler/meta/cache/archive.lux b/stdlib/source/test/lux/meta/compiler/meta/cache/archive.lux index 2ba4c9af8..9e80f0c14 100644 --- a/stdlib/source/test/lux/meta/compiler/meta/cache/archive.lux +++ b/stdlib/source/test/lux/meta/compiler/meta/cache/archive.lux @@ -34,7 +34,9 @@ [// ["[1][0]" context] ["[1][0]" archive (.only) - ["[2][0]" signature]]]]) + ["[2][0]" signature]] + [/// + ["[1][0]" configuration]]]]) (def .public test Test @@ -49,6 +51,7 @@ content/1 (random.only (|>> (n.= content/0) not) random.nat) hash random.nat signature $signature.random + configuration ($configuration.random 1) .let [key (key.key signature content/0) [archive expected] (|> (do try.monad [[@module/0 archive] (archive.reserve module/0 archive.empty) @@ -65,13 +68,13 @@ archive.#registry registry.empty]] archive (archive.has module/0 entry/0 archive) archive (archive.has module/1 entry/1 archive)] - (in [archive (archive.export ///.version archive)])) + (in [archive (archive.export ///.version configuration archive)])) try.trusted)]] (all _.and (in (do [! async.monad] [pre/0 (at fs file? (/.descriptor fs context)) enabled? (//.enable! ! fs context) - cached? (/.cache! fs context archive) + cached? (/.cache! fs configuration context archive) actual (at fs read (/.descriptor fs context)) post/0 (at fs file? (/.descriptor fs context))] (unit.coverage [/.descriptor /.cache!] -- cgit v1.2.3