aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/library')
-rw-r--r--stdlib/source/library/lux/data/collection/dictionary.lux46
-rw-r--r--stdlib/source/library/lux/program.lux47
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/generation.lux128
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux113
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux6
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux15
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/archive.lux9
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux107
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/archive/dependency.lux215
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/io/archive.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux25
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