diff options
Diffstat (limited to '')
18 files changed, 476 insertions, 85 deletions
diff --git a/documentation/bookmark/arithmetic.md b/documentation/bookmark/arithmetic.md index c58dd4923..e4a3ddd07 100644 --- a/documentation/bookmark/arithmetic.md +++ b/documentation/bookmark/arithmetic.md @@ -4,6 +4,7 @@ # Interval +1. [Interval Arithmetic: Not All Intervals are Created Equal](https://samlikes.pizza/pluto_interval_blog.jl.html) 1. [Growing a Language, by Guy Steele](https://www.youtube.com/watch?v=_ahvzDzKdB0&t=2214s) 1. [Yet another alternative to floating-point numbers](https://wordsandbuttons.online/yet_another_alternative_to_floating_point_numbers.html) 1. [Interval arithmetic](https://en.wikipedia.org/wiki/Interval_arithmetic) diff --git a/documentation/bookmark/distributed_programming.md b/documentation/bookmark/distributed_programming.md index 57802f081..c3b6edf46 100644 --- a/documentation/bookmark/distributed_programming.md +++ b/documentation/bookmark/distributed_programming.md @@ -9,6 +9,7 @@ # Reference +1. [No more DSLs: Implement and deploy a distributed system with a single program](http://catern.com/integration.html) 1. [Ambients: Peer-to-Peer Programs and Data](https://ipfs.io/ipfs/QmPhPJE55GvqSz7Pwvkc8n9dbKmqGw6tUGTE1MgfNQvzsf) 1. [Bastion: Highly-available Distributed Fault-tolerant Runtime](https://bastion.rs/) 1. [DDD and Messaging Architectures: An overview of my different series on patterns in distributed systems.](http://verraes.net/2019/05/ddd-msg-arch/) diff --git a/documentation/bookmark/format/zip.md b/documentation/bookmark/format/zip.md new file mode 100644 index 000000000..25dc93b9f --- /dev/null +++ b/documentation/bookmark/format/zip.md @@ -0,0 +1,5 @@ +# Reference + +1. [Zip - How not to design a file format.](https://games.greggman.com/game/zip-rant/) +1. [ZIP File Format Specification](https://pkware.cachefly.net/webdocs/casestudies/APPNOTE.TXT) + diff --git a/documentation/bookmark/free.md b/documentation/bookmark/free.md new file mode 100644 index 000000000..719b43f78 --- /dev/null +++ b/documentation/bookmark/free.md @@ -0,0 +1,4 @@ +# Reference + +1. [](http://poly.pizza/) + diff --git a/documentation/bookmark/inspiration.md b/documentation/bookmark/inspiration.md index 87b095b6f..576d73f99 100644 --- a/documentation/bookmark/inspiration.md +++ b/documentation/bookmark/inspiration.md @@ -1,3 +1,7 @@ +# Business + +1. [Why Aren't There More Programming Languages Startups?](https://www.akitasoftware.com/blog-posts/why-arent-there-more-programming-languages-startups) + # Tool 1. [Toward the next generation of programming tools: Programmers have built great tools for others. It’s time they built some for themselves.](https://www.oreilly.com/radar/toward-the-next-generation-of-programming-tools/) diff --git a/documentation/bookmark/recursion_schemes.md b/documentation/bookmark/recursion_schemes.md index 94951b99c..5c41438df 100644 --- a/documentation/bookmark/recursion_schemes.md +++ b/documentation/bookmark/recursion_schemes.md @@ -1,5 +1,6 @@ # Reference +1. [Probability Tree Diagrams. Recursion Schemes. Why Finding the Right Solution is Sometimes Hard?](https://rpeszek.github.io/posts/2021-07-18-prob-tree-scheme.html) 1. [Unifying Structured Recursion Schemes](https://www.cs.ox.ac.uk/people/nicolas.wu/papers/URS.pdf) 1. http://maartenfokkinga.github.io/utwente/mmf91m.pdf 1. http://blog.sumtypeofway.com/an-introduction-to-recursion-schemes/ diff --git a/documentation/bookmark/web_framework.md b/documentation/bookmark/web_framework.md index 48d7e827c..7e8a36a48 100644 --- a/documentation/bookmark/web_framework.md +++ b/documentation/bookmark/web_framework.md @@ -118,6 +118,7 @@ # Styling +1. [CSS Protips](https://github.com/AllThingsSmitty/css-protips) 1. [Layout-isolated components](https://visly.app/blog/layout-isolated-components) 1. [Centering in CSS: A Complete Guide](https://css-tricks.com/centering-css-complete-guide/) 1. [Vertical Rhythm Reset](https://jhildenbiddle.github.io/vertical-rhythm-reset/) diff --git a/stdlib/source/library/lux/program.lux b/stdlib/source/library/lux/program.lux index bd486796b..51c22c701 100644 --- a/stdlib/source/library/lux/program.lux +++ b/stdlib/source/library/lux/program.lux @@ -73,7 +73,8 @@ [(~+ (|> args (list\map (function (_ [binding parser]) (list binding parser))) - list\join))] + list\join)) + (~ g!_) (~! <cli>.end)] ((~' wrap) (~ initialization+event_loop)))) (~ g!args)) (#.Right (~ g!output)) diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index bc0e9b3cc..3d3f4cde0 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -520,7 +520,7 @@ (def: #export (compile import static expander platform compilation context) (All [<type_vars>] (-> Import Static Expander <Platform> Compilation <Context> <Return>)) - (let [[compilation_sources compilation_libraries compilation_target compilation_module] compilation + (let [[compilation_sources compilation_host_dependencies compilation_libraries compilation_target compilation_module] compilation base_compiler (:share [<type_vars>] <Context> context diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager.lux b/stdlib/source/library/lux/tool/compiler/meta/packager.lux index 621045e33..6cb17c7b6 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager.lux @@ -1,20 +1,16 @@ (.module: [library [lux #* - [abstract - [monad (#+ Monad)]] [control [try (#+ Try)]] [data [binary (#+ Binary)] [collection + [dictionary (#+ Dictionary)] ["." row] ["." list ("#\." functor)]]] [world - ["." file (#+ Path)]]]] - [program - [compositor - [static (#+ Static)]]] + ["." file]]]] [// [cache ["." dependency]] @@ -27,7 +23,10 @@ [generation (#+ Context)]]]]]) (type: #export Packager - (-> Archive Context (Try Binary))) + (-> (Dictionary file.Path Binary) + Archive + Context + (Try Binary))) (type: #export Order (List [archive.ID (List 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 7e79903d5..7794d3f5e 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux @@ -15,15 +15,20 @@ ["." text ["%" format (#+ format)]] [collection - ["." row (#+ Row) ("#\." fold)] - ["." list ("#\." functor fold)]]] + ["." row] + ["." list ("#\." functor)] + ["." dictionary] + ["." set (#+ Set)]]] [math [number - ["n" nat]]] + ["n" nat] + ["i" int]]] [target [jvm [encoding - ["." name]]]]]] + ["." name]]]] + [world + ["." file]]]] [program [compositor ["." static (#+ Static)]]] @@ -71,14 +76,20 @@ ["#::." (close [] void)]) -(import: java/io/OutputStream) +(import: java/io/OutputStream + ["#::." + (write [[byte] int int] void)]) (import: java/io/ByteArrayOutputStream ["#::." (new [int]) (toByteArray [] [byte])]) -(import: java/util/zip/ZipEntry) +(import: java/util/zip/ZipEntry + ["#::." + (getName [] java/lang/String) + (isDirectory [] boolean) + (getSize [] long)]) (import: java/util/zip/ZipOutputStream ["#::." @@ -92,15 +103,34 @@ (import: java/util/jar/JarOutputStream ["#::." (new [java/io/OutputStream java/util/jar/Manifest]) - (putNextEntry [java/util/zip/ZipEntry] void)]) + (putNextEntry [java/util/zip/ZipEntry] #try void)]) + +(import: java/io/ByteArrayInputStream + ["#::." + (new [[byte]])]) + +(import: java/io/InputStream + ["#::." + (read [[byte] int int] int)]) + +(import: java/util/jar/JarInputStream + ["#::." + (new [java/io/InputStream]) + (getNextJarEntry [] #try #? java/util/jar/JarEntry)]) + +(def: byte + 1) -(def: byte 1) ## https://en.wikipedia.org/wiki/Kibibyte -(def: kibi_byte (n.* 1,024 byte)) +(def: kibi_byte + (n.* 1,024 byte)) + ## https://en.wikipedia.org/wiki/Mebibyte -(def: mebi_byte (n.* 1,024 kibi_byte)) +(def: mebi_byte + (n.* 1,024 kibi_byte)) -(def: manifest_version "1.0") +(def: manifest_version + "1.0") (def: (manifest program) (-> Context java/util/jar/Manifest) @@ -112,37 +142,127 @@ (def: (write_class static module artifact custom content sink) (-> Static archive.ID artifact.ID (Maybe Text) Binary java/util/jar/JarOutputStream - java/util/jar/JarOutputStream) + (Try java/util/jar/JarOutputStream)) (let [class_path (|> custom (maybe\map (|>> name.internal name.read)) (maybe.default (runtime.class_name [module artifact])) (text.suffix (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)))) + (do try.monad + [_ (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new class_path) sink)] + (wrap (do_to sink + (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 custom content] sink) - (..write_class static module artifact custom content sink)) - sink - output)) + (Try java/util/jar/JarOutputStream)) + (monad.fold try.monad + (function (_ [artifact custom content] sink) + (..write_class static module artifact custom content sink)) + sink + (row.to_list output))) + +(def: (read_jar_entry_with_unknown_size input) + (-> java/util/jar/JarInputStream [Nat Binary]) + (let [chunk (binary.create ..mebi_byte) + chunk_size (.int ..mebi_byte) + buffer (java/io/ByteArrayOutputStream::new chunk_size)] + (loop [so_far 0] + (case (java/io/InputStream::read chunk 0 chunk_size input) + -1 + [so_far + (java/io/ByteArrayOutputStream::toByteArray buffer)] + + bytes_read + (exec + (java/io/OutputStream::write chunk +0 bytes_read buffer) + (recur (|> bytes_read .nat (n.+ so_far)))))))) + +(def: (read_jar_entry_with_known_size expected_size input) + (-> Nat java/util/jar/JarInputStream [Nat Binary]) + (let [buffer (binary.create expected_size)] + (loop [so_far 0] + (let [so_far' (|> input + (java/io/InputStream::read buffer (.int so_far) (.int (n.- so_far expected_size))) + .nat + (n.+ so_far))] + (if (n.= expected_size so_far') + [expected_size buffer] + (recur so_far')))))) + +(def: (read_jar_entry entry input) + (-> java/util/jar/JarEntry java/util/jar/JarInputStream [Nat Binary]) + (case (java/util/zip/ZipEntry::getSize entry) + -1 + (..read_jar_entry_with_unknown_size input) + + entry_size + (..read_jar_entry_with_known_size (.nat entry_size) input))) + +(def: (write_host_dependency jar [entries duplicates sink]) + (-> Binary + [(Set file.Path) (Set file.Path) java/util/jar/JarOutputStream] + (Try [(Set file.Path) (Set file.Path) java/util/jar/JarOutputStream])) + (let [input (|> jar + java/io/ByteArrayInputStream::new + java/util/jar/JarInputStream::new)] + (loop [entries entries + duplicates duplicates + sink sink] + (case (java/util/jar/JarInputStream::getNextJarEntry input) + (#try.Failure error) + (#try.Failure error) + + (#try.Success ?entry) + (case ?entry + #.None + (exec + (java/io/Closeable::close input) + (#try.Success [entries duplicates sink])) + + (#.Some entry) + (let [entry_path (java/util/zip/ZipEntry::getName entry) + entry_size (java/util/zip/ZipEntry::getSize entry)] + (if (not (or (java/util/zip/ZipEntry::isDirectory entry) + (text.starts_with? "META-INF/maven/" entry_path) + (text.starts_with? "META-INF/leiningen/" entry_path))) + (case (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new entry_path) sink) + (#try.Failure error) + (recur entries + (set.add entry_path duplicates) + sink) + + (#try.Success _) + (let [[entry_size entry_data] (read_jar_entry entry input)] + (recur (set.add entry_path entries) + duplicates + (do_to sink + (java/util/zip/ZipOutputStream::write entry_data +0 (.int entry_size)) + (java/io/Flushable::flush) + (java/util/zip/ZipOutputStream::closeEntry))))) + (recur entries + duplicates + sink)))))))) (def: #export (package static) (-> Static Packager) - (function (_ archive program) + (function (_ host_dependencies 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 + #let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi_byte))] + sink (|> order + (list\map (function (_ [module [module_id [descriptor document output]]]) + [module_id output])) + (monad.fold ! (..write_module static) + (java/util/jar/JarOutputStream::new buffer (..manifest program)))) + [entries duplicates sink] (|> host_dependencies + dictionary.values + (monad.fold ! ..write_host_dependency + [(set.new text.hash) + (set.new text.hash) + sink])) + #let [_ (do_to sink (java/io/Flushable::flush) (java/io/Closeable::close))]] (wrap (java/io/ByteArrayOutputStream::toByteArray buffer))))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux index bcd06b6fd..514de6852 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux @@ -118,7 +118,7 @@ (def: #export (package now) (-> Instant Packager) - (function (package archive program) + (function (package host_dependencies archive program) (do {! try.monad} [order (dependency.load_order $.key archive) #let [mapping (|> order diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux index 36b1db690..404b3d800 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux @@ -61,7 +61,7 @@ (-> directive directive directive) (-> directive directive) Packager)) - (function (package archive program) + (function (package host_dependencies archive program) (do {! try.monad} [order (dependency.load_order $.key archive)] (|> order diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index c0f9566a8..17301333a 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -1,7 +1,9 @@ (.module: [library [lux (#- Name) + ["." ffi (#+ import:)] [abstract + [order (#+ Order)] [monad (#+ do)]] [control ["." try (#+ Try)] @@ -12,14 +14,15 @@ [data ["." product] ["." maybe] - ["." text ("#\." equivalence) + ["." text ("#\." order) ["%" format (#+ format)]] [collection - ["." list ("#\." functor)] - ["." dictionary] + ["." list ("#\." functor fold)] + ["." dictionary (#+ Dictionary)] ["." set]]] [math [number + ["n" nat] ["i" int]]] [world ["." program (#+ Program)] @@ -37,7 +40,7 @@ ["#." runtime] ["#." dependency (#+ Dependency) ["#/." resolution (#+ Resolution)]] - ["#." artifact (#+ Group Name Artifact) + ["#." artifact (#+ Group Name Version Artifact) ["#/." type]]]) (type: Finder @@ -119,9 +122,62 @@ (def: (libraries fs home) (All [!] (-> (file.System !) Path Resolution (List Path))) (|>> dictionary.keys - (list.filter (|>> (get@ #///dependency.type) (text\= ///artifact/type.lux_library))) + (list.filter (|>> (get@ #///dependency.type) + (text\= ///artifact/type.lux_library))) (list\map (..path fs home)))) +(def: version_separator + ".") + +(implementation: version_order + (Order Version) + + (def: &equivalence + text.equivalence) + + (def: (< left right) + (loop [left (text.split_all_with ..version_separator left) + right (text.split_all_with ..version_separator right)] + (case [left right] + [(#.Cons leftH leftT) (#.Cons rightH rightT)] + (if (text\= leftH rightH) + (recur leftT rightT) + (or (n.< (text.size leftH) (text.size rightH)) + (text\< leftH rightH))) + + [(#.Cons leftH leftT) #.Nil] + false + + [#.Nil (#.Cons rightH rightT)] + true + + [#.Nil #.Nil] + false)))) + +(def: #export (host_dependencies fs home) + (All [!] (-> (file.System !) Path Resolution (List Path))) + (|>> dictionary.keys + (list.filter (|>> (get@ #///dependency.type) + (text\= ///artifact/type.lux_library) + not)) + (list\fold (function (_ dependency uniques) + (let [artifact (get@ #///dependency.artifact dependency) + identity [(get@ #///artifact.group artifact) + (get@ #///artifact.name artifact)] + version (get@ #///artifact.version artifact)] + (case (dictionary.get identity uniques) + (#.Some [current_version current_path]) + (if (\ version_order < version current_version) + (dictionary.put identity [version dependency] uniques) + uniques) + + #.None + (dictionary.put identity [version dependency] uniques)))) + (: (Dictionary [Group Name] [Version Dependency]) + (dictionary.new (product.hash text.hash text.hash)))) + dictionary.values + (list\map (|>> product.right (..path fs home))))) + (def: (singular name) (-> Text Text (List Text)) (|>> (list name))) @@ -169,6 +225,41 @@ [log_error! error] ) +(import: java/lang/System + ["#::." + (#static getProperty [java/lang/String] #io #try java/lang/String)]) + +(def: windows? + Bit + (|> (java/lang/System::getProperty "os.name") + io.run + (try.default "") + text.lower_case + (text.starts_with? "windows"))) + +(def: jvm_class_path_separator + (if windows? + ";" + ":")) + +(def: (jvm_class_path host_dependencies) + (-> (List Path) Text) + (|> host_dependencies + (#.Cons ".") + (text.join_with ..jvm_class_path_separator) + %.text)) + +(def: #export (with_jvm_class_path host_dependencies runtime) + (-> (List Path) ///runtime.Runtime ///runtime.Runtime) + (case host_dependencies + #.Nil + runtime + + _ + (update@ #///runtime.parameters + (|>> (list& "-classpath" (..jvm_class_path host_dependencies))) + runtime))) + (def: #export (do! console program fs shell resolution) (-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command [Exit Compiler Path])) (function (_ profile) @@ -184,29 +275,37 @@ working_directory (\ program directory)]] (do ///action.monad [[resolution compiler] (promise\wrap (..compiler resolution (get@ #///.compiler profile))) - #let [[[command compiler_params] output] (case compiler + #let [host_dependencies (..host_dependencies fs home resolution) + [[command compiler_params] output] (case compiler + (#JVM dependency) + [(|> (..path fs home dependency) + (///runtime.for (get@ #///.java profile)) + (with_jvm_class_path host_dependencies)) + "program.jar"] + (^template [<tag> <runtime> <program>] [(<tag> dependency) [(///runtime.for (get@ <runtime> profile) (..path fs home dependency)) <program>]]) - ([#JVM #///.java "program.jar"] - [#JS #///.js "program.js"] + ([#JS #///.js "program.js"] [#Python #///.java "program.py"] [#Lua #///.java "program.lua"] [#Ruby #///.java "program.rb"])) / (\ fs separator) cache_directory (format working_directory / target)] _ (console.write_line ..start console) + #let [full_parameters (list.concat (list compiler_params + (list "build") + (..plural "--library" (..libraries fs home resolution)) + (..plural "--host_dependency" host_dependencies) + (..plural "--source" (set.to_list (get@ #///.sources profile))) + (..singular "--target" cache_directory) + (..singular "--module" program_module)))] process (\ shell execute [environment working_directory command - (list.concat (list compiler_params - (list "build") - (..plural "--library" (..libraries fs home resolution)) - (..plural "--source" (set.to_list (get@ #///.sources profile))) - (..singular "--target" cache_directory) - (..singular "--module" program_module)))]) + full_parameters]) _ (..log_output! console process) _ (..log_error! console process) exit (\ process await []) diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux index 65f2bdc4e..1f32b2fc2 100644 --- a/stdlib/source/program/aedifex/command/test.lux +++ b/stdlib/source/program/aedifex/command/test.lux @@ -34,15 +34,23 @@ [environment (program.environment promise.monad program) #let [working_directory (\ program directory)]] (do {! ///action.monad} - [[build_exit compiler program] (//build.do! console program fs shell resolution + [#let [home (\ program home)] + [build_exit compiler program] (//build.do! console program fs shell resolution (set@ #///.program (get@ #///.test profile) profile))] (if (i.= shell.normal build_exit) (do ! [_ (console.write_line ..start console) - #let [[test_command test_parameters] (case compiler + #let [host_dependencies (//build.host_dependencies fs home resolution) + [test_command test_parameters] (case compiler + (#//build.JVM dependency) + (|> program + (///runtime.for (get@ #///.java profile)) + (//build.with_jvm_class_path host_dependencies)) + (^template [<tag> <runtime>] [(<tag> artifact) - (///runtime.for (get@ <runtime> profile) program)]) + (///runtime.for (get@ <runtime> profile) + program)]) ([#//build.JVM #///.java] [#//build.JS #///.js] [#//build.Python #///.python] diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index bc96e7ae0..aa3239de2 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -17,7 +17,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." dictionary] + ["." dictionary (#+ Dictionary)] ["." row (#+ Row)]]] [time ["." instant]] @@ -84,15 +84,32 @@ (format "Duration: ")))]] (wrap output))) -(def: (package! fs [packager package] static archive context) - (-> (file.System Promise) [Packager file.Path] Static Archive Context (Promise (Try Any))) - (case (packager archive context) +(def: (package! fs host_dependencies [packager package] static archive context) + (-> (file.System Promise) (Dictionary file.Path Binary) [Packager file.Path] Static Archive Context (Promise (Try Any))) + (case (packager host_dependencies archive context) (#try.Success content) (\ fs write content package) (#try.Failure error) (\ promise.monad wrap (#try.Failure error)))) +(def: (load_host_dependencies fs host_dependencies) + (-> (file.System Promise) (List file.Path) (Promise (Try (Dictionary file.Path Binary)))) + (do {! (try.with promise.monad)} + [] + (loop [pending host_dependencies + output (: (Dictionary file.Path Binary) + (dictionary.new text.hash))] + (case pending + #.Nil + (wrap output) + + (#.Cons head tail) + (do ! + [content (\ fs read head)] + (recur tail + (dictionary.put head content output))))))) + (with_expansions [<parameters> (as_is anchor expression artifact)] (def: #export (compiler static expander host_analysis platform generation_bundle host_directive_bundle program anchorT,expressionT,directiveT extender @@ -118,7 +135,7 @@ (<| (or_crash! "Compilation failed:") ..timed (do (try.with promise.monad) - [#let [[compilation_sources compilation_libraries compilation_target compilation_module] compilation] + [#let [[compilation_sources compilation_host_dependencies compilation_libraries compilation_target compilation_module] compilation] import (/import.import (get@ #platform.&file_system platform) compilation_libraries) [state archive] (:share [<parameters>] (Platform <parameters>) @@ -136,9 +153,11 @@ (:assume (platform.compile import static expander platform compilation [archive state]))) _ (ioW.freeze (get@ #platform.&file_system platform) static archive) program_context (promise\wrap ($/program.context archive)) + host_dependencies (..load_host_dependencies (get@ #platform.&file_system platform) compilation_host_dependencies) _ (..package! (for {@.old (file.async file.default) @.jvm (file.async file.default) @.js file.default}) + host_dependencies packager,package static archive diff --git a/stdlib/source/program/compositor/cli.lux b/stdlib/source/program/compositor/cli.lux index d3b61640b..f0fdb80be 100644 --- a/stdlib/source/program/compositor/cli.lux +++ b/stdlib/source/program/compositor/cli.lux @@ -16,6 +16,9 @@ (type: #export Source Path) +(type: #export Host_Dependency + Path) + (type: #export Library Path) @@ -23,7 +26,7 @@ Path) (type: #export Compilation - [(List Source) (List Library) Target Module]) + [(List Source) (List Host_Dependency) (List Library) Target Module]) (type: #export Export [(List Source) Target]) @@ -38,10 +41,11 @@ (Parser <type>) (cli.named <long> cli.any))] - [^source "--source" Source] - [^library "--library" Library] - [^target "--target" Target] - [^module "--module" Module] + [source_parser "--source" Source] + [host_dependency_parser "--host_dependency" Host_Dependency] + [library_parser "--library" Library] + [target_parser "--target" Target] + [module_parser "--module" Module] ) (def: #export service @@ -49,25 +53,27 @@ ($_ <>.or (<>.after (cli.this "build") ($_ <>.and - (<>.some ..^source) - (<>.some ..^library) - ..^target - ..^module)) + (<>.some ..source_parser) + (<>.some ..host_dependency_parser) + (<>.some ..library_parser) + ..target_parser + ..module_parser)) (<>.after (cli.this "repl") ($_ <>.and - (<>.some ..^source) - (<>.some ..^library) - ..^target - ..^module)) + (<>.some ..source_parser) + (<>.some ..host_dependency_parser) + (<>.some ..library_parser) + ..target_parser + ..module_parser)) (<>.after (cli.this "export") ($_ <>.and - (<>.some ..^source) - ..^target)) + (<>.some ..source_parser) + ..target_parser)) )) (def: #export target (-> Service Target) - (|>> (case> (^or (#Compilation [sources libraries target module]) - (#Interpretation [sources libraries target module]) + (|>> (case> (^or (#Compilation [sources host_dependencies libraries target module]) + (#Interpretation [sources host_dependencies libraries target module]) (#Export [sources target])) target))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index fcf33fa79..d482d75d5 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -510,11 +510,16 @@ [expected_left random.nat expected_right random.nat] (_.cover [/.-> /.function] - (let [actual (: (/.-> Nat Nat Nat) - (/.function (_ actual_left actual_right) - (n.* (inc actual_left) (dec actual_right))))] - (n.= (n.* (inc expected_left) (dec expected_right)) - (actual expected_left expected_right)))))) + (and (let [actual (: (/.-> Nat Nat Nat) + (/.function (_ actual_left actual_right) + (n.* (inc actual_left) (dec actual_right))))] + (n.= (n.* (inc expected_left) (dec expected_right)) + (actual expected_left expected_right))) + (let [actual (: (/.-> [Nat Nat] Nat) + (/.function (_ [actual_left actual_right]) + (n.* (inc actual_left) (dec actual_right))))] + (n.= (n.* (inc expected_left) (dec expected_right)) + (actual [expected_left expected_right]))))))) (/.template: (!n/+ <left> <right>) (n.+ <left> <right>)) @@ -783,6 +788,122 @@ (not (/.is? not_left left)))))) ))) +(type: (Pair l r) + {#left l + #right r}) + +(template: (!pair <left> <right>) + [{#left <left> + #right <right>}]) + +(def: for_case + Test + (do {! random.monad} + [expected_nat (\ ! map (n.% 1) random.nat) + expected_int (\ ! map (i.% +1) random.int) + expected_rev (random.either (wrap .5) + (wrap .25)) + expected_frac (random.either (wrap +0.5) + (wrap +1.25)) + expected_text (random.either (wrap "+0.5") + (wrap "+1.25"))] + ($_ _.and + (_.cover [/.case] + (and (/.case expected_nat + 0 true + _ false) + (/.case expected_int + +0 true + _ false) + (/.case expected_rev + .5 true + .25 true + _ false) + (/.case expected_frac + +0.5 true + +1.25 true + _ false) + (/.case expected_text + "+0.5" true + "+1.25" true + _ false) + (/.case [expected_nat expected_int] + [0 +0] true + _ false) + (/.case {#left expected_nat #right expected_int} + {#left 0 #right +0} true + _ false) + (/.case (: (Either Nat Int) (#.Left expected_nat)) + (#.Left 0) true + _ false) + (/.case (: (Either Nat Int) (#.Right expected_int)) + (#.Right +0) true + _ false) + )) + (_.cover [/.^or] + (and (/.case expected_rev + (/.^or .5 .25) true + _ false) + (/.case expected_frac + (/.^or +0.5 +1.25) true + _ false) + (/.case expected_text + (/.^or "+0.5" "+1.25") true + _ false))) + (_.cover [/.^slots] + (/.case {#left expected_nat #right expected_int} + (/.^slots [#left #right]) + (and (/.is? expected_nat left) + (/.is? expected_int right)))) + (_.cover [/.^] + (/.case {#left expected_nat #right expected_int} + (/.^ (!pair 0 +0)) true + _ false)) + (_.cover [/.^@] + (let [expected_pair (: (Pair Nat Int) + {#left expected_nat #right expected_int})] + (/.case expected_pair + (/.^@ actual_pair (/.^ (!pair actual_left actual_right))) + (and (/.is? expected_pair actual_pair) + (/.is? expected_nat actual_left) + (/.is? expected_int actual_right))))) + (_.cover [/.^multi] + (let [expected_pair (: (Pair Nat Int) + {#left expected_nat #right expected_int})] + (and (/.case expected_pair + (/.^multi (/.^ (!pair actual_left actual_right)) + [actual_left 0] + [actual_right +0]) + true + + _ + false) + (/.case expected_pair + (/.^multi (/.^ (!pair actual_left actual_right)) + (n.= 0 actual_left) + (i.= +0 actual_right)) + true + + _ + false)))) + (_.cover [/.^|>] + (case expected_frac + (/.^|> actual_frac [(f.* +2.0) (f.* +2.0)]) + (f.= (f.* +4.0 expected_frac) + actual_frac))) + (_.cover [/.^code] + (case (code.text expected_text) + (/.^code "+0.5") true + (/.^code "+1.25") true + _ false)) + (_.cover [/.let] + (and (/.let [actual_nat expected_nat] + (/.is? expected_nat actual_nat)) + (/.let [[actual_left actual_right] {#left expected_nat #right expected_int}] + (and (/.is? expected_nat actual_left) + (/.is? expected_int actual_right))))) + ))) + (def: test Test (<| (_.covering /._) @@ -807,6 +928,7 @@ ..for_associative ..for_expansion ..for_value + ..for_case ..sub_tests ))) |