diff options
author | Eduardo Julian | 2020-11-28 19:45:56 -0400 |
---|---|---|
committer | Eduardo Julian | 2020-11-28 19:45:56 -0400 |
commit | a02b7bf8ff358ccfa35b03272d28537aeac723ae (patch) | |
tree | 66f27c97f192d31d7cbee6b87be5ac6546640253 | |
parent | 889139602b77e4387a6e8bfbedacc2a08703e976 (diff) |
Added "private" macro to lux/debug.
Diffstat (limited to '')
75 files changed, 1319 insertions, 881 deletions
diff --git a/documentation/bookmark/Package.md b/documentation/bookmark/Package.md new file mode 100644 index 000000000..b58cc3221 --- /dev/null +++ b/documentation/bookmark/Package.md @@ -0,0 +1,5 @@ +# Repository + +1. [WebAssembly Package Manager](https://wapm.io/) +1. [About GitHub Packages](https://docs.github.com/en/free-pro-team@latest/packages/publishing-and-managing-packages/about-github-packages#supported-clients-and-formats) + diff --git a/documentation/bookmark/Pattern.md b/documentation/bookmark/Pattern.md new file mode 100644 index 000000000..0a7569078 --- /dev/null +++ b/documentation/bookmark/Pattern.md @@ -0,0 +1,5 @@ +# Reference + +1. [Patterns of Software: Tales from the Software Community](https://dreamsongs.com/Files/PatternsOfSoftware.pdf) +1. [Gerald Jay Sussman on Flexible Systems, The Power of Generic Operations](https://vimeo.com/151465912) + diff --git a/documentation/bookmark/back-end/JavaScript.md b/documentation/bookmark/back-end/JavaScript.md new file mode 100644 index 000000000..f3c57b57f --- /dev/null +++ b/documentation/bookmark/back-end/JavaScript.md @@ -0,0 +1,9 @@ +# Debugging + +1. [The JavaScript Self-Profiling API](https://addyosmani.com/blog/js-self-profiling/) + +# Number + +1. [BigInt: arbitrary-precision integers in JavaScript](https://v8.dev/features/bigint) +1. [WebAssembly integration with JavaScript BigInt](https://v8.dev/features/wasm-bigint) + diff --git a/documentation/bookmark/back-end/native.md b/documentation/bookmark/back-end/native.md index ec1ba689d..32da388c9 100644 --- a/documentation/bookmark/back-end/native.md +++ b/documentation/bookmark/back-end/native.md @@ -1,3 +1,11 @@ +# Java + +1. [Java Grinder](https://www.mikekohn.net/micro/java_grinder.php) + +# Register allocation + +1. [A Quick Introduction to Register Allocation](https://hassamuddin.com/blog/reg-alloc/) + # Call stack 1. http://stffrdhrn.github.io/software/embedded/openrisc/2018/06/08/gcc_stack_frames.html diff --git a/documentation/bookmark/database.md b/documentation/bookmark/database.md index 2152dd124..765f5ba0f 100644 --- a/documentation/bookmark/database.md +++ b/documentation/bookmark/database.md @@ -1,3 +1,7 @@ +# Pagination + +1. [Pagination with Relative Cursors](https://shopify.engineering/pagination-relative-cursors) + # Reference 1. ["Temporal Databases for Streaming Architectures" by Jeremy Taylor and Jon Pither](https://www.youtube.com/watch?v=ykbYNBE-V3k) @@ -15,6 +19,7 @@ # Query +1. [Reasons why SELECT * is bad for SQL performance](https://tanelpoder.com/posts/reasons-why-select-star-is-bad-for-sql-performance/) 1. [A Short Story About SQL’s Biggest Rival](https://www.holistics.io/blog/quel-vs-sql/) 1. https://calcite.apache.org/ 1. https://juxt.pro/blog/crux-sql diff --git a/documentation/bookmark/distributed_programming.md b/documentation/bookmark/distributed_programming.md index 916bdfcea..57802f081 100644 --- a/documentation/bookmark/distributed_programming.md +++ b/documentation/bookmark/distributed_programming.md @@ -59,6 +59,7 @@ # Programming language +1. [Choral: a choreographic programming language](https://www.choral-lang.org/) 1. ["Unison: a new distributed programming language" by Paul Chiusano](https://www.youtube.com/watch?v=gCWtkvDQ2ZI) 1. http://radicle.xyz/ 1. [Lambda World 2018 - Introduction to the Unison programming language - Rúnar Bjarnason](https://www.youtube.com/watch?v=rp_Eild1aq8) @@ -83,6 +84,7 @@ # Logical clock +1. [Interval Tree Clocks](https://ferd.ca/interval-tree-clocks.html) 1. [Version Vectors are not Vector Clocks](https://haslab.wordpress.com/2011/07/08/version-vectors-are-not-vector-clocks/) 1. [Distributed Systems: Physical, Logical, and Vector Clocks](https://levelup.gitconnected.com/distributed-systems-physical-logical-and-vector-clocks-7ca989f5f780) 1. [The Bloom Clock](https://arxiv.org/pdf/1905.13064.pdf) diff --git a/documentation/bookmark/game_programming.md b/documentation/bookmark/game_programming.md index 03efdc258..bb07c4bc3 100644 --- a/documentation/bookmark/game_programming.md +++ b/documentation/bookmark/game_programming.md @@ -1,3 +1,11 @@ +# Board game + +1. [Ludology](https://ludology.libsyn.com/) + +# Pattern + +1. [Game Programming Patterns](http://gameprogrammingpatterns.com/) + # Path finding 1. [Friday Facts #317 - New pathfinding algorithm](https://factorio.com/blog/post/fff-317) @@ -91,7 +99,6 @@ 1. http://www.jagregory.com/abrash-black-book/ 1. http://docs.godotengine.org/en/3.0/tutorials/math/rotations.html 1. http://www.essentialmath.com/ -1. http://gameprogrammingpatterns.com/ 1. http://higherorderfun.com/blog/2012/05/20/the-guide-to-implementing-2d-platformers/ 1. https://github.com/Dvergar/awesome-haxe-gamedev diff --git a/documentation/bookmark/math.md b/documentation/bookmark/math.md index 36f19a3cf..a91f3d788 100644 --- a/documentation/bookmark/math.md +++ b/documentation/bookmark/math.md @@ -1,3 +1,7 @@ +# Arithmetic + +1. [The Definitive Higher Math Guide on Integer Long Division (and Its Variants)](https://mathvault.ca/long-division/) + # Tensor calculus 1. [Introduction to Tensor Calculus](http://www.ita.uni-heidelberg.de/~dullemond/lectures/tensor/tensor.pdf) @@ -63,6 +67,7 @@ # Quaternions +1. [Maths - Quaternions](http://www.euclideanspace.com/maths/algebra/realNormedAlgebra/quaternions/index.htm) 1. [Dual Quaternions for Mere Mortals](https://www.jeremyong.com/math/2019/08/05/dual-quaternions-for-mere-mortals/) 1. [Stepping into a New Dimension: Using Quaternions to See the Invisible](https://medium.com/@vieyrasoftware/stepping-into-a-new-dimension-using-quaternions-to-see-the-invisible-478087c9ebbf) 1. [How Quaternions Produce 3D Rotation](https://penguinmaths.blogspot.com/2019/06/how-quaternions-produce-3d-rotation.html) @@ -169,6 +174,7 @@ # Geometric Algebra | Clifford Algebra +1. [Geometric Algebra](https://arxiv.org/abs/1205.5935) 1. [A Swift Introduction to Geometric Algebra](https://www.youtube.com/watch?v=60z_hpEAtD8) 1. [Euclidean Geometry and Geometric Algebra](http://geometry.mrao.cam.ac.uk/2020/06/euclidean-geometry-and-geometric-algebra/) 1. [Plane-based Geometric Algebra for Computer Science](https://bivector.net/PGA4CS.html) diff --git a/documentation/bookmark/methodology.md b/documentation/bookmark/methodology.md index 81b7b959b..63e770046 100644 --- a/documentation/bookmark/methodology.md +++ b/documentation/bookmark/methodology.md @@ -1,4 +1,5 @@ # Reference +1. [Managing developer identities in autonomous teams](https://kislayverma.com/organizations/managing-developer-identities-in-autonomous-teams/) 1. [Risk-First](https://riskfirst.org/) diff --git a/documentation/bookmark/paradigm/Plugin Oriented Programming.md b/documentation/bookmark/paradigm/Plugin Oriented Programming.md new file mode 100644 index 000000000..a41e8f102 --- /dev/null +++ b/documentation/bookmark/paradigm/Plugin Oriented Programming.md @@ -0,0 +1,4 @@ +# Reference + +1. [pop](https://gitlab.com/saltstack/pop/pop) + diff --git a/documentation/bookmark/web_framework.md b/documentation/bookmark/web_framework.md index 2e0e54977..741895072 100644 --- a/documentation/bookmark/web_framework.md +++ b/documentation/bookmark/web_framework.md @@ -146,6 +146,7 @@ # Rendering +1. [Incrementally Improving The DOM](https://blog.functorial.com/posts/2018-04-08-Incrementally-Improving-The-DOM.html) 1. https://medium.com/@ryansolid/the-fastest-way-to-render-the-dom-e3b226b15ca3 1. https://github.com/Famous/engine 1. https://redom.js.org/ diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index dabd82b7d..605539376 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -3,11 +3,11 @@ [abstract ["." monad]] [data - ["." maybe ("#@." monad)] + ["." maybe ("#\." monad)] ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." fold functor)]] + ["." list ("#\." fold functor)]] [number ["n" nat] ["i" int] @@ -21,7 +21,7 @@ ["csr" reader] ["csw" writer]]]]] [// - ["<>" parser ("#@." monad) + ["<>" parser ("#\." monad) ["<c>" code (#+ Parser)]]]) (type: Alias [Text Code]) @@ -45,12 +45,12 @@ (Parser Stack) (<>.either (<>.and (<>.maybe bottom^) (<c>.tuple (<>.some <c>.any))) - (<>.and (|> bottom^ (<>@map (|>> #.Some))) - (<>@wrap (list))))) + (<>.and (|> bottom^ (<>\map (|>> #.Some))) + (<>\wrap (list))))) (def: (stack-fold tops bottom) (-> (List Code) Code Code) - (list@fold (function (_ top bottom) + (list\fold (function (_ top bottom) (` [(~ bottom) (~ top)])) bottom tops)) @@ -65,18 +65,18 @@ _ (meta.fail (format "Cannot expand to more than a single AST/Code node:" text.new-line - (|> expansion (list@map %.code) (text.join-with " "))))))) + (|> expansion (list\map %.code) (text.join-with " "))))))) (syntax: #export (=> {aliases aliases^} {inputs stack^} {outputs stack^}) (let [de-alias (function (_ aliased) - (list@fold (function (_ [from to] pre) + (list\fold (function (_ [from to] pre) (code.replace (code.local-identifier from) to pre)) aliased aliases))] - (case [(|> inputs (get@ #bottom) (maybe@map (|>> code.nat (~) #.Parameter (`)))) - (|> outputs (get@ #bottom) (maybe@map (|>> code.nat (~) #.Parameter (`))))] + (case [(|> inputs (get@ #bottom) (maybe\map (|>> code.nat (~) #.Parameter (`)))) + (|> outputs (get@ #bottom) (maybe\map (|>> code.nat (~) #.Parameter (`))))] [(#.Some bottomI) (#.Some bottomO)] (monad.do meta.monad [inputC (singleton (meta.expand-all (stack-fold (get@ #top inputs) bottomI))) diff --git a/stdlib/source/lux/control/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux index aa30efa76..97c080273 100644 --- a/stdlib/source/lux/control/concurrency/actor.lux +++ b/stdlib/source/lux/control/concurrency/actor.lux @@ -7,7 +7,7 @@ ["." function] ["." try (#+ Try)] ["." exception (#+ exception:)] - ["." io (#+ IO io) ("#@." monad)] + ["." io (#+ IO io)] ["<>" parser ["<c>" code (#+ Parser)]]] [data @@ -17,7 +17,7 @@ [text ["%" format (#+ format)]] [collection - ["." list ("#@." monoid monad fold)]]] + ["." list ("#\." monoid monad fold)]]] [macro ["." code] [syntax (#+ syntax:) @@ -30,7 +30,7 @@ ["." abstract (#+ abstract: :representation :abstraction)]]] [// ["." atom (#+ Atom atom)] - ["." promise (#+ Promise Resolver) ("#@." monad)] + ["." promise (#+ Promise Resolver) ("#\." monad)] ["." frp (#+ Channel)]]) (exception: #export poisoned) @@ -200,7 +200,7 @@ (def: (default-on-stop cause state) (All [s] (-> Text s (Promise Any))) - (promise@wrap [])) + (promise\wrap [])) (def: #export default (All [s] (Behavior s s)) @@ -312,7 +312,7 @@ (do meta.monad [g!type (meta.gensym (format name "-abstract-type")) #let [g!actor (code.local-identifier name) - g!vars (list@map code.local-identifier vars)]] + g!vars (list\map code.local-identifier vars)]] (wrap (list (` ((~! abstract:) (~+ (csw.export export)) ((~ g!type) (~+ g!vars)) (~ state-type) @@ -376,9 +376,9 @@ #let [g!type (code.local-identifier (get@ #abstract.name actor-scope)) g!message (code.local-identifier (get@ #name signature)) g!actor-vars (get@ #abstract.type-vars actor-scope) - g!all-vars (|> (get@ #vars signature) (list@map code.local-identifier) (list@compose g!actor-vars)) - g!inputsC (|> (get@ #inputs signature) (list@map product.left)) - g!inputsT (|> (get@ #inputs signature) (list@map product.right)) + g!all-vars (|> (get@ #vars signature) (list\map code.local-identifier) (list\compose g!actor-vars)) + g!inputsC (|> (get@ #inputs signature) (list\map product.left)) + g!inputsT (|> (get@ #inputs signature) (list\map product.right)) g!state (|> signature (get@ #state) code.local-identifier) g!self (|> signature (get@ #self) code.local-identifier)]] (wrap (list (` (def: (~+ (csw.export export)) ((~ g!message) (~+ g!inputsC)) diff --git a/stdlib/source/lux/control/concurrency/frp.lux b/stdlib/source/lux/control/concurrency/frp.lux index fdec66a61..f4dbffe81 100644 --- a/stdlib/source/lux/control/concurrency/frp.lux +++ b/stdlib/source/lux/control/concurrency/frp.lux @@ -11,14 +11,12 @@ ["." exception (#+ exception:)] ["." io (#+ IO io)]] [data - ["." maybe ("#@." functor)] - [collection - ["." list ("#@." monoid)]]] + ["." maybe ("#\." functor)]] [type (#+ :share) abstract]] [// ["." atom (#+ Atom)] - ["." promise (#+ Promise) ("#@." functor)]]) + ["." promise (#+ Promise) ("#\." functor)]]) (type: #export (Channel a) {#.doc "An asynchronous channel to distribute values."} @@ -89,8 +87,8 @@ (Functor Channel) (def: (map f) - (promise@map - (maybe@map + (promise\map + (maybe\map (function (_ [head tail]) [(f head) (map f tail)]))))) @@ -185,7 +183,7 @@ (def: #export (from-promise promise) (All [a] (-> (Promise a) (Channel a))) - (promise@map (function (_ value) + (promise\map (function (_ value) (#.Some [value ..empty])) promise)) diff --git a/stdlib/source/lux/control/region.lux b/stdlib/source/lux/control/region.lux index 9965aee3e..f1bfd2c21 100644 --- a/stdlib/source/lux/control/region.lux +++ b/stdlib/source/lux/control/region.lux @@ -10,7 +10,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." fold)]]]] + ["." list ("#\." fold)]]]] [// ["." exception (#+ Exception exception:)]]) @@ -58,7 +58,7 @@ [[cleaners output] (computation [[] (list)]) results (monad.map ! (function (_ cleaner) (cleaner [])) cleaners)] - (wrap (list@fold combine-outcomes output results)))) + (wrap (list\fold combine-outcomes output results)))) (def: #export (acquire Monad<m> cleaner value) (All [m a] (-> (Monad m) (-> a (m (Try Any))) a diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux index cd9d7b202..be117d5bf 100644 --- a/stdlib/source/lux/control/security/capability.lux +++ b/stdlib/source/lux/control/security/capability.lux @@ -12,7 +12,7 @@ [text ["%" format (#+ format)]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [type abstract] ["." meta] @@ -56,7 +56,7 @@ (~ (writer.declaration declaration)) (~ capability))) (` (def: (~ (code.local-identifier forge)) - (All [(~+ (list@map code.local-identifier vars))] + (All [(~+ (list\map code.local-identifier vars))] (-> (-> (~ input) (~ output)) (~ capability))) (~! ..forge))) diff --git a/stdlib/source/lux/data/collection/dictionary.lux b/stdlib/source/lux/data/collection/dictionary.lux index f56d314a8..34b1d8217 100644 --- a/stdlib/source/lux/data/collection/dictionary.lux +++ b/stdlib/source/lux/data/collection/dictionary.lux @@ -683,17 +683,17 @@ (structure: #export (equivalence (^open ",@.")) (All [k v] (-> (Equivalence v) (Equivalence (Dictionary k v)))) - (def: (= test subject) - (and (n.= (size test) - (size subject)) - (list.every? (function (_ k) - (case [(get k test) (get k subject)] - [(#.Some tk) (#.Some sk)] - (,@= tk sk) + (def: (= reference subject) + (and (n.= (..size reference) + (..size subject)) + (list.every? (function (_ [k rv]) + (case (..get k subject) + (#.Some sv) + (,@= rv sv) _ #0)) - (keys test))))) + (..entries reference))))) (structure: functor' (All [k] (Functor (Node k))) diff --git a/stdlib/source/lux/data/format/css/style.lux b/stdlib/source/lux/data/format/css/style.lux index fbcab6700..487ad5e9d 100644 --- a/stdlib/source/lux/data/format/css/style.lux +++ b/stdlib/source/lux/data/format/css/style.lux @@ -14,9 +14,12 @@ {#.doc "The style associated with a CSS selector."} - (def: #export empty Style (:abstraction "")) + (def: #export empty + Style + (:abstraction "")) - (def: #export separator " ") + (def: #export separator + " ") (def: #export (with [property value]) (All [brand] diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 7fae80334..a5611a7c3 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -1,34 +1,36 @@ (.module: {#.doc (.doc "Functionality for reading and writing values in the JSON format." "For more information, please see: http://www.json.org/")} [lux #* + ["." meta (#+ monad with-gensyms)] [abstract - ["." monad (#+ do)] [equivalence (#+ Equivalence)] - codec] + [codec (#+ Codec)] + [predicate (#+ Predicate)] + ["." monad (#+ do)]] [control pipe ["." try (#+ Try)] ["<>" parser ("#@." monad) - ["<t>" text (#+ Parser)]]] + ["<.>" text (#+ Parser)]]] [data ["." bit] ["." maybe] ["." product] + ["." text ("#@." equivalence monoid)] [number ["n" nat] ["f" frac ("#@." decimal)]] - ["." text ("#@." equivalence monoid)] [collection ["." list ("#@." fold functor)] ["." row (#+ Row row) ("#@." monad)] ["." dictionary (#+ Dictionary)]]] - ["." meta (#+ monad with-gensyms)] [macro [syntax (#+ syntax:)] ["." code]]]) (template [<name> <type>] - [(type: #export <name> <type>)] + [(type: #export <name> + <type>)] [Null Any] [Boolean Bit] @@ -45,22 +47,28 @@ (#Object (Dictionary String JSON))) (template [<name> <type>] - [(type: #export <name> <type>)] + [(type: #export <name> + <type>)] [Array (Row JSON)] [Object (Dictionary String JSON)] ) +(def: #export null? + (Predicate JSON) + (|>> (case> #Null true + _ false))) + (def: #export object (-> (List [String JSON]) JSON) (|>> (dictionary.from-list text.hash) #..Object)) (syntax: #export (json token) {#.doc (doc "A simple way to produce JSON literals." + (json #null) (json #1) (json +123.456) - (json "Some text") - (json #null) + (json "this is a string") (json ["this" "is" "an" "array"]) (json {"this" "is" "an" "object"}))} @@ -98,7 +106,7 @@ _ (wrap (list token))))) -(def: #export (get-fields json) +(def: #export (fields json) {#.doc "Get all the fields in a JSON object."} (-> JSON (Try (List String))) (case json @@ -198,7 +206,9 @@ ############################################################ ############################################################ -(def: (format-null _) (-> Null Text) "null") +(def: (format-null _) + (-> Null Text) + "null") (def: format-boolean (-> Boolean Text) @@ -209,29 +219,56 @@ (def: format-number (-> Number Text) (|>> (case> - +0.0 "0.0" - -0.0 "0.0" + (^or +0.0 -0.0) "0.0" value (let [raw (:: f.decimal encode value)] (if (f.< +0.0 value) raw (|> raw (text.split 1) maybe.assume product.right)))))) -(def: format-string (-> String Text) text.encode) +(def: escape "\") +(def: escaped-dq (text@compose ..escape text.double-quote)) -(def: (format-array format elems) - (-> (-> JSON Text) (-> Array Text)) - ($_ text@compose "[" - (|> elems (row@map format) row.to-list (text.join-with ",")) - "]")) +(def: format-string + (-> String Text) + (|>> (text.replace-all text.double-quote ..escaped-dq) + (text.enclose [text.double-quote text.double-quote]))) -(def: (format-object format object) +(template [<token> <name>] + [(def: <name> + Text + <token>)] + + ["," separator] + [":" entry-separator] + + ["[" open-array] + ["]" close-array] + + ["{" open-object] + ["}" close-object] + ) + +(def: (format-array format) + (-> (-> JSON Text) (-> Array Text)) + (|>> (row@map format) + row.to-list + (text.join-with ..separator) + (text.enclose [..open-array ..close-array]))) + +(def: (format-kv format [key value]) + (-> (-> JSON Text) (-> [String JSON] Text)) + ($_ text@compose + (..format-string key) + ..entry-separator + (format value) + )) + +(def: (format-object format) (-> (-> JSON Text) (-> Object Text)) - ($_ text@compose "{" - (|> object - dictionary.entries - (list@map (function (_ [key value]) ($_ text@compose (format-string key) ":" (format value)))) - (text.join-with ",")) - "}")) + (|>> dictionary.entries + (list@map (..format-kv format)) + (text.join-with ..separator) + (text.enclose [..open-object ..close-object]))) (def: #export (format json) (-> JSON Text) @@ -239,61 +276,66 @@ (^template [<tag> <format>] [(<tag> value) (<format> value)]) - ([#Null format-null] - [#Boolean format-boolean] - [#Number format-number] - [#String format-string] - [#Array (format-array format)] - [#Object (format-object format)]) + ([#Null ..format-null] + [#Boolean ..format-boolean] + [#Number ..format-number] + [#String ..format-string] + [#Array (..format-array format)] + [#Object (..format-object format)]) )) ############################################################ ############################################################ ############################################################ -(def: space~ +(def: parse-space (Parser Text) - (<t>.some <t>.space)) + (<text>.some <text>.space)) -(def: data-sep +(def: parse-separator (Parser [Text Any Text]) - ($_ <>.and space~ (<t>.this ",") space~)) + ($_ <>.and + ..parse-space + (<text>.this ..separator) + ..parse-space)) -(def: null~ +(def: parse-null (Parser Null) (do <>.monad - [_ (<t>.this "null")] + [_ (<text>.this "null")] (wrap []))) (template [<name> <token> <value>] [(def: <name> (Parser Boolean) (do <>.monad - [_ (<t>.this <token>)] + [_ (<text>.this <token>)] (wrap <value>)))] - [true~ "true" #1] - [false~ "false" #0] + [parse-true "true" #1] + [parse-false "false" #0] ) -(def: boolean~ +(def: parse-boolean (Parser Boolean) - (<>.either true~ false~)) + ($_ <>.either + ..parse-true + ..parse-false)) -(def: number~ +(def: parse-number (Parser Number) (do {! <>.monad} - [signed? (<>.parses? (<t>.this "-")) - digits (<t>.many <t>.decimal) + [signed? (<>.parses? (<text>.this "-")) + digits (<text>.many <text>.decimal) decimals (<>.default "0" (do ! - [_ (<t>.this ".")] - (<t>.many <t>.decimal))) + [_ (<text>.this ".")] + (<text>.many <text>.decimal))) exp (<>.default "" (do ! - [mark (<t>.one-of "eE") - signed?' (<>.parses? (<t>.this "-")) - offset (<t>.many <t>.decimal)] + [mark (<text>.one-of "eE") + signed?' (<>.parses? (<text>.this "-")) + offset (<text>.many <text>.decimal)] (wrap ($_ text@compose mark (if signed?' "-" "") offset))))] (case (f@decode ($_ text@compose (if signed? "-" "") digits "." decimals exp)) (#try.Failure message) @@ -302,77 +344,77 @@ (#try.Success value) (wrap value)))) -(def: escaped~ +(def: parse-escaped (Parser Text) ($_ <>.either - (<>.after (<t>.this "\t") + (<>.after (<text>.this "\t") (<>@wrap text.tab)) - (<>.after (<t>.this "\b") + (<>.after (<text>.this "\b") (<>@wrap text.back-space)) - (<>.after (<t>.this "\n") + (<>.after (<text>.this "\n") (<>@wrap text.new-line)) - (<>.after (<t>.this "\r") + (<>.after (<text>.this "\r") (<>@wrap text.carriage-return)) - (<>.after (<t>.this "\f") + (<>.after (<text>.this "\f") (<>@wrap text.form-feed)) - (<>.after (<t>.this (text@compose "\" text.double-quote)) + (<>.after (<text>.this (text@compose "\" text.double-quote)) (<>@wrap text.double-quote)) - (<>.after (<t>.this "\\") + (<>.after (<text>.this "\\") (<>@wrap "\")))) -(def: string~ +(def: parse-string (Parser String) - (<| (<t>.enclosed [text.double-quote text.double-quote]) + (<| (<text>.enclosed [text.double-quote text.double-quote]) (loop [_ []]) (do {! <>.monad} - [chars (<t>.some (<t>.none-of (text@compose "\" text.double-quote))) - stop <t>.peek]) + [chars (<text>.some (<text>.none-of (text@compose "\" text.double-quote))) + stop <text>.peek]) (if (text@= "\" stop) (do ! - [escaped escaped~ + [escaped parse-escaped next-chars (recur [])] (wrap ($_ text@compose chars escaped next-chars))) (wrap chars)))) -(def: (kv~ json~) +(def: (parse-kv parse-json) (-> (Parser JSON) (Parser [String JSON])) (do <>.monad - [key string~ - _ space~ - _ (<t>.this ":") - _ space~ - value json~] + [key ..parse-string + _ ..parse-space + _ (<text>.this ..entry-separator) + _ ..parse-space + value parse-json] (wrap [key value]))) (template [<name> <type> <open> <close> <elem-parser> <prep>] - [(def: (<name> json~) + [(def: (<name> parse-json) (-> (Parser JSON) (Parser <type>)) (do <>.monad - [_ (<t>.this <open>) - _ space~ - elems (<>.sep-by data-sep <elem-parser>) - _ space~ - _ (<t>.this <close>)] + [_ (<text>.this <open>) + _ parse-space + elems (<>.sep-by ..parse-separator <elem-parser>) + _ parse-space + _ (<text>.this <close>)] (wrap (<prep> elems))))] - [array~ Array "[" "]" json~ row.from-list] - [object~ Object "{" "}" (kv~ json~) (dictionary.from-list text.hash)] + [parse-array Array ..open-array ..close-array parse-json row.from-list] + [parse-object Object ..open-object ..close-object (parse-kv parse-json) (dictionary.from-list text.hash)] ) -(def: json~ +(def: parse-json (Parser JSON) (<>.rec - (function (_ json~) + (function (_ parse-json) ($_ <>.or - null~ - boolean~ - number~ - string~ - (array~ json~) - (object~ json~))))) + parse-null + parse-boolean + parse-number + parse-string + (parse-array parse-json) + (parse-object parse-json))))) (structure: #export codec (Codec Text JSON) (def: encode ..format) - (def: decode (<t>.run json~))) + (def: decode (<text>.run parse-json))) diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux index 4ddcd18dd..cb136f810 100644 --- a/stdlib/source/lux/debug.lux +++ b/stdlib/source/lux/debug.lux @@ -10,7 +10,8 @@ ["." try (#+ Try)] ["." exception (#+ exception:)] ["<>" parser - ["<.>" type (#+ Parser)]] + ["<.>" type (#+ Parser)] + ["<.>" code]] pipe] [data ["." text @@ -26,7 +27,9 @@ [duration (#+ Duration)] [date (#+ Date)]] [macro - ["." template]]]) + ["." template] + ["." syntax (#+ syntax:)] + ["." code]]]) (with-expansions [<jvm> (as-is (import: java/lang/String) @@ -289,3 +292,9 @@ (#try.Failure _) (exception.throw ..cannot-represent-value type))) + +(syntax: #export (private {definition <code>.identifier}) + (let [[module _] definition] + (wrap (list (` ("lux in-module" + (~ (code.text module)) + (~ (code.identifier definition)))))))) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 22fc14b28..7dd6140cc 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -1,6 +1,6 @@ (.module: [lux (#- Type type int char) - ["lux-." type ("#@." equivalence)] + ["lux-." type ("#\." equivalence)] [abstract ["." monad (#+ Monad do)] ["." enum]] @@ -9,19 +9,18 @@ ["." io] ["." try (#+ Try)] ["." exception (#+ Exception exception:)] - ["<>" parser ("#@." monad) + ["<>" parser ("#\." monad) ["<t>" text] ["<c>" code (#+ Parser)]]] [data ["." maybe] ["." product] - ["." bit ("#@." codec)] number - ["." text ("#@." equivalence monoid) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection ["." array] - ["." list ("#@." monad fold monoid)] + ["." list ("#\." monad fold monoid)] ["." dictionary (#+ Dictionary)]]] [macro [syntax (#+ syntax:)] @@ -344,7 +343,7 @@ [parser.upper? limit (parameter-type limit)] [parser.class? [name parameters] (` (.primitive (~ (code.text name)) - [(~+ (list@map parameter-type parameters))]))])) + [(~+ (list\map parameter-type parameters))]))])) ## else (undefined) ))) @@ -401,12 +400,12 @@ (case (f input) (^template [<tag>] [[meta (<tag> parts)] - [meta (<tag> (list@map (pre-walk-replace f) parts))]]) + [meta (<tag> (list\map (pre-walk-replace f) parts))]]) ([#.Form] [#.Tuple]) [meta (#.Record pairs)] - [meta (#.Record (list@map (: (-> [Code Code] [Code Code]) + [meta (#.Record (list\map (: (-> [Code Code] [Code Code]) (function (_ [key val]) [(pre-walk-replace f key) (pre-walk-replace f val)])) pairs))] @@ -446,8 +445,8 @@ (<c>.tuple (<>.exactly (list.size arguments) <c>.any)))))] (wrap (` ("jvm member invoke constructor" (~ (code.text class-name)) (~+ (|> args - (list.zip/2 (list@map product.right arguments)) - (list@map ..decorate-input)))))))) + (list.zip/2 (list\map product.right arguments)) + (list\map ..decorate-input)))))))) (def: (make-static-method-parser class-name method-name arguments) (-> Text Text (List Argument) (Parser Code)) @@ -458,8 +457,8 @@ (<c>.tuple (<>.exactly (list.size arguments) <c>.any)))))] (wrap (` ("jvm member invoke static" (~ (code.text class-name)) (~ (code.text method-name)) (~+ (|> args - (list.zip/2 (list@map product.right arguments)) - (list@map ..decorate-input)))))))) + (list.zip/2 (list\map product.right arguments)) + (list\map ..decorate-input)))))))) (template [<name> <jvm-op>] [(def: (<name> class-name method-name arguments) @@ -472,8 +471,8 @@ (wrap (` (<jvm-op> (~ (code.text class-name)) (~ (code.text method-name)) (~' _jvm_this) (~+ (|> args - (list.zip/2 (list@map product.right arguments)) - (list@map ..decorate-input))))))))] + (list.zip/2 (list\map product.right arguments)) + (list\map ..decorate-input))))))))] [make-special-method-parser "jvm member invoke special"] [make-virtual-method-parser "jvm member invoke virtual"] @@ -537,7 +536,7 @@ (not (text.contains? name.external-separator name)))] (..assert ..class-name-cannot-be-a-type-variable [name type-vars] (not (list.member? text.equivalence - (list@map parser.name type-vars) + (list\map parser.name type-vars) name))))) (def: (valid-class-name type-vars) @@ -554,7 +553,7 @@ [[name parameters] (: (Parser [External (List (Type Parameter))]) ($_ <>.either (<>.and (valid-class-name type-vars) - (<>@wrap (list))) + (<>\wrap (list))) (<c>.form (<>.and <c>.local-identifier (<>.some (parameter^ type-vars))))))] (wrap (type.class (name.sanitize name) parameters)))) @@ -570,7 +569,7 @@ (do <>.monad [name <c>.local-identifier _ (..assert ..unexpected-type-variable [name type-vars] - (list.member? text.equivalence (list@map parser.name type-vars) name))] + (list.member? text.equivalence (list\map parser.name type-vars) name))] (wrap (type.var name)))) (def: wildcard^ @@ -664,7 +663,7 @@ (do <>.monad [[name variables] (: (Parser [External (List (Type Var))]) (<>.either (<>.and (valid-class-name (list)) - (<>@wrap (list))) + (<>\wrap (list))) (<c>.form (<>.and (valid-class-name (list)) (<>.some var^))) ))] @@ -766,7 +765,7 @@ [pm privacy-modifier^ strict-fp? (<>.parses? (<c>.this! (' #strict))) method-vars (<>.default (list) ..vars^) - #let [total-vars (list@compose class-vars method-vars)] + #let [total-vars (list\compose class-vars method-vars)] [_ self-name arguments] (<c>.form ($_ <>.and (<c>.this! (' new)) <c>.local-identifier @@ -787,7 +786,7 @@ strict-fp? (<>.parses? (<c>.this! (' #strict))) final? (<>.parses? (<c>.this! (' #final))) method-vars (<>.default (list) ..vars^) - #let [total-vars (list@compose class-vars method-vars)] + #let [total-vars (list\compose class-vars method-vars)] [name self-name arguments] (<c>.form ($_ <>.and <c>.local-identifier <c>.local-identifier @@ -807,7 +806,7 @@ [strict-fp? (<>.parses? (<c>.this! (' #strict))) owner-class ..declaration^ method-vars (<>.default (list) ..vars^) - #let [total-vars (list@compose (product.right (parser.declaration owner-class)) + #let [total-vars (list\compose (product.right (parser.declaration owner-class)) method-vars)] [name self-name arguments] (<c>.form ($_ <>.and <c>.local-identifier @@ -933,7 +932,7 @@ [tvars (<>.default (list) ..vars^) _ (<c>.identifier! ["" "new"]) ?alias import-member-alias^ - #let [total-vars (list@compose owner-vars tvars)] + #let [total-vars (list\compose owner-vars tvars)] ?prim-mode (<>.maybe primitive-mode^) args (..import-member-args^ total-vars) [io? try? maybe?] import-member-return-flags^] @@ -954,7 +953,7 @@ tvars (<>.default (list) ..vars^) name <c>.local-identifier ?alias import-member-alias^ - #let [total-vars (list@compose owner-vars tvars)] + #let [total-vars (list\compose owner-vars tvars)] ?prim-mode (<>.maybe primitive-mode^) args (..import-member-args^ total-vars) [io? try? maybe?] import-member-return-flags^ @@ -1005,7 +1004,7 @@ (def: (annotation$ [name params]) (-> Annotation Code) - (` ((~ (code.text name)) (~+ (list@map annotation-parameter$ params))))) + (` ((~ (code.text name)) (~+ (list\map annotation-parameter$ params))))) (template [<name> <category>] [(def: <name> @@ -1028,10 +1027,10 @@ (-> [Member-Declaration MethodDecl] Code) (let [(^slots [#method-tvars #method-inputs #method-output #method-exs]) method-decl] (` ((~ (code.text name)) - [(~+ (list@map annotation$ anns))] - [(~+ (list@map var$ method-tvars))] - [(~+ (list@map class$ method-exs))] - [(~+ (list@map value$ method-inputs))] + [(~+ (list\map annotation$ anns))] + [(~+ (list\map var$ method-tvars))] + [(~+ (list\map class$ method-exs))] + [(~+ (list\map value$ method-inputs))] (~ (return$ method-output)))))) (def: (state-modifier$ sm) @@ -1046,7 +1045,7 @@ (case field (#ConstantField class value) (` ("constant" (~ (code.text name)) - [(~+ (list@map annotation$ anns))] + [(~+ (list\map annotation$ anns))] (~ (value$ class)) (~ value) )) @@ -1055,7 +1054,7 @@ (` ("variable" (~ (code.text name)) (~ (privacy-modifier$ pm)) (~ (state-modifier$ sm)) - [(~+ (list@map annotation$ anns))] + [(~+ (list\map annotation$ anns))] (~ (value$ class)) )) )) @@ -1075,12 +1074,12 @@ (` ("init" (~ (privacy-modifier$ pm)) (~ (code.bit strict-fp?)) - [(~+ (list@map annotation$ anns))] - [(~+ (list@map var$ type-vars))] - [(~+ (list@map class$ exs))] + [(~+ (list\map annotation$ anns))] + [(~+ (list\map var$ type-vars))] + [(~+ (list\map class$ exs))] (~ (code.text self-name)) - [(~+ (list@map argument$ arguments))] - [(~+ (list@map constructor-arg$ constructor-args))] + [(~+ (list\map argument$ arguments))] + [(~+ (list\map constructor-arg$ constructor-args))] (~ (pre-walk-replace replacer body)) )) @@ -1090,12 +1089,12 @@ (~ (privacy-modifier$ pm)) (~ (code.bit final?)) (~ (code.bit strict-fp?)) - [(~+ (list@map annotation$ anns))] - [(~+ (list@map var$ type-vars))] + [(~+ (list\map annotation$ anns))] + [(~+ (list\map var$ type-vars))] (~ (code.text self-name)) - [(~+ (list@map argument$ arguments))] + [(~+ (list\map argument$ arguments))] (~ (return$ return-type)) - [(~+ (list@map class$ exs))] + [(~+ (list\map class$ exs))] (~ (pre-walk-replace replacer body)))) (#OverridenMethod strict-fp? declaration type-vars self-name arguments return-type body exs) @@ -1107,18 +1106,18 @@ (~ (code.text name)) (~' _jvm_this) (~+ (|> args - (list.zip/2 (list@map product.right arguments)) - (list@map ..decorate-input)))))))))] + (list.zip/2 (list\map product.right arguments)) + (list\map ..decorate-input)))))))))] (` ("override" (~ (declaration$ declaration)) (~ (code.text name)) (~ (code.bit strict-fp?)) - [(~+ (list@map annotation$ anns))] - [(~+ (list@map var$ type-vars))] + [(~+ (list\map annotation$ anns))] + [(~+ (list\map var$ type-vars))] (~ (code.text self-name)) - [(~+ (list@map argument$ arguments))] + [(~+ (list\map argument$ arguments))] (~ (return$ return-type)) - [(~+ (list@map class$ exs))] + [(~+ (list\map class$ exs))] (~ (|> body (pre-walk-replace replacer) (pre-walk-replace super-replacer))) @@ -1129,10 +1128,10 @@ (~ (code.text name)) (~ (privacy-modifier$ pm)) (~ (code.bit strict-fp?)) - [(~+ (list@map annotation$ anns))] - [(~+ (list@map var$ type-vars))] - [(~+ (list@map class$ exs))] - [(~+ (list@map argument$ arguments))] + [(~+ (list\map annotation$ anns))] + [(~+ (list\map var$ type-vars))] + [(~+ (list\map class$ exs))] + [(~+ (list\map argument$ arguments))] (~ (return$ return-type)) (~ (pre-walk-replace replacer body)))) @@ -1140,20 +1139,20 @@ (` ("abstract" (~ (code.text name)) (~ (privacy-modifier$ pm)) - [(~+ (list@map annotation$ anns))] - [(~+ (list@map var$ type-vars))] - [(~+ (list@map class$ exs))] - [(~+ (list@map argument$ arguments))] + [(~+ (list\map annotation$ anns))] + [(~+ (list\map var$ type-vars))] + [(~+ (list\map class$ exs))] + [(~+ (list\map argument$ arguments))] (~ (return$ return-type)))) (#NativeMethod type-vars arguments return-type exs) (` ("native" (~ (code.text name)) (~ (privacy-modifier$ pm)) - [(~+ (list@map annotation$ anns))] - [(~+ (list@map var$ type-vars))] - [(~+ (list@map class$ exs))] - [(~+ (list@map argument$ arguments))] + [(~+ (list\map annotation$ anns))] + [(~+ (list\map var$ type-vars))] + [(~+ (list\map class$ exs))] + [(~+ (list\map argument$ arguments))] (~ (return$ return-type)))) )) @@ -1209,19 +1208,19 @@ (do meta.monad [current-module meta.current-module-name #let [fully-qualified-class-name (name.qualify current-module full-class-name) - field-parsers (list@map (field->parser fully-qualified-class-name) fields) - method-parsers (list@map (method->parser fully-qualified-class-name) methods) - replacer (parser->replacer (list@fold <>.either + field-parsers (list\map (field->parser fully-qualified-class-name) fields) + method-parsers (list\map (method->parser fully-qualified-class-name) methods) + replacer (parser->replacer (list\fold <>.either (<>.fail "") - (list@compose field-parsers method-parsers)))]] + (list\compose field-parsers method-parsers)))]] (wrap (list (` ("jvm class" (~ (declaration$ (type.declaration (name.qualify current-module full-class-name) class-vars))) (~ (class$ super)) - [(~+ (list@map class$ interfaces))] + [(~+ (list\map class$ interfaces))] (~ (inheritance-modifier$ im)) - [(~+ (list@map annotation$ annotations))] - [(~+ (list@map field-decl$ fields))] - [(~+ (list@map (method-def$ replacer super) methods))])))))) + [(~+ (list\map annotation$ annotations))] + [(~+ (list\map field-decl$ fields))] + [(~+ (list\map (method-def$ replacer super) methods))])))))) (syntax: #export (interface: {#let [! <>.monad]} @@ -1237,9 +1236,9 @@ [current-module meta.current-module-name] (wrap (list (` ("jvm class interface" (~ (declaration$ (type.declaration (name.qualify current-module full-class-name) class-vars))) - [(~+ (list@map class$ supers))] - [(~+ (list@map annotation$ annotations))] - (~+ (list@map method-decl$ members)))))))) + [(~+ (list\map class$ supers))] + [(~+ (list\map annotation$ annotations))] + (~+ (list\map method-decl$ members)))))))) (syntax: #export (object {class-vars ..vars^} @@ -1261,11 +1260,11 @@ []))) )} (wrap (list (` ("jvm class anonymous" - [(~+ (list@map var$ class-vars))] + [(~+ (list\map var$ class-vars))] (~ (class$ super)) - [(~+ (list@map class$ interfaces))] - [(~+ (list@map constructor-arg$ constructor-args))] - [(~+ (list@map (method-def$ function.identity super) methods))]))))) + [(~+ (list\map class$ interfaces))] + [(~+ (list\map constructor-arg$ constructor-args))] + [(~+ (list\map (method-def$ function.identity super) methods))]))))) (syntax: #export (null) {#.doc (doc "Null object reference." @@ -1359,14 +1358,14 @@ (ClassName::method2 arg3 arg4 arg5)))} (with-gensyms [g!obj] (wrap (list (` (let [(~ g!obj) (~ obj)] - (exec (~+ (list@map (complete-call$ g!obj) methods)) + (exec (~+ (list\map (complete-call$ g!obj) methods)) (~ g!obj)))))))) (def: (class-import$ declaration) (-> (Type Declaration) Code) (let [[full-name params] (parser.declaration declaration) def-name (..internal full-name) - params' (list@map ..var$' params)] + params' (list\map ..var$' params)] (` (def: (~ (code.identifier ["" def-name])) {#..jvm-class (~ (code.text (..internal full-name)))} .Type @@ -1378,7 +1377,7 @@ (-> (List (Type Var)) Import-Member-Declaration (List (Type Var))) (case member (#ConstructorDecl [commons _]) - (list@compose class-tvars (get@ #import-member-tvars commons)) + (list\compose class-tvars (get@ #import-member-tvars commons)) (#MethodDecl [commons _]) (case (get@ #import-member-kind commons) @@ -1386,7 +1385,7 @@ (get@ #import-member-tvars commons) _ - (list@compose class-tvars (get@ #import-member-tvars commons))) + (list\compose class-tvars (get@ #import-member-tvars commons))) _ class-tvars)) @@ -1403,8 +1402,8 @@ (with-gensyms [arg-name] (wrap [maybe? arg-name])))) import-member-args) - #let [input-jvm-types (list@map product.right import-member-args) - arg-types (list@map (: (-> [Bit (Type Value)] Code) + #let [input-jvm-types (list\map product.right import-member-args) + arg-types (list\map (: (-> [Bit (Type Value)] Code) (function (_ [maybe? arg]) (let [arg-type (value-type (get@ #import-member-mode commons) arg)] (if maybe? @@ -1527,12 +1526,12 @@ (def: (jvm-invoke-inputs mode classes inputs) (-> Primitive-Mode (List (Type Value)) (List [Bit Code]) (List Code)) (|> inputs - (list@map (function (_ [maybe? input]) + (list\map (function (_ [maybe? input]) (if maybe? (` ((~! !!!) (~ (un-quote input)))) (un-quote input)))) (list.zip/2 classes) - (list@map (auto-convert-input mode)))) + (list\map (auto-convert-input mode)))) (def: (member-def-interop vars kind class [arg-function-inputs input-jvm-types arg-types] member method-prefix) (-> (List (Type Var)) Class-Kind (Type Declaration) [(List [Bit Code]) (List (Type Value)) (List Code)] Import-Member-Declaration Text (Meta (List Code))) @@ -1546,7 +1545,7 @@ (` (primitive (~ (code.text full-name)))) _ - (let [=class-tvars (list@map ..var$' class-tvars)] + (let [=class-tvars (list\map ..var$' class-tvars)] (` (All [(~+ =class-tvars)] (primitive (~ (code.text full-name)) [(~+ =class-tvars)])))))) getter-interop (: (-> Text Code) (function (_ name) @@ -1554,7 +1553,7 @@ (` (def: (~ getter-name) (~ enum-type) (~ (get-static-field full-name name)))))))]] - (wrap (list@map getter-interop enum-members))) + (wrap (list\map getter-interop enum-members))) (#ConstructorDecl [commons _]) (do meta.monad @@ -1562,17 +1561,17 @@ def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) jvm-interop (|> [classT (` ("jvm member invoke constructor" - [(~+ (list@map ..var$ class-tvars))] + [(~+ (list\map ..var$ class-tvars))] (~ (code.text full-name)) - [(~+ (list@map ..var$ (get@ #import-member-tvars commons)))] + [(~+ (list\map ..var$ (get@ #import-member-tvars commons)))] (~+ (|> (jvm-invoke-inputs (get@ #import-member-mode commons) input-jvm-types arg-function-inputs) (list.zip/2 input-jvm-types) - (list@map ..decorate-input)))))] + (list\map ..decorate-input)))))] (auto-convert-output (get@ #import-member-mode commons)) (decorate-return-maybe member true classT) (decorate-return-try member) (decorate-return-io member))]] - (wrap (list (` ((~! syntax:) ((~ def-name) (~+ (list@map product.right arg-function-inputs))) + (wrap (list (` ((~! syntax:) ((~ def-name) (~+ (list\map product.right arg-function-inputs))) ((~' wrap) (.list (.` (~ jvm-interop))))))))) (#MethodDecl [commons method]) @@ -1600,17 +1599,17 @@ method-return (get@ #import-method-return method) callC (: Code (` ((~ (code.text jvm-op)) - [(~+ (list@map ..var$ class-tvars))] + [(~+ (list\map ..var$ class-tvars))] (~ (code.text full-name)) (~ (code.text import-method-name)) - [(~+ (list@map ..var$ (get@ #import-member-tvars commons)))] + [(~+ (list\map ..var$ (get@ #import-member-tvars commons)))] (~+ (|> object-ast - (list@map ..un-quote) + (list\map ..un-quote) (list.zip/2 (list (type.class full-name (list)))) - (list@map (auto-convert-input (get@ #import-member-mode commons))))) + (list\map (auto-convert-input (get@ #import-member-mode commons))))) (~+ (|> (jvm-invoke-inputs (get@ #import-member-mode commons) input-jvm-types arg-function-inputs) (list.zip/2 input-jvm-types) - (list@map ..decorate-input)))))) + (list\map ..decorate-input)))))) jvm-interop (: Code (case (type.void? method-return) (#.Left method-return) @@ -1626,7 +1625,7 @@ (|> callC (decorate-return-try member) (decorate-return-io member))))]] - (wrap (list (` ((~! syntax:) ((~ def-name) (~+ (list@map product.right arg-function-inputs)) (~+ object-ast)) + (wrap (list (` ((~! syntax:) ((~ def-name) (~+ (list\map product.right arg-function-inputs)) (~+ object-ast)) ((~' wrap) (.list (.` (~ jvm-interop)))))))))) (#FieldAccessDecl fad) @@ -1759,7 +1758,7 @@ (do {! meta.monad} [kind (class-kind declaration) =members (monad.map ! (member-import$ class-type-vars kind declaration) members)] - (wrap (list& (class-import$ declaration) (list@join =members))))) + (wrap (list& (class-import$ declaration) (list\join =members))))) (syntax: #export (array {type (..type^ (list))} size) @@ -1793,12 +1792,12 @@ (with-expansions [<failure> (as-is (meta.fail (exception.construct ..cannot-convert-to-jvm-type [type])))] (def: (lux-type->jvm-type type) (-> .Type (Meta (Type Value))) - (if (lux-type@= Any type) + (if (lux-type\= Any type) (:: meta.monad wrap $Object) (case type (#.Primitive name params) (`` (cond (~~ (template [<type>] - [(text@= (..reflection <type>) name) + [(text\= (..reflection <type>) name) (case params #.Nil (:: meta.monad wrap <type>) @@ -1816,7 +1815,7 @@ [type.char])) (~~ (template [<type>] - [(text@= (..reflection (type.array <type>)) name) + [(text\= (..reflection (type.array <type>)) name) (case params #.Nil (:: meta.monad wrap (type.array <type>)) @@ -1833,7 +1832,7 @@ [type.double] [type.char])) - (text@= array.type-name name) + (text\= array.type-name name) (case params (#.Cons elementLT #.Nil) (:: meta.monad map type.array diff --git a/stdlib/source/lux/meta/annotation.lux b/stdlib/source/lux/meta/annotation.lux index ea47f6970..17fef0c8f 100644 --- a/stdlib/source/lux/meta/annotation.lux +++ b/stdlib/source/lux/meta/annotation.lux @@ -4,8 +4,7 @@ ["." monad (#+ do)]] [data ["." maybe] - ["." name ("#@." equivalence)] - ["." text ("#@." monoid)]]]) + ["." name ("#\." equivalence)]]]) (type: #export Annotation Code) @@ -19,7 +18,7 @@ (#.Cons [key value] ann') (case key [_ (#.Tag tag')] - (if (name@= tag tag') + (if (name\= tag tag') (#.Some value) (recur ann')) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 252fccc68..0dd2c030b 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -15,12 +15,10 @@ [data ["." maybe] [number - ["n" nat ("#@." decimal)] - ["i" int ("#@." decimal)]] - ["." text ("#@." monoid)] + ["i" int]] + ["." text ("#\." monoid)] [collection - ["." row] - ["." list ("#@." fold)]]] + ["." row]]] [type abstract]] ["." // (#+ Time) @@ -123,7 +121,7 @@ (-> Instant Text) (let [[date time] (..date-time instant) time (..clock-time time)] - ($_ text@compose + ($_ text\compose (:: date.codec encode date) ..date-suffix (:: //.codec encode time) ..time-suffix))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux index 6ad18d63d..8c5b74cff 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -9,7 +9,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." fold monoid monad)]]] + ["." list ("#\." fold monoid monad)]]] ["." type ["." check]] ["." meta]] @@ -37,7 +37,7 @@ ["Function" (%.code functionC)] ["Arguments" (|> arguments list.enumeration - (list@map (.function (_ [idx argC]) + (list\map (.function (_ [idx argC]) (format (%.nat idx) " " (%.code argC)))) (text.join-with text.new-line))])) @@ -89,7 +89,7 @@ (#.Function inputT outputT) (<| (:: ! map (.function (_ [scope bodyA]) - (#/.Function (list@map (|>> /.variable) + (#/.Function (list\map (|>> /.variable) (//scope.environment scope)) bodyA))) /.with-scope diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux index 8c1ba3644..582e7d860 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux @@ -7,10 +7,10 @@ ["." try] ["." exception (#+ exception:)]] [data - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection - ["." list ("#@." fold functor)] + ["." list ("#\." fold functor)] [dictionary ["." plist]]]] ["." meta]] @@ -102,7 +102,7 @@ (function (_ state) (#try.Success [(update@ #.modules (plist.update self-name (update@ #.imports (function (_ current) - (if (list.any? (text@= module) + (if (list.any? (text\= module) current) current (#.Cons module current))))) @@ -254,16 +254,16 @@ (/.throw cannot-declare-tags-for-unnamed-type [tags type])) _ (ensure-undeclared-tags self-name tags) _ (///.assert cannot-declare-tags-for-foreign-type [tags type] - (text@= self-name type-module))] + (text\= self-name type-module))] (///extension.lift (function (_ state) (case (|> state (get@ #.modules) (plist.get self-name)) (#.Some module) - (let [namespaced-tags (list@map (|>> [self-name]) tags)] + (let [namespaced-tags (list\map (|>> [self-name]) tags)] (#try.Success [(update@ #.modules (plist.update self-name (|>> (update@ #.tags (function (_ tag-bindings) - (list@fold (function (_ [idx tag] table) + (list\fold (function (_ [idx tag] table) (plist.put tag [idx namespaced-tags exported? type] table)) tag-bindings (list.enumeration tags)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension.lux index 3edad4d3b..f121b78ca 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension.lux @@ -10,10 +10,10 @@ ["." exception (#+ exception:)]] [data ["." product] - ["." text ("#@." order) + ["." text ("#\." order) ["%" format (#+ Format format)]] [collection - ["." list ("#@." functor)] + ["." list] ["." dictionary (#+ Dictionary)]]]] [///// ["//" phase] @@ -75,7 +75,7 @@ ["Extension" (%.text name)] ["Available" (|> bundle dictionary.keys - (list.sort text@<) + (list.sort text\<) (exception.enumerate %.text))])) (type: #export (Extender s i o) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index 618fbbfc9..0fdaa8c96 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -6,7 +6,7 @@ ["." monad (#+ do)]] [control pipe - ["." try (#+ Try) ("#@." monad)] + ["." try (#+ Try) ("#\." monad)] ["." exception (#+ exception:)] ["<>" parser ["<c>" code (#+ Parser)] @@ -16,20 +16,20 @@ ["." product] [number ["n" nat]] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection - ["." list ("#@." fold monad monoid)] + ["." list ("#\." fold monad monoid)] ["." array] ["." dictionary (#+ Dictionary)]]] ["." type - ["." check (#+ Check) ("#@." monad)]] + ["." check (#+ Check) ("#\." monad)]] [target ["." jvm #_ [".!" reflection] [encoding [name (#+ External)]] - ["#" type (#+ Type Argument Typed) ("#@." equivalence) + ["#" type (#+ Type Argument Typed) ("#\." equivalence) ["." category (#+ Void Value' Value Return' Return Primitive Object Class Array Var Parameter Method)] ["." box] ["." reflection] @@ -52,7 +52,7 @@ ["#." synthesis] [/// [reference (#+)] - ["." phase ("#@." monad)] + ["." phase ("#\." monad)] [meta [archive (#+ Archive) [descriptor (#+ Module)]]]]]]]]) @@ -146,7 +146,7 @@ ["Class" class] ["Method" method] ["Arguments" (exception.enumerate ..signature inputsJT)] - ["Hints" (exception.enumerate %.type (list@map product.left hints))]))] + ["Hints" (exception.enumerate %.type (list\map product.left hints))]))] [no-candidates] [too-many-candidates] @@ -275,14 +275,14 @@ (/////analysis.throw ..non-jvm-type luxT)) (^ (#.Primitive (static array.type-name) (list elemT))) - (phase@map jvm.array (jvm-type elemT)) + (phase\map jvm.array (jvm-type elemT)) (#.Primitive class parametersT) (case (dictionary.get class ..boxes) (#.Some [_ primitive-type]) (case parametersT #.Nil - (phase@wrap primitive-type) + (phase\wrap primitive-type) _ (/////analysis.throw ..primitives-cannot-have-type-parameters class)) @@ -304,7 +304,7 @@ (wrap (jvm.class class parametersJT)))) (#.Ex _) - (phase@wrap (jvm.class ..object-class (list))) + (phase\wrap (jvm.class ..object-class (list))) _ (/////analysis.throw ..non-jvm-type luxT))) @@ -398,7 +398,7 @@ (#.Primitive name parameters) (`` (cond (or (~~ (template [<type>] - [(text@= (..reflection <type>) name)] + [(text\= (..reflection <type>) name)] [jvm.boolean] [jvm.byte] @@ -412,14 +412,14 @@ (/////analysis.throw ..non-parameter objectT) ## else - (phase@wrap (jvm.class name (list))))) + (phase\wrap (jvm.class name (list))))) (#.Named name anonymous) (check-parameter anonymous) (^template [<tag>] [(<tag> id) - (phase@wrap (jvm.class ..object-class (list)))]) + (phase\wrap (jvm.class ..object-class (list)))]) ([#.Var] [#.Ex]) @@ -445,8 +445,8 @@ (case objectT (#.Primitive name #.Nil) (`` (cond (~~ (template [<type>] - [(text@= (..reflection <type>) name) - (phase@wrap <type>)] + [(text\= (..reflection <type>) name) + (phase\wrap <type>)] [jvm.boolean] [jvm.byte] @@ -458,8 +458,8 @@ [jvm.char])) (~~ (template [<type>] - [(text@= (..reflection (jvm.array <type>)) name) - (phase@wrap (jvm.array <type>))] + [(text\= (..reflection (jvm.array <type>)) name) + (phase\wrap (jvm.array <type>))] [jvm.boolean] [jvm.byte] @@ -476,18 +476,18 @@ (check-jvm (#.Primitive unprefixed (list))))) ## else - (phase@wrap (jvm.class name (list))))) + (phase\wrap (jvm.class name (list))))) (^ (#.Primitive (static array.type-name) (list elementT))) (|> elementT check-jvm - (phase@map jvm.array)) + (phase\map jvm.array)) (#.Primitive name parameters) (do {! phase.monad} [parameters (monad.map ! check-parameter parameters)] - (phase@wrap (jvm.class name parameters))) + (phase\wrap (jvm.class name parameters))) (#.Named name anonymous) (check-jvm anonymous) @@ -515,12 +515,12 @@ [name (:: ! map ..reflection (check-jvm objectT))] (if (dictionary.contains? name ..boxes) (/////analysis.throw ..primitives-are-not-objects [name]) - (phase@wrap name)))) + (phase\wrap name)))) (def: (check-return type) (-> .Type (Operation (Type Return))) (if (is? .Any type) - (phase@wrap jvm.void) + (phase\wrap jvm.void) (check-jvm type))) (def: (read-primitive-array-handler lux-type jvm-type) @@ -866,11 +866,11 @@ can-cast? (: (Operation Bit) (`` (cond (~~ (template [<primitive> <object>] [(let [=primitive (reflection.reflection <primitive>)] - (or (and (text@= =primitive from-name) - (or (text@= <object> to-name) - (text@= =primitive to-name))) - (and (text@= <object> from-name) - (text@= =primitive to-name)))) + (or (and (text\= =primitive from-name) + (or (text\= <object> to-name) + (text\= =primitive to-name))) + (and (text\= <object> from-name) + (text\= =primitive to-name)))) (wrap true)] [reflection.boolean box.boolean] @@ -889,23 +889,23 @@ _ (phase.assert ..primitives-are-not-objects [to-name] (not (dictionary.contains? to-name ..boxes))) to-class (phase.lift (reflection!.load to-name)) - _ (if (text@= ..inheritance-relationship-type-name from-name) + _ (if (text\= ..inheritance-relationship-type-name from-name) (wrap []) (do ! [from-class (phase.lift (reflection!.load from-name))] (phase.assert cannot-cast [fromT toT fromC] (java/lang/Class::isAssignableFrom from-class to-class))))] (loop [[current-name currentT] [from-name fromT]] - (if (text@= to-name current-name) + (if (text\= to-name current-name) (wrap true) (do ! [candidate-parents (: (Operation (List [[Text .Type] Bit])) - (if (text@= ..inheritance-relationship-type-name current-name) + (if (text\= ..inheritance-relationship-type-name current-name) (inheritance-candidate-parents currentT to-class toT fromC) (class-candidate-parents current-name currentT to-name to-class)))] (case (|> candidate-parents (list.filter product.right) - (list@map product.left)) + (list\map product.left)) (#.Cons [next-name nextT] _) (recur [next-name nextT]) @@ -1035,7 +1035,7 @@ phase.lift) #let [modifiers (java/lang/reflect/Method::getModifiers method) correct-class? (java/lang/Object::equals class (java/lang/reflect/Method::getDeclaringClass method)) - correct-method? (text@= method-name (java/lang/reflect/Method::getName method)) + correct-method? (text\= method-name (java/lang/reflect/Method::getName method)) static-matches? (case method-style #Static (java/lang/reflect/Modifier::isStatic modifiers) @@ -1050,9 +1050,9 @@ _ true) arity-matches? (n.= (list.size inputsJT) (list.size parameters)) - inputs-match? (list@fold (function (_ [expectedJC actualJC] prev) + inputs-match? (list\fold (function (_ [expectedJC actualJC] prev) (and prev - (jvm@= expectedJC (: (Type Value) + (jvm\= expectedJC (: (Type Value) (case (jvm-parser.var? actualJC) (#.Some name) (|> aliasing @@ -1080,9 +1080,9 @@ phase.lift)] (wrap (and (java/lang/Object::equals class (java/lang/reflect/Constructor::getDeclaringClass constructor)) (n.= (list.size inputsJT) (list.size parameters)) - (list@fold (function (_ [expectedJC actualJC] prev) + (list\fold (function (_ [expectedJC actualJC] prev) (and prev - (jvm@= expectedJC (: (Type Value) + (jvm\= expectedJC (: (Type Value) (case (jvm-parser.var? actualJC) (#.Some name) (|> aliasing @@ -1101,15 +1101,15 @@ (def: (jvm-type-var-mapping owner-tvars method-tvars) (-> (List Text) (List Text) [(List .Type) Mapping]) - (let [jvm-tvars (list@compose owner-tvars method-tvars) + (let [jvm-tvars (list\compose owner-tvars method-tvars) lux-tvars (|> jvm-tvars list.reverse list.enumeration - (list@map (function (_ [idx name]) + (list\map (function (_ [idx name]) [name (idx-to-parameter idx)])) list.reverse) num-owner-tvars (list.size owner-tvars) - owner-tvarsT (|> lux-tvars (list.take num-owner-tvars) (list@map product.right)) + owner-tvarsT (|> lux-tvars (list.take num-owner-tvars) (list\map product.right)) mapping (dictionary.from-list text.hash lux-tvars)] [owner-tvarsT mapping])) @@ -1123,28 +1123,28 @@ _ (|> (java/lang/Class::getTypeParameters owner) array.to-list - (list@map (|>> java/lang/reflect/TypeVariable::getName)))) + (list\map (|>> java/lang/reflect/TypeVariable::getName)))) method-tvars (|> (java/lang/reflect/Method::getTypeParameters method) array.to-list - (list@map (|>> java/lang/reflect/TypeVariable::getName))) + (list\map (|>> java/lang/reflect/TypeVariable::getName))) [owner-tvarsT mapping] (jvm-type-var-mapping owner-tvars method-tvars)] (do {! phase.monad} [inputsT (|> (java/lang/reflect/Method::getGenericParameterTypes method) array.to-list (monad.map ! (|>> reflection!.type phase.lift)) - (phase@map (monad.map ! (..reflection-type mapping))) - phase@join) + (phase\map (monad.map ! (..reflection-type mapping))) + phase\join) outputT (|> method java/lang/reflect/Method::getGenericReturnType reflection!.return phase.lift - (phase@map (..reflection-return mapping)) - phase@join) + (phase\map (..reflection-return mapping)) + phase\join) exceptionsT (|> (java/lang/reflect/Method::getGenericExceptionTypes method) array.to-list (monad.map ! (|>> reflection!.type phase.lift)) - (phase@map (monad.map ! (..reflection-type mapping))) - phase@join) + (phase\map (monad.map ! (..reflection-type mapping))) + phase\join) #let [methodT (<| (type.univ-q (dictionary.size mapping)) (type.function (case method-style #Static @@ -1161,22 +1161,22 @@ (let [owner (java/lang/reflect/Constructor::getDeclaringClass constructor) owner-tvars (|> (java/lang/Class::getTypeParameters owner) array.to-list - (list@map (|>> java/lang/reflect/TypeVariable::getName))) + (list\map (|>> java/lang/reflect/TypeVariable::getName))) method-tvars (|> (java/lang/reflect/Constructor::getTypeParameters constructor) array.to-list - (list@map (|>> java/lang/reflect/TypeVariable::getName))) + (list\map (|>> java/lang/reflect/TypeVariable::getName))) [owner-tvarsT mapping] (jvm-type-var-mapping owner-tvars method-tvars)] (do {! phase.monad} [inputsT (|> (java/lang/reflect/Constructor::getGenericParameterTypes constructor) array.to-list (monad.map ! (|>> reflection!.type phase.lift)) - (phase@map (monad.map ! (reflection-type mapping))) - phase@join) + (phase\map (monad.map ! (reflection-type mapping))) + phase\join) exceptionsT (|> (java/lang/reflect/Constructor::getGenericExceptionTypes constructor) array.to-list (monad.map ! (|>> reflection!.type phase.lift)) - (phase@map (monad.map ! (reflection-type mapping))) - phase@join) + (phase\map (monad.map ! (reflection-type mapping))) + phase\join) #let [objectT (#.Primitive (java/lang/Class::getName owner) owner-tvarsT) constructorT (<| (type.univ-q (dictionary.size mapping)) (type.function inputsT) @@ -1205,7 +1205,7 @@ (-> <type> (List (Type Var))) (|>> <method> array.to-list - (list@map (|>> java/lang/reflect/TypeVariable::getName jvm.var))))] + (list\map (|>> java/lang/reflect/TypeVariable::getName jvm.var))))] [class-type-variables (java/lang/Class java/lang/Object) java/lang/Class::getTypeParameters] [constructor-type-variables (java/lang/reflect/Constructor java/lang/Object) java/lang/reflect/Constructor::getTypeParameters] @@ -1214,8 +1214,8 @@ (def: (aliasing expected actual) (-> (List (Type Var)) (List (Type Var)) Aliasing) - (|> (list.zip/2 (list@map jvm-parser.name actual) - (list@map jvm-parser.name expected)) + (|> (list.zip/2 (list\map jvm-parser.name actual) + (list\map jvm-parser.name expected)) (dictionary.from-list text.hash))) (def: (method-candidate actual-class-tvars class-name actual-method-tvars method-name method-style inputsJT) @@ -1226,7 +1226,7 @@ candidates (|> class java/lang/Class::getDeclaredMethods array.to-list - (list.filter (|>> java/lang/reflect/Method::getName (text@= method-name))) + (list.filter (|>> java/lang/reflect/Method::getName (text\= method-name))) (monad.map ! (: (-> java/lang/reflect/Method (Operation Evaluation)) (function (_ method) (do ! @@ -1295,8 +1295,8 @@ (def: (decorate-inputs typesT inputsA) (-> (List (Type Value)) (List Analysis) (List Analysis)) (|> inputsA - (list.zip/2 (list@map (|>> ..signature /////analysis.text) typesT)) - (list@map (function (_ [type value]) + (list.zip/2 (list\map (|>> ..signature /////analysis.text) typesT)) + (list\map (function (_ [type value]) (/////analysis.tuple (list type value)))))) (def: type-vars (<c>.tuple (<>.some ..var))) @@ -1307,9 +1307,9 @@ [($_ <>.and ..type-vars ..member ..type-vars (<>.some ..input)) (function (_ extension-name analyse archive [class-tvars [class method] method-tvars argsTC]) (do phase.monad - [#let [argsT (list@map product.left argsTC)] + [#let [argsT (list\map product.left argsTC)] [methodT exceptionsT] (method-candidate class-tvars class method-tvars method #Static argsT) - [outputT argsA] (inferenceA.general archive analyse methodT (list@map product.right argsTC)) + [outputT argsA] (inferenceA.general archive analyse methodT (list\map product.right argsTC)) outputJT (check-return outputT)] (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text (..signature (jvm.class class (list)))) (/////analysis.text method) @@ -1322,9 +1322,9 @@ [($_ <>.and ..type-vars ..member ..type-vars <c>.any (<>.some ..input)) (function (_ extension-name analyse archive [class-tvars [class method] method-tvars objectC argsTC]) (do phase.monad - [#let [argsT (list@map product.left argsTC)] + [#let [argsT (list\map product.left argsTC)] [methodT exceptionsT] (method-candidate class-tvars class method-tvars method #Virtual argsT) - [outputT allA] (inferenceA.general archive analyse methodT (list& objectC (list@map product.right argsTC))) + [outputT allA] (inferenceA.general archive analyse methodT (list& objectC (list\map product.right argsTC))) #let [[objectA argsA] (case allA (#.Cons objectA argsA) [objectA argsA] @@ -1344,9 +1344,9 @@ [($_ <>.and ..type-vars ..member ..type-vars <c>.any (<>.some ..input)) (function (_ extension-name analyse archive [class-tvars [class method] method-tvars objectC argsTC]) (do phase.monad - [#let [argsT (list@map product.left argsTC)] + [#let [argsT (list\map product.left argsTC)] [methodT exceptionsT] (method-candidate class-tvars class method-tvars method #Special argsT) - [outputT argsA] (inferenceA.general archive analyse methodT (list& objectC (list@map product.right argsTC))) + [outputT argsA] (inferenceA.general archive analyse methodT (list& objectC (list\map product.right argsTC))) outputJT (check-return outputT)] (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text (..signature (jvm.class class (list)))) (/////analysis.text method) @@ -1359,12 +1359,12 @@ [($_ <>.and ..type-vars ..member ..type-vars <c>.any (<>.some ..input)) (function (_ extension-name analyse archive [class-tvars [class-name method] method-tvars objectC argsTC]) (do phase.monad - [#let [argsT (list@map product.left argsTC)] + [#let [argsT (list\map product.left argsTC)] class (phase.lift (reflection!.load class-name)) _ (phase.assert non-interface class-name (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class))) [methodT exceptionsT] (method-candidate class-tvars class-name method-tvars method #Interface argsT) - [outputT allA] (inferenceA.general archive analyse methodT (list& objectC (list@map product.right argsTC))) + [outputT allA] (inferenceA.general archive analyse methodT (list& objectC (list\map product.right argsTC))) #let [[objectA argsA] (case allA (#.Cons objectA argsA) [objectA argsA] @@ -1384,9 +1384,9 @@ [($_ <>.and ..type-vars <c>.text ..type-vars (<>.some ..input)) (function (_ extension-name analyse archive [class-tvars class method-tvars argsTC]) (do phase.monad - [#let [argsT (list@map product.left argsTC)] + [#let [argsT (list\map product.left argsTC)] [methodT exceptionsT] (constructor-candidate class-tvars class method-tvars argsT) - [outputT argsA] (inferenceA.general archive analyse methodT (list@map product.right argsTC))] + [outputT argsA] (inferenceA.general archive analyse methodT (list\map product.right argsTC))] (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text (..signature (jvm.class class (list)))) (decorate-inputs argsT argsA))))))])) @@ -1437,7 +1437,7 @@ (def: (annotation-analysis [name parameters]) (-> (Annotation Analysis) Analysis) (/////analysis.tuple (list& (/////analysis.text name) - (list@map annotation-parameter-analysis parameters)))) + (list\map annotation-parameter-analysis parameters)))) (template [<name> <category>] [(def: <name> @@ -1492,9 +1492,9 @@ [(def: <name> (-> (List (Type Class)) (Try (List [Text (Type Method)]))) (|>> (monad.map try.monad (|>> ..reflection reflection!.load)) - (try@map (monad.map try.monad <methods>)) - try@join - (try@map list@join)))] + (try\map (monad.map try.monad <methods>)) + try\join + (try\map list\join)))] [all-abstract-methods ..abstract-methods] [all-methods ..methods] @@ -1601,20 +1601,20 @@ [scope bodyA] (|> arguments' (#.Cons [self-name selfT]) list.reverse - (list@fold scope.with-local (analyse archive body)) + (list\fold scope.with-local (analyse archive body)) (typeA.with-type .Any) /////analysis.with-scope)] (wrap (/////analysis.tuple (list (/////analysis.text ..constructor-tag) (visibility-analysis visibility) (/////analysis.bit strict-fp?) - (/////analysis.tuple (list@map annotation-analysis annotationsA)) - (/////analysis.tuple (list@map var-analysis vars)) + (/////analysis.tuple (list\map annotation-analysis annotationsA)) + (/////analysis.tuple (list\map var-analysis vars)) (/////analysis.text self-name) - (/////analysis.tuple (list@map ..argument-analysis arguments)) - (/////analysis.tuple (list@map class-analysis exceptions)) - (/////analysis.tuple (list@map typed-analysis super-arguments)) + (/////analysis.tuple (list\map ..argument-analysis arguments)) + (/////analysis.tuple (list\map class-analysis exceptions)) + (/////analysis.tuple (list\map typed-analysis super-arguments)) (#/////analysis.Function - (list@map (|>> /////analysis.variable) + (list\map (|>> /////analysis.variable) (scope.environment scope)) (/////analysis.tuple (list bodyA))) )))))) @@ -1677,7 +1677,7 @@ [scope bodyA] (|> arguments' (#.Cons [self-name selfT]) list.reverse - (list@fold scope.with-local (analyse archive body)) + (list\fold scope.with-local (analyse archive body)) (typeA.with-type returnT) /////analysis.with-scope)] (wrap (/////analysis.tuple (list (/////analysis.text ..virtual-tag) @@ -1685,14 +1685,14 @@ (visibility-analysis visibility) (/////analysis.bit final?) (/////analysis.bit strict-fp?) - (/////analysis.tuple (list@map annotation-analysis annotationsA)) - (/////analysis.tuple (list@map var-analysis vars)) + (/////analysis.tuple (list\map annotation-analysis annotationsA)) + (/////analysis.tuple (list\map var-analysis vars)) (/////analysis.text self-name) - (/////analysis.tuple (list@map ..argument-analysis arguments)) + (/////analysis.tuple (list\map ..argument-analysis arguments)) (return-analysis return) - (/////analysis.tuple (list@map class-analysis exceptions)) + (/////analysis.tuple (list\map class-analysis exceptions)) (#/////analysis.Function - (list@map (|>> /////analysis.variable) + (list\map (|>> /////analysis.variable) (scope.environment scope)) (/////analysis.tuple (list bodyA))) )))))) @@ -1750,21 +1750,21 @@ arguments) [scope bodyA] (|> arguments' list.reverse - (list@fold scope.with-local (analyse archive body)) + (list\fold scope.with-local (analyse archive body)) (typeA.with-type returnT) /////analysis.with-scope)] (wrap (/////analysis.tuple (list (/////analysis.text ..static-tag) (/////analysis.text method-name) (visibility-analysis visibility) (/////analysis.bit strict-fp?) - (/////analysis.tuple (list@map annotation-analysis annotationsA)) - (/////analysis.tuple (list@map var-analysis vars)) - (/////analysis.tuple (list@map ..argument-analysis arguments)) + (/////analysis.tuple (list\map annotation-analysis annotationsA)) + (/////analysis.tuple (list\map var-analysis vars)) + (/////analysis.tuple (list\map ..argument-analysis arguments)) (return-analysis return) - (/////analysis.tuple (list@map class-analysis + (/////analysis.tuple (list\map class-analysis exceptions)) (#/////analysis.Function - (list@map (|>> /////analysis.variable) + (list\map (|>> /////analysis.variable) (scope.environment scope)) (/////analysis.tuple (list bodyA))) )))))) @@ -1826,22 +1826,22 @@ [scope bodyA] (|> arguments' (#.Cons [self-name selfT]) list.reverse - (list@fold scope.with-local (analyse archive body)) + (list\fold scope.with-local (analyse archive body)) (typeA.with-type returnT) /////analysis.with-scope)] (wrap (/////analysis.tuple (list (/////analysis.text ..overriden-tag) (class-analysis parent-type) (/////analysis.text method-name) (/////analysis.bit strict-fp?) - (/////analysis.tuple (list@map annotation-analysis annotationsA)) - (/////analysis.tuple (list@map var-analysis vars)) + (/////analysis.tuple (list\map annotation-analysis annotationsA)) + (/////analysis.tuple (list\map var-analysis vars)) (/////analysis.text self-name) - (/////analysis.tuple (list@map ..argument-analysis arguments)) + (/////analysis.tuple (list\map ..argument-analysis arguments)) (return-analysis return) - (/////analysis.tuple (list@map class-analysis + (/////analysis.tuple (list\map class-analysis exceptions)) (#/////analysis.Function - (list@map (|>> /////analysis.variable) + (list\map (|>> /////analysis.variable) (scope.environment scope)) (/////analysis.tuple (list bodyA))) )))))) @@ -1864,8 +1864,8 @@ (list.filter (function (_ [sub-name subJT]) (|> super-set (list.filter (function (_ [super-name superJT]) - (and (text@= super-name sub-name) - (jvm@= superJT subJT)))) + (and (text\= super-name sub-name) + (jvm\= superJT subJT)))) list.size (n.= 1) not)) @@ -1886,12 +1886,12 @@ class (phase.lift (reflection!.load name)) #let [expected-parameters (|> (java/lang/Class::getTypeParameters class) array.to-list - (list@map (|>> java/lang/reflect/TypeVariable::getName)))] + (list\map (|>> java/lang/reflect/TypeVariable::getName)))] _ (phase.assert ..class-parameter-mismatch [expected-parameters actual-parameters] (n.= (list.size expected-parameters) (list.size actual-parameters)))] (wrap (|> (list.zip/2 expected-parameters actual-parameters) - (list@fold (function (_ [expected actual] mapping) + (list\fold (function (_ [expected actual] mapping) (case (jvm-parser.var? actual) (#.Some actual) (dictionary.put actual expected mapping) @@ -1923,7 +1923,7 @@ (do {! phase.monad} [parameters (typeA.with-env (..parameter-types parameters)) - #let [mapping (list@fold (function (_ [parameterJ parameterT] mapping) + #let [mapping (list\fold (function (_ [parameterJ parameterT] mapping) (dictionary.put (jvm-parser.name parameterJ) parameterT mapping)) @@ -1958,7 +1958,7 @@ body]) (do ! [aliasing (super-aliasing parent-type)] - (wrap [method-name (|> (jvm.method [(list@map product.right arguments) + (wrap [method-name (|> (jvm.method [(list\map product.right arguments) return exceptions]) (jvm-alias.method aliasing))]))) @@ -1971,8 +1971,8 @@ (list.empty? invalid-overriden-methods))] (wrap (#/////analysis.Extension extension-name (list (class-analysis super-class) - (/////analysis.tuple (list@map class-analysis super-interfaces)) - (/////analysis.tuple (list@map typed-analysis constructor-argsA+)) + (/////analysis.tuple (list\map class-analysis super-interfaces)) + (/////analysis.tuple (list\map typed-analysis constructor-argsA+)) (/////analysis.tuple methodsA))))))])) (def: bundle::class diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index 1c50d6eb5..29fb70e63 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -15,7 +15,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." functor)] + ["." list ("#\." functor)] ["." dictionary (#+ Dictionary)]]] [type ["." check]] @@ -113,9 +113,9 @@ else (typeA.with-type expectedT (phase archive else))] (wrap (|> conditionals - (list@map (function (_ [cases branch]) + (list\map (function (_ [cases branch]) (////analysis.tuple - (list (////analysis.tuple (list@map (|>> ////analysis.nat) cases)) + (list (////analysis.tuple (list\map (|>> ////analysis.nat) cases)) branch)))) (list& input else) (#////analysis.Extension extension-name)))))]))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux index 8f44551d1..2837d6620 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux @@ -5,7 +5,7 @@ ["." monad (#+ do)]] [control [pipe (#+ case>)] - ["<>" parser ("#@." monad) + ["<>" parser ("#\." monad) ["<c>" code (#+ Parser)] ["<t>" text]]] [data @@ -15,7 +15,7 @@ [text ["%" format (#+ format)]] [collection - ["." list ("#@." functor fold)] + ["." list ("#\." functor fold)] ["." dictionary] ["." row]]] [type @@ -25,7 +25,7 @@ [target [jvm ["_" bytecode (#+ Bytecode)] - ["." modifier (#+ Modifier) ("#@." monoid)] + ["." modifier (#+ Modifier) ("#\." monoid)] ["." attribute] ["." field] ["." version] @@ -75,7 +75,7 @@ (Parser (Modifier field.Field)) (`` ($_ <>.either (~~ (template [<label> <modifier>] - [(<>.after (<c>.text! <label>) (<>@wrap <modifier>))] + [(<>.after (<c>.text! <label>) (<>\wrap <modifier>))] ["public" field.public] ["private" field.private] @@ -86,7 +86,7 @@ (Parser (Modifier class.Class)) (`` ($_ <>.either (~~ (template [<label> <modifier>] - [(<>.after (<c>.text! <label>) (<>@wrap <modifier>))] + [(<>.after (<c>.text! <label>) (<>\wrap <modifier>))] ["final" class.final] ["abstract" class.abstract] @@ -96,7 +96,7 @@ (Parser (Modifier field.Field)) (`` ($_ <>.either (~~ (template [<label> <modifier>] - [(<>.after (<c>.text! <label>) (<>@wrap <modifier>))] + [(<>.after (<c>.text! <label>) (<>\wrap <modifier>))] ["volatile" field.volatile] ["final" field.final] @@ -175,7 +175,7 @@ (def: constant::modifier (Modifier field.Field) - ($_ modifier@compose + ($_ modifier\compose field.public field.static field.final)) @@ -209,7 +209,7 @@ ## TODO: Handle annotations. (#Variable [name visibility state annotations type]) - (field.field (modifier@compose visibility state) + (field.field (modifier\compose visibility state) name type (row.row)))) (def: (method-definition [mapping selfT] [analyse synthesize generate]) @@ -261,7 +261,7 @@ [parameters (directive.lift-analysis (typeA.with-env (jvm.parameter-types parameters))) - #let [mapping (list@fold (function (_ [parameterJ parameterT] mapping) + #let [mapping (list\fold (function (_ [parameterJ parameterT] mapping) (dictionary.put (parser.name parameterJ) parameterT mapping)) luxT.fresh parameters)] @@ -273,7 +273,7 @@ (monad.map check.monad (|>> ..signature (luxT.check (luxT.class mapping))) super-interfaces))) - #let [selfT (jvm.inheritance-relationship-type (#.Primitive name (list@map product.right parameters)) + #let [selfT (jvm.inheritance-relationship-type (#.Primitive name (list\map product.right parameters)) super-classT super-interfaceT+)] state (extension.lift phase.get-state) @@ -286,10 +286,10 @@ ## (generation.save! true ["" name] ## [name ## (class.class version.v6_0 - ## (modifier@compose class.public inheritance) - ## (name.internal name) (list@map (|>> product.left parser.name ..constraint) parameters) + ## (modifier\compose class.public inheritance) + ## (name.internal name) (list\map (|>> product.left parser.name ..constraint) parameters) ## super-class super-interfaces - ## (list@map ..field-definition fields) + ## (list\map ..field-definition fields) ## (list) ## TODO: Add methods ## (row.row))])) _ (directive.lift-generation diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index d8d6ed817..a1adf0041 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux @@ -20,7 +20,7 @@ ["." meta] [macro ["." code]] - ["." type (#+ :share :by-example) ("#@." equivalence) + ["." type (#+ :share) ["." check]]] ["." /// (#+ Extender) ["#." bundle] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux index 2122a38a4..1485d7230 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux @@ -11,7 +11,7 @@ [number ["f" frac]] [collection - ["." list ("#@." functor)] + ["." list ("#\." functor)] ["." dictionary]]] ["@" target ["_" js (#+ Literal Expression Statement)]]] @@ -131,7 +131,7 @@ (monad.map ! (function (_ [chars branch]) (do ! [branchG (phase archive branch)] - (wrap [(list@map (|>> .int _.int) chars) + (wrap [(list\map (|>> .int _.int) chars) (_.return branchG)]))) conditionals))] (wrap (_.apply/* (_.closure (list) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux index 5c98aeba1..630e212c3 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux @@ -13,11 +13,11 @@ ["." i32] ["f" frac]] [collection - ["." list ("#@." monad)] + ["." list ("#\." monad)] ["." dictionary]]] [target [jvm - ["_" bytecode (#+ Label Bytecode) ("#@." monad)] + ["_" bytecode (#+ Label Bytecode) ("#\." monad)] [encoding ["." signed (#+ S4)]] ["." type (#+ Type) @@ -114,7 +114,7 @@ (do ! [branchG (phase archive branch) @branch ///runtime.forge-label] - (wrap [(list@map (function (_ char) + (wrap [(list\map (function (_ char) [(try.assume (signed.s4 (.int char))) @branch]) chars) ($_ _.compose @@ -123,10 +123,10 @@ (_.goto @end))]))) conditionalsS)) #let [table (|> conditionalsG+ - (list@map product.left) - list@join) + (list\map product.left) + list\join) conditionalsG (|> conditionalsG+ - (list@map product.right) + (list\map product.right) (monad.seq _.monad))]] (wrap (do _.monad [@else _.new-label] @@ -308,7 +308,7 @@ (_.invokevirtual ..$String "length" (type.method [(list) type.int (list)])) ..lux-int)) -(def: no-op (Bytecode Any) (_@wrap [])) +(def: no-op (Bytecode Any) (_\wrap [])) (template [<name> <pre-subject> <pre-param> <op> <post>] [(def: (<name> [paramG subjectG]) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux index e584bd1e4..ee9c3b1a2 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux @@ -11,12 +11,12 @@ [data ["." product] ["." maybe] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [number ["." i32]] [collection - ["." list ("#@." monad)] + ["." list ("#\." monad)] ["." dictionary (#+ Dictionary)] ["." set] ["." row]] @@ -25,14 +25,14 @@ [target [jvm ["." version] - ["." modifier ("#@." monoid)] + ["." modifier ("#\." monoid)] ["." method (#+ Method)] ["." class (#+ Class)] [constant [pool (#+ Resource)]] [encoding ["." name]] - ["_" bytecode (#+ Label Bytecode) ("#@." monad) + ["_" bytecode (#+ Label Bytecode) ("#\." monad) ["__" instruction (#+ Primitive-Array-Type)]] ["." type (#+ Type Typed Argument) ["." category (#+ Void Value' Value Return' Return Primitive Object Array Var Parameter)] @@ -580,18 +580,18 @@ (do //////.monad [valueG (generate archive valueS)] (wrap (`` (cond (~~ (template [<object> <type> <unwrap>] - [(and (text@= (..reflection <type>) + [(and (text\= (..reflection <type>) from) - (text@= <object> + (text\= <object> to)) (let [$<object> (type.class <object> (list))] ($_ _.compose valueG (_.invokestatic $<object> "valueOf" (type.method [(list <type>) $<object> (list)])))) - (and (text@= <object> + (and (text\= <object> from) - (text@= (..reflection <type>) + (text\= (..reflection <type>) to)) (let [$<object> (type.class <object> (list))] ($_ _.compose @@ -754,7 +754,7 @@ [inputsTG (monad.map ! (generate-input generate archive) inputsTS)] (wrap ($_ _.compose (monad.map _.monad product.right inputsTG) - (_.invokestatic class method (type.method [(list@map product.left inputsTG) outputT (list)])) + (_.invokestatic class method (type.method [(list\map product.left inputsTG) outputT (list)])) (prepare-output outputT)))))])) (template [<name> <invoke>] @@ -770,7 +770,7 @@ objectG (_.checkcast class) (monad.map _.monad product.right inputsTG) - (<invoke> class method (type.method [(list@map product.left inputsTG) outputT (list)])) + (<invoke> class method (type.method [(list\map product.left inputsTG) outputT (list)])) (prepare-output outputT)))))]))] [invoke::virtual _.invokevirtual] @@ -789,7 +789,7 @@ (_.new class) _.dup (monad.map _.monad product.right inputsTG) - (_.invokespecial class "<init>" (type.method [(list@map product.left inputsTG) type.void (list)]))))))])) + (_.invokespecial class "<init>" (type.method [(list\map product.left inputsTG) type.void (list)]))))))])) (def: bundle::member Bundle @@ -883,7 +883,7 @@ (//////synthesis.variant [lefts right? (recur sub)]) (^ (//////synthesis.tuple members)) - (//////synthesis.tuple (list@map recur members)) + (//////synthesis.tuple (list\map recur members)) (^ (//////synthesis.variable var)) (|> mapping @@ -904,13 +904,13 @@ (//////synthesis.branch/get [path (recur recordS)]) (^ (//////synthesis.loop/scope [offset initsS+ bodyS])) - (//////synthesis.loop/scope [offset (list@map recur initsS+) (recur bodyS)]) + (//////synthesis.loop/scope [offset (list\map recur initsS+) (recur bodyS)]) (^ (//////synthesis.loop/recur updatesS+)) - (//////synthesis.loop/recur (list@map recur updatesS+)) + (//////synthesis.loop/recur (list\map recur updatesS+)) (^ (//////synthesis.function/abstraction [environment arity bodyS])) - (//////synthesis.function/abstraction [(list@map (function (_ local) + (//////synthesis.function/abstraction [(list\map (function (_ local) (case local (^ (//////synthesis.variable local)) (|> mapping @@ -925,10 +925,10 @@ bodyS]) (^ (//////synthesis.function/apply [functionS inputsS+])) - (//////synthesis.function/apply [(recur functionS) (list@map recur inputsS+)]) + (//////synthesis.function/apply [(recur functionS) (list\map recur inputsS+)]) (#//////synthesis.Extension [name inputsS+]) - (#//////synthesis.Extension [name (list@map recur inputsS+)])))) + (#//////synthesis.Extension [name (list\map recur inputsS+)])))) (def: $Object (type.class "java.lang.Object" (list))) @@ -953,7 +953,7 @@ (#.Some ($_ _.compose (_.aload 0) (monad.map _.monad product.right inputsTG) - (_.invokespecial super-class "<init>" (type.method [(list@map product.left inputsTG) type.void (list)])) + (_.invokespecial super-class "<init>" (type.method [(list\map product.left inputsTG) type.void (list)])) store-capturedG _.return))))) @@ -1015,26 +1015,26 @@ class (type.class anonymous-class-name (list)) total-environment (|> overriden-methods ## Get all the environments. - (list@map product.left) + (list\map product.left) ## Combine them. - list@join + list\join ## Remove duplicates. (set.from-list //////synthesis.hash) set.to-list) global-mapping (|> total-environment ## Give them names as "foreign" variables. list.enumeration - (list@map (function (_ [id capture]) + (list\map (function (_ [id capture]) [capture (#//////variable.Foreign id)])) (dictionary.from-list //////variable.hash)) - normalized-methods (list@map (function (_ [environment + normalized-methods (list\map (function (_ [environment [ownerT name strict-fp? annotations vars self-name arguments returnT exceptionsT body]]) (let [local-mapping (|> environment list.enumeration - (list@map (function (_ [foreign-id capture]) + (list\map (function (_ [foreign-id capture]) [(#//////variable.Foreign foreign-id) (|> global-mapping (dictionary.get capture) @@ -1053,14 +1053,14 @@ (do ! [bodyG (//////generation.with-context artifact-id (generate archive bodyS))] - (wrap (method.method ($_ modifier@compose + (wrap (method.method ($_ modifier\compose method.public method.final (if strict-fp? method.strict - modifier@identity)) + modifier\identity)) name - (type.method [(list@map product.right arguments) + (type.method [(list\map product.right arguments) returnT exceptionsT]) (list) @@ -1070,10 +1070,10 @@ normalized-methods) bytecode (<| (:: ! map (format.run class.writer)) //////.lift - (class.class version.v6_0 ($_ modifier@compose class.public class.final) + (class.class version.v6_0 ($_ modifier\compose class.public class.final) (name.internal anonymous-class-name) (name.internal (..reflection super-class)) - (list@map (|>> ..reflection name.internal) super-interfaces) + (list\map (|>> ..reflection name.internal) super-interfaces) (foreign.variables total-environment) (list& (..with-anonymous-init class total-environment super-class inputsTI) method-definitions) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux index e6a587f9f..e4d72cb92 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux @@ -8,7 +8,7 @@ [data ["." maybe] [collection - ["." list ("#@." functor)] + ["." list ("#\." functor)] ["." dictionary (#+ Dictionary)]]]] ["." / #_ ["#." function] @@ -22,7 +22,7 @@ [/// [reference (#+) [variable (#+)]] - ["." phase ("#@." monad)]]]]]) + ["." phase ("#\." monad)]]]]]) (def: (primitive analysis) (-> ///analysis.Primitive /.Primitive) @@ -49,7 +49,7 @@ (function (optimization' analysis) (case analysis (#///analysis.Primitive analysis') - (phase@wrap (#/.Primitive (..primitive analysis'))) + (phase\wrap (#/.Primitive (..primitive analysis'))) (#///analysis.Structure structure) (/.with-currying? false @@ -62,10 +62,10 @@ (#///analysis.Tuple tuple) (|> tuple (monad.map phase.monad optimization') - (phase@map (|>> /.tuple))))) + (phase\map (|>> /.tuple))))) (#///analysis.Reference reference) - (phase@wrap (#/.Reference reference)) + (phase\wrap (#/.Reference reference)) (#///analysis.Case inputA branchesAB+) (/.with-currying? false @@ -92,7 +92,7 @@ (#try.Failure _) (|> args (monad.map phase.monad optimization') - (phase@map (|>> [name] #/.Extension)) + (phase\map (|>> [name] #/.Extension)) (phase.run' state)))))) ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux b/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux index cc1bf4500..0fe2bf712 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux @@ -11,8 +11,8 @@ ["." sum] ["." product] ["." maybe] - ["." bit ("#@." equivalence)] - ["." text ("#@." equivalence) + ["." bit ("#\." equivalence)] + ["." text ("#\." equivalence) ["%" format (#+ Format format)]] [number ["." i64] @@ -20,7 +20,7 @@ ["i" int] ["f" frac]] [collection - ["." list ("#@." functor)] + ["." list ("#\." functor)] ["." dictionary (#+ Dictionary)]]]] [// ["." analysis (#+ Environment Composite Analysis)] @@ -275,7 +275,7 @@ (^template [<tag> <format>] [(<tag> cons) (|> (#.Cons cons) - (list@map (function (_ [test then]) + (list\map (function (_ [test then]) (format (<format> test) " " (%path' %then then)))) (text.join-with " ") (text.enclose ["(? " ")"]))]) @@ -338,7 +338,7 @@ (#analysis.Tuple members) (|> members - (list@map %synthesis) + (list\map %synthesis) (text.join-with " ") (text.enclose ["[" "]"]))) @@ -351,7 +351,7 @@ (case function (#Abstraction [environment arity body]) (let [environment' (|> environment - (list@map %synthesis) + (list\map %synthesis) (text.join-with " ") (text.enclose ["[" "]"]))] (|> (format environment' " " (%.nat arity) " " (%synthesis body)) @@ -359,7 +359,7 @@ (#Apply func args) (|> args - (list@map %synthesis) + (list\map %synthesis) (text.join-with " ") (format (%synthesis func) " ") (text.enclose ["(" ")"]))) @@ -376,7 +376,7 @@ (#Get members record) (|> (format (%.list (%path' %synthesis) - (list@map (|>> #Member #Access) members)) + (list\map (|>> #Member #Access) members)) " " (%synthesis record)) (text.enclose ["(#get " ")"])) @@ -389,7 +389,7 @@ (#Scope scope) (|> (format (%.nat (get@ #start scope)) " " (|> (get@ #inits scope) - (list@map %synthesis) + (list\map %synthesis) (text.join-with " ") (text.enclose ["[" "]"])) " " (%synthesis (get@ #iteration scope))) @@ -397,12 +397,12 @@ (#Recur args) (|> args - (list@map %synthesis) + (list\map %synthesis) (text.join-with " ") (text.enclose ["(#recur " ")"])))) (#Extension [name args]) - (|> (list@map %synthesis args) + (|> (list\map %synthesis args) (text.join-with " ") (format (%.text name) " ") (text.enclose ["(" ")"])))) @@ -419,9 +419,9 @@ (^template [<tag> <eq> <format>] [[(<tag> reference') (<tag> sample')] (<eq> reference' sample')]) - ([#Bit bit@= %.bit] + ([#Bit bit\= %.bit] [#F64 f.= %.frac] - [#Text text@= %.text]) + [#Text text\= %.text]) [(#I64 reference') (#I64 sample')] (i.= (.int reference') (.int sample')) @@ -493,7 +493,7 @@ [(#Bit-Fork reference-when reference-then reference-else) (#Bit-Fork sample-when sample-then sample-else)] - (and (bit@= reference-when sample-when) + (and (bit\= reference-when sample-when) (= reference-then sample-then) (:: (maybe.equivalence =) = reference-else sample-else)) @@ -571,32 +571,32 @@ (n.* 29 (:: super hash body)) ))) -(structure: (branch-equivalence (^open "/@.")) +(structure: (branch-equivalence (^open "\.")) (All [a] (-> (Equivalence a) (Equivalence (Branch a)))) (def: (= reference sample) (case [reference sample] [(#Let [reference-input reference-register reference-body]) (#Let [sample-input sample-register sample-body])] - (and (/@= reference-input sample-input) + (and (\= reference-input sample-input) (n.= reference-register sample-register) - (/@= reference-body sample-body)) + (\= reference-body sample-body)) [(#If [reference-test reference-then reference-else]) (#If [sample-test sample-then sample-else])] - (and (/@= reference-test sample-test) - (/@= reference-then sample-then) - (/@= reference-else sample-else)) + (and (\= reference-test sample-test) + (\= reference-then sample-then) + (\= reference-else sample-else)) [(#Get [reference-path reference-record]) (#Get [sample-path sample-record])] (and (:: (list.equivalence ..member-equivalence) = reference-path sample-path) - (/@= reference-record sample-record)) + (\= reference-record sample-record)) [(#Case [reference-input reference-path]) (#Case [sample-input sample-path])] - (and (/@= reference-input sample-input) - (:: (path'-equivalence /@=) = reference-path sample-path)) + (and (\= reference-input sample-input) + (:: (path'-equivalence \=) = reference-path sample-path)) _ false))) @@ -632,7 +632,7 @@ (:: (..path'-hash super) hash path)) ))) -(structure: (loop-equivalence (^open "/@.")) +(structure: (loop-equivalence (^open "\.")) (All [a] (-> (Equivalence a) (Equivalence (Loop a)))) (def: (= reference sample) @@ -640,11 +640,11 @@ [(#Scope [reference-start reference-inits reference-iteration]) (#Scope [sample-start sample-inits sample-iteration])] (and (n.= reference-start sample-start) - (:: (list.equivalence /@=) = reference-inits sample-inits) - (/@= reference-iteration sample-iteration)) + (:: (list.equivalence \=) = reference-inits sample-inits) + (\= reference-iteration sample-iteration)) [(#Recur reference) (#Recur sample)] - (:: (list.equivalence /@=) = reference sample) + (:: (list.equivalence \=) = reference sample) _ false))) @@ -668,21 +668,21 @@ (:: (list.hash super) hash resets)) ))) -(structure: (function-equivalence (^open "/@.")) +(structure: (function-equivalence (^open "\.")) (All [a] (-> (Equivalence a) (Equivalence (Function a)))) (def: (= reference sample) (case [reference sample] [(#Abstraction [reference-environment reference-arity reference-body]) (#Abstraction [sample-environment sample-arity sample-body])] - (and (:: (list.equivalence /@=) = reference-environment sample-environment) + (and (:: (list.equivalence \=) = reference-environment sample-environment) (n.= reference-arity sample-arity) - (/@= reference-body sample-body)) + (\= reference-body sample-body)) [(#Apply [reference-abstraction reference-arguments]) (#Apply [sample-abstraction sample-arguments])] - (and (/@= reference-abstraction sample-abstraction) - (:: (list.equivalence /@=) = reference-arguments sample-arguments)) + (and (\= reference-abstraction sample-abstraction) + (:: (list.equivalence \=) = reference-arguments sample-arguments)) _ false))) @@ -707,14 +707,14 @@ (:: (list.hash super) hash arguments)) ))) -(structure: (control-equivalence (^open "/@.")) +(structure: (control-equivalence (^open "\.")) (All [a] (-> (Equivalence a) (Equivalence (Control a)))) (def: (= reference sample) (case [reference sample] (^template [<tag> <equivalence>] [[(<tag> reference) (<tag> sample)] - (:: (<equivalence> /@=) = reference sample)]) + (:: (<equivalence> \=) = reference sample)]) ([#Branch ..branch-equivalence] [#Loop ..loop-equivalence] [#Function ..function-equivalence]) diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux index ea177db2c..b954a5d9f 100644 --- a/stdlib/source/lux/world/shell.lux +++ b/stdlib/source/lux/world/shell.lux @@ -26,7 +26,8 @@ ["." list ("#@." fold functor)] ["." dictionary]]]] [// - [environment (#+ Environment)]]) + [environment (#+ Environment)] + [file (#+ Path)]]) (capability: #export (Can-Read !) (can-read [] (! (Try Text)))) @@ -87,7 +88,7 @@ Text) (capability: #export (Can-Execute !) - (can-execute [Environment Command (List Argument)] (! (Try (Process !))))) + (can-execute [Environment Path Command (List Argument)] (! (Try (Process !))))) (signature: #export (Shell !) (: (Can-Execute !) @@ -270,10 +271,15 @@ [await ..can-wait java/lang/Process::waitFor] )))))))) + (import: java/io/File + ["#::." + (new [java/lang/String])]) + (import: java/lang/ProcessBuilder ["#::." (new [[java/lang/String]]) - (environment [] #io #try (java/util/Map java/lang/String java/lang/String)) + (environment [] #try (java/util/Map java/lang/String java/lang/String)) + (directory [java/io/File] java/lang/ProcessBuilder) (start [] #io #try java/lang/Process)]) (import: java/lang/System @@ -304,7 +310,7 @@ (def: execute (..can-execute - (function (_ [environment command arguments]) + (function (_ [environment working-directory command arguments]) (with-expansions [<jvm> (as-is (do {! (try.with io.monad)} [windows? ..windows? #let [builder (if windows? @@ -314,8 +320,11 @@ (..jvm::process-builder ..unix-policy (:: ..unix-policy command command) (list@map (:: ..unix-policy argument) arguments)))] - _ (:: ! map (..jvm::load-environment environment) - (java/lang/ProcessBuilder::environment builder)) + _ (|> builder + (java/lang/ProcessBuilder::directory (java/io/File::new working-directory)) + java/lang/ProcessBuilder::environment + (:: try.functor map (..jvm::load-environment environment)) + (:: io.monad wrap)) process (java/lang/ProcessBuilder::start builder)] (..default-process process)))] (for {@.old (as-is <jvm>) @@ -387,7 +396,7 @@ (structure: #export (mock simulation init) (All [s] - (-> (-> [Environment Command (List Argument)] + (-> (-> [Environment Path Command (List Argument)] (Try (Simulation s))) s (Shell Promise))) diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index bc8f75ee0..0b2dda8f2 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -13,7 +13,7 @@ [security ["!" capability]] [concurrency - ["." promise (#+ Promise) ("#@." monad)]]] + ["." promise (#+ Promise) ("#\." monad)]]] [data [binary (#+ Binary)] ["." text @@ -31,7 +31,9 @@ [lux ["." syntax]]]]] [world - ["." file (#+ Path)]]] + ["." environment (#+ Environment)] + ["." file (#+ Path)] + ["." shell (#+ Shell)]]] ["." / #_ ["#" profile] ["#." action (#+ Action)] @@ -61,10 +63,14 @@ (list\map (|>> /repository.remote /repository.async)))) (def: (with-dependencies command profile) - (All [a] (-> (-> (file.System Promise) Resolution (Command a)) (Command a))) - (do /action.monad - [resolution (/command/deps.do! (file.async file.default) (..repositories profile) profile)] - (command (file.async file.default) resolution profile))) + (All [a] + (-> (-> Environment (file.System Promise) (Shell Promise) Resolution (Command a)) + (Command a))) + (do promise.monad + [environment (promise.future environment.read)] + (do /action.monad + [resolution (/command/deps.do! (file.async file.default) (..repositories profile) profile)] + ((command environment (file.async file.default) (shell.async shell.default) resolution) profile)))) (exception: (cannot-find-repository {repository Text} {options (Dictionary Text Address)}) @@ -103,10 +109,10 @@ profile) [#.None _] - (promise@wrap (exception.throw /.no-identity [])) + (promise\wrap (exception.throw /.no-identity [])) [_ #.None] - (promise@wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)]))) + (promise\wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)]))) (wrap [])) #/cli.Dependencies diff --git a/stdlib/source/program/aedifex/artifact.lux b/stdlib/source/program/aedifex/artifact.lux index 84e7839f8..3160ef356 100644 --- a/stdlib/source/program/aedifex/artifact.lux +++ b/stdlib/source/program/aedifex/artifact.lux @@ -7,7 +7,7 @@ ["." text ["%" format (#+ Format)]] [collection - ["." list ("#@." monoid)]]] + ["." list ("#\." monoid)]]] [world ["." file (#+ Path)] [net @@ -85,7 +85,7 @@ (def: #export (local artifact) (-> Artifact (List Text)) - (list@compose (|> artifact + (list\compose (|> artifact (get@ #group) (text.split-all-with ..group-separator)) (list (get@ #name artifact) diff --git a/stdlib/source/program/aedifex/command/auto.lux b/stdlib/source/program/aedifex/command/auto.lux index 80ff8ac8c..aa230daba 100644 --- a/stdlib/source/program/aedifex/command/auto.lux +++ b/stdlib/source/program/aedifex/command/auto.lux @@ -14,7 +14,9 @@ ["." list] ["." set]]] [world - ["." file (#+ Path)]]] + [environment (#+ Environment)] + ["." file (#+ Path)] + ["." shell (#+ Shell)]]] ["." // #_ ["/#" // #_ ["#" profile] @@ -126,31 +128,34 @@ #.None (wrap [])))) -(def: #export (do! command fs resolution profile) +(def: #export (do! command) (All [a] - (-> (-> (file.System Promise) Resolution (Command a)) - (-> (file.System Promise) Resolution (Command Any)))) - (do {! ///action.monad} - [watcher (promise.future - (java/nio/file/FileSystem::newWatchService - (java/nio/file/FileSystems::getDefault))) - targets (|> profile - (get@ #///.sources) - set.to-list - (monad.map ! ..targets) - (:: ! map list.concat)) - _ (monad.map ! (..watch! watcher) targets) - _ (command fs resolution profile)] - (loop [_ []] - (do ! - [?key (..poll! watcher) - _ (case ?key - (#.Some key) - (do ! - [_ (promise.future (..drain! watcher)) - _ (command fs resolution profile)] - (wrap [])) - - #.None - (wrap []))] - (recur []))))) + (-> (-> Environment (file.System Promise) (Shell Promise) Resolution (Command a)) + (-> Environment (file.System Promise) (Shell Promise) Resolution (Command Any)))) + (function (_ environment fs shell resolution) + (function (_ profile) + (with-expansions [<call> ((command environment fs shell resolution) profile)] + (do {! ///action.monad} + [watcher (promise.future + (java/nio/file/FileSystem::newWatchService + (java/nio/file/FileSystems::getDefault))) + targets (|> profile + (get@ #///.sources) + set.to-list + (monad.map ! ..targets) + (:: ! map list.concat)) + _ (monad.map ! (..watch! watcher) targets) + _ <call>] + (loop [_ []] + (do ! + [?key (..poll! watcher) + _ (case ?key + (#.Some key) + (do ! + [_ (promise.future (..drain! watcher)) + _ <call>] + (wrap [])) + + #.None + (wrap []))] + (recur [])))))))) diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index 72f96b25e..94d6760b6 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -1,6 +1,5 @@ (.module: [lux (#- Name) - ["." host (#+ import:)] [abstract [monad (#+ do)]] [control @@ -8,18 +7,24 @@ ["." exception (#+ exception:)] ["." io (#+ IO)] [concurrency - ["." promise (#+ Promise) ("#@." monad)]]] + ["." promise (#+ Promise) ("#\." monad)]] + [security + ["!" capability]]] [data ["." product] ["." maybe] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection - ["." list ("#@." functor)] + ["." list ("#\." functor)] ["." dictionary] - ["." set]]] + ["." set]] + [number + ["i" int]]] [world - ["." file (#+ Path)]]] + [environment (#+ Environment)] + ["." file (#+ Path)] + ["." shell (#+ Shell)]]] ["." /// #_ ["#" profile] ["#." action] @@ -41,22 +46,30 @@ (-> Group Name Finder) (|>> dictionary.entries (list.one (function (_ [dependency package]) - (if (and (text@= group (get@ [#///dependency.artifact #///artifact.group] dependency)) - (text@= name (get@ [#///dependency.artifact #///artifact.name] dependency))) + (if (and (text\= group (get@ [#///dependency.artifact #///artifact.group] dependency)) + (text\= name (get@ [#///dependency.artifact #///artifact.name] dependency))) (#.Some dependency) #.None))))) -(def: lux-group +(def: #export lux-group Group "com.github.luxlang") -(template [<name> <finder>] +(def: #export jvm-compiler-name + Name + "lux-jvm") + +(def: #export js-compiler-name + Name + "lux-js") + +(template [<finder> <name>] [(def: <finder> Finder (..dependency-finder ..lux-group <name>))] - ["lux-jvm" jvm-compiler] - ["lux-js" js-compiler] + [jvm-compiler ..jvm-compiler-name] + [js-compiler ..js-compiler-name] ) (exception: #export no-available-compiler) @@ -91,58 +104,55 @@ (def: (libraries fs) (All [!] (-> (file.System !) Resolution (List Path))) (|>> dictionary.keys - (list.filter (|>> (get@ #///dependency.type) (text@= ///artifact/type.lux-library))) - (list@map (|>> (get@ #///dependency.artifact) (///local.path fs))))) - -(import: java/lang/String) - -## https://docs.oracle.com/javase/tutorial/essential/environment/sysprop.html -(import: java/lang/System - ["#::." - (#static getProperty [java/lang/String] #io #? java/lang/String)]) + (list.filter (|>> (get@ #///dependency.type) (text\= ///artifact/type.lux-library))) + (list\map (|>> (get@ #///dependency.artifact) (///local.path fs))))) (def: #export working-directory - (IO (Try Text)) - (do io.monad - [?value (java/lang/System::getProperty "user.dir")] - (wrap (#try.Success (maybe.default "~" ?value))))) + (-> Environment (Try Text)) + (|>> (dictionary.get "user.dir") try.from-maybe)) -(def: (singular-parameter name value) - (-> Text Text Text) - (format name " " value)) +(def: (singular name) + (-> Text Text (List Text)) + (|>> (list name))) -(def: (plural-parameter name values) - (-> Text (List Text) Text) - (|> values (list@map (|>> (format name " "))) (text.join-with " "))) +(def: (plural name) + (-> Text (List Text) (List Text)) + (|>> (list\map (|>> (list name))) list.concat)) -(def: #export (do! fs resolution profile) - (-> (file.System Promise) Resolution (Command [Compiler Path])) +(def: #export (do! environment fs shell resolution profile) + (-> Environment (file.System Promise) (Shell Promise) Resolution (Command [Compiler Path])) (case [(get@ #///.program profile) (get@ #///.target profile)] [#.None _] - (promise@wrap (exception.throw ..no-specified-program [])) + (promise\wrap (exception.throw ..no-specified-program [])) [_ #.None] - (promise@wrap (exception.throw ..no-specified-target [])) + (promise\wrap (exception.throw ..no-specified-target [])) [(#.Some program) (#.Some target)] (do ///action.monad - [[resolution compiler] (promise@wrap (..compiler resolution)) - working-directory (promise.future ..working-directory) - #let [[prefix output] (case compiler - (#JVM artifact) [(///runtime.java (///local.path fs artifact)) - "program.jar"] - (#JS artifact) [(///runtime.node (///local.path fs artifact)) - "program.js"]) - cache-directory (format working-directory (:: fs separator) target) - command (format prefix " build" - " " (..plural-parameter "--library" (..libraries fs resolution)) - " " (..plural-parameter "--source" (set.to-list (get@ #///.sources profile))) - " " (..singular-parameter "--target" cache-directory) - " " (..singular-parameter "--module" program))] + [[resolution compiler] (promise\wrap (..compiler resolution)) + working-directory (promise\wrap (..working-directory environment)) + #let [[command output] (let [[compiler output] (case compiler + (#JVM artifact) [(///runtime.java (///local.path fs artifact)) + "program.jar"] + (#JS artifact) [(///runtime.node (///local.path fs artifact)) + "program.js"])] + [(format compiler " build") output]) + / (:: fs separator) + cache-directory (format working-directory / target)] #let [_ (log! "[BUILD STARTED]")] - outcome (///shell.execute command working-directory) - #let [_ (log! "[BUILD ENDED]")]] + process (!.use (:: shell execute) + [environment + working-directory + command + (list.concat (list (..plural "--library" (..libraries fs resolution)) + (..plural "--source" (set.to-list (get@ #///.sources profile))) + (..singular "--target" cache-directory) + (..singular "--module" program)))]) + exit (!.use (:: process await) []) + #let [_ (log! (if (i.= shell.normal exit) + "[BUILD ENDED]" + "[BUILD FAILED]"))]] (wrap [compiler - (format cache-directory (:: fs separator) output)])) - )) + (format cache-directory / output)])))) diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux index 37a5a0f40..839bc7906 100644 --- a/stdlib/source/program/aedifex/command/deploy.lux +++ b/stdlib/source/program/aedifex/command/deploy.lux @@ -4,7 +4,7 @@ [monad (#+ do)]] [control [concurrency - ["." promise (#+ Promise) ("#@." monad)]]] + ["." promise (#+ Promise) ("#\." monad)]]] [data [binary (#+ Binary)] [text @@ -40,7 +40,7 @@ set.to-list (export.library fs) (:: ! map (binary.run tar.writer))) - pom (promise@wrap (///pom.write profile)) + pom (promise\wrap (///pom.write profile)) _ (deploy! ///artifact/extension.pom (|> pom (:: xml.codec encode) encoding.to-utf8)) _ (deploy! ///artifact/extension.lux-library library) _ (deploy! ///artifact/extension.sha-1 (///hash.data (///hash.sha-1 library))) diff --git a/stdlib/source/program/aedifex/command/pom.lux b/stdlib/source/program/aedifex/command/pom.lux index f493092a5..695a7839f 100644 --- a/stdlib/source/program/aedifex/command/pom.lux +++ b/stdlib/source/program/aedifex/command/pom.lux @@ -7,7 +7,7 @@ [security ["!" capability]] [concurrency - ["." promise (#+ Promise) ("#@." monad)]]] + ["." promise (#+ Promise) ("#\." monad)]]] [data ["." text ["%" format (#+ format)] @@ -24,7 +24,7 @@ (def: #export (do! fs profile) (-> (file.System Promise) (Command Path)) (do ///action.monad - [pom (promise@wrap (///pom.write profile)) + [pom (promise\wrap (///pom.write profile)) file (: (Promise (Try (File Promise))) (file.get-file promise.monad fs ///pom.file)) outcome (|> pom diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux index d4519b2d0..2996a6741 100644 --- a/stdlib/source/program/aedifex/command/test.lux +++ b/stdlib/source/program/aedifex/command/test.lux @@ -4,12 +4,18 @@ [monad (#+ do)]] [control [concurrency - ["." promise (#+ Promise)]]] + ["." promise (#+ Promise) ("#\." monad)]] + [security + ["!" capability]]] [data [text - ["%" format (#+ format)]]] + ["%" format (#+ format)]] + [number + ["i" int]]] [world - ["." file]]] + [environment (#+ Environment)] + ["." file] + ["." shell (#+ Shell)]]] ["." // #_ ["#." build] ["/#" // #_ @@ -20,15 +26,21 @@ [dependency [resolution (#+ Resolution)]]]]) -(def: #export (do! fs resolution profile) - (-> (file.System Promise) Resolution (Command Any)) +(def: #export (do! environment fs shell resolution profile) + (-> Environment (file.System Promise) (Shell Promise) Resolution (Command Any)) (do ///action.monad - [[compiler program] (//build.do! fs resolution profile) - working-directory (promise.future //build.working-directory) - #let [command (case compiler - (#//build.JVM artifact) (///runtime.java program) - (#//build.JS artifact) (///runtime.node program))] + [[compiler program] (//build.do! environment fs shell resolution profile) + working-directory (promise\wrap (//build.working-directory environment)) #let [_ (log! "[TEST STARTED]")] - outcome (///shell.execute command working-directory) - #let [_ (log! "[TEST ENDED]")]] + process (!.use (:: shell execute) + [environment + working-directory + (case compiler + (#//build.JVM artifact) (///runtime.java program) + (#//build.JS artifact) (///runtime.node program)) + (list)]) + exit (!.use (:: process await) []) + #let [_ (log! (if (i.= shell.normal exit) + "[TEST ENDED]" + "[TEST FAILED]"))]] (wrap []))) diff --git a/stdlib/source/program/aedifex/format.lux b/stdlib/source/program/aedifex/format.lux index 4ec8b8ae6..b5d6571be 100644 --- a/stdlib/source/program/aedifex/format.lux +++ b/stdlib/source/program/aedifex/format.lux @@ -1,10 +1,10 @@ (.module: [lux #* [data - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [collection ["." dictionary (#+ Dictionary)] - ["." list ("#@." functor)] + ["." list ("#\." functor)] ["." set (#+ Set)]]] [macro ["." code]]] @@ -56,7 +56,7 @@ (def: aggregate (Format Aggregate) (|>> dictionary.entries - (list@map (function (_ [key value]) + (list\map (function (_ [key value]) [(code.local-tag key) value])) code.record)) @@ -82,7 +82,7 @@ aggregate value - (dictionary.put field (` [(~+ (list@map format value))]) aggregate))) + (dictionary.put field (` [(~+ (list\map format value))]) aggregate))) (def: (on-set field value format aggregate) (All [a] @@ -97,7 +97,7 @@ (dictionary.put field (|> value dictionary.entries - (list@map (function (_ [key value]) + (list\map (function (_ [key value]) [(key-format key) (value-format value)])) code.record) aggregate))) @@ -126,7 +126,7 @@ (def: (dependency [artifact type]) (Format Dependency) - (if (text@= //artifact/type.lux-library type) + (if (text\= //artifact/type.lux-library type) (` [(~+ (..artifact' artifact))]) (` [(~+ (..artifact' artifact)) (~ (code.text type))]))) @@ -149,6 +149,6 @@ (def: #export project (Format Project) (|>> dictionary.entries - (list@map (function (_ [key value]) + (list\map (function (_ [key value]) [(code.text key) (..profile value)])) code.record)) diff --git a/stdlib/source/program/aedifex/package.lux b/stdlib/source/program/aedifex/package.lux index 11d073b51..ae9e98a54 100644 --- a/stdlib/source/program/aedifex/package.lux +++ b/stdlib/source/program/aedifex/package.lux @@ -3,7 +3,7 @@ [abstract ["." equivalence (#+ Equivalence)]] [control - ["." try (#+ Try) ("#@." functor)] + ["." try (#+ Try) ("#\." functor)] [parser ["<.>" xml]]] [data @@ -62,7 +62,7 @@ (-> Package (Try (Set Dependency))) (|>> (get@ #pom) (<xml>.run //pom.parser) - (try@map (get@ #/.dependencies)))) + (try\map (get@ #/.dependencies)))) (def: #export equivalence (Equivalence Package) diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux index a310b2c48..8a6712930 100644 --- a/stdlib/source/program/aedifex/pom.lux +++ b/stdlib/source/program/aedifex/pom.lux @@ -10,11 +10,11 @@ ["<xml>" xml (#+ Parser)]]] [data ["." name] - ["." maybe ("#@." functor)] + ["." maybe ("#\." functor)] [format ["_" xml (#+ Tag XML)]] [collection - ["." list ("#@." monoid functor fold)] + ["." list ("#\." monoid functor fold)] ["." set] ["." dictionary]]]] ["." // #_ @@ -75,7 +75,7 @@ (-> Dependency XML) (#_.Node ["" "dependency"] _.attrs - (list@compose (..artifact (get@ #//dependency.artifact value)) + (list\compose (..artifact (get@ #//dependency.artifact value)) (list (..property "type" (get@ #//dependency.type value)))))) (def: (group tag) @@ -104,7 +104,7 @@ (-> /.Developer (List XML)) (list& (..property "name" name) (..property "email" email) - (|> organization (maybe@map ..developer-organization) (maybe.default (list))))) + (|> organization (maybe\map ..developer-organization) (maybe.default (list))))) (template [<name> <type> <tag>] [(def: <name> @@ -117,14 +117,14 @@ (def: (info value) (-> /.Info (List XML)) - ($_ list@compose - (|> value (get@ #/.url) (maybe@map (..property "url")) maybe.to-list) - (|> value (get@ #/.description) (maybe@map (..property "description")) maybe.to-list) - (|> value (get@ #/.licenses) (list@map ..license) (..group "licenses") list) - (|> value (get@ #/.scm) (maybe@map ..scm) maybe.to-list) - (|> value (get@ #/.organization) (maybe@map ..organization) maybe.to-list) - (|> value (get@ #/.developers) (list@map ..developer) (..group "developers") list) - (|> value (get@ #/.contributors) (list@map ..contributor) (..group "contributors") list) + ($_ list\compose + (|> value (get@ #/.url) (maybe\map (..property "url")) maybe.to-list) + (|> value (get@ #/.description) (maybe\map (..property "description")) maybe.to-list) + (|> value (get@ #/.licenses) (list\map ..license) (..group "licenses") list) + (|> value (get@ #/.scm) (maybe\map ..scm) maybe.to-list) + (|> value (get@ #/.organization) (maybe\map ..organization) maybe.to-list) + (|> value (get@ #/.developers) (list\map ..developer) (..group "developers") list) + (|> value (get@ #/.contributors) (list\map ..contributor) (..group "contributors") list) )) ) @@ -134,11 +134,11 @@ (#.Some identity) (#try.Success (#_.Node ["" ..project-tag] _.attrs - ($_ list@compose + ($_ list\compose (list ..version) (..artifact identity) - (|> value (get@ #/.repositories) set.to-list (list@map ..repository) (..group "repositories") list) - (|> value (get@ #/.dependencies) set.to-list (list@map ..dependency) (..group ..dependencies-tag) list) + (|> value (get@ #/.repositories) set.to-list (list\map ..repository) (..group "repositories") list) + (|> value (get@ #/.dependencies) set.to-list (list\map ..dependency) (..group ..dependencies-tag) list) ))) _ @@ -183,4 +183,4 @@ _ (<>.some <xml>.ignore)] (wrap (|> (:: /.monoid identity) (update@ #/.dependencies (function (_ empty) - (list@fold set.add empty dependencies))))))))) + (list\fold set.add empty dependencies))))))))) diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux index e165c9e3b..d4e33267d 100644 --- a/stdlib/source/program/aedifex/profile.lux +++ b/stdlib/source/program/aedifex/profile.lux @@ -6,11 +6,11 @@ [control ["." exception (#+ exception:)]] [data - ["." maybe ("#@." monoid)] + ["." maybe ("#\." monoid)] ["." text] [collection ["." dictionary (#+ Dictionary)] - ["." list ("#@." monoid)] + ["." list ("#\." monoid)] ["." set (#+ Set)]]] [world [net (#+ URL)] @@ -189,15 +189,15 @@ #deploy-repositories (dictionary.new text.hash)}) (def: (compose override baseline) - {#parents (list@compose (get@ #parents baseline) (get@ #parents override)) - #identity (maybe@compose (get@ #identity override) (get@ #identity baseline)) - #info (maybe@compose (get@ #info override) (get@ #info baseline)) + {#parents (list\compose (get@ #parents baseline) (get@ #parents override)) + #identity (maybe\compose (get@ #identity override) (get@ #identity baseline)) + #info (maybe\compose (get@ #info override) (get@ #info baseline)) #repositories (set.union (get@ #repositories baseline) (get@ #repositories override)) #dependencies (set.union (get@ #dependencies baseline) (get@ #dependencies override)) #sources (set.union (get@ #sources baseline) (get@ #sources override)) - #target (maybe@compose (get@ #target override) (get@ #target baseline)) - #program (maybe@compose (get@ #program override) (get@ #program baseline)) - #test (maybe@compose (get@ #test override) (get@ #test baseline)) + #target (maybe\compose (get@ #target override) (get@ #target baseline)) + #program (maybe\compose (get@ #program override) (get@ #program baseline)) + #test (maybe\compose (get@ #test override) (get@ #test baseline)) #deploy-repositories (dictionary.merge (get@ #deploy-repositories override) (get@ #deploy-repositories baseline))})) (exception: #export no-identity) diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux index b084e0a3d..c2946b482 100644 --- a/stdlib/source/program/aedifex/project.lux +++ b/stdlib/source/program/aedifex/project.lux @@ -13,7 +13,7 @@ [collection ["." dictionary (#+ Dictionary)] ["." set (#+ Set)] - ["." list ("#@." fold)]]]] + ["." list ("#\." fold)]]]] ["." // #_ ["#" profile (#+ Name Profile)]]) @@ -62,7 +62,7 @@ (do {! try.monad} [parents (monad.map ! (profile' (set.add name lineage) project) (get@ #//.parents profile))] - (wrap (list@fold (function (_ parent child) + (wrap (list\fold (function (_ parent child) (:: //.monoid compose child parent)) (set@ #//.parents (list) profile) parents)))) diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux index d2ba2c226..e5dc55d2c 100644 --- a/stdlib/source/program/aedifex/repository.lux +++ b/stdlib/source/program/aedifex/repository.lux @@ -135,7 +135,7 @@ (new [java/io/InputStream]) (read [[byte] int int] #io #try int)]) -(exception: #export (failure {code Int}) +(exception: #export (deployment-failure {code Int}) (exception.report ["Code" (%.int code)])) @@ -190,5 +190,5 @@ code (java/net/HttpURLConnection::getResponseCode connection)] (case code +200 (wrap []) - _ (:: io.monad wrap (exception.throw ..failure [code]))))) + _ (:: io.monad wrap (exception.throw ..deployment-failure [code]))))) ) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index e7884bf70..225d01362 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -12,7 +12,7 @@ [security ["!" capability]] [concurrency - ["." promise (#+ Promise) ("#@." monad)]]] + ["." promise (#+ Promise) ("#\." monad)]]] [data [binary (#+ Binary)] ["." product] @@ -20,8 +20,7 @@ ["%" format (#+ format)]] [collection ["." dictionary] - ["." row (#+ Row)] - ["." list ("#@." functor fold)]]] + ["." row (#+ Row)]]] [world ["." file (#+ File Path)] ## ["." console] @@ -141,7 +140,7 @@ {(Promise (Try [Archive (directive.State+ <parameters>)])) (: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)) + program-context (promise\wrap ($/program.context archive)) _ (promise.future (..package! io.monad file.default packager,package static archive program-context))] (wrap (log! "Compilation complete!")))) diff --git a/stdlib/source/program/compositor/export.lux b/stdlib/source/program/compositor/export.lux index 00bdf6f19..b1e525098 100644 --- a/stdlib/source/program/compositor/export.lux +++ b/stdlib/source/program/compositor/export.lux @@ -5,7 +5,7 @@ [control ["." try (#+ Try)] [concurrency - ["." promise (#+ Promise) ("#@." monad)]] + ["." promise (#+ Promise)]] [security ["!" capability]]] [data diff --git a/stdlib/source/program/compositor/import.lux b/stdlib/source/program/compositor/import.lux index d69915cbb..0f2d00905 100644 --- a/stdlib/source/program/compositor/import.lux +++ b/stdlib/source/program/compositor/import.lux @@ -6,7 +6,7 @@ ["." try (#+ Try)] ["." exception (#+ exception:)] [concurrency - ["." promise (#+ Promise) ("#@." monad)]] + ["." promise (#+ Promise) ("#\." monad)]] [security ["!" capability]] ["<>" parser @@ -38,7 +38,7 @@ [library (: (Action (File Promise)) (!.use (:: system file) [library])) binary (!.use (:: library content) [])] - (promise@wrap + (promise\wrap (do {! try.monad} [tar (<b>.run tar.parser binary)] (monad.fold ! (function (_ entry import) diff --git a/stdlib/source/program/scriptum.lux b/stdlib/source/program/scriptum.lux index 8cc7e3afb..cc4960bf9 100644 --- a/stdlib/source/program/scriptum.lux +++ b/stdlib/source/program/scriptum.lux @@ -17,14 +17,14 @@ ["n" nat]] [format ["md" markdown (#+ Markdown Span Block)]] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)] ["." encoding]] [collection - ["." sequence (#+ Sequence) ("#@." functor)] - ["." list ("#@." functor fold)]]] + ["." sequence (#+ Sequence) ("#\." functor)] + ["." list ("#\." functor fold)]]] ["." function] - ["." type ("#@." equivalence)] + ["." type ("#\." equivalence)] ["." macro] ["." io (#+ IO io)] [world @@ -48,7 +48,7 @@ (def: type-var-names (Sequence Text) - (|> 0 (sequence.iterate inc) (sequence@map parameter-type-name))) + (|> 0 (sequence.iterate inc) (sequence\map parameter-type-name))) (template [<name> <partition>] [(def: (<name> id) @@ -85,13 +85,13 @@ (|> level dec (enum.range n.enum 0) - (list@map (|>> (n.+ (inc offset)) parameter-type-name))))) + (list\map (|>> (n.+ (inc offset)) parameter-type-name))))) (def: (prefix-lines prefix lines) (-> Text Text Text) (|> lines (text.split-all-with text.new-line) - (list@map (|>> (format prefix))) + (list\map (|>> (format prefix))) (text.join-with text.new-line))) (def: (pprint-type-definition level type-func-info tags module signature? recursive-type? type) @@ -110,7 +110,7 @@ (format "(primitive " (%.text name) ")") _ - (format "(primitive " (%.text name) " " (|> params (list@map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) ")")) + (format "(primitive " (%.text name) " " (|> params (list\map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) ")")) [_ (#.Sum _)] (let [members (type.flatten-variant type)] @@ -118,20 +118,20 @@ #.Nil (format "(| " (|> members - (list@map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) + (list\map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) ")") _ (|> members (list.zip/2 tags) - (list@map (function (_ [[_ t-name] type]) + (list\map (function (_ [[_ t-name] type]) (case type (#.Product _) (let [types (type.flatten-tuple type)] (format "(#" t-name " " (|> types - (list@map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) + (list\map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) ")")) @@ -143,12 +143,12 @@ (let [members (type.flatten-tuple type)] (case tags #.Nil - (format "[" (|> members (list@map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) "]") + (format "[" (|> members (list\map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) "]") _ (let [member-docs (|> members (list.zip/2 tags) - (list@map (function (_ [[_ t-name] type]) + (list\map (function (_ [[_ t-name] type]) (if signature? (format "(: " (pprint-type-definition level type-func-info #.None module signature? recursive-type? type) text.new-line " " t-name ")") (format "#" t-name " " (pprint-type-definition level type-func-info #.None module signature? recursive-type? type))))) @@ -159,7 +159,7 @@ [_ (#.Function input output)] (let [[ins out] (type.flatten-function type)] - (format "(-> " (|> ins (list@map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) + (format "(-> " (|> ins (list\map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) " " (pprint-type-definition level type-func-info #.None module signature? recursive-type? out) ")")) @@ -194,10 +194,10 @@ [_ (#.Apply param fun)] (let [[type-func type-arguments] (type.flatten-application type)] - (format "(" (pprint-type-definition level type-func-info tags module signature? recursive-type? type-func) " " (|> type-arguments (list@map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) ")")) + (format "(" (pprint-type-definition level type-func-info tags module signature? recursive-type? type-func) " " (|> type-arguments (list\map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) ")")) [_ (#.Named [_module _name] type)] - (if (text@= module _module) + (if (text\= module _module) _name (%.name [_module _name])) ))) @@ -211,20 +211,20 @@ (format "(primitive " (%.text name) ")") _ - (format "(primitive " (%.text name) " " (|> params (list@map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) ")")) + (format "(primitive " (%.text name) " " (|> params (list\map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) ")")) (#.Sum _) (let [members (type.flatten-variant type)] - (format "(| " (|> members (list@map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) ")")) + (format "(| " (|> members (list\map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) ")")) (#.Product _) (let [members (type.flatten-tuple type)] - (format "[" (|> members (list@map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) "]")) + (format "[" (|> members (list\map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) "]")) (#.Function input output) (let [[ins out] (type.flatten-function type)] (format "(-> " - (|> ins (list@map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) + (|> ins (list\map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) " " (pprint-type level type-func-name module out) ")")) @@ -251,10 +251,10 @@ (#.Apply param fun) (let [[type-func type-arguments] (type.flatten-application type)] - (format "(" (pprint-type level type-func-name module type-func) " " (|> type-arguments (list@map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) ")")) + (format "(" (pprint-type level type-func-name module type-func) " " (|> type-arguments (list\map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) ")")) (#.Named [_module _name] type) - (if (text@= module _module) + (if (text\= module _module) _name (%.name [_module _name])) )) @@ -272,18 +272,18 @@ (def: (lux-module? module-name) (-> Text Bit) - (or (text@= "lux" module-name) + (or (text\= "lux" module-name) (text.starts-with? "lux/" module-name))) (def: (add-definition [name [def-type def-annotations def-value]] organization) (-> [Text Definition] Organization Organization) - (cond (type@= .Type def-type) + (cond (type\= .Type def-type) (update@ #types (: (Mutation (List Value)) (|>> (#.Cons [name def-annotations (:coerce Type def-value)]))) organization) - (type@= .Macro def-type) + (type\= .Macro def-type) (update@ #macros (: (Mutation (List [Text Code])) (|>> (#.Cons [name def-annotations]))) @@ -303,9 +303,9 @@ (def: name-sort (All [r] (-> [Text r] [Text r] Bit)) - (let [text@< (:: text.order <)] + (let [text\< (:: text.order <)] (function (_ [n1 _] [n2 _]) - (text@< n1 n2)))) + (text\< n1 n2)))) (def: (organize-definitions defs) (-> (List [Text Definition]) Organization) @@ -313,7 +313,7 @@ #macros (list) #structures (list) #values (list)}] - (|> (list@fold add-definition init defs) + (|> (list\fold add-definition init defs) (update@ #types (list.sort name-sort)) (update@ #macros (list.sort name-sort)) (update@ #structures (list.sort name-sort)) @@ -367,7 +367,7 @@ (when> recursive-type? [unrecurse-type]) (pprint-type-definition (dec nesting) [_name type-arguments] (maybe.default (list) tags) module signature? recursive-type?) (text.split-all-with text.new-line) - (list@map (|>> (format " "))) + (list\map (|>> (format " "))) (text.join-with text.new-line)) ")")))) @@ -393,14 +393,14 @@ md.empty) type-code))))) types)] - (wrap (list@fold (function.flip md.then) + (wrap (list\fold (function.flip md.then) (md.heading/2 "Types") type-docs)))) (def: (document-macros module-name names) (-> Text (List [Text Code]) (Markdown Block)) (|> names - (list@map (: (-> [Text Code] (Markdown Block)) + (list\map (: (-> [Text Code] (Markdown Block)) (function (_ [name def-annotations]) ($_ md.then (md.heading/3 name) @@ -409,7 +409,7 @@ (do maybe.monad [documentation (macro.get-documentation def-annotations)] (wrap (md.code documentation)))))))) - (list@fold (function.flip md.then) + (list\fold (function.flip md.then) (md.heading/2 "Macros")))) (template [<singular> <plural> <header>] @@ -420,7 +420,7 @@ (def: (<plural> module values) (-> Text (List Value) (Markdown Block)) (|> values - (list@map (function (_ [name def-annotations value-type]) + (list\map (function (_ [name def-annotations value-type]) (let [?doc (macro.get-documentation def-annotations) usage (case (macro.function-arguments def-annotations) #.Nil @@ -437,7 +437,7 @@ _ md.empty) (<singular> module value-type))))) - (list@fold (function.flip md.then) + (list\fold (function.flip md.then) (md.heading/2 <header>))))] [document-structure document-structures "Structures"] @@ -448,7 +448,7 @@ (-> [Text Text] Text Text) (|> block (text.split-all-with text.new-line) - (list@map (text.enclose pre+post)) + (list\map (text.enclose pre+post)) (text.join-with text.new-line))) (def: (document-module [[module-name module] organization]) @@ -506,7 +506,7 @@ (list.sort name-sort))] lux-exports (monad.map ! (function.compose macro.exports product.left) lux-modules) - module-documentation (|> (list@map organize-definitions lux-exports) + module-documentation (|> (list\map organize-definitions lux-exports) (list.zip/2 lux-modules) (monad.map ! document-module)) #let [_ (io.run (monad.map io.monad save-documentation! module-documentation))]] diff --git a/stdlib/source/spec/compositor/analysis/type.lux b/stdlib/source/spec/compositor/analysis/type.lux index 718c1d01e..7cbd5884b 100644 --- a/stdlib/source/spec/compositor/analysis/type.lux +++ b/stdlib/source/spec/compositor/analysis/type.lux @@ -1,16 +1,12 @@ (.module: [lux #* ["_" test (#+ Test)] - ["." type ("#@." equivalence)] [abstract [monad (#+ do)]] [control [pipe (#+ case>)] ["." io] ["." try]] - [data - ["." bit ("#@." equivalence)] - ["." text ("#@." equivalence)]] [math ["r" random (#+ Random)]] [macro diff --git a/stdlib/source/spec/compositor/generation/case.lux b/stdlib/source/spec/compositor/generation/case.lux index 764d7351b..908fef201 100644 --- a/stdlib/source/spec/compositor/generation/case.lux +++ b/stdlib/source/spec/compositor/generation/case.lux @@ -7,13 +7,13 @@ [pipe (#+ case>)] ["." try (#+ Try)]] [data - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [number ["n" nat] ["f" frac]] [collection - ["." list ("#@." fold)]]] + ["." list ("#\." fold)]]] [math ["r" random (#+ Random)]] [tool @@ -152,7 +152,7 @@ (function (_ head tail) (synthesis.variant [0 #1 (synthesis.tuple (list head tail))]))) _list_ (: (-> (List Synthesis) Synthesis) - (list@fold _cons_ _nil_))] + (list\fold _cons_ _nil_))] (let [__tuple__ (: (-> (List Synthesis) Synthesis) (|>> list.reverse _list_ [9 #0] synthesis.variant _code_)) __form__ (: (-> (List Synthesis) Synthesis) @@ -169,7 +169,7 @@ (_code_ (synthesis.variant [7 #0 (synthesis.tuple (list (synthesis.text module) (synthesis.text short)))])))) __list__ (: (-> (List Synthesis) Synthesis) - (list@fold (function (_ head tail) + (list\fold (function (_ head tail) (__form__ (list (__tag__ ["" "Cons"]) head tail))) (__tag__ ["" "Nil"]))) __apply__ (: (-> Synthesis Synthesis Synthesis) @@ -247,7 +247,7 @@ (-> Runner Test) ($_ _.and (_.test "===" - (and (text@= (synthesis.%path special-path) + (and (text\= (synthesis.%path special-path) (synthesis.%path special-pattern-path)) (:: synthesis.path-equivalence = special-path special-pattern-path))) (_.test "CODE" diff --git a/stdlib/source/spec/compositor/generation/common.lux b/stdlib/source/spec/compositor/generation/common.lux index 9060675f6..60caf1a32 100644 --- a/stdlib/source/spec/compositor/generation/common.lux +++ b/stdlib/source/spec/compositor/generation/common.lux @@ -7,13 +7,13 @@ [pipe (#+ case>)] ["." try (#+ Try)]] [data - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] [number ["." i64] ["n" nat] ["i" int] ["f" frac]] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection ["." list]]] @@ -90,7 +90,7 @@ (let [subject <subject-expr>])))] ["lux i64 f64" Frac i.frac f.= subject] - ["lux i64 char" Text (|>> (:coerce Nat) text.from-code) text@= (|> subject + ["lux i64 char" Text (|>> (:coerce Nat) text.from-code) text\= (|> subject (:coerce Nat) (n.% (i64.left-shift 8 1)) (:coerce Int))] @@ -111,8 +111,8 @@ ["lux i64 *" i.* Int i.=] ["lux i64 /" i./ Int i.=] ["lux i64 %" i.% Int i.=] - ["lux i64 =" i.= Bit bit@=] - ["lux i64 <" i.< Bit bit@=] + ["lux i64 =" i.= Bit bit\=] + ["lux i64 <" i.< Bit bit\=] )) )))) @@ -145,7 +145,7 @@ (synthesis.f64 subject))) (run (..sanitize <extension>)) (case> (#try.Success valueV) - (bit@= (<text> param subject) + (bit\= (<text> param subject) (:coerce Bit valueV)) _ @@ -179,7 +179,7 @@ sample-lower (r.ascii/lower-alpha sample-size) sample-upper (r.ascii/upper-alpha sample-size) sample-alpha (|> (r.ascii/alpha sample-size) - (r.filter (|>> (text@= sample-upper) not))) + (r.filter (|>> (text\= sample-upper) not))) char-idx (|> r.nat (:: ! map (n.% sample-size))) #let [sample-lowerS (synthesis.text sample-lower) sample-upperS (synthesis.text sample-upper) @@ -259,7 +259,7 @@ (run (..sanitize "lux text clip")) (case> (^multi (#try.Success valueV) [(:coerce (Maybe Text) valueV) (#.Some valueV)]) - (text@= expected valueV) + (text\= expected valueV) _ false))))] @@ -316,7 +316,7 @@ (run (..sanitize "lux try")) (case> (^multi (#try.Success valueV) [(:coerce (Try Text) valueV) (#try.Success valueV)]) - (text@= message valueV) + (text\= message valueV) _ false)))) diff --git a/stdlib/source/spec/compositor/generation/function.lux b/stdlib/source/spec/compositor/generation/function.lux index fefe039f7..21b2b4446 100644 --- a/stdlib/source/spec/compositor/generation/function.lux +++ b/stdlib/source/spec/compositor/generation/function.lux @@ -11,9 +11,9 @@ [number ["n" nat]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [math - ["r" random (#+ Random) ("#@." monad)]] + ["r" random (#+ Random) ("#\." monad)]] [tool [compiler [analysis (#+ Arity)] @@ -28,11 +28,11 @@ (def: arity (Random Arity) - (|> r.nat (r@map (|>> (n.% max-arity) (n.max 1))))) + (|> r.nat (r\map (|>> (n.% max-arity) (n.max 1))))) (def: (local arity) (-> Arity (Random Register)) - (|> r.nat (r@map (|>> (n.% arity) inc)))) + (|> r.nat (r\map (|>> (n.% arity) inc)))) (def: function (Random [Arity Register Synthesis]) @@ -52,7 +52,7 @@ partial-arity (|> r.nat (:: ! map (|>> (n.% arity) (n.max 1)))) inputs (r.list arity r.safe-frac) #let [expectation (maybe.assume (list.nth (dec local) inputs)) - inputsS (list@map (|>> synthesis.f64) inputs)]] + inputsS (list\map (|>> synthesis.f64) inputs)]] ($_ _.and (_.test "Can read arguments." (|> (synthesis.function/apply {#synthesis.function functionS @@ -73,7 +73,7 @@ (or (n.= 1 arity) (let [environment (|> partial-arity (enum.range n.enum 1) - (list@map (|>> #reference.Local))) + (list\map (|>> #reference.Local))) variableS (if (n.<= partial-arity local) (synthesis.variable/foreign (dec local)) (synthesis.variable/local (|> local (n.- partial-arity)))) diff --git a/stdlib/source/spec/compositor/generation/primitive.lux b/stdlib/source/spec/compositor/generation/primitive.lux index e5b601677..3b6dd657b 100644 --- a/stdlib/source/spec/compositor/generation/primitive.lux +++ b/stdlib/source/spec/compositor/generation/primitive.lux @@ -7,10 +7,10 @@ [pipe (#+ case>)] ["." try]] [data - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] [number ["f" frac]] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]]] [math ["r" random]] @@ -40,9 +40,9 @@ (#try.Failure _) false))))] - ["bit" synthesis.bit r.bit bit@=] + ["bit" synthesis.bit r.bit bit\=] ["i64" synthesis.i64 r.i64 "lux i64 ="] ["f64" synthesis.f64 r.frac f.='] - ["text" synthesis.text (r.ascii 5) text@=] + ["text" synthesis.text (r.ascii 5) text\=] )) ))) diff --git a/stdlib/source/spec/compositor/generation/structure.lux b/stdlib/source/spec/compositor/generation/structure.lux index cd790c6d2..e728867eb 100644 --- a/stdlib/source/spec/compositor/generation/structure.lux +++ b/stdlib/source/spec/compositor/generation/structure.lux @@ -11,11 +11,11 @@ [number ["n" nat] ["i" int]] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection ["." array (#+ Array)] - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [math ["r" random]] ["." host (#+ import:)] @@ -51,7 +51,7 @@ same-tag? (|> tag-out host.int-to-long (:coerce Nat) (n.= tag-in)) same-flag? (case last?-out (#.Some last?-out') - (and last?-in (text@= "" (:coerce Text last?-out'))) + (and last?-in (text\= "" (:coerce Text last?-out'))) #.None (not last?-in)) @@ -69,7 +69,7 @@ [size (|> r.nat (:: ! map (|>> (n.% 10) (n.max 2)))) tuple-in (r.list size r.i64)] (_.test (%.name (name-of synthesis.tuple)) - (|> (synthesis.tuple (list@map (|>> synthesis.i64) tuple-in)) + (|> (synthesis.tuple (list\map (|>> synthesis.i64) tuple-in)) (run "tuple") (case> (#try.Success tuple-out) (let [tuple-out (:coerce (Array Any) tuple-out)] diff --git a/stdlib/source/spec/lux/world/shell.lux b/stdlib/source/spec/lux/world/shell.lux index c10f77c12..e0eacbee6 100644 --- a/stdlib/source/spec/lux/world/shell.lux +++ b/stdlib/source/spec/lux/world/shell.lux @@ -23,12 +23,13 @@ {1 ["." / [// - [environment (#+ Environment)]]]}) + [environment (#+ Environment)] + [file (#+ Path)]]]}) (template [<name> <command> <type> <prep>] [(def: <name> - (-> <type> [Environment /.Command (List /.Argument)]) - (|>> <prep> list [environment.empty <command>]))] + (-> <type> [Environment Path /.Command (List /.Argument)]) + (|>> <prep> list [environment.empty "~" <command>]))] [echo! "echo" Text (|>)] [sleep! "sleep" Nat %.nat] diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 4947dcf18..7540b4541 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -13,7 +13,8 @@ ["#/." pom] ["#/." install] ["#/." deploy] - ["#/." deps]] + ["#/." deps] + ["#/." build]] ["#." local] ["#." cache] ["#." dependency @@ -38,6 +39,7 @@ /command/install.test /command/deploy.test /command/deps.test + /command/build.test /local.test /cache.test /dependency.test diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux new file mode 100644 index 000000000..5285b7548 --- /dev/null +++ b/stdlib/source/test/aedifex/command/build.lux @@ -0,0 +1,147 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + ["." predicate]] + [control + ["." try] + ["." exception] + [concurrency + ["." promise]] + [parser + ["." environment]]] + [data + [text + ["%" format (#+ format)]] + [collection + ["." dictionary] + ["." set]]] + [math + ["." random (#+ Random)]] + [world + ["." file] + ["." shell]]] + ["$." /// #_ + ["#." package] + ["#." artifact] + ["#." dependency #_ + ["#/." resolution]]] + {#program + ["." / + ["//#" /// #_ + ["#" profile (#+ Profile)] + ["#." action] + ["#." pom] + ["#." package] + ["#." cache] + ["#." repository] + ["#." artifact + ["#/." type]] + ["#." dependency + ["#/." resolution]]]]}) + +(def: #export test + Test + (<| (_.covering /._) + (do {! random.monad} + [#let [fs (file.mock (:: file.default separator)) + shell (shell.mock + (function (_ [actual-environment actual-working-directory actual-command actual-arguments]) + (#try.Success + (: (shell.Simulation []) + (structure + (def: (on-read state) + (#try.Failure "on-read")) + (def: (on-error state) + (#try.Failure "on-error")) + (def: (on-write input state) + (#try.Failure "on-write")) + (def: (on-destroy state) + (#try.Failure "on-destroy")) + (def: (on-await state) + (#try.Success [state shell.normal])))))) + [])] + program (random.ascii/alpha 5) + target (random.ascii/alpha 5) + working-directory (random.ascii/alpha 5) + #let [empty-profile (: Profile + (:: ///.monoid identity)) + with-target (: (-> Profile Profile) + (set@ #///.target (#.Some target))) + with-program (: (-> Profile Profile) + (set@ #///.program (#.Some program))) + + profile (|> empty-profile + with-program + with-target) + + no-working-directory environment.empty + + environment (dictionary.put "user.dir" working-directory environment.empty)]] + ($_ _.and + (_.cover [/.working-directory] + (and (case (/.working-directory no-working-directory) + (#try.Success _) + false + + (#try.Failure error) + true) + (case (/.working-directory environment) + (#try.Success _) + true + + (#try.Failure error) + false))) + (wrap (do promise.monad + [outcome (/.do! environment fs shell ///dependency/resolution.empty + (with-target empty-profile))] + (_.claim [/.no-specified-program] + (case outcome + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.no-specified-program error))))) + (wrap (do promise.monad + [outcome (/.do! environment fs shell ///dependency/resolution.empty + (with-program empty-profile))] + (_.claim [/.no-specified-target] + (case outcome + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.no-specified-target error))))) + (wrap (do promise.monad + [outcome (/.do! environment fs shell ///dependency/resolution.empty profile)] + (_.claim [/.Compiler /.no-available-compiler] + (case outcome + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.no-available-compiler error))))) + (do ! + [lux-version (random.ascii/alpha 5) + [_ compiler-package] $///package.random + #let [jvm-compiler {#///dependency.artifact {#///artifact.group /.lux-group + #///artifact.name /.jvm-compiler-name + #///artifact.version lux-version} + #///dependency.type ///artifact/type.lux-library} + js-compiler {#///dependency.artifact {#///artifact.group /.lux-group + #///artifact.name /.js-compiler-name + #///artifact.version lux-version} + #///dependency.type ///artifact/type.lux-library}] + compiler-dependency (random.either (wrap jvm-compiler) + (wrap js-compiler))] + (wrap (do promise.monad + [verdict (do ///action.monad + [#let [resolution (|> ///dependency/resolution.empty + (dictionary.put compiler-dependency compiler-package))] + _ (/.do! environment fs shell resolution profile)] + (wrap true))] + (_.claim [/.do! + /.lux-group /.jvm-compiler-name /.js-compiler-name] + (try.default false verdict))))) + )))) diff --git a/stdlib/source/test/licentia.lux b/stdlib/source/test/licentia.lux index f73d55ab4..506a61c61 100644 --- a/stdlib/source/test/licentia.lux +++ b/stdlib/source/test/licentia.lux @@ -5,13 +5,13 @@ [abstract/monad (#+ do)] [io (#+ io)] [data - ["." bit ("#;." equivalence)] - ["." maybe ("#;." functor)] + ["." bit ("#\." equivalence)] + ["." maybe ("#\." functor)] ["." text] [number - ["n" nat ("#@." interval)]] + ["n" nat ("#\." interval)]] [collection - ["." list ("#;." functor)]]] + ["." list ("#\." functor)]]] [math ["r" random (#+ Random)]]] {#program @@ -43,9 +43,9 @@ (def: period (Random (Period Nat)) (do {! r.monad} - [start (r.filter (|>> (n.= n@top) not) + [start (r.filter (|>> (n.= n\top) not) r.nat) - #let [wiggle-room (n.- start n@top)] + #let [wiggle-room (n.- start n\top)] end (:: ! map (|>> (n.% wiggle-room) (n.max 1)) r.nat)] @@ -173,10 +173,10 @@ (_.test "Litigation conditions are present." (present? liability.litigation)) (_.test "Liability acceptance conditions may be present." - (bit;= (get@ #license.can-accept? liability) + (bit\= (get@ #license.can-accept? liability) (present? liability.can-accept))) (_.test "Liability acceptance conditions may be present." - (bit;= (get@ #license.disclaim-high-risk? liability) + (bit\= (get@ #license.disclaim-high-risk? liability) (present? liability.disclaim-high-risk))) )) @@ -195,13 +195,13 @@ (Concern Commercial) ($_ _.and (_.test "Non-commercial clause is present." - (bit;= (not (get@ #license.can-sell? commercial)) + (bit\= (not (get@ #license.can-sell? commercial)) (present? commercial.cannot-sell))) (_.test "Contributor credit condition is present." - (bit;= (get@ #license.require-contributor-credit? commercial) + (bit\= (get@ #license.require-contributor-credit? commercial) (present? commercial.require-contributor-attribution))) (_.test "Anti-endorsement condition is present." - (bit;= (not (get@ #license.allow-contributor-endorsement? commercial)) + (bit\= (not (get@ #license.allow-contributor-endorsement? commercial)) (present? commercial.disallow-contributor-endorsement))) )) @@ -209,11 +209,11 @@ (Concern Extension) ($_ _.and (_.test "The license is viral." - (bit;= (get@ #license.same-license? extension) + (bit\= (get@ #license.same-license? extension) (and (list.every? present? extension.sharing-requirement) (list.every? present? extension.license-conflict-resolution)))) (_.test "Extensions must be distinguishable from the original work." - (bit;= (get@ #license.must-be-distinguishable? extension) + (bit\= (get@ #license.must-be-distinguishable? extension) (present? extension.distinctness-requirement))) (_.test "The community must be notified of new extensions." (case (get@ #license.notification-period extension) @@ -223,7 +223,7 @@ #.None true)) (_.test "Must describe modifications." - (bit;= (get@ #license.must-describe-modifications? extension) + (bit\= (get@ #license.must-describe-modifications? extension) (present? extension.description-requirement))) )) @@ -235,14 +235,14 @@ (_.test "The attribution phrase is present." (|> attribution (get@ #license.phrase) - (maybe;map present?) + (maybe\map present?) (maybe.default true))) (_.test "The attribution URL is present." (present? (get@ #license.url attribution))) (_.test "The attribution image is present." (|> attribution (get@ #license.image) - (maybe;map present?) + (maybe\map present?) (maybe.default true))) )) @@ -295,7 +295,7 @@ yes) every-entity-is-mentioned? (|> black-list (get@ #license.entities) - (list;map black-list.entity) + (list\map black-list.entity) (list.every? present?))] (and black-list-is-justified? every-entity-is-mentioned?))) diff --git a/stdlib/source/test/lux/control/concatenative.lux b/stdlib/source/test/lux/control/concatenative.lux index f346ff568..8d6ed4e87 100644 --- a/stdlib/source/test/lux/control/concatenative.lux +++ b/stdlib/source/test/lux/control/concatenative.lux @@ -131,7 +131,7 @@ (!numerical r.= random.rev (|>> (r.= .0) not) [[/.r/+ r.+] [/.r/- r.-] [/.r/* r.*] [/.r// r./] [/.r/% r.%]] [[/.r/= r.=] [/.r/< r.<] [/.r/<= r.<=] [/.r/> r.>] [/.r/>= r.>=]]) - (!numerical f.= random.frac (|>> (f.= +0.0) not) + (!numerical f.= random.safe-frac (|>> (f.= +0.0) not) [[/.f/+ f.+] [/.f/- f.-] [/.f/* f.*] [/.f// f./] [/.f/% f.%]] [[/.f/= f.=] [/.f/< f.<] [/.f/<= f.<=] [/.f/> f.>] [/.f/>= f.>=]]) )) diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux index 74a295777..5a80af5a7 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -4,7 +4,7 @@ [abstract [monad (#+ do)]] [math - ["." random ("#@." monad)]]] + ["." random]]] ["." / #_ ["#." binary] ["#." bit] diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index 7a5e686ac..5a94f13b7 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -12,6 +12,8 @@ [data ["." bit] ["." maybe] + ["." text ("#\." equivalence) + ["%" format (#+ format)]] [number ["n" nat]] [collection @@ -46,6 +48,45 @@ ($fold.spec ..injection /.equivalence /.fold)) ))) +(def: search + Test + (do {! random.monad} + [size ..bounded-size + base random.nat + shift random.nat + #let [expected (n.+ base shift)] + the-array (random.array size random.nat)] + ($_ _.and + (_.cover [/.find] + (:: (maybe.equivalence n.equivalence) = + (/.find n.even? the-array) + (list.find n.even? (/.to-list the-array)))) + (_.cover [/.find+] + (case [(/.find n.even? the-array) + (/.find+ (function (_ idx member) + (n.even? member)) + the-array)] + [(#.Some expected) (#.Some [idx actual])] + (case (/.read idx the-array) + (#.Some again) + (and (n.= expected actual) + (n.= actual again)) + + #.None + false) + + [#.None #.None] + true)) + (_.cover [/.every?] + (:: bit.equivalence = + (list.every? n.even? (/.to-list the-array)) + (/.every? n.even? the-array))) + (_.cover [/.any?] + (:: bit.equivalence = + (list.any? n.even? (/.to-list the-array)) + (/.any? n.even? the-array))) + ))) + (def: #export test Test (<| (_.covering /._) @@ -59,10 +100,18 @@ the-array (random.array size random.nat)] ($_ _.and ..structures + ..search (_.cover [/.new /.size] (n.= size (/.size (: (Array Nat) (/.new size))))) + (_.cover [/.type-name] + (case (:of (/.new size)) + (^ (#.UnivQ _ (#.Apply _ (#.Named _ (#.UnivQ _ (#.Primitive nominal-type (list (#.Parameter 1)))))))) + (text\= /.type-name nominal-type) + + _ + false)) (_.cover [/.read /.write!] (let [the-array (|> (/.new 2) (: (Array Nat)) @@ -171,32 +220,4 @@ (or (n.even? value) (is? default value))) (/.to-list' default the-array))))) - (_.cover [/.find] - (:: (maybe.equivalence n.equivalence) = - (/.find n.even? the-array) - (list.find n.even? (/.to-list the-array)))) - (_.cover [/.find+] - (case [(/.find n.even? the-array) - (/.find+ (function (_ idx member) - (n.even? member)) - the-array)] - [(#.Some expected) (#.Some [idx actual])] - (case (/.read idx the-array) - (#.Some again) - (and (n.= expected actual) - (n.= actual again)) - - #.None - false) - - [#.None #.None] - true)) - (_.cover [/.every?] - (:: bit.equivalence = - (list.every? n.even? (/.to-list the-array)) - (/.every? n.even? the-array))) - (_.cover [/.any?] - (:: bit.equivalence = - (list.any? n.even? (/.to-list the-array)) - (/.any? n.even? the-array))) )))) diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index c1341aae0..22834745d 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -1,67 +1,199 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] + ["." meta] [abstract - codec - [monad (#+ do Monad)] - [equivalence (#+ Equivalence)] + [monad (#+ do)] {[0 #spec] [/ ["$." equivalence] ["$." codec]]}] [control - pipe - ["p" parser]] + ["." try ("#\." functor)]] [data + ["." product] ["." bit] - ["." maybe] - ["." text] + ["." text + ["%" format (#+ format)]] [number ["n" nat] ["." frac]] [collection - [row (#+ row)] - ["d" dictionary] - ["." list]]] - [macro - [poly (#+ derived:)]] - [type - ["." unit]] + ["." row] + ["." dictionary] + ["." set] + ["." list ("#\." functor)]]] [math - ["r" random (#+ Random)]] - [time - ["ti" instant] - ["tda" date] - ## ["tdu" duration] - ]] - [test - [lux - [time - ["_." instant] - ## ["_." duration] - ["_." date]]]] + ["." random (#+ Random)]] + [macro + ["." syntax (#+ syntax:)] + ["." code]]] {1 - ["." / (#+ JSON)]}) + ["." / (#+ JSON) ("\." equivalence)]}) (def: #export json - (Random JSON) - (r.rec (function (_ recur) - (do {! r.monad} - [size (:: ! map (n.% 2) r.nat)] - ($_ r.or - (:: ! wrap []) - r.bit - r.safe-frac - (r.unicode size) - (r.row size recur) - (r.dictionary text.hash size (r.unicode size) recur) - ))))) + (Random /.JSON) + (random.rec + (function (_ recur) + (do {! random.monad} + [size (:: ! map (n.% 2) random.nat)] + ($_ random.or + (:: ! wrap []) + random.bit + random.safe-frac + (random.unicode size) + (random.row size recur) + (random.dictionary text.hash size (random.unicode size) recur) + ))))) + +(syntax: (boolean) + (do meta.monad + [value meta.count] + (wrap (list (code.bit (n.even? value)))))) + +(syntax: (number) + (do meta.monad + [value meta.count] + (wrap (list (code.frac (n.frac value)))))) + +(syntax: (string) + (do meta.monad + [value (meta.gensym "string")] + (wrap (list (code.text (%.code value)))))) (def: #export test Test - (<| (_.context (%.name (name-of /._))) - ($_ _.and - ($equivalence.spec /.equivalence ..json) - ($codec.spec /.equivalence /.codec ..json) - ))) + (<| (_.covering /._) + (_.with-cover [/.JSON]) + (`` ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence ..json)) + (_.with-cover [/.codec] + ($codec.spec /.equivalence /.codec ..json)) + + (do random.monad + [sample ..json] + (_.cover [/.Null /.null?] + (:: bit.equivalence = + (/.null? sample) + (case sample + #/.Null true + _ false)))) + (do random.monad + [expected ..json] + (_.cover [/.format] + (|> expected + /.format + (:: /.codec decode) + (try\map (\= expected)) + (try.default false)))) + (do random.monad + [keys (random.set text.hash 3 (random.ascii/alpha 1)) + values (random.set frac.hash 3 random.safe-frac) + #let [expected (list.zip/2 (set.to-list keys) + (list\map (|>> #/.Number) (set.to-list values))) + object (/.object expected)]] + ($_ _.and + (_.cover [/.object /.fields] + (case (/.fields object) + (#try.Success actual) + (:: (list.equivalence text.equivalence) = + (list\map product.left expected) + actual) + + (#try.Failure error) + false)) + (_.cover [/.get] + (list.every? (function (_ [key expected]) + (|> (/.get key object) + (try\map (\= expected)) + (try.default false))) + expected)) + )) + (do random.monad + [key (random.ascii/alpha 1) + unknown (random.filter (|>> (:: text.equivalence = key) not) + (random.ascii/alpha 1)) + expected random.safe-frac] + (_.cover [/.set] + (<| (try.default false) + (do try.monad + [object (/.set key (#/.Number expected) (/.object (list))) + #let [can-find-known-key! + (|> object + (/.get key) + (try\map (\= (#/.Number expected))) + (try.default false)) + + cannot-find-unknown-key! + (case (/.get unknown object) + (#try.Success _) + false + + (#try.Failure error) + true)]] + (wrap (and can-find-known-key! + cannot-find-unknown-key!)))))) + (~~ (template [<type> <get> <tag> <random> <equivalence>] + [(do random.monad + [key (random.ascii/alpha 1) + value <random>] + (_.cover [<type> <get>] + (|> (/.object (list [key (<tag> value)])) + (<get> key) + (try\map (:: <equivalence> = value)) + (try.default false))))] + + [/.Boolean /.get-boolean #/.Boolean random.bit bit.equivalence] + [/.Number /.get-number #/.Number random.safe-frac frac.equivalence] + [/.String /.get-string #/.String (random.ascii/alpha 1) text.equivalence] + [/.Array /.get-array #/.Array (random.row 3 ..json) (row.equivalence /.equivalence)] + [/.Object /.get-object #/.Object (random.dictionary text.hash 3 (random.ascii/alpha 1) ..json) (dictionary.equivalence /.equivalence)] + )) + (with-expansions [<boolean> (boolean) + <number> (number) + <string> (string) + <array-row> (row.row #/.Null + (#/.Boolean <boolean>) + (#/.Number <number>) + (#/.String <string>)) + <key0> (string) + <key1> (string) + <key2> (string) + <key3> (string) + <key4> (string) + <key5> (string) + <key6> (string)] + (_.cover [/.json] + (and (\= #/.Null (/.json #null)) + (~~ (template [<tag> <value>] + [(\= (<tag> <value>) (/.json <value>))] + + [#/.Boolean <boolean>] + [#/.Number <number>] + [#/.String <string>] + )) + (\= (#/.Array <array-row>) (/.json [#null <boolean> <number> <string>])) + (let [object (/.json {<key0> #null + <key1> <boolean> + <key2> <number> + <key3> <string> + <key4> [#null <boolean> <number> <string>] + <key5> {<key6> <number>}})] + (<| (try.default false) + (do try.monad + [value0 (/.get <key0> object) + value1 (/.get <key1> object) + value2 (/.get <key2> object) + value3 (/.get <key3> object) + value4 (/.get <key4> object) + value5 (/.get <key5> object) + value6 (/.get <key6> value5)] + (wrap (and (\= #/.Null value0) + (\= (#/.Boolean <boolean>) value1) + (\= (#/.Number <number>) value2) + (\= (#/.String <string>) value3) + (\= (#/.Array <array-row>) value4) + (\= (#/.Number <number>) value6)))))) + ))) + )))) diff --git a/stdlib/source/test/lux/host.js.lux b/stdlib/source/test/lux/host.js.lux index 507cda9ff..6e42fc363 100644 --- a/stdlib/source/test/lux/host.js.lux +++ b/stdlib/source/test/lux/host.js.lux @@ -8,7 +8,7 @@ [control ["." try]] [data - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [number ["." nat] ["." frac]]]] @@ -55,21 +55,21 @@ /.on-node-js? /.on-browser?)) (_.cover [/.type-of] - (and (text@= "boolean" (/.type-of boolean)) - (text@= "number" (/.type-of number)) - (text@= "string" (/.type-of string)) - (text@= "function" (/.type-of function)) - (text@= "object" (/.type-of object)))) + (and (text\= "boolean" (/.type-of boolean)) + (text\= "number" (/.type-of number)) + (text\= "string" (/.type-of string)) + (text\= "function" (/.type-of function)) + (text\= "object" (/.type-of object)))) (_.cover [/.try] (case (/.try (error! string)) (#try.Success _) false (#try.Failure error) - (text@= string error))) + (text\= string error))) (_.cover [/.import:] (let [encoding "utf8"] - (text@= string + (text\= string (cond /.on-nashorn? (let [binary (java/lang/String::getBytes [encoding] (:coerce java/lang/String string))] (|> (java/lang/String::new [binary encoding]) diff --git a/stdlib/source/test/lux/locale.lux b/stdlib/source/test/lux/locale.lux index 37a629596..3518dac9d 100644 --- a/stdlib/source/test/lux/locale.lux +++ b/stdlib/source/test/lux/locale.lux @@ -7,9 +7,9 @@ [/ ["$." equivalence]]}] [math - ["." random (#+ Random) ("#@." monad)]] + ["." random (#+ Random) ("#\." monad)]] [data - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["." encoding (#+ Encoding)]] [collection ["." list]]]] @@ -23,18 +23,18 @@ (def: random-language (Random Language) - (random.either (random@wrap language.afar) - (random@wrap language.zaza))) + (random.either (random\wrap language.afar) + (random\wrap language.zaza))) (def: random-territory (Random Territory) - (random.either (random@wrap territory.afghanistan) - (random@wrap territory.zimbabwe))) + (random.either (random\wrap territory.afghanistan) + (random\wrap territory.zimbabwe))) (def: random-encoding (Random Encoding) - (random.either (random@wrap encoding.ascii) - (random@wrap encoding.koi8-u))) + (random.either (random\wrap encoding.ascii) + (random\wrap encoding.koi8-u))) (def: random-locale (Random /.Locale) @@ -60,7 +60,7 @@ lt-locale (/.locale language (#.Some territory) #.None) le-locale (/.locale language #.None (#.Some encoding)) lte-locale (/.locale language (#.Some territory) (#.Some encoding))] - #let [language-check (and (text@= (language.code language) + #let [language-check (and (text\= (language.code language) (/.code l-locale)) (list.every? (|>> /.code (text.starts-with? (language.code language))) (list lt-locale le-locale lte-locale))) diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux index 52955680e..96f653a11 100644 --- a/stdlib/source/test/lux/macro/code.lux +++ b/stdlib/source/test/lux/macro/code.lux @@ -2,7 +2,7 @@ [lux #* ["_" test (#+ Test)] [math - ["." random (#+ Random) ("#@." monad)]] + ["." random (#+ Random) ("#\." monad)]] [abstract [monad (#+ do)] {[0 #spec] @@ -16,7 +16,7 @@ [number ["n" nat]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [meta ["." location]] [tool @@ -52,17 +52,17 @@ (random.rec (function (_ random) ($_ random.either - (random@map /.bit random.bit) - (random@map /.nat random.nat) - (random@map /.int random.int) - (random@map /.rev random.rev) - (random@map /.frac random.safe-frac) - (random@map /.text ..random-text) - (random@map /.identifier ..random-name) - (random@map /.tag ..random-name) - (random@map /.form (..random-sequence random)) - (random@map /.tuple (..random-sequence random)) - (random@map /.record (..random-record random)) + (random\map /.bit random.bit) + (random\map /.nat random.nat) + (random\map /.int random.int) + (random\map /.rev random.rev) + (random\map /.frac random.safe-frac) + (random\map /.text ..random-text) + (random\map /.identifier ..random-name) + (random\map /.tag ..random-name) + (random\map /.form (..random-sequence random)) + (random\map /.tuple (..random-sequence random)) + (random\map /.record (..random-record random)) )))) (def: (read source-code) @@ -87,29 +87,29 @@ (function (_ to-code) (do {! random.monad} [parts (..random-sequence replace-simulation)] - (wrap [(to-code (list@map product.left parts)) - (to-code (list@map product.right parts))]))))] + (wrap [(to-code (list\map product.left parts)) + (to-code (list\map product.right parts))]))))] ($_ random.either - (random@wrap [original substitute]) + (random\wrap [original substitute]) (do {! random.monad} [sample (random.filter (|>> (:: /.equivalence = original) not) ($_ random.either - (random@map /.bit random.bit) - (random@map /.nat random.nat) - (random@map /.int random.int) - (random@map /.rev random.rev) - (random@map /.frac random.safe-frac) - (random@map /.text ..random-text) - (random@map /.identifier ..random-name) - (random@map /.tag ..random-name)))] + (random\map /.bit random.bit) + (random\map /.nat random.nat) + (random\map /.int random.int) + (random\map /.rev random.rev) + (random\map /.frac random.safe-frac) + (random\map /.text ..random-text) + (random\map /.identifier ..random-name) + (random\map /.tag ..random-name)))] (wrap [sample sample])) (for-sequence /.form) (for-sequence /.tuple) (do {! random.monad} [parts (..random-sequence replace-simulation)] - (wrap [(/.record (let [parts' (list@map product.left parts)] + (wrap [(/.record (let [parts' (list\map product.left parts)] (list.zip/2 parts' parts'))) - (/.record (let [parts' (list@map product.right parts)] + (/.record (let [parts' (list\map product.right parts)] (list.zip/2 parts' parts')))])) ))))) diff --git a/stdlib/source/test/lux/macro/syntax/common.lux b/stdlib/source/test/lux/macro/syntax/common.lux index d50b94eaa..b470ca574 100644 --- a/stdlib/source/test/lux/macro/syntax/common.lux +++ b/stdlib/source/test/lux/macro/syntax/common.lux @@ -12,7 +12,7 @@ ["<>" parser ["<c>" code]]] [data - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] ["." name] ["." text] [number @@ -62,7 +62,7 @@ /writer.export (<c>.run /reader.export) (case> (#try.Success actual) - (bit@= expected actual) + (bit\= expected actual) (#try.Failure error) false)))) diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index fca611825..c6a141be8 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -13,7 +13,7 @@ [collection ["." list]]]] {1 - ["." / ("#@." equivalence)]} + ["." / ("#\." equivalence)]} ["." / #_ ["#." check] ["#." dynamic] @@ -32,13 +32,13 @@ (def: #export type (r.Random Type) - (let [(^open "R@.") r.monad] + (let [(^open "R\.") r.monad] (r.rec (function (_ recur) (let [pairG (r.and recur recur) idG r.nat - quantifiedG (r.and (R@wrap (list)) recur)] + quantifiedG (r.and (R\wrap (list)) recur)] ($_ r.or - (r.and ..short (R@wrap (list))) + (r.and ..short (R\wrap (list))) pairG pairG pairG @@ -95,15 +95,15 @@ #1))) (list.repeat size) (M.seq !)) - #let [(^open "/@.") /.equivalence - (^open "list@.") (list.equivalence /.equivalence)]] + #let [(^open "/\.") /.equivalence + (^open "list\.") (list.equivalence /.equivalence)]] (`` ($_ _.and (~~ (template [<desc> <ctor> <dtor> <unit>] [(_.test (format "Can build and tear-down " <desc> " types.") (let [flat (|> members <ctor> <dtor>)] - (or (list@= members flat) - (and (list@= (list) members) - (list@= (list <unit>) flat)))))] + (or (list\= members flat) + (and (list\= (list) members) + (list\= (list <unit>) flat)))))] ["variant" /.variant /.flatten-variant Nothing] ["tuple" /.tuple /.flatten-tuple Any] @@ -120,13 +120,13 @@ _ #1)))) - #let [(^open "/@.") /.equivalence - (^open "list@.") (list.equivalence /.equivalence)]] + #let [(^open "/\.") /.equivalence + (^open "list\.") (list.equivalence /.equivalence)]] ($_ _.and (_.test "Can build and tear-down function types." (let [[inputs output] (|> (/.function members extra) /.flatten-function)] - (and (list@= members inputs) - (/@= extra output)))) + (and (list\= members inputs) + (/\= extra output)))) (_.test "Can build and tear-down application types." (let [[tfunc tparams] (|> extra (/.application members) /.flatten-application)] @@ -142,13 +142,13 @@ _ #1)))) - #let [(^open "/@.") /.equivalence]] + #let [(^open "/\.") /.equivalence]] (`` ($_ _.and (~~ (template [<desc> <ctor> <dtor>] [(_.test (format "Can build and tear-down " <desc> " types.") (let [[flat-size flat-body] (|> extra (<ctor> size) <dtor>)] (and (n.= size flat-size) - (/@= extra flat-body))))] + (/\= extra flat-body))))] ["universally-quantified" /.univ-q /.flatten-univ-q] ["existentially-quantified" /.ex-q /.flatten-ex-q] @@ -157,7 +157,7 @@ (_.test (%.name (name-of /.:by-example)) (let [example (: (Maybe Nat) #.None)] - (/@= (.type (List Nat)) + (/\= (.type (List Nat)) (/.:by-example [a] {(Maybe a) example} (List a))))) diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux index 4846f5e7d..bbaaa5712 100644 --- a/stdlib/source/test/lux/type/check.lux +++ b/stdlib/source/test/lux/type/check.lux @@ -10,13 +10,13 @@ [data ["." product] ["." maybe] - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [number ["n" nat]] [collection - ["." list ("#@." functor)] + ["." list ("#\." functor)] ["." set]]] - ["." type ("#@." equivalence)]] + ["." type ("#\." equivalence)]] {1 ["." /]}) @@ -33,28 +33,28 @@ (-> Nat (r.Random Type)) (do r.monad [_ (wrap [])] - (let [(^open "R@.") r.monad + (let [(^open "R\.") r.monad pairG (r.and (type' num-vars) (type' num-vars)) - quantifiedG (r.and (R@wrap (list)) (type' (inc num-vars))) - random-pair (r.either (r.either (R@map (|>> #.Sum) pairG) - (R@map (|>> #.Product) pairG)) - (r.either (R@map (|>> #.Function) pairG) - (R@map (|>> #.Apply) pairG))) - random-id (let [random-id (r.either (R@map (|>> #.Var) r.nat) - (R@map (|>> #.Ex) r.nat))] + quantifiedG (r.and (R\wrap (list)) (type' (inc num-vars))) + random-pair (r.either (r.either (R\map (|>> #.Sum) pairG) + (R\map (|>> #.Product) pairG)) + (r.either (R\map (|>> #.Function) pairG) + (R\map (|>> #.Apply) pairG))) + random-id (let [random-id (r.either (R\map (|>> #.Var) r.nat) + (R\map (|>> #.Ex) r.nat))] (case num-vars 0 random-id - _ (r.either (R@map (|>> (n.% num-vars) (n.* 2) inc #.Parameter) r.nat) + _ (r.either (R\map (|>> (n.% num-vars) (n.* 2) inc #.Parameter) r.nat) random-id))) - random-quantified (r.either (R@map (|>> #.UnivQ) quantifiedG) - (R@map (|>> #.ExQ) quantifiedG))] + random-quantified (r.either (R\map (|>> #.UnivQ) quantifiedG) + (R\map (|>> #.ExQ) quantifiedG))] ($_ r.either - (R@map (|>> #.Primitive) (r.and ..short (R@wrap (list)))) + (R\map (|>> #.Primitive) (r.and ..short (R\wrap (list)))) random-pair random-id random-quantified - (R@map (|>> #.Named) (r.and ..name (type' num-vars))) + (R\map (|>> #.Named) (r.and ..name (type' num-vars))) )))) (def: type @@ -157,7 +157,7 @@ (do r.monad [#let [gen-short (r.ascii 10)] nameL gen-short - nameR (|> gen-short (r.filter (|>> (text@= nameL) not))) + nameR (|> gen-short (r.filter (|>> (text\= nameL) not))) paramL ..type paramR (r.filter (|>> (/.checks? paramL) not) ..type)] ($_ _.and @@ -207,7 +207,7 @@ (_.test "Can create rings of variables." (type-checks? (do /.monad [[[head-id head-type] ids+types [tail-id tail-type]] (build-ring num-connections) - #let [ids (list@map product.left ids+types)] + #let [ids (list\map product.left ids+types)] headR (/.ring head-id) tailR (/.ring tail-id)] (/.assert "" @@ -222,7 +222,7 @@ (_.test "When a var in a ring is bound, all the ring is bound." (type-checks? (do {! /.monad} [[[head-id headT] ids+types tailT] (build-ring num-connections) - #let [ids (list@map product.left ids+types)] + #let [ids (list\map product.left ids+types)] _ (/.check headT boundT) head-bound (/.read head-id) tail-bound (monad.map ! /.read ids) @@ -230,8 +230,8 @@ tailR+ (monad.map ! /.ring ids)] (let [rings-were-erased? (and (set.empty? headR) (list.every? set.empty? tailR+)) - same-types? (list.every? (type@= boundT) (list& (maybe.default headT head-bound) - (list@map (function (_ [tail-id ?tailT]) + same-types? (list.every? (type\= boundT) (list& (maybe.default headT head-bound) + (list\map (function (_ [tail-id ?tailT]) (maybe.default (#.Var tail-id) ?tailT)) (list.zip/2 ids tail-bound))))] (/.assert "" diff --git a/stdlib/source/test/lux/type/implicit.lux b/stdlib/source/test/lux/type/implicit.lux index 4cdb9009f..203aad478 100644 --- a/stdlib/source/test/lux/type/implicit.lux +++ b/stdlib/source/test/lux/type/implicit.lux @@ -8,7 +8,7 @@ [monad (#+ do)] ["." enum]] [data - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] [number ["n" nat]] [collection @@ -29,10 +29,10 @@ end (n.max left right)]] ($_ _.and (_.test "Can automatically select first-order structures." - (let [(^open "list@.") (list.equivalence n.equivalence)] - (and (bit@= (:: n.equivalence = left right) + (let [(^open "list\.") (list.equivalence n.equivalence)] + (and (bit\= (:: n.equivalence = left right) (/.::: = left right)) - (list@= (:: list.functor map inc (enum.range n.enum start end)) + (list\= (:: list.functor map inc (enum.range n.enum start end)) (/.::: map inc (enum.range n.enum start end)))))) (_.test "Can automatically select second-order structures." (/.::: = diff --git a/stdlib/source/test/lux/world/shell.lux b/stdlib/source/test/lux/world/shell.lux index 094b32420..dd37f63ba 100644 --- a/stdlib/source/test/lux/world/shell.lux +++ b/stdlib/source/test/lux/world/shell.lux @@ -1,6 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] + ["." debug] [abstract [monad (#+ do)]] [control @@ -25,19 +26,15 @@ {1 ["." / [// - [environment (#+ Environment)]]]} + [environment (#+ Environment)] + [file (#+ Path)]]]} {[1 #spec] ["$." /]}) -(macro: (|private| definition+ compiler) - (let [[module _] (name-of /._)] - (#.Right [compiler (list (` ("lux in-module" (~ [["" 0 0] (#.Text module)]) - (~+ definition+))))]))) - (exception: dead) -(def: (simulation [environment command arguments]) - (-> [Environment /.Command (List /.Argument)] +(def: (simulation [environment working-directory command arguments]) + (-> [Environment Path /.Command (List /.Argument)] (/.Simulation Bit)) (structure (def: (on-read dead?) @@ -71,30 +68,30 @@ (-> /.Command Text Text Text /.Exit (/.Shell IO)) (structure (def: execute - ((|private| /.can-execute) - (function (_ [environment command arguments]) + ((debug.private /.can-execute) + (function (_ [environment working-directory command arguments]) (io.io (#try.Success (: (/.Process IO) (structure (def: read - ((|private| /.can-read) + ((debug.private /.can-read) (function (_ _) (io.io (#try.Success command))))) (def: error - ((|private| /.can-read) + ((debug.private /.can-read) (function (_ _) (io.io (#try.Success oops))))) (def: write - ((|private| /.can-write) + ((debug.private /.can-write) (function (_ message) (io.io (#try.Failure message))))) (def: destroy - ((|private| /.can-destroy) + ((debug.private /.can-destroy) (function (_ _) (io.io (#try.Failure destruction))))) (def: await - ((|private| /.can-wait) + ((debug.private /.can-wait) (function (_ _) (io.io (#try.Success exit)))))))))))))) @@ -116,10 +113,10 @@ #let [shell (/.async (..io-shell command oops input destruction exit))]] (wrap (do {! promise.monad} [verdict (do (try.with !) - [process (!.use (:: shell execute) [environment.empty command (list)]) + [process (!.use (:: shell execute) [environment.empty "~" command (list)]) read (!.use (:: process read) []) error (!.use (:: process error) []) - write? (do ! + wrote! (do ! [write (!.use (:: process write) [input])] (wrap (#try.Success (case write (#try.Success _) @@ -127,19 +124,19 @@ (#try.Failure write) (text\= input write))))) - destroy? (do ! - [destroy (!.use (:: process destroy) [])] - (wrap (#try.Success (case destroy - (#try.Success _) - false - - (#try.Failure destroy) - (text\= destruction destroy))))) + destroyed! (do ! + [destroy (!.use (:: process destroy) [])] + (wrap (#try.Success (case destroy + (#try.Success _) + false + + (#try.Failure destroy) + (text\= destruction destroy))))) await (!.use (:: process await) [])] (wrap (and (text\= command read) (text\= oops error) - write? - destroy? + wrote! + destroyed! (i.= exit await))))] (_.claim [/.async /.Can-Write] (try.default false verdict))))) |