aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/library/lux/program.lux3
-rw-r--r--stdlib/source/library/lux/tool/compiler/default/platform.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/packager.lux13
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux180
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/packager/script.lux2
-rw-r--r--stdlib/source/program/aedifex/command/build.lux127
-rw-r--r--stdlib/source/program/aedifex/command/test.lux14
-rw-r--r--stdlib/source/program/compositor.lux29
-rw-r--r--stdlib/source/program/compositor/cli.lux40
-rw-r--r--stdlib/source/test/lux.lux132
11 files changed, 459 insertions, 85 deletions
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
)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-28 00:50:25 +0000