aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/tool/compiler/meta
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/lux/tool/compiler/meta')
-rw-r--r--stdlib/source/lux/tool/compiler/meta/archive.lux279
-rw-r--r--stdlib/source/lux/tool/compiler/meta/archive/artifact.lux154
-rw-r--r--stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux48
-rw-r--r--stdlib/source/lux/tool/compiler/meta/archive/document.lux71
-rw-r--r--stdlib/source/lux/tool/compiler/meta/archive/key.lux18
-rw-r--r--stdlib/source/lux/tool/compiler/meta/archive/signature.lux41
-rw-r--r--stdlib/source/lux/tool/compiler/meta/cache/dependency.lux96
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io.lux19
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/archive.lux449
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/context.lux169
-rw-r--r--stdlib/source/lux/tool/compiler/meta/packager.lux42
-rw-r--r--stdlib/source/lux/tool/compiler/meta/packager/jvm.lux144
-rw-r--r--stdlib/source/lux/tool/compiler/meta/packager/scheme.lux131
-rw-r--r--stdlib/source/lux/tool/compiler/meta/packager/script.lux75
14 files changed, 0 insertions, 1736 deletions
diff --git a/stdlib/source/lux/tool/compiler/meta/archive.lux b/stdlib/source/lux/tool/compiler/meta/archive.lux
deleted file mode 100644
index 09b501ef3..000000000
--- a/stdlib/source/lux/tool/compiler/meta/archive.lux
+++ /dev/null
@@ -1,279 +0,0 @@
-(.module:
- [lux (#- Module)
- [abstract
- ["." equivalence (#+ Equivalence)]
- ["." monad (#+ do)]]
- [control
- ["." try (#+ Try)]
- ["." exception (#+ exception:)]
- ["." function]
- ["<>" parser
- ["<b>" binary (#+ Parser)]]]
- [data
- [binary (#+ Binary)]
- ["." product]
- ["." name]
- ["." text
- ["%" format (#+ format)]]
- [format
- ["." binary (#+ Writer)]]
- [collection
- ["." list ("#\." functor fold)]
- ["." dictionary (#+ Dictionary)]
- ["." set]
- ["." row (#+ Row)]]]
- [math
- [number
- ["n" nat ("#\." equivalence)]]]
- [type
- abstract]]
- [/
- ["." artifact]
- ["." signature (#+ Signature)]
- ["." key (#+ Key)]
- ["." descriptor (#+ Module Descriptor)]
- ["." document (#+ Document)]
- [///
- [version (#+ Version)]]])
-
-(type: #export Output
- (Row [artifact.ID Binary]))
-
-(exception: #export (unknown_document {module Module}
- {known_modules (List Module)})
- (exception.report
- ["Module" (%.text module)]
- ["Known Modules" (exception.enumerate %.text known_modules)]))
-
-(exception: #export (cannot_replace_document {module Module}
- {old (Document Any)}
- {new (Document Any)})
- (exception.report
- ["Module" (%.text module)]
- ["Old key" (signature.description (document.signature old))]
- ["New key" (signature.description (document.signature new))]))
-
-(exception: #export (module_has_already_been_reserved {module Module})
- (exception.report
- ["Module" (%.text module)]))
-
-(exception: #export (module_must_be_reserved_before_it_can_be_added {module Module})
- (exception.report
- ["Module" (%.text module)]))
-
-(exception: #export (module_is_only_reserved {module Module})
- (exception.report
- ["Module" (%.text module)]))
-
-(type: #export ID
- Nat)
-
-(def: #export runtime_module
- Module
- "")
-
-(abstract: #export Archive
- {#next ID
- #resolver (Dictionary Module [ID (Maybe [Descriptor (Document Any) Output])])}
-
- (def: next
- (-> Archive ID)
- (|>> :representation (get@ #next)))
-
- (def: #export empty
- Archive
- (:abstraction {#next 0
- #resolver (dictionary.new text.hash)}))
-
- (def: #export (id module archive)
- (-> Module Archive (Try ID))
- (let [(^slots [#..resolver]) (:representation archive)]
- (case (dictionary.get module resolver)
- (#.Some [id _])
- (#try.Success id)
-
- #.None
- (exception.throw ..unknown_document [module
- (dictionary.keys resolver)]))))
-
- (def: #export (reserve module archive)
- (-> Module Archive (Try [ID Archive]))
- (let [(^slots [#..next #..resolver]) (:representation archive)]
- (case (dictionary.get module resolver)
- (#.Some _)
- (exception.throw ..module_has_already_been_reserved [module])
-
- #.None
- (#try.Success [next
- (|> archive
- :representation
- (update@ #..resolver (dictionary.put module [next #.None]))
- (update@ #..next inc)
- :abstraction)]))))
-
- (def: #export (add module [descriptor document output] archive)
- (-> Module [Descriptor (Document Any) Output] Archive (Try Archive))
- (let [(^slots [#..resolver]) (:representation archive)]
- (case (dictionary.get module resolver)
- (#.Some [id #.None])
- (#try.Success (|> archive
- :representation
- (update@ #..resolver (dictionary.put module [id (#.Some [descriptor document output])]))
- :abstraction))
-
- (#.Some [id (#.Some [existing_descriptor existing_document existing_output])])
- (if (is? document existing_document)
- ## TODO: Find out why this code allows for the same module to be added more than once. It looks fishy...
- (#try.Success archive)
- (exception.throw ..cannot_replace_document [module existing_document document]))
-
- #.None
- (exception.throw ..module_must_be_reserved_before_it_can_be_added [module]))))
-
- (def: #export (find module archive)
- (-> Module Archive (Try [Descriptor (Document Any) Output]))
- (let [(^slots [#..resolver]) (:representation archive)]
- (case (dictionary.get module resolver)
- (#.Some [id (#.Some entry)])
- (#try.Success entry)
-
- (#.Some [id #.None])
- (exception.throw ..module_is_only_reserved [module])
-
- #.None
- (exception.throw ..unknown_document [module
- (dictionary.keys resolver)]))))
-
- (def: #export (archived? archive module)
- (-> Archive Module Bit)
- (case (..find module archive)
- (#try.Success _)
- yes
-
- (#try.Failure _)
- no))
-
- (def: #export archived
- (-> Archive (List Module))
- (|>> :representation
- (get@ #resolver)
- dictionary.entries
- (list.all (function (_ [module [id descriptor+document]])
- (case descriptor+document
- (#.Some _) (#.Some module)
- #.None #.None)))))
-
- (def: #export (reserved? archive module)
- (-> Archive Module Bit)
- (let [(^slots [#..resolver]) (:representation archive)]
- (case (dictionary.get module resolver)
- (#.Some [id _])
- yes
-
- #.None
- no)))
-
- (def: #export reserved
- (-> Archive (List Module))
- (|>> :representation
- (get@ #resolver)
- dictionary.keys))
-
- (def: #export reservations
- (-> Archive (List [Module ID]))
- (|>> :representation
- (get@ #resolver)
- dictionary.entries
- (list\map (function (_ [module [id _]])
- [module id]))))
-
- (def: #export (merge additions archive)
- (-> Archive Archive Archive)
- (let [[+next +resolver] (:representation additions)]
- (|> archive
- :representation
- (update@ #next (n.max +next))
- (update@ #resolver (function (_ resolver)
- (list\fold (function (_ [module [id entry]] resolver)
- (case entry
- (#.Some _)
- (dictionary.put module [id entry] resolver)
-
- #.None
- resolver))
- resolver
- (dictionary.entries +resolver))))
- :abstraction)))
-
- (type: Reservation [Module ID])
- (type: Frozen [Version ID (List Reservation)])
-
- (def: reader
- (Parser ..Frozen)
- ($_ <>.and
- <b>.nat
- <b>.nat
- (<b>.list (<>.and <b>.text <b>.nat))))
-
- (def: writer
- (Writer ..Frozen)
- ($_ binary.and
- binary.nat
- binary.nat
- (binary.list (binary.and binary.text binary.nat))))
-
- (def: #export (export version archive)
- (-> Version Archive Binary)
- (let [(^slots [#..next #..resolver]) (:representation archive)]
- (|> resolver
- dictionary.entries
- (list.all (function (_ [module [id descriptor+document]])
- (case descriptor+document
- (#.Some _) (#.Some [module id])
- #.None #.None)))
- [version next]
- (binary.run ..writer))))
-
- (exception: #export (version_mismatch {expected Version} {actual Version})
- (exception.report
- ["Expected" (%.nat expected)]
- ["Actual" (%.nat actual)]))
-
- (exception: #export corrupt_data)
-
- (def: (correct_modules? reservations)
- (-> (List Reservation) Bit)
- (n.= (list.size reservations)
- (|> reservations
- (list\map product.left)
- (set.from_list text.hash)
- set.size)))
-
- (def: (correct_ids? reservations)
- (-> (List Reservation) Bit)
- (n.= (list.size reservations)
- (|> reservations
- (list\map product.right)
- (set.from_list n.hash)
- set.size)))
-
- (def: (correct_reservations? reservations)
- (-> (List Reservation) Bit)
- (and (correct_modules? reservations)
- (correct_ids? reservations)))
-
- (def: #export (import expected binary)
- (-> Version Binary (Try Archive))
- (do try.monad
- [[actual next reservations] (<b>.run ..reader binary)
- _ (exception.assert ..version_mismatch [expected actual]
- (n\= expected actual))
- _ (exception.assert ..corrupt_data []
- (correct_reservations? reservations))]
- (wrap (:abstraction
- {#next next
- #resolver (list\fold (function (_ [module id] archive)
- (dictionary.put module [id #.None] archive))
- (get@ #resolver (:representation ..empty))
- reservations)}))))
- )
diff --git a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux
deleted file mode 100644
index 5592df470..000000000
--- a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux
+++ /dev/null
@@ -1,154 +0,0 @@
-(.module:
- [lux #*
- [abstract
- [monad (#+ do)]]
- [control
- [pipe (#+ case>)]
- ["." exception (#+ exception:)]
- ["<>" parser
- ["<b>" binary (#+ Parser)]]]
- [data
- ["." product]
- ["." text
- ["%" format (#+ format)]]
- [collection
- ["." list]
- ["." row (#+ Row) ("#\." functor fold)]
- ["." dictionary (#+ Dictionary)]]
- [format
- ["." binary (#+ Writer)]]]
- [type
- abstract]])
-
-(type: #export ID
- Nat)
-
-(type: #export Category
- #Anonymous
- (#Definition Text)
- (#Analyser Text)
- (#Synthesizer Text)
- (#Generator Text)
- (#Directive Text))
-
-(type: #export Artifact
- {#id ID
- #category Category})
-
-(abstract: #export Registry
- {#artifacts (Row Artifact)
- #resolver (Dictionary Text ID)}
-
- (def: #export empty
- Registry
- (:abstraction {#artifacts row.empty
- #resolver (dictionary.new text.hash)}))
-
- (def: #export artifacts
- (-> Registry (Row Artifact))
- (|>> :representation (get@ #artifacts)))
-
- (def: next
- (-> Registry ID)
- (|>> ..artifacts row.size))
-
- (def: #export (resource registry)
- (-> Registry [ID Registry])
- (let [id (..next registry)]
- [id
- (|> registry
- :representation
- (update@ #artifacts (row.add {#id id
- #category #Anonymous}))
- :abstraction)]))
-
- (template [<tag> <create> <fetch>]
- [(def: #export (<create> name registry)
- (-> Text Registry [ID Registry])
- (let [id (..next registry)]
- [id
- (|> registry
- :representation
- (update@ #artifacts (row.add {#id id
- #category (<tag> name)}))
- (update@ #resolver (dictionary.put name id))
- :abstraction)]))
-
- (def: #export (<fetch> registry)
- (-> Registry (List Text))
- (|> registry
- :representation
- (get@ #artifacts)
- row.to_list
- (list.all (|>> (get@ #category)
- (case> (<tag> name) (#.Some name)
- _ #.None)))))]
-
- [#Definition definition definitions]
- [#Analyser analyser analysers]
- [#Synthesizer synthesizer synthesizers]
- [#Generator generator generators]
- [#Directive directive directives]
- )
-
- (def: #export (remember name registry)
- (-> Text Registry (Maybe ID))
- (|> (:representation registry)
- (get@ #resolver)
- (dictionary.get name)))
-
- (def: #export writer
- (Writer Registry)
- (let [category (: (Writer Category)
- (function (_ value)
- (case value
- (^template [<nat> <tag> <writer>]
- [(<tag> value) ((binary.and binary.nat <writer>) [<nat> value])])
- ([0 #Anonymous binary.any]
- [1 #Definition binary.text]
- [2 #Analyser binary.text]
- [3 #Synthesizer binary.text]
- [4 #Generator binary.text]
- [5 #Directive binary.text]))))
- artifacts (: (Writer (Row Category))
- (binary.row/64 category))]
- (|>> :representation
- (get@ #artifacts)
- (row\map (get@ #category))
- artifacts)))
-
- (exception: #export (invalid_category {tag Nat})
- (exception.report
- ["Tag" (%.nat tag)]))
-
- (def: #export parser
- (Parser Registry)
- (let [category (: (Parser Category)
- (do {! <>.monad}
- [tag <b>.nat]
- (case tag
- 0 (\ ! map (|>> #Anonymous) <b>.any)
- 1 (\ ! map (|>> #Definition) <b>.text)
- 2 (\ ! map (|>> #Analyser) <b>.text)
- 3 (\ ! map (|>> #Synthesizer) <b>.text)
- 4 (\ ! map (|>> #Generator) <b>.text)
- 5 (\ ! map (|>> #Directive) <b>.text)
- _ (<>.fail (exception.construct ..invalid_category [tag])))))]
- (|> (<b>.row/64 category)
- (\ <>.monad map (row\fold (function (_ artifact registry)
- (product.right
- (case artifact
- #Anonymous
- (..resource registry)
-
- (^template [<tag> <create>]
- [(<tag> name)
- (<create> name registry)])
- ([#Definition ..definition]
- [#Analyser ..analyser]
- [#Synthesizer ..synthesizer]
- [#Generator ..generator]
- [#Directive ..directive])
- )))
- ..empty)))))
- )
diff --git a/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux b/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux
deleted file mode 100644
index a31f6e793..000000000
--- a/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux
+++ /dev/null
@@ -1,48 +0,0 @@
-(.module:
- [lux (#- Module)
- [control
- ["<>" parser
- ["<b>" binary (#+ Parser)]]]
- [data
- ["." text]
- [collection
- [set (#+ Set)]]
- [format
- ["." binary (#+ Writer)]]]
- [world
- [file (#+ Path)]]]
- [//
- ["." artifact (#+ Registry)]])
-
-(type: #export Module
- Text)
-
-(type: #export Descriptor
- {#name Module
- #file Path
- #hash Nat
- #state Module_State
- #references (Set Module)
- #registry Registry})
-
-(def: #export writer
- (Writer Descriptor)
- ($_ binary.and
- binary.text
- binary.text
- binary.nat
- binary.any
- (binary.set binary.text)
- artifact.writer
- ))
-
-(def: #export parser
- (Parser Descriptor)
- ($_ <>.and
- <b>.text
- <b>.text
- <b>.nat
- (\ <>.monad wrap #.Cached)
- (<b>.set text.hash <b>.text)
- artifact.parser
- ))
diff --git a/stdlib/source/lux/tool/compiler/meta/archive/document.lux b/stdlib/source/lux/tool/compiler/meta/archive/document.lux
deleted file mode 100644
index b60d77246..000000000
--- a/stdlib/source/lux/tool/compiler/meta/archive/document.lux
+++ /dev/null
@@ -1,71 +0,0 @@
-(.module:
- [lux (#- Module)
- [abstract
- [monad (#+ do)]]
- [control
- ["." try (#+ Try)]
- ["." exception (#+ exception:)]
- ["<>" parser
- [binary (#+ Parser)]]]
- [data
- [collection
- ["." dictionary (#+ Dictionary)]]
- [format
- ["." binary (#+ Writer)]]]
- [type (#+ :share)
- abstract]]
- [//
- ["." signature (#+ Signature)]
- ["." key (#+ Key)]
- [descriptor (#+ Module)]])
-
-(exception: #export (invalid-signature {expected Signature} {actual Signature})
- (exception.report
- ["Expected" (signature.description expected)]
- ["Actual" (signature.description actual)]))
-
-(abstract: #export (Document d)
- {#signature Signature
- #content d}
-
- (def: #export (read key document)
- (All [d] (-> (Key d) (Document Any) (Try d)))
- (let [[document//signature document//content] (:representation document)]
- (if (\ signature.equivalence =
- (key.signature key)
- document//signature)
- (#try.Success (:share [e]
- (Key e)
- key
-
- e
- (:assume document//content)))
- (exception.throw ..invalid-signature [(key.signature key)
- document//signature]))))
-
- (def: #export (write key content)
- (All [d] (-> (Key d) d (Document d)))
- (:abstraction {#signature (key.signature key)
- #content content}))
-
- (def: #export (check key document)
- (All [d] (-> (Key d) (Document Any) (Try (Document d))))
- (do try.monad
- [_ (..read key document)]
- (wrap (:assume document))))
-
- (def: #export signature
- (-> (Document Any) Signature)
- (|>> :representation (get@ #signature)))
-
- (def: #export (writer content)
- (All [d] (-> (Writer d) (Writer (Document d))))
- (let [writer (binary.and signature.writer
- content)]
- (|>> :representation writer)))
-
- (def: #export parser
- (All [d] (-> (Parser d) (Parser (Document d))))
- (|>> (<>.and signature.parser)
- (\ <>.monad map (|>> :abstraction))))
- )
diff --git a/stdlib/source/lux/tool/compiler/meta/archive/key.lux b/stdlib/source/lux/tool/compiler/meta/archive/key.lux
deleted file mode 100644
index 1f30e105b..000000000
--- a/stdlib/source/lux/tool/compiler/meta/archive/key.lux
+++ /dev/null
@@ -1,18 +0,0 @@
-(.module:
- [lux #*
- [type
- abstract]]
- [//
- [signature (#+ Signature)]])
-
-(abstract: #export (Key k)
- Signature
-
- (def: #export signature
- (-> (Key Any) Signature)
- (|>> :representation))
-
- (def: #export (key signature sample)
- (All [d] (-> Signature d (Key d)))
- (:abstraction signature))
- )
diff --git a/stdlib/source/lux/tool/compiler/meta/archive/signature.lux b/stdlib/source/lux/tool/compiler/meta/archive/signature.lux
deleted file mode 100644
index 8956f99ec..000000000
--- a/stdlib/source/lux/tool/compiler/meta/archive/signature.lux
+++ /dev/null
@@ -1,41 +0,0 @@
-(.module:
- [lux #*
- [abstract
- [equivalence (#+ Equivalence)]]
- [control
- ["<>" parser
- ["<b>" binary (#+ Parser)]]]
- [data
- ["." product]
- ["." name]
- ["." text
- ["%" format (#+ format)]]
- [format
- ["." binary (#+ Writer)]]]
- [math
- [number
- ["." nat]]]]
- [////
- [version (#+ Version)]])
-
-(type: #export Signature
- {#name Name
- #version Version})
-
-(def: #export equivalence
- (Equivalence Signature)
- (product.equivalence name.equivalence nat.equivalence))
-
-(def: #export (description signature)
- (-> Signature Text)
- (format (%.name (get@ #name signature)) " " (%.nat (get@ #version signature))))
-
-(def: #export writer
- (Writer Signature)
- (binary.and (binary.and binary.text binary.text)
- binary.nat))
-
-(def: #export parser
- (Parser Signature)
- (<>.and (<>.and <b>.text <b>.text)
- <b>.nat))
diff --git a/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux b/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux
deleted file mode 100644
index 2a9389235..000000000
--- a/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux
+++ /dev/null
@@ -1,96 +0,0 @@
-(.module:
- [lux (#- Module)
- [abstract
- ["." monad (#+ do)]]
- [control
- ["." try (#+ Try)]
- ["." state]
- ["." function
- ["." memo (#+ Memo)]]]
- [data
- ["." maybe ("#\." functor)]
- ["." text
- ["%" format (#+ format)]]
- [collection
- ["." list ("#\." functor fold)]
- ["." dictionary (#+ Dictionary)]
- ["." set (#+ Set)]]]]
- [///
- ["." archive (#+ Output Archive)
- [key (#+ Key)]
- ["." descriptor (#+ Module Descriptor)]
- ["." document (#+ Document)]]])
-
-(type: Ancestry
- (Set Module))
-
-(def: fresh
- Ancestry
- (set.new text.hash))
-
-(type: #export Graph
- (Dictionary Module Ancestry))
-
-(def: empty
- Graph
- (dictionary.new text.hash))
-
-(def: #export modules
- (-> Graph (List Module))
- dictionary.keys)
-
-(type: Dependency
- {#module Module
- #imports Ancestry})
-
-(def: #export graph
- (-> (List Dependency) Graph)
- (list\fold (function (_ [module imports] graph)
- (dictionary.put module imports graph))
- ..empty))
-
-(def: (ancestry archive)
- (-> Archive Graph)
- (let [memo (: (Memo Module Ancestry)
- (function (_ recur module)
- (do {! state.monad}
- [#let [parents (case (archive.find module archive)
- (#try.Success [descriptor document])
- (get@ #descriptor.references descriptor)
-
- (#try.Failure error)
- ..fresh)]
- ancestors (monad.map ! recur (set.to_list parents))]
- (wrap (list\fold set.union parents ancestors)))))
- ancestry (memo.open memo)]
- (list\fold (function (_ module memory)
- (if (dictionary.key? memory module)
- memory
- (let [[memory _] (ancestry [memory module])]
- memory)))
- ..empty
- (archive.archived archive))))
-
-(def: (dependency? ancestry target source)
- (-> Graph Module Module Bit)
- (let [target_ancestry (|> ancestry
- (dictionary.get target)
- (maybe.default ..fresh))]
- (set.member? target_ancestry source)))
-
-(type: #export Order
- (List [Module [archive.ID [Descriptor (Document .Module) Output]]]))
-
-(def: #export (load_order key archive)
- (-> (Key .Module) Archive (Try Order))
- (let [ancestry (..ancestry archive)]
- (|> ancestry
- dictionary.keys
- (list.sort (..dependency? ancestry))
- (monad.map try.monad
- (function (_ module)
- (do try.monad
- [module_id (archive.id module archive)
- [descriptor document output] (archive.find module archive)
- document (document.check key document)]
- (wrap [module [module_id [descriptor document output]]])))))))
diff --git a/stdlib/source/lux/tool/compiler/meta/io.lux b/stdlib/source/lux/tool/compiler/meta/io.lux
deleted file mode 100644
index 6bafa0a79..000000000
--- a/stdlib/source/lux/tool/compiler/meta/io.lux
+++ /dev/null
@@ -1,19 +0,0 @@
-(.module:
- [lux (#- Code)
- [data
- ["." text]]
- [world
- [file (#+ Path System)]]])
-
-(type: #export Context
- Path)
-
-(type: #export Code
- Text)
-
-(def: #export (sanitize system)
- (All [m] (-> (System m) Text Text))
- (text.replace_all "/" (\ system separator)))
-
-(def: #export lux_context
- "lux")
diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
deleted file mode 100644
index 1ff603267..000000000
--- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux
+++ /dev/null
@@ -1,449 +0,0 @@
-(.module:
- [lux (#- Module)
- [target (#+ Target)]
- [abstract
- [predicate (#+ Predicate)]
- ["." monad (#+ do)]]
- [control
- [pipe (#+ case>)]
- ["." try (#+ Try)]
- ["." exception (#+ exception:)]
- [concurrency
- ["." promise (#+ Promise) ("#\." monad)]]
- ["<>" parser
- ["<.>" binary (#+ Parser)]]]
- [data
- [binary (#+ Binary)]
- ["." product]
- ["." text ("#\." equivalence)
- ["%" format (#+ format)]]
- [collection
- ["." list ("#\." functor fold)]
- ["." dictionary (#+ Dictionary)]
- ["." row (#+ Row)]
- ["." set]]]
- [math
- [number
- ["n" nat]]]
- [world
- ["." file]]]
- [program
- [compositor
- [import (#+ Import)]
- ["." static (#+ Static)]]]
- ["." // (#+ Context)
- ["#." context]
- ["/#" //
- ["." archive (#+ Output Archive)
- ["." artifact (#+ Artifact)]
- ["." descriptor (#+ Module Descriptor)]
- ["." document (#+ Document)]]
- [cache
- ["." dependency]]
- ["/#" // (#+ Input)
- [language
- ["$" lux
- ["." version]
- ["." analysis]
- ["." synthesis]
- ["." generation]
- ["." directive]
- ["#/." program]]]]]])
-
-(exception: #export (cannot_prepare {archive file.Path}
- {module_id archive.ID}
- {error Text})
- (exception.report
- ["Archive" archive]
- ["Module ID" (%.nat module_id)]
- ["Error" error]))
-
-(def: (archive fs static)
- (All [!] (-> (file.System !) Static file.Path))
- (format (get@ #static.target static)
- (\ fs separator)
- (get@ #static.host static)))
-
-(def: (unversioned_lux_archive fs static)
- (All [!] (-> (file.System !) Static file.Path))
- (format (..archive fs static)
- (\ fs separator)
- //.lux_context))
-
-(def: (versioned_lux_archive fs static)
- (All [!] (-> (file.System !) Static file.Path))
- (format (..unversioned_lux_archive fs static)
- (\ fs separator)
- (%.nat version.version)))
-
-(def: (module fs static module_id)
- (All [!] (-> (file.System !) Static archive.ID file.Path))
- (format (..versioned_lux_archive fs static)
- (\ fs separator)
- (%.nat module_id)))
-
-(def: #export (artifact fs static module_id artifact_id)
- (All [!] (-> (file.System !) Static archive.ID artifact.ID file.Path))
- (format (..module fs static module_id)
- (\ fs separator)
- (%.nat artifact_id)
- (get@ #static.artifact_extension static)))
-
-(def: (ensure_directory fs path)
- (-> (file.System Promise) file.Path (Promise (Try Any)))
- (do promise.monad
- [? (\ fs directory? path)]
- (if ?
- (wrap (#try.Success []))
- (\ fs make_directory path))))
-
-(def: #export (prepare fs static module_id)
- (-> (file.System Promise) Static archive.ID (Promise (Try Any)))
- (do {! promise.monad}
- [#let [module (..module fs static module_id)]
- module_exists? (\ fs directory? module)]
- (if module_exists?
- (wrap (#try.Success []))
- (do (try.with !)
- [_ (ensure_directory fs (..unversioned_lux_archive fs static))
- _ (ensure_directory fs (..versioned_lux_archive fs static))]
- (|> module
- (\ fs make_directory)
- (\ ! map (|>> (case> (#try.Success output)
- (#try.Success [])
-
- (#try.Failure error)
- (exception.throw ..cannot_prepare [(..archive fs static)
- module_id
- error])))))))))
-
-(def: #export (write fs static module_id artifact_id content)
- (-> (file.System Promise) Static archive.ID artifact.ID Binary (Promise (Try Any)))
- (\ fs write content (..artifact fs static module_id artifact_id)))
-
-(def: #export (enable fs static)
- (-> (file.System Promise) Static (Promise (Try Any)))
- (do (try.with promise.monad)
- [_ (..ensure_directory fs (get@ #static.target static))]
- (..ensure_directory fs (..archive fs static))))
-
-(def: (general_descriptor fs static)
- (-> (file.System Promise) Static file.Path)
- (format (..archive fs static)
- (\ fs separator)
- "general_descriptor"))
-
-(def: #export (freeze fs static archive)
- (-> (file.System Promise) Static Archive (Promise (Try Any)))
- (\ fs write (archive.export ///.version archive) (..general_descriptor fs static)))
-
-(def: module_descriptor_file
- "module_descriptor")
-
-(def: (module_descriptor fs static module_id)
- (-> (file.System Promise) Static archive.ID file.Path)
- (format (..module fs static module_id)
- (\ fs separator)
- ..module_descriptor_file))
-
-(def: #export (cache fs static module_id content)
- (-> (file.System Promise) Static archive.ID Binary (Promise (Try Any)))
- (\ fs write content (..module_descriptor fs static module_id)))
-
-(def: (read_module_descriptor fs static module_id)
- (-> (file.System Promise) Static archive.ID (Promise (Try Binary)))
- (\ fs read (..module_descriptor fs static module_id)))
-
-(def: parser
- (Parser [Descriptor (Document .Module)])
- (<>.and descriptor.parser
- (document.parser $.parser)))
-
-(def: (fresh_analysis_state host)
- (-> Target .Lux)
- (analysis.state (analysis.info version.version host)))
-
-(def: (analysis_state host archive)
- (-> Target Archive (Try .Lux))
- (do {! try.monad}
- [modules (: (Try (List [Module .Module]))
- (monad.map ! (function (_ module)
- (do !
- [[descriptor document output] (archive.find module archive)
- content (document.read $.key document)]
- (wrap [module content])))
- (archive.archived archive)))]
- (wrap (set@ #.modules modules (fresh_analysis_state host)))))
-
-(def: (cached_artifacts fs static module_id)
- (-> (file.System Promise) Static archive.ID (Promise (Try (Dictionary Text Binary))))
- (let [! (try.with promise.monad)]
- (|> (..module fs static module_id)
- (\ fs directory_files)
- (\ ! map (|>> (list\map (function (_ file)
- [(file.name fs file) file]))
- (list.filter (|>> product.left (text\= ..module_descriptor_file) not))
- (monad.map ! (function (_ [name path])
- (|> path
- (\ fs read)
- (\ ! map (|>> [name])))))
- (\ ! map (dictionary.from_list text.hash))))
- (\ ! join))))
-
-(type: Definitions (Dictionary Text Any))
-(type: Analysers (Dictionary Text analysis.Handler))
-(type: Synthesizers (Dictionary Text synthesis.Handler))
-(type: Generators (Dictionary Text generation.Handler))
-(type: Directives (Dictionary Text directive.Handler))
-
-(type: Bundles
- [Analysers
- Synthesizers
- Generators
- Directives])
-
-(def: empty_bundles
- Bundles
- [(dictionary.new text.hash)
- (dictionary.new text.hash)
- (dictionary.new text.hash)
- (dictionary.new text.hash)])
-
-(def: (loaded_document extension host module_id expected actual document)
- (All [expression directive]
- (-> Text (generation.Host expression directive) archive.ID (Row Artifact) (Dictionary Text Binary) (Document .Module)
- (Try [(Document .Module) Bundles])))
- (do {! try.monad}
- [[definitions bundles] (: (Try [Definitions Bundles])
- (loop [input (row.to_list expected)
- definitions (: Definitions
- (dictionary.new text.hash))
- bundles ..empty_bundles]
- (let [[analysers synthesizers generators directives] bundles]
- (case input
- (#.Cons [[artifact_id artifact_category] input'])
- (case (do !
- [data (try.from_maybe (dictionary.get (format (%.nat artifact_id) extension) actual))
- #let [context [module_id artifact_id]
- directive (\ host ingest context data)]]
- (case artifact_category
- #artifact.Anonymous
- (do !
- [_ (\ host re_learn context directive)]
- (wrap [definitions
- [analysers
- synthesizers
- generators
- directives]]))
-
- (#artifact.Definition name)
- (if (text\= $/program.name name)
- (wrap [definitions
- [analysers
- synthesizers
- generators
- directives]])
- (do !
- [value (\ host re_load context directive)]
- (wrap [(dictionary.put name value definitions)
- [analysers
- synthesizers
- generators
- directives]])))
-
- (#artifact.Analyser extension)
- (do !
- [value (\ host re_load context directive)]
- (wrap [definitions
- [(dictionary.put extension (:as analysis.Handler value) analysers)
- synthesizers
- generators
- directives]]))
-
- (#artifact.Synthesizer extension)
- (do !
- [value (\ host re_load context directive)]
- (wrap [definitions
- [analysers
- (dictionary.put extension (:as synthesis.Handler value) synthesizers)
- generators
- directives]]))
-
- (#artifact.Generator extension)
- (do !
- [value (\ host re_load context directive)]
- (wrap [definitions
- [analysers
- synthesizers
- (dictionary.put extension (:as generation.Handler value) generators)
- directives]]))
-
- (#artifact.Directive extension)
- (do !
- [value (\ host re_load context directive)]
- (wrap [definitions
- [analysers
- synthesizers
- generators
- (dictionary.put extension (:as directive.Handler value) directives)]]))))
- (#try.Success [definitions' bundles'])
- (recur input' definitions' bundles')
-
- failure
- failure)
-
- #.None
- (#try.Success [definitions bundles])))))
- content (document.read $.key document)
- definitions (monad.map ! (function (_ [def_name def_global])
- (case def_global
- (#.Alias alias)
- (wrap [def_name (#.Alias alias)])
-
- (#.Definition [exported? type annotations _])
- (do !
- [value (try.from_maybe (dictionary.get def_name definitions))]
- (wrap [def_name (#.Definition [exported? type annotations value])]))))
- (get@ #.definitions content))]
- (wrap [(document.write $.key (set@ #.definitions definitions content))
- bundles])))
-
-(def: (load_definitions fs static module_id host_environment [descriptor document output])
- (All [expression directive]
- (-> (file.System Promise) Static archive.ID (generation.Host expression directive)
- [Descriptor (Document .Module) Output]
- (Promise (Try [[Descriptor (Document .Module) Output]
- Bundles]))))
- (do (try.with promise.monad)
- [actual (cached_artifacts fs static module_id)
- #let [expected (|> descriptor (get@ #descriptor.registry) artifact.artifacts)]
- [document bundles] (promise\wrap (loaded_document (get@ #static.artifact_extension static) host_environment module_id expected actual document))]
- (wrap [[descriptor document output] bundles])))
-
-(def: (purge! fs static [module_name module_id])
- (-> (file.System Promise) Static [Module archive.ID] (Promise (Try Any)))
- (do {! (try.with promise.monad)}
- [#let [cache (..module fs static module_id)]
- _ (|> cache
- (\ fs directory_files)
- (\ ! map (monad.map ! (\ fs delete)))
- (\ ! join))]
- (\ fs delete cache)))
-
-(def: (valid_cache? expected actual)
- (-> Descriptor Input Bit)
- (and (text\= (get@ #descriptor.name expected)
- (get@ #////.module actual))
- (text\= (get@ #descriptor.file expected)
- (get@ #////.file actual))
- (n.= (get@ #descriptor.hash expected)
- (get@ #////.hash actual))))
-
-(type: Purge
- (Dictionary Module archive.ID))
-
-(def: initial_purge
- (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module) Output]]]])
- Purge)
- (|>> (list.all (function (_ [valid_cache? [module_name [module_id _]]])
- (if valid_cache?
- #.None
- (#.Some [module_name module_id]))))
- (dictionary.from_list text.hash)))
-
-(def: (full_purge caches load_order)
- (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module) Output]]]])
- dependency.Order
- Purge)
- (list\fold (function (_ [module_name [module_id [descriptor document output]]] purge)
- (let [purged? (: (Predicate Module)
- (dictionary.key? purge))]
- (if (purged? module_name)
- purge
- (if (|> descriptor
- (get@ #descriptor.references)
- set.to_list
- (list.any? purged?))
- (dictionary.put module_name module_id purge)
- purge))))
- (..initial_purge caches)
- load_order))
-
-(def: pseudo_module
- Text
- "(Lux Caching System)")
-
-(def: (load_every_reserved_module host_environment fs static import contexts archive)
- (All [expression directive]
- (-> (generation.Host expression directive) (file.System Promise) Static Import (List Context) Archive
- (Promise (Try [Archive .Lux Bundles]))))
- (do {! (try.with promise.monad)}
- [pre_loaded_caches (|> archive
- archive.reservations
- (monad.map ! (function (_ [module_name module_id])
- (do !
- [data (..read_module_descriptor fs static module_id)
- [descriptor document] (promise\wrap (<binary>.run ..parser data))]
- (if (text\= archive.runtime_module module_name)
- (wrap [true
- [module_name [module_id [descriptor document (: Output row.empty)]]]])
- (do !
- [input (//context.read fs ..pseudo_module import contexts (get@ #static.host_module_extension static) module_name)]
- (wrap [(..valid_cache? descriptor input)
- [module_name [module_id [descriptor document (: Output row.empty)]]]])))))))
- load_order (|> pre_loaded_caches
- (list\map product.right)
- (monad.fold try.monad
- (function (_ [module [module_id descriptor,document,output]] archive)
- (archive.add module descriptor,document,output archive))
- archive)
- (\ try.monad map (dependency.load_order $.key))
- (\ try.monad join)
- promise\wrap)
- #let [purge (..full_purge pre_loaded_caches load_order)]
- _ (|> purge
- dictionary.entries
- (monad.map ! (..purge! fs static)))
- loaded_caches (|> load_order
- (list.filter (function (_ [module_name [module_id [descriptor document output]]])
- (not (dictionary.key? purge module_name))))
- (monad.map ! (function (_ [module_name [module_id descriptor,document,output]])
- (do !
- [[descriptor,document,output bundles] (..load_definitions fs static module_id host_environment descriptor,document,output)]
- (wrap [[module_name descriptor,document,output]
- bundles])))))]
- (promise\wrap
- (do {! try.monad}
- [archive (monad.fold !
- (function (_ [[module descriptor,document] _bundle] archive)
- (archive.add module descriptor,document archive))
- archive
- loaded_caches)
- analysis_state (..analysis_state (get@ #static.host static) archive)]
- (wrap [archive
- analysis_state
- (list\fold (function (_ [_ [+analysers +synthesizers +generators +directives]]
- [analysers synthesizers generators directives])
- [(dictionary.merge +analysers analysers)
- (dictionary.merge +synthesizers synthesizers)
- (dictionary.merge +generators generators)
- (dictionary.merge +directives directives)])
- ..empty_bundles
- loaded_caches)])))))
-
-(def: #export (thaw host_environment fs static import contexts)
- (All [expression directive]
- (-> (generation.Host expression directive) (file.System Promise) Static Import (List Context)
- (Promise (Try [Archive .Lux Bundles]))))
- (do promise.monad
- [binary (\ fs read (..general_descriptor fs static))]
- (case binary
- (#try.Success binary)
- (do (try.with promise.monad)
- [archive (promise\wrap (archive.import ///.version binary))]
- (..load_every_reserved_module host_environment fs static import contexts archive))
-
- (#try.Failure error)
- (wrap (#try.Success [archive.empty
- (fresh_analysis_state (get@ #static.host static))
- ..empty_bundles])))))
diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux
deleted file mode 100644
index f31b4e1b2..000000000
--- a/stdlib/source/lux/tool/compiler/meta/io/context.lux
+++ /dev/null
@@ -1,169 +0,0 @@
-(.module:
- [lux (#- Module Code)
- ["@" target]
- [abstract
- [predicate (#+ Predicate)]
- ["." monad (#+ Monad do)]]
- [control
- ["." try (#+ Try)]
- ["." exception (#+ exception:)]
- [concurrency
- ["." promise (#+ Promise) ("#\." monad)]]]
- [data
- [binary (#+ Binary)]
- ["." text ("#\." hash)
- ["%" format (#+ format)]
- [encoding
- ["." utf8]]]
- [collection
- ["." dictionary (#+ Dictionary)]]]
- [world
- ["." file]]]
- [program
- [compositor
- [import (#+ Import)]]]
- ["." // (#+ Context Code)
- ["/#" // #_
- [archive
- [descriptor (#+ Module)]]
- ["/#" // (#+ Input)]]])
-
-(exception: #export (cannot_find_module {importer Module} {module Module})
- (exception.report
- ["Module" (%.text module)]
- ["Importer" (%.text importer)]))
-
-(exception: #export (cannot_read_module {module Module})
- (exception.report
- ["Module" (%.text module)]))
-
-(type: #export Extension
- Text)
-
-(def: lux_extension
- Extension
- ".lux")
-
-(def: #export (path fs context module)
- (All [m] (-> (file.System m) Context Module file.Path))
- (|> module
- (//.sanitize fs)
- (format context (\ fs separator))))
-
-(def: (find_source_file fs importer contexts module extension)
- (-> (file.System Promise) Module (List Context) Module Extension
- (Promise (Try file.Path)))
- (case contexts
- #.Nil
- (promise\wrap (exception.throw ..cannot_find_module [importer module]))
-
- (#.Cons context contexts')
- (let [path (format (..path fs context module) extension)]
- (do promise.monad
- [? (\ fs file? path)]
- (if ?
- (wrap (#try.Success path))
- (find_source_file fs importer contexts' module extension))))))
-
-(def: (full_host_extension partial_host_extension)
- (-> Extension Extension)
- (format partial_host_extension ..lux_extension))
-
-(def: (find_local_source_file fs importer import contexts partial_host_extension module)
- (-> (file.System Promise) Module Import (List Context) Extension Module
- (Promise (Try [file.Path Binary])))
- ## Preference is explicitly being given to Lux files that have a host extension.
- ## Normal Lux files (i.e. without a host extension) are then picked as fallback files.
- (do {! promise.monad}
- [outcome (..find_source_file fs importer contexts module (..full_host_extension partial_host_extension))]
- (case outcome
- (#try.Success path)
- (|> path
- (\ fs read)
- (\ (try.with !) map (|>> [path])))
-
- (#try.Failure _)
- (do {! (try.with !)}
- [path (..find_source_file fs importer contexts module ..lux_extension)]
- (|> path
- (\ fs read)
- (\ ! map (|>> [path])))))))
-
-(def: (find_library_source_file importer import partial_host_extension module)
- (-> Module Import Extension Module (Try [file.Path Binary]))
- (let [path (format module (..full_host_extension partial_host_extension))]
- (case (dictionary.get path import)
- (#.Some data)
- (#try.Success [path data])
-
- #.None
- (let [path (format module ..lux_extension)]
- (case (dictionary.get path import)
- (#.Some data)
- (#try.Success [path data])
-
- #.None
- (exception.throw ..cannot_find_module [importer module]))))))
-
-(def: (find_any_source_file fs importer import contexts partial_host_extension module)
- (-> (file.System Promise) Module Import (List Context) Extension Module
- (Promise (Try [file.Path Binary])))
- ## Preference is explicitly being given to Lux files that have a host extension.
- ## Normal Lux files (i.e. without a host extension) are then picked as fallback files.
- (do {! promise.monad}
- [outcome (find_local_source_file fs importer import contexts partial_host_extension module)]
- (case outcome
- (#try.Success [path data])
- (wrap outcome)
-
- (#try.Failure _)
- (wrap (..find_library_source_file importer import partial_host_extension module)))))
-
-(def: #export (read fs importer import contexts partial_host_extension module)
- (-> (file.System Promise) Module Import (List Context) Extension Module
- (Promise (Try Input)))
- (do (try.with promise.monad)
- [[path binary] (..find_any_source_file fs importer import contexts partial_host_extension module)]
- (case (\ utf8.codec decode binary)
- (#try.Success code)
- (wrap {#////.module module
- #////.file path
- #////.hash (text\hash code)
- #////.code code})
-
- (#try.Failure _)
- (promise\wrap (exception.throw ..cannot_read_module [module])))))
-
-(type: #export Enumeration
- (Dictionary file.Path Binary))
-
-(def: (enumerate_context fs directory enumeration)
- (-> (file.System Promise) Context Enumeration (Promise (Try Enumeration)))
- (do {! (try.with promise.monad)}
- [enumeration (|> directory
- (\ fs directory_files)
- (\ ! map (monad.fold ! (function (_ file enumeration)
- (if (text.ends_with? ..lux_extension file)
- (do !
- [source_code (\ fs read file)]
- (promise\wrap
- (dictionary.try_put (file.name fs file) source_code enumeration)))
- (wrap enumeration)))
- enumeration))
- (\ ! join))]
- (|> directory
- (\ fs sub_directories)
- (\ ! map (monad.fold ! (enumerate_context fs) enumeration))
- (\ ! join))))
-
-(def: Action
- (type (All [a] (Promise (Try a)))))
-
-(def: #export (enumerate fs contexts)
- (-> (file.System Promise) (List Context) (Action Enumeration))
- (monad.fold (: (Monad Action)
- (try.with promise.monad))
- (..enumerate_context fs)
- (: Enumeration
- (dictionary.new text.hash))
- contexts))
diff --git a/stdlib/source/lux/tool/compiler/meta/packager.lux b/stdlib/source/lux/tool/compiler/meta/packager.lux
deleted file mode 100644
index fff07d28f..000000000
--- a/stdlib/source/lux/tool/compiler/meta/packager.lux
+++ /dev/null
@@ -1,42 +0,0 @@
-(.module:
- [lux #*
- [abstract
- [monad (#+ Monad)]]
- [control
- [try (#+ Try)]]
- [data
- [binary (#+ Binary)]
- [collection
- ["." row]
- ["." list ("#\." functor)]]]
- [world
- ["." file (#+ Path)]]]
- [program
- [compositor
- [static (#+ Static)]]]
- [//
- [cache
- ["." dependency]]
- ["." archive (#+ Archive)
- ["." descriptor]
- ["." artifact]]
- [//
- [language
- [lux
- [generation (#+ Context)]]]]])
-
-(type: #export Packager
- (-> Archive Context (Try Binary)))
-
-(type: #export Order
- (List [archive.ID (List artifact.ID)]))
-
-(def: #export order
- (-> dependency.Order Order)
- (list\map (function (_ [module [module_id [descriptor document]]])
- (|> descriptor
- (get@ #descriptor.registry)
- artifact.artifacts
- row.to_list
- (list\map (|>> (get@ #artifact.id)))
- [module_id]))))
diff --git a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux
deleted file mode 100644
index a89bdc836..000000000
--- a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux
+++ /dev/null
@@ -1,144 +0,0 @@
-(.module:
- [lux (#- Module Definition)
- [type (#+ :share)]
- ["." ffi (#+ import: do_to)]
- [abstract
- ["." monad (#+ Monad do)]]
- [control
- ["." try (#+ Try)]
- [concurrency
- ["." promise (#+ Promise)]]]
- [data
- ["." binary (#+ Binary)]
- ["." text
- ["%" format (#+ format)]]
- [collection
- ["." row (#+ Row) ("#\." fold)]
- ["." list ("#\." functor fold)]]]
- [math
- [number
- ["n" nat]]]
- [target
- [jvm
- [encoding
- ["." name]]]]]
- [program
- [compositor
- ["." static (#+ Static)]]]
- ["." // (#+ Packager)
- [//
- ["." archive (#+ Output)
- ["." descriptor (#+ Module)]
- ["." artifact]]
- [cache
- ["." dependency]]
- ["." io #_
- ["#" archive]]
- [//
- [language
- ["$" lux
- [generation (#+ Context)]
- [phase
- [generation
- [jvm
- ["." runtime (#+ Definition)]]]]]]]]])
-
-(import: java/lang/Object)
-
-(import: java/lang/String)
-
-(import: java/util/jar/Attributes
- ["#::."
- (put [java/lang/Object java/lang/Object] #? java/lang/Object)])
-
-(import: java/util/jar/Attributes$Name
- ["#::."
- (#static MAIN_CLASS java/util/jar/Attributes$Name)
- (#static MANIFEST_VERSION java/util/jar/Attributes$Name)])
-
-(import: java/util/jar/Manifest
- ["#::."
- (new [])
- (getMainAttributes [] java/util/jar/Attributes)])
-
-(import: java/io/Flushable
- ["#::."
- (flush [] void)])
-
-(import: java/io/Closeable
- ["#::."
- (close [] void)])
-
-(import: java/io/OutputStream)
-
-(import: java/io/ByteArrayOutputStream
- ["#::."
- (new [int])
- (toByteArray [] [byte])])
-
-(import: java/util/zip/ZipEntry)
-
-(import: java/util/zip/ZipOutputStream
- ["#::."
- (write [[byte] int int] void)
- (closeEntry [] void)])
-
-(import: java/util/jar/JarEntry
- ["#::."
- (new [java/lang/String])])
-
-(import: java/util/jar/JarOutputStream
- ["#::."
- (new [java/io/OutputStream java/util/jar/Manifest])
- (putNextEntry [java/util/zip/ZipEntry] void)])
-
-(def: byte 1)
-## https://en.wikipedia.org/wiki/Kibibyte
-(def: kibi_byte (n.* 1,024 byte))
-## https://en.wikipedia.org/wiki/Mebibyte
-(def: mebi_byte (n.* 1,024 kibi_byte))
-
-(def: manifest_version "1.0")
-
-(def: (manifest program)
- (-> Context java/util/jar/Manifest)
- (let [manifest (java/util/jar/Manifest::new)]
- (exec (do_to (java/util/jar/Manifest::getMainAttributes manifest)
- (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MAIN_CLASS) (|> program runtime.class_name name.internal name.external))
- (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MANIFEST_VERSION) ..manifest_version))
- manifest)))
-
-(def: (write_class static module artifact content sink)
- (-> Static archive.ID artifact.ID Binary java/util/jar/JarOutputStream
- java/util/jar/JarOutputStream)
- (let [class_path (format (runtime.class_name [module artifact])
- (get@ #static.artifact_extension static))]
- (do_to sink
- (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new class_path))
- (java/util/zip/ZipOutputStream::write content +0 (.int (binary.size content)))
- (java/io/Flushable::flush)
- (java/util/zip/ZipOutputStream::closeEntry))))
-
-(def: (write_module static [module output] sink)
- (-> Static [archive.ID Output] java/util/jar/JarOutputStream
- java/util/jar/JarOutputStream)
- (row\fold (function (_ [artifact content] sink)
- (..write_class static module artifact content sink))
- sink
- output))
-
-(def: #export (package static)
- (-> Static Packager)
- (function (_ archive program)
- (do {! try.monad}
- [order (dependency.load_order $.key archive)
- #let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi_byte))
- sink (|> order
- (list\map (function (_ [module [module_id [descriptor document output]]])
- [module_id output]))
- (list\fold (..write_module static)
- (java/util/jar/JarOutputStream::new buffer (..manifest program))))
- _ (do_to sink
- (java/io/Flushable::flush)
- (java/io/Closeable::close))]]
- (wrap (java/io/ByteArrayOutputStream::toByteArray buffer)))))
diff --git a/stdlib/source/lux/tool/compiler/meta/packager/scheme.lux b/stdlib/source/lux/tool/compiler/meta/packager/scheme.lux
deleted file mode 100644
index ac35684ed..000000000
--- a/stdlib/source/lux/tool/compiler/meta/packager/scheme.lux
+++ /dev/null
@@ -1,131 +0,0 @@
-(.module:
- [lux (#- Module)
- [type (#+ :share)]
- [abstract
- ["." monad (#+ Monad do)]]
- [control
- ["." try (#+ Try)]]
- [data
- [binary (#+ Binary)]
- ["." product]
- ["." text
- ["%" format (#+ format)]
- ["." encoding]]
- [collection
- ["." row]
- ["." list ("#\." functor fold)]
- ["." dictionary (#+ Dictionary)]
- ["." set]]
- [format
- ["." tar]
- ["." binary]]]
- [target
- ["_" scheme]]
- [time
- ["." instant (#+ Instant)]]
- [world
- ["." file]]]
- [program
- [compositor
- ["." static (#+ Static)]]]
- ["." // (#+ Packager)
- [//
- ["." archive (#+ Output)
- ["." descriptor (#+ Module Descriptor)]
- ["." artifact]
- ["." document (#+ Document)]]
- [cache
- ["." dependency]]
- ["." io #_
- ["#" archive]]
- [//
- [language
- ["$" lux
- [generation (#+ Context)]]]]]])
-
-## TODO: Delete ASAP
-(type: (Action ! a)
- (! (Try a)))
-
-(def: (then pre post)
- (-> _.Expression _.Expression _.Expression)
- (_.manual (format (_.code pre)
- text.new_line
- (_.code post))))
-
-(def: bundle_module
- (-> Output (Try _.Expression))
- (|>> row.to_list
- (list\map product.right)
- (monad.fold try.monad
- (function (_ content so_far)
- (|> content
- (\ encoding.utf8 decode)
- (\ try.monad map
- (|>> :assume
- (:share [directive]
- directive
- so_far
-
- directive)
- (..then so_far)))))
- (: _.Expression (_.manual "")))))
-
-(def: module_file
- (-> archive.ID file.Path)
- (|>> %.nat (text.suffix ".scm")))
-
-(def: mode
- tar.Mode
- ($_ tar.and
- tar.read_by_group
- tar.read_by_owner
-
- tar.write_by_other
- tar.write_by_group
- tar.write_by_owner))
-
-(def: owner
- tar.Owner
- {#tar.name tar.anonymous
- #tar.id tar.no_id})
-
-(def: ownership
- {#tar.user ..owner
- #tar.group ..owner})
-
-(def: (write_module now mapping [module [module_id [descriptor document output]]])
- (-> Instant (Dictionary Module archive.ID)
- [Module [archive.ID [Descriptor (Document .Module) Output]]]
- (Try tar.Entry))
- (do {! try.monad}
- [bundle (: (Try _.Expression)
- (..bundle_module output))
- entry_content (: (Try tar.Content)
- (|> descriptor
- (get@ #descriptor.references)
- set.to_list
- (list.all (function (_ module) (dictionary.get module mapping)))
- (list\map (|>> ..module_file _.string _.load-relative/1))
- (list\fold ..then bundle)
- (: _.Expression)
- _.code
- (\ encoding.utf8 encode)
- tar.content))
- module_file (tar.path (..module_file module_id))]
- (wrap (#tar.Normal [module_file now ..mode ..ownership entry_content]))))
-
-(def: #export (package now)
- (-> Instant Packager)
- (function (package archive program)
- (do {! try.monad}
- [order (dependency.load_order $.key archive)
- #let [mapping (|> order
- (list\map (function (_ [module [module_id [descriptor document output]]])
- [module module_id]))
- (dictionary.from_list text.hash)
- (: (Dictionary Module archive.ID)))]
- entries (monad.map ! (..write_module now mapping) order)]
- (wrap (|> entries
- row.from_list
- (binary.run tar.writer))))))
diff --git a/stdlib/source/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/lux/tool/compiler/meta/packager/script.lux
deleted file mode 100644
index 98a011a4c..000000000
--- a/stdlib/source/lux/tool/compiler/meta/packager/script.lux
+++ /dev/null
@@ -1,75 +0,0 @@
-(.module:
- [lux #*
- [type (#+ :share)]
- [abstract
- ["." monad (#+ Monad do)]]
- [control
- ["." try (#+ Try)]]
- [data
- [binary (#+ Binary)]
- ["." product]
- [text
- ["%" format (#+ format)]
- [encoding
- ["." utf8]]]
- [collection
- ["." row]
- ["." list ("#\." functor)]]]]
- [program
- [compositor
- ["." static (#+ Static)]]]
- ["." // (#+ Packager)
- [//
- ["." archive (#+ Output)
- ["." descriptor]
- ["." artifact]]
- [cache
- ["." dependency]]
- ["." io #_
- ["#" archive]]
- [//
- [language
- ["$" lux
- [generation (#+ Context)]]]]]])
-
-## TODO: Delete ASAP
-(type: (Action ! a)
- (! (Try a)))
-
-(def: (write_module sequence [module output] so_far)
- (All [directive]
- (-> (-> directive directive directive) [archive.ID Output] directive
- (Try directive)))
- (|> output
- row.to_list
- (list\map product.right)
- (monad.fold try.monad
- (function (_ content so_far)
- (|> content
- (\ utf8.codec decode)
- (\ try.monad map
- (function (_ content)
- (sequence so_far
- (:share [directive]
- directive
- so_far
-
- directive
- (:assume content)))))))
- so_far)))
-
-(def: #export (package header to_code sequence scope)
- (All [directive]
- (-> directive
- (-> directive Text)
- (-> directive directive directive)
- (-> directive directive)
- Packager))
- (function (package archive program)
- (do {! try.monad}
- [order (dependency.load_order $.key archive)]
- (|> order
- (list\map (function (_ [module [module_id [descriptor document output]]])
- [module_id output]))
- (monad.fold ! (..write_module sequence) header)
- (\ ! map (|>> scope to_code (\ utf8.codec encode)))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-13 02:34:37 +0000