diff options
Diffstat (limited to 'stdlib/source/library')
12 files changed, 509 insertions, 206 deletions
diff --git a/stdlib/source/library/lux/data/collection/dictionary.lux b/stdlib/source/library/lux/data/collection/dictionary.lux index ac9fe8002..ee7b7cb7d 100644 --- a/stdlib/source/library/lux/data/collection/dictionary.lux +++ b/stdlib/source/library/lux/data/collection/dictionary.lux @@ -534,29 +534,34 @@ (array.size colls) )) -(def: (node#entries node) - (All (_ k v) (-> (Node k v) (List [k v]))) +(def: (node#mix f init node) + (All (_ k v a) (-> (-> [k v] a a) a (Node k v) a)) (case node {#Hierarchy _size hierarchy} - (array#mix (function (_ sub_node tail) (list#composite (node#entries sub_node) tail)) - {.#End} + (array#mix (function (_ sub_node current) + (node#mix f current sub_node)) + init hierarchy) {#Base bitmap base} - (array#mix (function (_ branch tail) + (array#mix (function (_ branch current) (case branch {.#Left sub_node} - (list#composite (node#entries sub_node) tail) + (node#mix f current sub_node) - {.#Right [key' val']} - {.#Item [key' val'] tail})) - {.#End} + {.#Right kv} + (f kv current))) + init base) {#Collisions hash colls} - (array#mix (function (_ [key' val'] tail) {.#Item [key' val'] tail}) - {.#End} - colls))) + (array#mix f init colls))) + +(def: node#entries + (All (_ k v) (-> (Node k v) (List [k v]))) + (node#mix (function (_ head tail) + {.#Item head tail}) + {.#End})) (type: .public (Dictionary k v) (Record @@ -619,7 +624,7 @@ (def: .public size (All (_ k v) (-> (Dictionary k v) Nat)) - (|>> product.right ..node#size)) + (|>> (value@ #root) ..node#size)) (def: .public empty? (All (_ k v) (-> (Dictionary k v) Bit)) @@ -627,7 +632,7 @@ (def: .public entries (All (_ k v) (-> (Dictionary k v) (List [k v]))) - (|>> product.right ..node#entries)) + (|>> (value@ #root) ..node#entries)) (def: .public (of_list key_hash kvs) (All (_ k v) (-> (Hash k) (List [k v]) (Dictionary k v))) @@ -639,8 +644,8 @@ (template [<side> <name>] [(def: .public <name> (All (_ k v) (-> (Dictionary k v) (List <side>))) - (|>> ..entries - (list#mix (function (_ [k v] bundle) + (|>> (value@ #root) + (node#mix (function (_ [k v] bundle) {.#Item <side> bundle}) {.#End})))] @@ -650,13 +655,14 @@ (def: .public (merged dict2 dict1) (All (_ k v) (-> (Dictionary k v) (Dictionary k v) (Dictionary k v))) - (list#mix (function (_ [key val] dict) (has key val dict)) + (node#mix (function (_ [key val] dict) + (has key val dict)) dict1 - (entries dict2))) + (value@ #root dict2))) (def: .public (merged_with f dict2 dict1) (All (_ k v) (-> (-> v v v) (Dictionary k v) (Dictionary k v) (Dictionary k v))) - (list#mix (function (_ [key val2] dict) + (node#mix (function (_ [key val2] dict) (case (value key dict) {.#None} (has key val2 dict) @@ -664,7 +670,7 @@ {.#Some val1} (has key (f val2 val1) dict))) dict1 - (entries dict2))) + (value@ #root dict2))) (def: .public (re_bound from_key to_key dict) (All (_ k v) (-> k k (Dictionary k v) (Dictionary k v))) diff --git a/stdlib/source/library/lux/program.lux b/stdlib/source/library/lux/program.lux index 0d9576d79..469aa68e6 100644 --- a/stdlib/source/library/lux/program.lux +++ b/stdlib/source/library/lux/program.lux @@ -1,19 +1,19 @@ (.using - [library - [lux "*" - ["@" target] - [abstract - [monad {"+" do}]] - [control - ["[0]" io] - [concurrency - ["[0]" thread]] - ["<>" parser - ["<[0]>" code] - ["<[0]>" cli]]] - [macro {"+" with_symbols} - [syntax {"+" syntax:}] - ["[0]" code]]]]) + [library + [lux "*" + ["@" target] + [abstract + [monad {"+" do}]] + [control + ["[0]" io] + [concurrency + ["[0]" thread]] + ["<>" parser + ["<[0]>" code] + ["<[0]>" cli]]] + [macro {"+" with_symbols} + [syntax {"+" syntax:}] + ["[0]" code]]]]) (type: Arguments (Variant @@ -28,15 +28,14 @@ (syntax: .public (program: [args ..arguments^ body <code>.any]) (with_symbols [g!program g!args g!_ g!output g!message] - (let [initialization+event_loop - (` ((~! do) (~! io.monad) - [(~ g!output) (~ body) - (~+ (for [@.old (list) - @.jvm (list) - @.js (list) - @.python (list)] - (list g!_ (` (~! thread.run!)))))] - ((~' in) (~ g!output))))] + (let [initialization+event_loop (for [@.old body + @.jvm body + @.js body + @.python body] + (` ((~! do) (~! io.monad) + [(~ g!output) (~ body) + (~ g!_) (~! thread.run!)] + ((~' in) (~ g!output)))))] (in (list (` ("lux def program" (~ (case args {#Raw args} 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 b2a99c6a4..ac37f48aa 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux @@ -1,35 +1,38 @@ (.using - [library - [lux {"-" Module symbol} - [abstract - [monad {"+" do}]] - [control - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}] - ["[0]" function]] - [data - [binary {"+" Binary}] - ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence) - ["%" format {"+" format}]] - [collection - ["[0]" sequence {"+" Sequence}] - ["[0]" list ("[1]#[0]" functor)]]] - [math - [number - ["n" nat]]] - [meta - ["[0]" symbol]]]] - [// - [synthesis {"+" Synthesis}] - [phase - ["[0]" extension]] - [/// - ["[0]" phase] - [meta - ["[0]" archive {"+" Archive} - ["[0]" descriptor {"+" Module}] - ["[0]" artifact]]]]]) + [library + [lux {"-" Module symbol} + [abstract + [monad {"+" do}]] + [control + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}] + ["[0]" function]] + [data + [binary {"+" Binary}] + ["[0]" product] + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" format}]] + [collection + ["[0]" sequence {"+" Sequence}] + ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" set {"+" Set}]]] + [macro + ["[0]" template]] + [math + [number + ["n" nat]]] + [meta + ["[0]" symbol]]]] + [// + [synthesis {"+" Synthesis}] + [phase + ["[0]" extension]] + [/// + ["[0]" phase] + [meta + ["[0]" archive {"+" Archive} + ["[0]" descriptor {"+" Module}] + ["[0]" artifact]]]]]) (type: .public Context [archive.ID artifact.ID]) @@ -75,7 +78,8 @@ #registry artifact.Registry #counter Nat #context (Maybe artifact.ID) - #log (Sequence Text)])) + #log (Sequence Text) + #interim_artifacts (List artifact.ID)])) (template [<special> <general>] [(type: .public (<special> anchor expression directive) @@ -101,7 +105,8 @@ #registry artifact.empty #counter 0 #context {.#None} - #log sequence.empty]) + #log sequence.empty + #interim_artifacts (list)]) (def: .public empty_buffer Buffer @@ -241,21 +246,21 @@ {.#None} (phase.except ..no_buffer_for_saving_code [artifact_id])))) -(template [<name> <artifact>] - [(def: .public (<name> name) - (All (_ anchor expression directive) - (-> Text (Operation anchor expression directive artifact.ID))) - (function (_ (^@ stateE [bundle state])) - (let [[id registry'] (<artifact> name (value@ #registry state))] - {try.#Success [[bundle (with@ #registry registry' state)] - id]})))] - - [learn artifact.definition] - [learn_custom artifact.custom] - [learn_analyser artifact.analyser] - [learn_synthesizer artifact.synthesizer] - [learn_generator artifact.generator] - [learn_directive artifact.directive] +(template [<mandatory?> <inputs> <input_types> <name> <artifact>] + [(`` (def: .public (<name> name (~~ (template.spliced <inputs>)) dependencies) + (All (_ anchor expression directive) + (-> Text (~~ (template.spliced <input_types>)) (Set artifact.Dependency) (Operation anchor expression directive artifact.ID))) + (function (_ (^@ stateE [bundle state])) + (let [[id registry'] (<artifact> name <mandatory?> dependencies (value@ #registry state))] + {try.#Success [[bundle (with@ #registry registry' state)] + id]}))))] + + [mandatory? [mandatory?] [Bit] learn artifact.definition] + [#1 [] [] learn_custom artifact.custom] + [#0 [] [] learn_analyser artifact.analyser] + [#0 [] [] learn_synthesizer artifact.synthesizer] + [#0 [] [] learn_generator artifact.generator] + [#0 [] [] learn_directive artifact.directive] ) (exception: .public (unknown_definition [name Symbol @@ -318,16 +323,17 @@ (in [[bundle' (with@ #context (value@ #context state) state')] output])))) -(def: .public (with_new_context archive body) +(def: .public (with_new_context archive dependencies body) (All (_ anchor expression directive a) - (-> Archive (Operation anchor expression directive a) + (-> Archive (Set artifact.Dependency) (Operation anchor expression directive a) (Operation anchor expression directive [Context a]))) (function (_ (^@ stateE [bundle state])) - (let [[id registry'] (artifact.resource (value@ #registry state))] + (let [[id registry'] (artifact.resource false dependencies (value@ #registry state))] (do try.monad [[[bundle' state'] output] (body [bundle (|> state (with@ #registry registry') - (with@ #context {.#Some id}))]) + (with@ #context {.#Some id}) + (revised@ #interim_artifacts (|>> {.#Item id})))]) module_id (archive.id (value@ #module state) archive)] (in [[bundle' (with@ #context (value@ #context state) state')] [[module_id id] @@ -340,3 +346,21 @@ {try.#Success [[bundle (revised@ #log (sequence.suffix message) state)] []]})) + +(def: .public (with_interim_artifacts archive body) + (All (_ anchor expression directive a) + (-> Archive (Operation anchor expression directive a) + (Operation anchor expression directive [(Set Context) a]))) + (do phase.monad + [module (extension.read (value@ #module))] + (function (_ state+) + (do try.monad + [module_id (archive.id module archive) + [[bundle' state'] output] (body state+)] + (in [[bundle' + (with@ #interim_artifacts (list) state')] + [(list#mix (function (_ artifact_id dependencies) + (set.has [module_id artifact_id] dependencies)) + artifact.no_dependencies + (value@ #interim_artifacts state')) + output]]))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index 12a13781c..49e889381 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux @@ -1,51 +1,54 @@ (.using - [library - [lux "*" - ["@" target] - ["[0]" meta] - [abstract - ["[0]" monad {"+" do}]] - [control - [io {"+" IO}] - ["[0]" try] - ["[0]" exception {"+" exception:}] - ["<>" parser - ["<[0]>" code {"+" Parser}]]] - [data - ["[0]" binary] - ["[0]" product] - ["[0]" text - ["%" format {"+" format}]] - [collection - ["[0]" dictionary] - ["[0]" array] - ["[0]" list ("[1]#[0]" functor)]]] - [macro - ["[0]" code]] - [math - [number - ["n" nat]]] - ["[0]" type {"+" :sharing} ("[1]#[0]" equivalence) - ["[0]" check]]]] - ["[0]" /// {"+" Extender} - ["[1][0]" bundle] - ["[1][0]" analysis] + [library + [lux "*" + ["@" target] + ["[0]" meta] + [abstract + ["[0]" monad {"+" do}]] + [control + [io {"+" IO}] + ["[0]" try] + ["[0]" exception {"+" exception:}] + ["<>" parser + ["<[0]>" code {"+" Parser}]]] + [data + ["[0]" binary] + ["[0]" product] + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" dictionary] + ["[0]" array] + ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" set {"+" Set}]]] + [macro + ["[0]" code]] + [math + [number + ["n" nat]]] + ["[0]" type {"+" :sharing} ("[1]#[0]" equivalence) + ["[0]" check]]]] + ["[0]" /// {"+" Extender} + ["[1][0]" bundle] + ["[1][0]" analysis] + ["/[1]" // "_" + [analysis + ["[0]" module] + ["[0]A" type]] ["/[1]" // "_" - [analysis - ["[0]" module] - ["[0]A" type]] - ["/[1]" // "_" - ["[1][0]" analysis - [macro {"+" Expander}] - ["[1]/[0]" evaluation]] - ["[1][0]" synthesis {"+" Synthesis}] - ["[1][0]" generation {"+" Context}] - ["[1][0]" directive {"+" Import Requirements Phase Operation Handler Bundle}] - ["[1][0]" program {"+" Program}] - [/// - ["[0]" phase] - [meta - ["[0]" archive {"+" Archive}]]]]]]) + ["[1][0]" analysis + [macro {"+" Expander}] + ["[1]/[0]" evaluation]] + ["[1][0]" synthesis {"+" Synthesis}] + ["[1][0]" generation {"+" Context}] + ["[1][0]" directive {"+" Import Requirements Phase Operation Handler Bundle}] + ["[1][0]" program {"+" Program}] + [/// + ["[0]" phase] + [meta + ["[0]" archive {"+" Archive} + ["[0]" artifact] + ["[0]" dependency]]]]]]]) (def: .public (custom [syntax handler]) (All (_ anchor expression directive s) @@ -114,9 +117,11 @@ (Operation anchor expression directive [Type expression Any]))) (/////directive.lifted_generation (do phase.monad - [codeG (generate archive codeS) - id (/////generation.learn name) + [[interim_artifacts codeG] (/////generation.with_interim_artifacts archive + (generate archive codeS)) + dependencies (dependency.dependencies archive codeS) module_id (phase.lifted (archive.id module archive)) + id (/////generation.learn name false (set.union interim_artifacts dependencies)) [target_name value directive] (/////generation.define! [module_id id] {.#None} codeG) _ (/////generation.save! id {.#None} directive)] (in [code//type codeG value])))) @@ -166,9 +171,11 @@ (///.lifted meta.current_module_name))] (/////directive.lifted_generation (do phase.monad - [codeG (generate archive codeS) + [[interim_artifacts codeG] (/////generation.with_interim_artifacts archive + (generate archive codeS)) + dependencies (dependency.dependencies archive codeS) module_id (phase.lifted (archive.id current_module archive)) - id (<learn> extension) + id (<learn> extension (set.union interim_artifacts dependencies)) [target_name value directive] (/////generation.define! [module_id id] {.#None} codeG) _ (/////generation.save! id {.#None} directive)] (in [codeG value]))))) @@ -489,8 +496,10 @@ Synthesis (/////generation.Operation anchor expression directive Any))) (do phase.monad - [programG (generate archive programS) - artifact_id (/////generation.learn /////program.name)] + [[interim_artifacts programG] (/////generation.with_interim_artifacts archive + (generate archive programS)) + dependencies (dependency.dependencies archive programS) + artifact_id (/////generation.learn /////program.name true (set.union interim_artifacts dependencies))] (/////generation.save! artifact_id {.#None} (program [module_id artifact_id] programG)))) (def: (def::program program) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux index 32c78830d..1c4bee276 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux @@ -29,7 +29,8 @@ [variable {"+" Register Variable}]] [meta [archive {"+" Archive} - ["[0]" artifact]]]]]]]) + ["[0]" artifact] + ["[0]" dependency]]]]]]]) (def: .public (apply expression archive [functionS argsS+]) (Generator (Application Synthesis)) @@ -66,7 +67,8 @@ (def: .public (function statement expression archive [environment arity bodyS]) (-> Phase! (Generator (Abstraction Synthesis))) (do [! ///////phase.monad] - [[[function_module function_artifact] body!] (/////generation.with_new_context archive + [dependencies (dependency.dependencies archive bodyS) + [[function_module function_artifact] body!] (/////generation.with_new_context archive dependencies (/////generation.with_anchor 1 (statement expression archive bodyS))) closureO+ (monad.each ! (expression archive) environment) 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 19ef21fbf..936d40b2e 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 @@ -283,13 +283,16 @@ (|>> (_.bit_and (_.manual "+0x80000000")) (_.= (_.int +0)))) +(def: i32##up + (_.bit_shl (_.int +32))) + (template: (i64 @high @low) [(|> (_.? (i32##positive? @high) @high (|> (_.manual "+0xFFFFFFFF") (_.- @high) _.bit_not)) - (_.bit_shl (_.int +32)) + i32##up (_.bit_or @low))]) (template [<runtime> <host>] @@ -347,11 +350,9 @@ (_.set (list low) (|> input i32##low (_.bit_shr shift) (_.bit_or (|> input i32##high (_.bit_shl (_.- shift (_.int +32))))))) (_.return (..i64 high low)))) - ($_ _.then - (_.set (list low) (_.? (|> shift (_.= (_.int +32))) - (i32##high input) - (|> input i32##high (_.bit_shr (_.- (_.int +32) shift))))) - (_.return (..i64 (_.int +0) low))))))) + (_.return (_.? (|> shift (_.= (_.int +32))) + (i32##high input) + (|> input i32##high (_.bit_shr (_.- (_.int +32) shift))))))))) (runtime: (i64##/ parameter subject) (let [extra (_.do "remainder" (list parameter) {.#None} subject)] @@ -580,7 +581,7 @@ [_ (/////generation.execute! ..runtime) _ (/////generation.save! ..module_id {.#None} ..runtime)] (in [(|> artifact.empty - artifact.resource + (artifact.resource true artifact.no_dependencies) product.right) (sequence.sequence [..module_id {.#None} diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index cbcdd36b3..c09aff7e6 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -5,6 +5,7 @@ ["[0]" equivalence {"+" Equivalence}] ["[0]" monad {"+" do}]] [control + ["[0]" maybe] ["[0]" try {"+" Try}] ["[0]" exception {"+" exception:}] ["[0]" function] @@ -132,6 +133,14 @@ {.#None} (exception.except ..module_must_be_reserved_before_it_can_be_added [module])))) + (def: .public entries + (-> Archive (List [Module [ID [Descriptor (Document Any) Output]]])) + (|>> :representation + (value@ #resolver) + dictionary.entries + (list.all (function (_ [module [module_id entry]]) + (# maybe.monad each (|>> [module_id] [module]) entry))))) + (def: .public (find module archive) (-> Module Archive (Try [Descriptor (Document Any) Output])) (let [(^open "_[0]") (:representation archive)] diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux index 9bb7c3914..8f636a0b2 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux @@ -1,25 +1,29 @@ (.using - [library - [lux "*" - [abstract - [monad {"+" do}]] - [control - [pipe {"+" case>}] - ["[0]" exception {"+" exception:}] - ["<>" parser - ["<[0]>" binary {"+" Parser}]]] - [data - ["[0]" product] - ["[0]" text - ["%" format {"+" format}]] - [collection - ["[0]" list] - ["[0]" sequence {"+" Sequence} ("[1]#[0]" functor mix)] - ["[0]" dictionary {"+" Dictionary}]] - [format - ["[0]" binary {"+" Writer}]]] - [type - abstract]]]) + [library + [lux "*" + [abstract + [monad {"+" do}]] + [control + [pipe {"+" case>}] + ["[0]" exception {"+" exception:}] + ["<>" parser + ["<[0]>" binary {"+" Parser}]]] + [data + ["[0]" product] + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" list] + ["[0]" sequence {"+" Sequence} ("[1]#[0]" functor mix)] + ["[0]" dictionary {"+" Dictionary}] + ["[0]" set {"+" Set}]] + [format + ["[0]" binary {"+" Writer}]]] + [math + [number + ["[0]" nat]]] + [type + abstract]]]) (type: .public ID Nat) @@ -34,10 +38,22 @@ {#Directive Text} {#Custom Text})) +(type: .public Dependency + [Nat ID]) + +(def: dependency_hash + (product.hash nat.hash nat.hash)) + +(def: .public no_dependencies + (Set Dependency) + (set.empty dependency_hash)) + (type: .public Artifact (Record [#id ID - #category Category])) + #category Category + #mandatory? Bit + #dependencies (Set Dependency)])) (abstract: .public Registry (Record @@ -57,25 +73,29 @@ (-> Registry ID) (|>> ..artifacts sequence.size)) - (def: .public (resource registry) - (-> Registry [ID Registry]) + (def: .public (resource mandatory? dependencies registry) + (-> Bit (Set Dependency) Registry [ID Registry]) (let [id (..next registry)] [id (|> registry :representation (revised@ #artifacts (sequence.suffix [#id id - #category {#Anonymous}])) + #category {#Anonymous} + #mandatory? mandatory? + #dependencies dependencies])) :abstraction)])) (template [<tag> <create> <fetch>] - [(def: .public (<create> name registry) - (-> Text Registry [ID Registry]) + [(def: .public (<create> name mandatory? dependencies registry) + (-> Text Bit (Set Dependency) Registry [ID Registry]) (let [id (..next registry)] [id (|> registry :representation (revised@ #artifacts (sequence.suffix [#id id - #category {<tag> name}])) + #category {<tag> name} + #mandatory? mandatory? + #dependencies dependencies])) (revised@ #resolver (dictionary.has name id)) :abstraction)])) @@ -118,11 +138,19 @@ [4 #Generator binary.text] [5 #Directive binary.text] [6 #Custom binary.text])))) - artifacts (: (Writer (Sequence Category)) - (binary.sequence/64 category))] + mandatory? binary.bit + dependency (: (Writer Dependency) + (binary.and binary.nat binary.nat)) + dependencies (: (Writer (Set Dependency)) + (binary.set dependency)) + artifacts (: (Writer (Sequence [Category Bit (Set Dependency)])) + (binary.sequence/64 ($_ binary.and category mandatory? dependencies)))] (|>> :representation (value@ #artifacts) - (sequence#each (value@ #category)) + (sequence#each (function (_ it) + [(value@ #category it) + (value@ #mandatory? it) + (value@ #dependencies it)])) artifacts))) (exception: .public (invalid_category [tag Nat]) @@ -146,17 +174,22 @@ [5 #Directive <binary>.text] [6 #Custom <binary>.text]) - _ (<>.failure (exception.error ..invalid_category [tag])))))] - (|> (<binary>.sequence/64 category) - (# <>.monad each (sequence#mix (function (_ artifact registry) + _ (<>.failure (exception.error ..invalid_category [tag]))))) + mandatory? <binary>.bit + dependency (: (Parser Dependency) + (<>.and <binary>.nat <binary>.nat)) + dependencies (: (Parser (Set Dependency)) + (<binary>.set ..dependency_hash dependency))] + (|> (<binary>.sequence/64 ($_ <>.and category mandatory? dependencies)) + (# <>.monad each (sequence#mix (function (_ [category mandatory? dependencies] registry) (product.right - (case artifact + (case category {#Anonymous} - (..resource registry) + (..resource mandatory? dependencies registry) (^template [<tag> <create>] [{<tag> name} - (<create> name registry)]) + (<create> name mandatory? dependencies registry)]) ([#Definition ..definition] [#Analyser ..analyser] [#Synthesizer ..synthesizer] diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/dependency.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/dependency.lux new file mode 100644 index 000000000..70f5b5744 --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/dependency.lux @@ -0,0 +1,215 @@ +... https://en.wikipedia.org/wiki/Tree_shaking +(.using + [library + [lux "*" + [abstract + [hash {"+" Hash}] + ["[0]" monad {"+" do}]] + [data + ["[0]" product] + [collection + ["[0]" list ("[1]#[0]" monoid mix monad)] + ["[0]" set {"+" Set}] + ["[0]" dictionary {"+" Dictionary}] + ["[0]" sequence]]] + [math + [number + ["[0]" nat]]] + [meta + ["[0]" symbol]] + [tool + [compiler + ["[0]" phase] + ["[0]" reference {"+" Constant}] + [language + [lux + ["[0]" analysis] + ["[0]" synthesis {"+" Synthesis Path}] + ["[0]" generation {"+" Context Operation}]]] + [meta + ["[0]" archive {"+" Archive} + ["[0]" artifact] + ["[0]" descriptor]]]]]]]) + +(def: (path_references references) + (-> (-> Synthesis (List Constant)) + (-> Path (List Constant))) + (function (again path) + (case path + (^or {synthesis.#Pop} + {synthesis.#Access _} + {synthesis.#Bind _}) + (list) + + (^template [<tag>] + [{<tag> left right} + ($_ list#composite + (again left) + (again right))]) + ([synthesis.#Alt] + [synthesis.#Seq]) + + {synthesis.#Bit_Fork when then else} + (case else + {.#Some else} + ($_ list#composite + (again then) + (again else)) + + {.#None} + (again then)) + + (^template [<tag>] + [{<tag> fork} + (|> {.#Item fork} + (list#each (|>> product.right again)) + list#conjoint)]) + ([synthesis.#I64_Fork] + [synthesis.#F64_Fork] + [synthesis.#Text_Fork]) + + {synthesis.#Then then} + (references then)))) + +(def: (references value) + (-> Synthesis (List Constant)) + (case value + {synthesis.#Primitive value} + (list) + + {synthesis.#Structure value} + (case value + {analysis.#Variant value} + (|> value + (value@ analysis.#value) + references) + + {analysis.#Tuple value} + (|> value + (list#each references) + list#conjoint)) + + {synthesis.#Reference value} + (case value + {reference.#Variable _} + (list) + + {reference.#Constant value} + (list value)) + + {synthesis.#Control value} + (case value + {synthesis.#Branch value} + (case value + {synthesis.#Let input _ body} + ($_ list#composite + (references input) + (references body)) + + {synthesis.#If test then else} + ($_ list#composite + (references test) + (references then) + (references else)) + + {synthesis.#Get _ record} + (references record) + + {synthesis.#Case input path} + ($_ list#composite + (references input) + (path_references references path))) + + {synthesis.#Loop value} + (case value + {synthesis.#Scope value} + (|> value + (value@ synthesis.#iteration) + references) + + {synthesis.#Again value} + (|> value + (list#each references) + list#conjoint)) + + {synthesis.#Function value} + (case value + {synthesis.#Abstraction value} + (|> value + (value@ synthesis.#body) + references) + + {synthesis.#Apply function arguments} + (|> (list& function arguments) + (list#each references) + list#conjoint))) + + {synthesis.#Extension [name parameters]} + (|> parameters + (list#each references) + list#conjoint))) + +(def: context_hash + (Hash Context) + (product.hash nat.hash nat.hash)) + +(def: .public (dependencies archive value) + (All (_ anchor expression directive) + (-> Archive Synthesis (Operation anchor expression directive (Set artifact.Dependency)))) + (let [! phase.monad] + (|> value + ..references + (set.of_list symbol.hash) + set.list + (monad.each ! (generation.remember archive)) + (# ! each (set.of_list context_hash))))) + +(def: .public all + (-> (List (Set artifact.Dependency)) + (Set artifact.Dependency)) + (list#mix set.union artifact.no_dependencies)) + +(def: (immediate_dependencies archive) + (-> Archive [(List artifact.Dependency) + (Dictionary artifact.Dependency (Set artifact.Dependency))]) + (|> archive + archive.entries + (list#each (function (_ [module [module_id [descriptor document output]]]) + (|> descriptor + (value@ descriptor.#registry) + artifact.artifacts + sequence.list + (list#each (function (_ artifact) + [[module_id (value@ artifact.#id artifact)] + (value@ artifact.#mandatory? artifact) + (value@ artifact.#dependencies artifact)]))))) + list.together + (list#mix (function (_ [artifact_id mandatory? dependencies] + [mandatory_dependencies + all_dependencies]) + [(if mandatory? + (list& artifact_id mandatory_dependencies) + mandatory_dependencies) + (dictionary.has artifact_id dependencies all_dependencies)]) + [(list) + (dictionary.empty context_hash)]))) + +(def: .public (necessary_dependencies archive) + (-> Archive (Set artifact.Dependency)) + (let [[mandatory immediate] (immediate_dependencies archive)] + (loop [pending mandatory + minimum artifact.no_dependencies] + (case pending + {.#Item head tail} + (if (set.member? minimum head) + (again tail minimum) + (again (case (dictionary.value head immediate) + {.#Some additional} + (list#composite (set.list additional) tail) + + {.#None} + tail) + (set.has head minimum))) + + {.#End} + minimum)))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux index 1cf11fda6..6e8a800ec 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux @@ -7,7 +7,7 @@ ["[0]" maybe ("[1]#[0]" functor)] ["[0]" try {"+" Try}] ["[0]" state] - ["[0]" function + [function ["[0]" memo {"+" Memo}]]] [data ["[0]" text 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 f5243e5d2..ee222ea36 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -223,7 +223,7 @@ output (: Output sequence.empty)] (let [[analysers synthesizers generators directives] bundles] (case input - {.#Item [[artifact_id artifact_category] input']} + {.#Item [[artifact_id artifact_category mandatory_artifact? artifact_dependencies] input']} (case (do ! [data (try.of_maybe (dictionary.value (format (%.nat artifact_id) extension) actual)) .let [context [module_id 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 af39e83e9..bab2f6ed9 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux @@ -33,7 +33,8 @@ [// ["[0]" archive {"+" Output} ["[0]" descriptor {"+" Module}] - ["[0]" artifact]] + ["[0]" artifact] + ["tree_shaking" dependency]] [cache ["[0]" dependency]] ["[0]" io "_" @@ -151,14 +152,17 @@ (java/io/Flushable::flush) (java/util/zip/ZipOutputStream::closeEntry)))))) -(def: (write_module static [module output] sink) - (-> Static [archive.ID Output] java/util/jar/JarOutputStream +(def: (write_module static necessary_dependencies [module output] sink) + (-> Static (Set Context) [archive.ID Output] java/util/jar/JarOutputStream (Try java/util/jar/JarOutputStream)) - (monad.mix try.monad - (function (_ [artifact custom content] sink) - (..write_class static module artifact custom content sink)) - sink - (sequence.list output))) + (let [! try.monad] + (monad.mix try.monad + (function (_ [artifact custom content] sink) + (if (set.member? necessary_dependencies [module artifact]) + (..write_class static module artifact custom content sink) + (# ! in sink))) + sink + (sequence.list output)))) (def: (read_jar_entry_with_unknown_size input) (-> java/util/jar/JarInputStream [Nat Binary]) @@ -248,12 +252,13 @@ (-> Static Packager) (function (_ host_dependencies archive program) (do [! try.monad] - [order (dependency.load_order $.key archive) + [.let [necessary_dependencies (tree_shaking.necessary_dependencies archive)] + order (dependency.load_order $.key archive) .let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi_byte))] sink (|> order (list#each (function (_ [module [module_id [descriptor document output]]]) [module_id output])) - (monad.mix ! (..write_module static) + (monad.mix ! (..write_module static necessary_dependencies) (java/util/jar/JarOutputStream::new buffer (..manifest program)))) [entries duplicates sink] (|> host_dependencies dictionary.values |