diff options
author | Eduardo Julian | 2022-02-05 14:51:37 -0400 |
---|---|---|
committer | Eduardo Julian | 2022-02-05 14:51:37 -0400 |
commit | 54bb56a07e6d8f1e76bd447436fb721a74f09f66 (patch) | |
tree | fd3d5699ce5d7546a92f4328dee496ab6ca86aed /stdlib/source | |
parent | e4bc4d0e2cd14a955530160c4fc7859e6c46874e (diff) |
Updated copyright notices.
Diffstat (limited to 'stdlib/source')
-rw-r--r-- | stdlib/source/library/lux/ffi.jvm.lux | 12 | ||||
-rw-r--r-- | stdlib/source/library/lux/target/jvm/bytecode/instruction.lux | 86 | ||||
-rw-r--r-- | stdlib/source/library/lux/target/python.lux | 4 | ||||
-rw-r--r-- | stdlib/source/library/lux/tool/compiler/default/platform.lux | 2 | ||||
-rw-r--r-- | stdlib/source/library/lux/tool/compiler/meta/cli.lux (renamed from stdlib/source/program/compositor/cli.lux) | 27 | ||||
-rw-r--r-- | stdlib/source/program/compositor.lux | 8 | ||||
-rw-r--r-- | stdlib/source/program/compositor/export.lux | 55 | ||||
-rw-r--r-- | stdlib/source/program/compositor/import.lux | 8 | ||||
-rw-r--r-- | stdlib/source/test/lux.lux | 75 | ||||
-rw-r--r-- | stdlib/source/test/lux/ffi.jvm.lux | 53 | ||||
-rw-r--r-- | stdlib/source/test/lux/tool.lux | 4 | ||||
-rw-r--r-- | stdlib/source/test/lux/tool/compiler/meta/cli.lux | 119 |
12 files changed, 308 insertions, 145 deletions
diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index 55cbe77ba..f13818a4a 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -585,18 +585,18 @@ (<code>.form (<>.and class_name^ (<>.some (parameter^ type_vars))))))] (in (type.class (name.safe name) parameters)))) -(exception: .public (unexpected_type_variable [name Text - type_vars (List (Type Var))]) +(exception: .public (unknown_type_variable [name Text + type_vars (List (Type Var))]) (exception.report ["Unexpected Type Variable" (%.text name)] ["Expected Type Variables" (exception.listing parser.name type_vars)])) -(def: (variable^ type_vars) +(def: (type_variable options) (-> (List (Type Var)) (Parser (Type Parameter))) (do <>.monad [name <code>.local_symbol - _ (..assertion ..unexpected_type_variable [name type_vars] - (list.member? text.equivalence (list#each parser.name type_vars) name))] + _ (..assertion ..unknown_type_variable [name options] + (list.member? text.equivalence (list#each parser.name options) name))] (in (type.var name)))) (def: wildcard^ @@ -623,7 +623,7 @@ (function (_ _) (let [class^ (..class^' parameter^ type_vars)] ($_ <>.either - (..variable^ type_vars) + (..type_variable type_vars) ..wildcard^ (upper^ class^) (lower^ class^) diff --git a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux index d1962e192..c422dd1c2 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux @@ -1,40 +1,40 @@ (.using - [library - [lux "*" - [abstract - [monad {"+" do}] - [monoid {"+" Monoid}]] - [control - ["[0]" function] - ["[0]" try]] - [data - ["[0]" product] - ["[0]" binary] - ["[0]" format "_" - ["[1]" binary {"+" Mutation Specification}]] - [collection - ["[0]" list]]] - [macro - ["[0]" template]] - [math - [number {"+" hex} - ["n" nat]]] - [type - abstract]]] - ["[0]" // "_" - ["[1][0]" address {"+" Address}] - ["[1][0]" jump {"+" Jump Big_Jump}] - [environment - [limit - [registry {"+" Register}]]] - ["/[1]" // "_" - ["[1][0]" index {"+" Index}] - ["[1][0]" constant {"+" Class Reference}] - [encoding - ["[1][0]" unsigned {"+" U1 U2 U4}] - ["[1][0]" signed {"+" S1 S2 S4}]] - [type - [category {"+" Value Method}]]]]) + [library + [lux "*" + [abstract + [monad {"+" do}] + [monoid {"+" Monoid}]] + [control + ["[0]" function] + ["[0]" try]] + [data + ["[0]" product] + ["[0]" binary] + ["[0]" format "_" + ["[1]" binary {"+" Mutation Specification}]] + [collection + ["[0]" list]]] + [macro + ["[0]" template]] + [math + [number {"+" hex} + ["n" nat]]] + [type + abstract]]] + ["[0]" // "_" + ["[1][0]" address {"+" Address}] + ["[1][0]" jump {"+" Jump Big_Jump}] + [environment + [limit + [registry {"+" Register}]]] + ["/[1]" // "_" + ["[1][0]" index {"+" Index}] + ["[1][0]" constant {"+" Class Reference}] + [encoding + ["[1][0]" unsigned {"+" U1 U2 U4}] + ["[1][0]" signed {"+" S1 S2 S4}]] + [type + [category {"+" Value Method}]]]]) (type: .public Size U2) @@ -60,15 +60,15 @@ (type: Opcode Nat) -(template [<name> <size>] +(template [<size> <name>] [(def: <name> Size (|> <size> ///unsigned.u2 try.trusted))] - [opcode_size 1] - [register_size 1] - [byte_size 1] - [index_size 2] - [big_jump_size 4] - [integer_size 4] + [1 opcode_size] + [1 register_size] + [1 byte_size] + [2 index_size] + [4 big_jump_size] + [4 integer_size] ) (def: (nullary' opcode) diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux index 6d3746721..87864e062 100644 --- a/stdlib/source/library/lux/target/python.lux +++ b/stdlib/source/library/lux/target/python.lux @@ -194,8 +194,8 @@ ... ..expression (format left_delimiter (|> entries - (list#each entry_serializer) - (text.interposed ", ")) + (list#each (|>> entry_serializer (text.suffix ", "))) + text.together) right_delimiter)))) (template [<name> <pre> <post>] diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index 668daffc5..dc9ff4533 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -49,6 +49,7 @@ [phase ["[0]" extension {"+" Extender}]]]] [meta + [cli {"+" Compilation Library}] ["[0]" archive {"+" Output Archive} ["[0]" registry {"+" Registry}] ["[0]" artifact] @@ -60,7 +61,6 @@ ["ioW" archive]]]]] [program [compositor - [cli {"+" Compilation Library}] [import {"+" Import}] ["[0]" static {"+" Static}]]]) diff --git a/stdlib/source/program/compositor/cli.lux b/stdlib/source/library/lux/tool/compiler/meta/cli.lux index 1962569b3..c4d5eb819 100644 --- a/stdlib/source/program/compositor/cli.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cli.lux @@ -4,13 +4,13 @@ [control [pipe {"+" case>}] ["<>" parser - ["[0]" cli {"+" Parser}]]] + ["<[0]>" cli {"+" Parser}]]] [tool [compiler [meta [archive [module - [descriptor {"+" Module}]]]]]] + ["[0]" descriptor]]]]]] [world [file {"+" Path}]]]]) @@ -26,8 +26,19 @@ (type: .public Target Path) +(type: .public Module + descriptor.Module) + (type: .public Compilation - [(List Source) (List Host_Dependency) (List Library) Target Module]) + (Record + [#sources (List Source) + #host_dependencies (List Host_Dependency) + #libraries (List Library) + #target Target + #module Module])) + +(type: .public Interpretation + ..Compilation) (type: .public Export [(List Source) Target]) @@ -35,13 +46,13 @@ (type: .public Service (Variant {#Compilation Compilation} - {#Interpretation Compilation} + {#Interpretation Interpretation} {#Export Export})) (template [<name> <long> <type>] [(def: <name> (Parser <type>) - (cli.named <long> cli.any))] + (<cli>.named <long> <cli>.any))] [source_parser "--source" Source] [host_dependency_parser "--host_dependency" Host_Dependency] @@ -53,21 +64,21 @@ (def: .public service (Parser Service) ($_ <>.or - (<>.after (cli.this "build") + (<>.after (<cli>.this "build") ($_ <>.and (<>.some ..source_parser) (<>.some ..host_dependency_parser) (<>.some ..library_parser) ..target_parser ..module_parser)) - (<>.after (cli.this "repl") + (<>.after (<cli>.this "repl") ($_ <>.and (<>.some ..source_parser) (<>.some ..host_dependency_parser) (<>.some ..library_parser) ..target_parser ..module_parser)) - (<>.after (cli.this "export") + (<>.after (<cli>.this "export") ($_ <>.and (<>.some ..source_parser) ..target_parser)) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 59c53550e..0d90a15dc 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -40,6 +40,7 @@ [phase [extension {"+" Extender}]]]] [meta + ["[0]" cli {"+" Service}] [packager {"+" Packager}] [archive {"+" Archive} ["[0]" unit] @@ -50,7 +51,6 @@ ... ["[0]" interpreter] ]]] ["[0]" / "_" - ["[1][0]" cli {"+" Service}] ["[1][0]" static {"+" Static}] ["[1][0]" export] ["[1][0]" import]]) @@ -148,7 +148,7 @@ (do [! async.monad] [platform (async.future platform)] (case service - {/cli.#Compilation compilation} + {cli.#Compilation compilation} (<| (or_crash! "Compilation failed:") ..timed (do (try.with async.monad) @@ -182,14 +182,14 @@ program_context)] (in (debug.log! "Compilation complete!")))) - {/cli.#Export export} + {cli.#Export export} (<| (or_crash! "Export failed:") (do (try.with async.monad) [_ (/export.export (value@ platform.#&file_system platform) export)] (in (debug.log! "Export complete!")))) - {/cli.#Interpretation interpretation} + {cli.#Interpretation interpretation} ... TODO: Fix the interpreter... (undefined) ... (<| (or_crash! "Interpretation failed:") diff --git a/stdlib/source/program/compositor/export.lux b/stdlib/source/program/compositor/export.lux index cb19398e7..4ac08f423 100644 --- a/stdlib/source/program/compositor/export.lux +++ b/stdlib/source/program/compositor/export.lux @@ -1,32 +1,31 @@ (.using - [library - [lux {"-" Source} - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" try {"+" Try}] - [concurrency - ["[0]" async {"+" Async}]]] - [data - ["[0]" text - ["%" format {"+" format}]] - [collection - ["[0]" dictionary] - ["[0]" sequence]] - [format - ["[0]" binary] - ["[0]" tar]]] - [time - ["[0]" instant]] - [tool - [compiler - [meta - ["[0]" io "_" - ["[1]" context {"+" Extension}]]]]] - [world - ["[0]" file]]]] - [// - [cli {"+" Source Export}]]) + [library + [lux {"-" Source} + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" try {"+" Try}] + [concurrency + ["[0]" async {"+" Async}]]] + [data + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" dictionary] + ["[0]" sequence]] + [format + ["[0]" binary] + ["[0]" tar]]] + [time + ["[0]" instant]] + [tool + [compiler + [meta + [cli {"+" Source Export}] + ["[0]" io "_" + ["[1]" context {"+" Extension}]]]]] + [world + ["[0]" file]]]]) (def: file "library.tar") diff --git a/stdlib/source/program/compositor/import.lux b/stdlib/source/program/compositor/import.lux index 9554ec934..7f21f20ec 100644 --- a/stdlib/source/program/compositor/import.lux +++ b/stdlib/source/program/compositor/import.lux @@ -22,13 +22,9 @@ [tool [compiler [meta - [archive - [module - [descriptor {"+" Module}]]]]]] + [cli {"+" Library Module}]]]] [world - ["[0]" file]]]] - [// - [cli {"+" Library}]]) + ["[0]" file]]]]) (def: Action (type (All (_ a) (Async (Try a))))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index b859f456f..e8a6a482d 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -449,78 +449,89 @@ <m2/1> (template.text [<module/2> "/" <module/1>]) <m0/1/2> (template.text [<module/0> "/" <module/1> "/" <module/2>]) <open/0> (template.text [<module/0> "#[0]"])] - (and (~~ (template [<input> <pattern>] + (and (~~ (template [<input> <module> <referrals>] [(with_expansions [<input>' (macro.final <input>)] (let [scenario (: (-> Any Bit) (function (_ _) - (case (' [<input>']) - (^code <pattern>) - true - - _ - false)))] + ... TODO: Remove this hack once Jython is no longer being used as the Python interpreter. + (`` (for [@.python (case (' [<input>']) + (^code [<module> + ("lux def" (~ [_ {.#Symbol ["" _]}]) [] #0) + (~~ (template.spliced <referrals>))]) + true + + _ + false)] + (case (' [<input>']) + (^code [<module> (~~ (template.spliced <referrals>))]) + true + + _ + false)))))] (scenario [])))] [(.using [<module/0>']) - [("lux def module" [])]] + ("lux def module" []) + []] [(.using [<alias> <module/0>' "*"]) - [("lux def module" [[<module/0> <alias>]]) - (<referral> <module/0> "*")]] + ("lux def module" [[<module/0> <alias>]]) + [(<referral> <module/0> "*")]] [(.using [<alias> <module/0>' {"+" <definition>}]) - [("lux def module" [[<module/0> <alias>]]) - (<referral> <module/0> {"+" <definition>})]] + ("lux def module" [[<module/0> <alias>]]) + [(<referral> <module/0> {"+" <definition>})]] [(.using [<alias> <module/0>' {"-" <definition>}]) - [("lux def module" [[<module/0> <alias>]]) - (<referral> <module/0> {"-" <definition>})]] + ("lux def module" [[<module/0> <alias>]]) + [(<referral> <module/0> {"-" <definition>})]] [(.using [<alias> <module/0>' "_"]) - [("lux def module" [])]] + ("lux def module" []) + []] [(.using [<module/0>' [<alias> <module/1>']]) - [("lux def module" [[<m0/1> <alias>]]) - (<referral> <m0/1>)]] + ("lux def module" [[<m0/1> <alias>]]) + [(<referral> <m0/1>)]] [(.using ["[0]" <module/0>' ["[0]" <module/1>']]) - [("lux def module" [[<module/0> <module/0>] - [<m0/1> <module/1>]]) - (<referral> <module/0>) + ("lux def module" [[<module/0> <module/0>] + [<m0/1> <module/1>]]) + [(<referral> <module/0>) (<referral> <m0/1>)]] [(.using ["[0]" <module/0>' "_" ["[1]" <module/1>']]) - [("lux def module" [[<m0/1> <module/0>]]) - (<referral> <m0/1>)]] + ("lux def module" [[<m0/1> <module/0>]]) + [(<referral> <m0/1>)]] [(.using ["[0]" <module/0>' "_" ["[1]" <module/1>' "_" ["[2]" <module/2>']]]) - [("lux def module" [[<m0/1/2> <module/0>]]) - (<referral> <m0/1/2>)]] + ("lux def module" [[<m0/1/2> <module/0>]]) + [(<referral> <m0/1/2>)]] [(.using [<module/0>' ["[0]" <module/1>' ["[0]" <//>']]]) - [("lux def module" [[<m0/1> <module/1>] - [<m0/2> <//>]]) - (<referral> <m0/1>) + ("lux def module" [[<m0/1> <module/1>] + [<m0/2> <//>]]) + [(<referral> <m0/1>) (<referral> <m0/2>)]] [(.using ["[0]" <module/0>' [<module/1>' ["[0]" <\\>']]]) - [("lux def module" [[<module/0> <module/0>] - [<m2/1> <\\>]]) - (<referral> <module/0>) + ("lux def module" [[<module/0> <module/0>] + [<m2/1> <\\>]]) + [(<referral> <module/0>) (<referral> <m2/1>)]] [(.using ["[0]" <module/0>' ("[1]#[0]" <definition>)]) - [("lux def module" [[<module/0> <module/0>]]) - (<referral> <module/0> (<open/0> <definition>))]] + ("lux def module" [[<module/0> <module/0>]]) + [(<referral> <module/0> (<open/0> <definition>))]] )))))) )))))) diff --git a/stdlib/source/test/lux/ffi.jvm.lux b/stdlib/source/test/lux/ffi.jvm.lux index f77fbc54f..7684d7b96 100644 --- a/stdlib/source/test/lux/ffi.jvm.lux +++ b/stdlib/source/test/lux/ffi.jvm.lux @@ -4,11 +4,12 @@ ["_" test {"+" Test}] ["[0]" type ("[1]#[0]" equivalence)] ["[0]" meta] + ["[0]" debug] [abstract [monad {"+" do}]] [control [pipe {"+" case>}] - ["[0]" try] + ["[0]" try ("[1]#[0]" functor)] ["[0]" exception] [parser ["<[0]>" code]]] @@ -27,7 +28,10 @@ [number ["n" nat] ["i" int ("[1]#[0]" equivalence)] - ["f" frac ("[1]#[0]" equivalence)]]]]] + ["f" frac ("[1]#[0]" equivalence)]]] + [target + ["[0]" jvm "_" + ["[1]" type ("[1]#[0]" equivalence)]]]]] [\\library ["[0]" /]]) @@ -597,18 +601,39 @@ (def: for_exception Test - ($_ _.and - (_.cover [/.class_names_cannot_contain_periods] - (with_expansions [<class> (template.symbol ["java.lang.Float"])] - (not (expands? (/.import: <class>))))) - (_.cover [/.class_name_cannot_be_a_type_variable] - (and (not (expands? (/.import: (java/lang/Double a) - ["[1]::[0]" - (invalid [] (a java/lang/String))]))) - (not (expands? (/.import: java/lang/Double - ["[1]::[0]" - ([a] invalid [] (a java/lang/String))]))))) - )) + (do [! random.monad] + [var/0 (random.ascii/lower 1) + var/1 (random.ascii/lower 2) + var/2 (random.ascii/lower 3)] + ($_ _.and + (_.cover [/.class_names_cannot_contain_periods] + (with_expansions [<class> (template.symbol ["java.lang.Float"])] + (not (expands? (/.import: <class>))))) + (_.cover [/.class_name_cannot_be_a_type_variable] + (and (not (expands? (/.import: (java/lang/Double a) + ["[1]::[0]" + (invalid [] (a java/lang/String))]))) + (not (expands? (/.import: java/lang/Double + ["[1]::[0]" + ([a] invalid [] (a java/lang/String))]))))) + (_.cover [/.unknown_type_variable] + (let [type_variable ((debug.private /.type_variable) (list (jvm.var var/0) (jvm.var var/1)))] + (and (|> (list (code.local_symbol var/0)) + (<code>.result type_variable) + (try#each (|>> (jvm#= (jvm.var var/0)))) + (try.else false)) + (|> (list (code.local_symbol var/1)) + (<code>.result type_variable) + (try#each (|>> (jvm#= (jvm.var var/1)))) + (try.else false)) + (|> (list (code.local_symbol var/2)) + (<code>.result type_variable) + (case> {try.#Failure error} + (exception.match? /.unknown_type_variable error) + + _ + false))))) + ))) (def: .public test (<| (_.covering /._) diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index 6fa62a7da..2291880ec 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -20,7 +20,8 @@ ... ["[1]/[0]" synthesis] ]]] ["[1][0]" meta "_" - ["[1]/[0]" archive]] + ["[1]/[0]" archive] + ["[1]/[0]" cli]] ]]) (def: .public test @@ -32,6 +33,7 @@ /phase.test /analysis.test /meta/archive.test + /meta/cli.test /phase/extension.test /phase/analysis/simple.test /phase/analysis/complex.test diff --git a/stdlib/source/test/lux/tool/compiler/meta/cli.lux b/stdlib/source/test/lux/tool/compiler/meta/cli.lux new file mode 100644 index 000000000..7c5f0266e --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/meta/cli.lux @@ -0,0 +1,119 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + [pipe {"+" case>}] + ["[0]" try ("[1]#[0]" functor)] + ["<>" parser + ["<[0]>" cli]]] + [data + ["[0]" product] + ["[0]" text] + [collection + ["[0]" list ("[1]#[0]" monoid monad)]]] + [math + ["[0]" random] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Service /.service]) + (let [(^open "list#[0]") (list.equivalence text.equivalence)]) + (do [! random.monad] + [amount (# ! each (|>> (n.% 5) ++) random.nat) + sources (random.list amount (random.ascii/lower 1)) + host_dependencies (random.list amount (random.ascii/lower 2)) + libraries (random.list amount (random.ascii/lower 3)) + target (random.ascii/lower 4) + module (random.ascii/lower 5) + .let [compilation' ($_ list#composite + (list#conjoint (list#each (|>> (list "--source")) sources)) + (list#conjoint (list#each (|>> (list "--host_dependency")) host_dependencies)) + (list#conjoint (list#each (|>> (list "--library")) libraries)) + (list "--target" target) + (list "--module" module)) + export ($_ list#composite + (list#conjoint (list#each (|>> (list "--source")) sources)) + (list "--target" target))]] + ($_ _.and + (_.for [/.Compilation] + (`` ($_ _.and + (~~ (template [<type> <slot> <?>] + [(_.cover [<type>] + (|> (list& "build" compilation') + (<cli>.result /.service) + (try#each (|>> (case> {/.#Compilation it} + (|> it + (value@ <slot>) + <?>) + + _ + false))) + (try.else false)))] + + [/.Source /.#sources (list#= sources)] + [/.Host_Dependency /.#host_dependencies (list#= host_dependencies)] + [/.Library /.#libraries (list#= libraries)] + [/.Target /.#target (same? target)] + [/.Module /.#module (same? module)] + )) + ))) + (_.cover [/.Interpretation] + (`` (and (~~ (template [<slot> <?>] + [(|> (list& "repl" compilation') + (<cli>.result /.service) + (try#each (|>> (case> {/.#Interpretation it} + (|> it + (value@ <slot>) + <?>) + + _ + false))) + (try.else false))] + + [/.#sources (list#= sources)] + [/.#host_dependencies (list#= host_dependencies)] + [/.#libraries (list#= libraries)] + [/.#target (same? target)] + [/.#module (same? module)] + ))))) + (_.cover [/.Export] + (`` (and (~~ (template [<side> <?>] + [(|> (list& "export" export) + (<cli>.result /.service) + (try#each (|>> (case> {/.#Export it} + (|> it + <side> + <?>) + + _ + false))) + (try.else false))] + + [product.left (list#= sources)] + [product.right (same? target)] + ))))) + (_.cover [/.target] + (`` (and (~~ (template [<it>] + [(same? target (/.target <it>))] + + [{/.#Compilation [/.#sources sources + /.#host_dependencies host_dependencies + /.#libraries libraries + /.#target target + /.#module module]}] + [{/.#Interpretation [/.#sources sources + /.#host_dependencies host_dependencies + /.#libraries libraries + /.#target target + /.#module module]}] + [{/.#Export [sources target]}] + ))))) + )))) |