diff options
Diffstat (limited to '')
78 files changed, 1468 insertions, 714 deletions
diff --git a/documentation/bookmark/math.md b/documentation/bookmark/math.md index a582bb64d..36f19a3cf 100644 --- a/documentation/bookmark/math.md +++ b/documentation/bookmark/math.md @@ -87,10 +87,9 @@ 1. [Circles and lines vs. polynomial splines](https://wordsandbuttons.online/circles_and_lines_vs_polynomial_splines.html) 1. https://cormullion.github.io/blog/2018/06/21/bezier.html -1. https://pomax.github.io/bezierinfo/ +1. [A Primer on Bézier Curves](https://pomax.github.io/bezierinfo/) 1. https://99designs.com/blog/engineering/math-draw-vector-curves/ 1. https://medium.freecodecamp.org/nerding-out-with-bezier-curves-6e3c0bc48e2f -1. https://pomax.github.io/bezierinfo/#curvature 1. https://raphlinus.github.io/curves/2018/12/28/bezier-arclength.html 1. https://astiopin.github.io/2019/01/04/qbez-parabola.html 1. http://dlacko.org/blog/2016/10/19/approximating-bezier-curves-by-biarcs/ @@ -170,6 +169,7 @@ # Geometric Algebra | Clifford Algebra +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) 1. [Differential geometric algebra foundations: Grassmann.jl Ascend](https://www.youtube.com/watch?v=7hlDRLEhc8o&feature=youtu.be) diff --git a/documentation/bookmark/paradigm/ranked programming.md b/documentation/bookmark/paradigm/ranked programming.md new file mode 100644 index 000000000..3ff796c9d --- /dev/null +++ b/documentation/bookmark/paradigm/ranked programming.md @@ -0,0 +1,5 @@ +# Reference + +1. [Ranked Programming](https://github.com/tjitze/ranked-programming/blob/master/README.md) +1. [Ranked Programming](https://github.com/tjitze/ranked-programming/blob/master/documentation/ranked_programming.pdf) + diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux index 798cf8298..0ec4fb1d5 100644 --- a/lux-jvm/source/luxc/lang/directive/jvm.lux +++ b/lux-jvm/source/luxc/lang/directive/jvm.lux @@ -223,8 +223,8 @@ (-> /.Object Inst) (case instruction (^template [<tag> <inst>] - (<tag> class field-name field-type) - (<inst> class field-name field-type)) + [(<tag> class field-name field-type) + (<inst> class field-name field-type)]) ([#/.GETSTATIC _.GETSTATIC] [#/.PUTSTATIC _.PUTSTATIC] [#/.GETFIELD _.GETFIELD] @@ -236,8 +236,8 @@ (#/.CHECKCAST type) (_.CHECKCAST type) (^template [<tag> <inst>] - (<tag> class method-name method-type) - (<inst> class method-name method-type)) + [(<tag> class method-name method-type) + (<inst> class method-name method-type)]) ([#/.INVOKEINTERFACE _.INVOKEINTERFACE] [#/.INVOKESPECIAL _.INVOKESPECIAL] [#/.INVOKESTATIC _.INVOKESTATIC] @@ -402,9 +402,9 @@ (Re-labeler /.Branching) (case instruction (^template [<tag>] - (<tag> label) - (let [[mapping label] (..relabel [mapping label])] - [mapping (<tag> label)])) + [(<tag> label) + (let [[mapping label] (..relabel [mapping label])] + [mapping (<tag> label)])]) ([#/.IF_ICMPEQ] [#/.IF_ICMPGE] [#/.IF_ICMPGT] [#/.IF_ICMPLE] [#/.IF_ICMPLT] [#/.IF_ICMPNE] [#/.IFEQ] [#/.IFNE] [#/.IFGE] [#/.IFGT] [#/.IFLE] [#/.IFLT] @@ -444,16 +444,16 @@ (Re-labeler /.Control) (case instruction (^template [<tag> <relabel>] - (<tag> instruction) - (let [[mapping instruction] (<relabel> [mapping instruction])] - [mapping (<tag> instruction)])) + [(<tag> instruction) + (let [[mapping instruction] (<relabel> [mapping instruction])] + [mapping (<tag> instruction)])]) ([#/.GOTO ..relabel] [#/.Branching ..relabel-branching] [#/.Exception ..relabel-exception]) (^template [<tag>] - (<tag> instruction) - [mapping (<tag> instruction)]) + [(<tag> instruction) + [mapping (<tag> instruction)]]) ([#/.Concurrency] [#/.Return]) )) @@ -463,8 +463,8 @@ #/.NOP [mapping #/.NOP] (^template [<tag>] - (<tag> instruction) - [mapping (<tag> instruction)]) + [(<tag> instruction) + [mapping (<tag> instruction)]]) ([#/.Constant] [#/.Arithmetic] [#/.Bitwise] diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux index eea77aaf0..68d9b4347 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux @@ -118,27 +118,27 @@ elseG)))) (^template [<tag> <unwrap> <dup> <pop> <test> <comparison> <if>] - (<tag> cons) - (do {@ phase.monad} - [forkG (: (Operation Inst) - (monad.fold @ (function (_ [test thenP] elseG) - (do @ - [thenG (path' stack-depth @else @end phase archive thenP)] - (wrap (<| _.with-label (function (_ @else)) - (|>> <dup> - (<test> test) - <comparison> - (<if> @else) - <pop> - thenG - (_.label @else) - elseG))))) - (|>> <pop> - (_.GOTO @else)) - (#.Cons cons)))] - (wrap (|>> peekI - <unwrap> - forkG)))) + [(<tag> cons) + (do {@ phase.monad} + [forkG (: (Operation Inst) + (monad.fold @ (function (_ [test thenP] elseG) + (do @ + [thenG (path' stack-depth @else @end phase archive thenP)] + (wrap (<| _.with-label (function (_ @else)) + (|>> <dup> + (<test> test) + <comparison> + (<if> @else) + <pop> + thenG + (_.label @else) + elseG))))) + (|>> <pop> + (_.GOTO @else)) + (#.Cons cons)))] + (wrap (|>> peekI + <unwrap> + forkG)))]) ([#synthesis.I64-Fork (_.unwrap type.long) _.DUP2 _.POP2 (|>> .int _.long) _.LCMP _.IFNE] [#synthesis.F64-Fork (_.unwrap type.double) _.DUP2 _.POP2 _.double _.DCMPL _.IFNE] [#synthesis.Text-Fork (|>) _.DUP _.POP _.string @@ -153,41 +153,41 @@ (_.GOTO @end)))) (^template [<pattern> <right?>] - (^ (<pattern> lefts)) - (operation@wrap (<| _.with-label (function (_ @success)) - _.with-label (function (_ @fail)) - (|>> peekI - (_.CHECKCAST //.$Variant) - (structure.tagI lefts <right?>) - (structure.flagI <right?>) - (_.INVOKESTATIC //.$Runtime "pm_variant" (type.method [(list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value (list)])) - _.DUP - (_.IFNULL @fail) - (_.GOTO @success) - (_.label @fail) - _.POP - (_.GOTO @else) - (_.label @success) - pushI)))) + [(^ (<pattern> lefts)) + (operation@wrap (<| _.with-label (function (_ @success)) + _.with-label (function (_ @fail)) + (|>> peekI + (_.CHECKCAST //.$Variant) + (structure.tagI lefts <right?>) + (structure.flagI <right?>) + (_.INVOKESTATIC //.$Runtime "pm_variant" (type.method [(list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value (list)])) + _.DUP + (_.IFNULL @fail) + (_.GOTO @success) + (_.label @fail) + _.POP + (_.GOTO @else) + (_.label @success) + pushI)))]) ([synthesis.side/left false] [synthesis.side/right true]) ## Extra optimization (^template [<path> <projection>] - (^ (<path> lefts)) - (operation@wrap (|>> peekI - (<projection> lefts) - pushI)) - - (^ (synthesis.path/seq - (<path> lefts) - (synthesis.!bind-top register thenP))) - (do phase.monad - [then! (path' stack-depth @else @end phase archive thenP)] - (wrap (|>> peekI - (<projection> lefts) - (_.ASTORE register) - then!)))) + [(^ (<path> lefts)) + (operation@wrap (|>> peekI + (<projection> lefts) + pushI)) + + (^ (synthesis.path/seq + (<path> lefts) + (synthesis.!bind-top register thenP))) + (do phase.monad + [then! (path' stack-depth @else @end phase archive thenP)] + (wrap (|>> peekI + (<projection> lefts) + (_.ASTORE register) + then!)))]) ([synthesis.member/left ..left-projection] [synthesis.member/right ..right-projection]) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux index 26db95ac1..86b814bad 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux @@ -822,14 +822,14 @@ (synthesis.path/then (normalize bodyS)) (^template [<tag>] - (^ (<tag> leftP rightP)) - (<tag> (recur leftP) (recur rightP))) + [(^ (<tag> leftP rightP)) + (<tag> (recur leftP) (recur rightP))]) ([#synthesis.Alt] [#synthesis.Seq]) (^template [<tag>] - (^ (<tag> value)) - path) + [(^ (<tag> value)) + path]) ([#synthesis.Pop] [#synthesis.Bind] [#synthesis.Access]) @@ -838,11 +838,11 @@ (#synthesis.Bit-Fork when (recur then) (maybe@map recur else)) (^template [<tag>] - (<tag> [[test then] elses]) - (<tag> [[test (recur then)] - (list@map (function (_ [else-test else-then]) - [else-test (recur else-then)]) - elses)])) + [(<tag> [[test then] elses]) + (<tag> [[test (recur then)] + (list@map (function (_ [else-test else-then]) + [else-test (recur else-then)]) + elses)])]) ([#synthesis.I64-Fork] [#synthesis.F64-Fork] [#synthesis.Text-Fork]) @@ -853,8 +853,8 @@ (function (recur body) (case body (^template [<tag>] - (^ (<tag> value)) - body) + [(^ (<tag> value)) + body]) ([#synthesis.Primitive] [synthesis.constant]) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux index d8ab2cbee..2e0aba43e 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux @@ -34,14 +34,14 @@ (-> (I64 Any) (Operation Inst)) (case (.int value) (^template [<int> <instruction>] - <int> - (operation@wrap (|>> <instruction> (_.wrap type.long)))) + [<int> + (operation@wrap (|>> <instruction> (_.wrap type.long)))]) ([+0 _.LCONST_0] [+1 _.LCONST_1]) (^template [<int> <instruction>] - <int> - (operation@wrap (|>> <instruction> _.I2L (_.wrap type.long)))) + [<int> + (operation@wrap (|>> <instruction> _.I2L (_.wrap type.long)))]) ([-1 _.ICONST_M1] ## [+0 _.ICONST_0] ## [+1 _.ICONST_1] @@ -74,18 +74,18 @@ (-> Frac (Operation Inst)) (case value (^template [<int> <instruction>] - <int> - (operation@wrap (|>> <instruction> (_.wrap type.double)))) + [<int> + (operation@wrap (|>> <instruction> (_.wrap type.double)))]) ([+1.0 _.DCONST_1]) (^template [<int> <instruction>] - <int> - (operation@wrap (|>> <instruction> _.F2D (_.wrap type.double)))) + [<int> + (operation@wrap (|>> <instruction> _.F2D (_.wrap type.double)))]) ([+2.0 _.FCONST_2]) (^template [<int> <instruction>] - <int> - (operation@wrap (|>> <instruction> _.I2D (_.wrap type.double)))) + [<int> + (operation@wrap (|>> <instruction> _.I2D (_.wrap type.double)))]) ([-1.0 _.ICONST_M1] ## [+0.0 _.ICONST_0] ## [+1.0 _.ICONST_1] diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj index fb2a2dd9e..b7d78aa23 100644 --- a/luxc/src/lux/analyser/lux.clj +++ b/luxc/src/lux/analyser/lux.clj @@ -539,8 +539,15 @@ (defn ^:private ensure-undefined! [module-name local-name] (|do [verdict (&&module/defined? module-name local-name)] - (&/assert! (not verdict) - (str "[Analyser Error] Cannot re-define " module-name &/+name-separator+ local-name)))) + (if verdict + (|do [[[real-module real-name] _] (&&module/find-def module-name local-name) + :let [wanted-name (str module-name &/+name-separator+ local-name) + source-name (str real-module &/+name-separator+ real-name)]] + (&/assert! false (str "[Analyser Error] Cannot re-define " wanted-name + (if (= wanted-name source-name) + "" + (str "\nThis is an alias for " source-name))))) + (return &/$Nil)))) (defn analyse-def* [analyse optimize eval! compile-def ?name ?value ?meta exported? & [?expected-type]] (|do [_ &/ensure-directive diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index c65384392..959f6f910 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -420,11 +420,11 @@ #1) ## (type: Alias -## [Text Text]) +## Name) ("lux def" Alias ("lux check type" (#Named ["lux" "Alias"] - (#Product Text Text))) + Name)) (record$ #Nil) #1) diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux index 4334e7f41..1f5c592f3 100644 --- a/stdlib/source/lux/data/color.lux +++ b/stdlib/source/lux/data/color.lux @@ -2,7 +2,8 @@ [lux #* [abstract [equivalence (#+ Equivalence)] - [monoid (#+ Monoid)]] + [monoid (#+ Monoid)] + ["." hash (#+ Hash)]] [data [number ["n" nat] @@ -58,15 +59,24 @@ (-> Color RGB) (|>> :representation)) - (structure: #export equivalence + (def: #export hash + (Hash Color) + (let [hash ($_ hash.product + n.hash + n.hash + n.hash)] + (structure + (def: &equivalence + (structure + (def: (= reference sample) + (:: hash = (:representation reference) (:representation sample))))) + + (def: hash + (|>> :representation (:: hash hash)))))) + + (def: #export equivalence (Equivalence Color) - - (def: (= reference sample) - (let [[rr rg rb] (:representation reference) - [sr sg sb] (:representation sample)] - (and (n.= rr sr) - (n.= rg sg) - (n.= rb sb))))) + (:: ..hash &equivalence)) (def: #export black (..from-rgb {#red 0 diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux index bb18e5596..da2f5a9c5 100644 --- a/stdlib/source/lux/host.js.lux +++ b/stdlib/source/lux/host.js.lux @@ -12,7 +12,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." functor fold)]]] + ["." list ("#\." functor fold)]]] [type abstract] ["." meta (#+ with-gensyms)] @@ -120,7 +120,7 @@ (def: input-variables (-> (List Nullable) (List [Bit Code])) (|>> list.enumeration - (list@map (function (_ [idx [nullable? type]]) + (list\map (function (_ [idx [nullable? type]]) [nullable? (|> idx %.nat code.local-identifier)])))) (def: (nullable-type [nullable? type]) @@ -198,8 +198,8 @@ (-> Code Code Text (List Nullable) Bit Bit Nullable Code) (let [g!inputs (input-variables inputsT)] (` (def: ((~ g!method) - [(~+ (list@map product.right g!inputs))]) - (-> [(~+ (list@map nullable-type inputsT))] + [(~+ (list\map product.right g!inputs))]) + (-> [(~+ (list\map nullable-type inputsT))] (~ (|> (nullable-type outputT) (try-type try?) (io-type io?)))) @@ -209,7 +209,7 @@ (without-null g!temp outputT) (` ("js apply" ("js constant" (~ (code.text source))) - (~+ (list@map (with-null g!temp) g!inputs))))))))))) + (~+ (list\map (with-null g!temp) g!inputs))))))))))) (syntax: #export (import: {import ..import}) (with-gensyms [g!temp] @@ -222,18 +222,18 @@ real-class (text.replace-all "/" "." class)] (wrap (list& (` (type: (~ g!type) (..Object (primitive (~ (code.text real-class)))))) - (list@map (function (_ member) + (list\map (function (_ member) (case member (#Constructor inputsT) (let [g!inputs (input-variables inputsT)] (` (def: ((~ (qualify "new")) - [(~+ (list@map product.right g!inputs))]) - (-> [(~+ (list@map nullable-type inputsT))] + [(~+ (list\map product.right g!inputs))]) + (-> [(~+ (list\map nullable-type inputsT))] (~ g!type)) (:assume ("js object new" ("js constant" (~ (code.text real-class))) - [(~+ (list@map (with-null g!temp) g!inputs))]))))) + [(~+ (list\map (with-null g!temp) g!inputs))]))))) (#Field [static? field fieldT]) (if static? @@ -262,9 +262,9 @@ (#Virtual [method alias inputsT io? try? outputT]) (let [g!inputs (input-variables inputsT)] (` (def: ((~ (qualify (maybe.default method alias))) - [(~+ (list@map product.right g!inputs))] + [(~+ (list\map product.right g!inputs))] (~ g!object)) - (-> [(~+ (list@map nullable-type inputsT))] + (-> [(~+ (list\map nullable-type inputsT))] (~ g!type) (~ (|> (nullable-type outputT) (try-type try?) @@ -276,7 +276,7 @@ (` ("js object do" (~ (code.text method)) (~ g!object) - [(~+ (list@map (with-null g!temp) g!inputs))]))))))))))) + [(~+ (list\map (with-null g!temp) g!inputs))]))))))))))) members))))) (#Function [name alias inputsT io? try? outputT]) @@ -315,7 +315,7 @@ (~ g!_) (..constant (~ type) [(~ (code.local-identifier (format head "." next))) - (~+ (list@map code.local-identifier tail))]))))))))))) + (~+ (list\map code.local-identifier tail))]))))))))))) (template: (!defined? <constant>) (.case (..constant Any <constant>) diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux index af26b4372..70819c754 100644 --- a/stdlib/source/lux/host.old.lux +++ b/stdlib/source/lux/host.old.lux @@ -12,14 +12,14 @@ [data ["." maybe] ["." product] - ["." bit ("#@." codec)] + ["." bit ("#\." codec)] number - ["." text ("#@." equivalence monoid) + ["." text ("#\." equivalence monoid) ["%" format (#+ format)]] [collection ["." array (#+ Array)] - ["." list ("#@." monad fold monoid)]]] - ["." type ("#@." equivalence)] + ["." list ("#\." monad fold monoid)]]] + ["." type ("#\." equivalence)] [macro ["." code] [syntax (#+ syntax:)]] @@ -284,7 +284,7 @@ [[name params] _ _] (let [name (sanitize name) - =params (list@map (class->type' mode type-params in-array?) params)] + =params (list\map (class->type' mode type-params in-array?) params)] (` (primitive (~ (code.text name)) [(~+ =params)]))))) (def: (class->type' mode type-params in-array? class) @@ -292,7 +292,7 @@ (case class (#GenericTypeVar name) (case (list.find (function (_ [pname pbounds]) - (and (text@= name pname) + (and (text\= name pname) (not (list.empty? pbounds)))) type-params) #.None @@ -326,7 +326,7 @@ (def: (class-decl-type$ (^slots [#class-name #class-params])) (-> Class-Declaration Code) - (let [=params (list@map (: (-> Type-Parameter Code) + (let [=params (list\map (: (-> Type-Parameter Code) (function (_ [pname pbounds]) (case pbounds #.Nil @@ -345,7 +345,7 @@ (case class (#GenericTypeVar name) (case (list.find (function (_ [pname pbounds]) - (and (text@= name pname) + (and (text\= name pname) (not (list.empty? pbounds)))) env) #.None @@ -411,12 +411,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))] @@ -450,7 +450,7 @@ [args (: (Parser (List Code)) (s.form (p.after (s.this! (' ::new!)) (s.tuple (p.exactly (list.size arg-decls) s.any))))) - #let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ params)) arg-decls))]] + #let [arg-decls' (: (List Text) (list\map (|>> product.right (simple-class$ params)) arg-decls))]] (wrap (` ((~ (code.text (format "jvm new" ":" class-name ":" (text.join-with "," arg-decls')))) (~+ args)))))) @@ -461,7 +461,7 @@ args (: (Parser (List Code)) (s.form (p.after (s.this! (code.identifier ["" dotted-name])) (s.tuple (p.exactly (list.size arg-decls) s.any))))) - #let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ params)) arg-decls))]] + #let [arg-decls' (: (List Text) (list\map (|>> product.right (simple-class$ params)) arg-decls))]] (wrap (`' ((~ (code.text (format "jvm invokestatic" ":" class-name ":" method-name ":" (text.join-with "," arg-decls')))) (~+ args)))))) @@ -473,7 +473,7 @@ args (: (Parser (List Code)) (s.form (p.after (s.this! (code.identifier ["" dotted-name])) (s.tuple (p.exactly (list.size arg-decls) s.any))))) - #let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ params)) arg-decls))]] + #let [arg-decls' (: (List Text) (list\map (|>> product.right (simple-class$ params)) arg-decls))]] (wrap (`' ((~ (code.text (format <jvm-op> ":" class-name ":" method-name ":" (text.join-with "," arg-decls')))) (~' _jvm_this) (~+ args))))))] @@ -544,7 +544,7 @@ (do p.monad [name s.local-identifier _ (assert-no-periods name)] - (if (list.member? text.equivalence (list@map product.left type-vars) name) + (if (list.member? text.equivalence (list\map product.left type-vars) name) (wrap (#GenericTypeVar name)) (wrap (#GenericClass name (list))))) (s.tuple (do p.monad @@ -569,7 +569,7 @@ _ (assert-no-periods name) params (p.some recur^) _ (p.assert (format name " cannot be a type-parameter!") - (not (list.member? text.equivalence (list@map product.left type-vars) name)))] + (not (list.member? text.equivalence (list\map product.left type-vars) name)))] (wrap (#GenericClass name params)))) )))) @@ -713,7 +713,7 @@ [pm privacy-modifier^ strict-fp? (p.parses? (s.this! (' #strict))) method-vars ..type-params^ - #let [total-vars (list@compose class-vars method-vars)] + #let [total-vars (list\compose class-vars method-vars)] [_ arg-decls] (s.form (p.and (s.this! (' new)) (..arg-decls^ total-vars))) constructor-args (..constructor-args^ total-vars) @@ -732,7 +732,7 @@ strict-fp? (p.parses? (s.this! (' #strict))) final? (p.parses? (s.this! (' #final))) method-vars ..type-params^ - #let [total-vars (list@compose class-vars method-vars)] + #let [total-vars (list\compose class-vars method-vars)] [name this-name arg-decls] (s.form ($_ p.and s.local-identifier s.local-identifier @@ -755,7 +755,7 @@ [strict-fp? (p.parses? (s.this! (' #strict))) owner-class ..class-decl^ method-vars ..type-params^ - #let [total-vars (list@compose (product.right owner-class) method-vars)] + #let [total-vars (list\compose (product.right owner-class) method-vars)] [name this-name arg-decls] (s.form ($_ p.and s.local-identifier s.local-identifier @@ -879,7 +879,7 @@ [tvars ..type-params^ _ (s.this! (' new)) ?alias import-member-alias^ - #let [total-vars (list@compose owner-vars tvars)] + #let [total-vars (list\compose owner-vars tvars)] ?prim-mode (p.maybe primitive-mode^) args (..import-member-args^ total-vars) [io? try? maybe?] import-member-return-flags^] @@ -900,7 +900,7 @@ tvars ..type-params^ name s.local-identifier ?alias import-member-alias^ - #let [total-vars (list@compose owner-vars tvars)] + #let [total-vars (list\compose owner-vars tvars)] ?prim-mode (p.maybe primitive-mode^) args (..import-member-args^ total-vars) [io? try? maybe?] import-member-return-flags^ @@ -965,7 +965,7 @@ (def: (annotation$ [name params]) (-> Annotation JVM-Code) - (format "(" name " " "{" (text.join-with text.tab (list@map annotation-param$ params)) "}" ")")) + (format "(" name " " "{" (text.join-with text.tab (list\map annotation-param$ params)) "}" ")")) (def: (bound-kind$ kind) (-> BoundKind JVM-Code) @@ -980,7 +980,7 @@ name (#GenericClass name params) - (format "(" (sanitize name) " " (spaced (list@map generic-type$ params)) ")") + (format "(" (sanitize name) " " (spaced (list\map generic-type$ params)) ")") (#GenericArray param) (format "(" array.type-name " " (generic-type$ param) ")") @@ -993,25 +993,25 @@ (def: (type-param$ [name bounds]) (-> Type-Parameter JVM-Code) - (format "(" name " " (spaced (list@map generic-type$ bounds)) ")")) + (format "(" name " " (spaced (list\map generic-type$ bounds)) ")")) (def: (class-decl$ (^open ".")) (-> Class-Declaration JVM-Code) - (format "(" (sanitize class-name) " " (spaced (list@map type-param$ class-params)) ")")) + (format "(" (sanitize class-name) " " (spaced (list\map type-param$ class-params)) ")")) (def: (super-class-decl$ (^slots [#super-class-name #super-class-params])) (-> Super-Class-Decl JVM-Code) - (format "(" (sanitize super-class-name) " " (spaced (list@map generic-type$ super-class-params)) ")")) + (format "(" (sanitize super-class-name) " " (spaced (list\map generic-type$ super-class-params)) ")")) (def: (method-decl$ [[name pm anns] method-decl]) (-> [Member-Declaration MethodDecl] JVM-Code) (let [(^slots [#method-tvars #method-inputs #method-output #method-exs]) method-decl] (with-parens (spaced (list name - (with-brackets (spaced (list@map annotation$ anns))) - (with-brackets (spaced (list@map type-param$ method-tvars))) - (with-brackets (spaced (list@map generic-type$ method-exs))) - (with-brackets (spaced (list@map generic-type$ method-inputs))) + (with-brackets (spaced (list\map annotation$ anns))) + (with-brackets (spaced (list\map type-param$ method-tvars))) + (with-brackets (spaced (list\map generic-type$ method-exs))) + (with-brackets (spaced (list\map generic-type$ method-inputs))) (generic-type$ method-output)) )))) @@ -1028,7 +1028,7 @@ (#ConstantField class value) (with-parens (spaced (list "constant" name - (with-brackets (spaced (list@map annotation$ anns))) + (with-brackets (spaced (list\map annotation$ anns))) (generic-type$ class) (code.format value)) )) @@ -1038,7 +1038,7 @@ (spaced (list "variable" name (privacy-modifier$ pm) (state-modifier$ sm) - (with-brackets (spaced (list@map annotation$ anns))) + (with-brackets (spaced (list\map annotation$ anns))) (generic-type$ class)) )) )) @@ -1060,12 +1060,12 @@ (with-parens (spaced (list "init" (privacy-modifier$ pm) - (bit@encode strict-fp?) - (with-brackets (spaced (list@map annotation$ anns))) - (with-brackets (spaced (list@map type-param$ type-vars))) - (with-brackets (spaced (list@map generic-type$ exs))) - (with-brackets (spaced (list@map arg-decl$ arg-decls))) - (with-brackets (spaced (list@map constructor-arg$ constructor-args))) + (bit\encode strict-fp?) + (with-brackets (spaced (list\map annotation$ anns))) + (with-brackets (spaced (list\map type-param$ type-vars))) + (with-brackets (spaced (list\map generic-type$ exs))) + (with-brackets (spaced (list\map arg-decl$ arg-decls))) + (with-brackets (spaced (list\map constructor-arg$ constructor-args))) (code.format (pre-walk-replace replacer body)) ))) @@ -1074,12 +1074,12 @@ (spaced (list "virtual" name (privacy-modifier$ pm) - (bit@encode final?) - (bit@encode strict-fp?) - (with-brackets (spaced (list@map annotation$ anns))) - (with-brackets (spaced (list@map type-param$ type-vars))) - (with-brackets (spaced (list@map generic-type$ exs))) - (with-brackets (spaced (list@map arg-decl$ arg-decls))) + (bit\encode final?) + (bit\encode strict-fp?) + (with-brackets (spaced (list\map annotation$ anns))) + (with-brackets (spaced (list\map type-param$ type-vars))) + (with-brackets (spaced (list\map generic-type$ exs))) + (with-brackets (spaced (list\map arg-decl$ arg-decls))) (generic-type$ return-type) (code.format (pre-walk-replace replacer (` (let [(~ (code.local-identifier this-name)) (~' _jvm_this)] (~ body)))))))) @@ -1088,7 +1088,7 @@ (let [super-replacer (parser->replacer (s.form (do p.monad [_ (s.this! (' ::super!)) args (s.tuple (p.exactly (list.size arg-decls) s.any)) - #let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ (list))) + #let [arg-decls' (: (List Text) (list\map (|>> product.right (simple-class$ (list))) arg-decls))]] (wrap (`' ((~ (code.text (format "jvm invokespecial" ":" (get@ #super-class-name super-class) @@ -1099,11 +1099,11 @@ (spaced (list "override" (class-decl$ class-decl) name - (bit@encode strict-fp?) - (with-brackets (spaced (list@map annotation$ anns))) - (with-brackets (spaced (list@map type-param$ type-vars))) - (with-brackets (spaced (list@map generic-type$ exs))) - (with-brackets (spaced (list@map arg-decl$ arg-decls))) + (bit\encode strict-fp?) + (with-brackets (spaced (list\map annotation$ anns))) + (with-brackets (spaced (list\map type-param$ type-vars))) + (with-brackets (spaced (list\map generic-type$ exs))) + (with-brackets (spaced (list\map arg-decl$ arg-decls))) (generic-type$ return-type) (|> (` (let [(~ (code.local-identifier this-name)) (~' _jvm_this)] (~ body))) @@ -1117,11 +1117,11 @@ (spaced (list "static" name (privacy-modifier$ pm) - (bit@encode strict-fp?) - (with-brackets (spaced (list@map annotation$ anns))) - (with-brackets (spaced (list@map type-param$ type-vars))) - (with-brackets (spaced (list@map generic-type$ exs))) - (with-brackets (spaced (list@map arg-decl$ arg-decls))) + (bit\encode strict-fp?) + (with-brackets (spaced (list\map annotation$ anns))) + (with-brackets (spaced (list\map type-param$ type-vars))) + (with-brackets (spaced (list\map generic-type$ exs))) + (with-brackets (spaced (list\map arg-decl$ arg-decls))) (generic-type$ return-type) (code.format (pre-walk-replace replacer body))))) @@ -1130,10 +1130,10 @@ (spaced (list "abstract" name (privacy-modifier$ pm) - (with-brackets (spaced (list@map annotation$ anns))) - (with-brackets (spaced (list@map type-param$ type-vars))) - (with-brackets (spaced (list@map generic-type$ exs))) - (with-brackets (spaced (list@map arg-decl$ arg-decls))) + (with-brackets (spaced (list\map annotation$ anns))) + (with-brackets (spaced (list\map type-param$ type-vars))) + (with-brackets (spaced (list\map generic-type$ exs))) + (with-brackets (spaced (list\map arg-decl$ arg-decls))) (generic-type$ return-type)))) (#NativeMethod type-vars arg-decls return-type exs) @@ -1141,10 +1141,10 @@ (spaced (list "native" name (privacy-modifier$ pm) - (with-brackets (spaced (list@map annotation$ anns))) - (with-brackets (spaced (list@map type-param$ type-vars))) - (with-brackets (spaced (list@map generic-type$ exs))) - (with-brackets (spaced (list@map arg-decl$ arg-decls))) + (with-brackets (spaced (list\map annotation$ anns))) + (with-brackets (spaced (list\map type-param$ type-vars))) + (with-brackets (spaced (list\map generic-type$ exs))) + (with-brackets (spaced (list\map arg-decl$ arg-decls))) (generic-type$ return-type)))) )) @@ -1203,19 +1203,19 @@ (do meta.monad [current-module meta.current-module-name #let [fully-qualified-class-name (format (sanitize current-module) "." full-class-name) - field-parsers (list@map (field->parser fully-qualified-class-name) fields) - method-parsers (list@map (method->parser (product.right class-decl) fully-qualified-class-name) methods) - replacer (parser->replacer (list@fold p.either + field-parsers (list\map (field->parser fully-qualified-class-name) fields) + method-parsers (list\map (method->parser (product.right class-decl) fully-qualified-class-name) methods) + replacer (parser->replacer (list\fold p.either (p.fail "") - (list@compose field-parsers method-parsers))) + (list\compose field-parsers method-parsers))) def-code (format "jvm class:" (spaced (list (class-decl$ class-decl) (super-class-decl$ super) - (with-brackets (spaced (list@map super-class-decl$ interfaces))) + (with-brackets (spaced (list\map super-class-decl$ interfaces))) (inheritance-modifier$ im) - (with-brackets (spaced (list@map annotation$ annotations))) - (with-brackets (spaced (list@map field-decl$ fields))) - (with-brackets (spaced (list@map (method-def$ replacer super) methods))))))]] + (with-brackets (spaced (list\map annotation$ annotations))) + (with-brackets (spaced (list\map field-decl$ fields))) + (with-brackets (spaced (list\map (method-def$ replacer super) methods))))))]] (wrap (list (` ((~ (code.text def-code)))))))) (syntax: #export (interface: @@ -1230,9 +1230,9 @@ ([] foo [boolean String] void #throws [Exception])))} (let [def-code (format "jvm interface:" (spaced (list (class-decl$ class-decl) - (with-brackets (spaced (list@map super-class-decl$ supers))) - (with-brackets (spaced (list@map annotation$ annotations))) - (spaced (list@map method-decl$ members)))))] + (with-brackets (spaced (list\map super-class-decl$ supers))) + (with-brackets (spaced (list\map annotation$ annotations))) + (spaced (list\map method-decl$ members)))))] (wrap (list (` ((~ (code.text def-code)))))) )) @@ -1257,9 +1257,9 @@ )} (let [def-code (format "jvm anon-class:" (spaced (list (super-class-decl$ super) - (with-brackets (spaced (list@map super-class-decl$ interfaces))) - (with-brackets (spaced (list@map constructor-arg$ constructor-args))) - (with-brackets (spaced (list@map (method-def$ function.identity super) methods))))))] + (with-brackets (spaced (list\map super-class-decl$ interfaces))) + (with-brackets (spaced (list\map constructor-arg$ constructor-args))) + (with-brackets (spaced (list\map (method-def$ function.identity super) methods))))))] (wrap (list (` ((~ (code.text def-code)))))))) (syntax: #export (null) @@ -1354,12 +1354,12 @@ (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$ [full-name params]) (-> Class-Declaration Code) - (let [params' (list@map (|>> product.left code.local-identifier) params)] + (let [params' (list\map (|>> product.left code.local-identifier) params)] (` (def: (~ (code.identifier ["" full-name])) {#..jvm-class (~ (code.text full-name))} Type @@ -1371,7 +1371,7 @@ (-> (List Type-Parameter) Import-Member-Declaration (List Type-Parameter)) (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) @@ -1379,7 +1379,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)) @@ -1397,9 +1397,9 @@ (wrap [maybe? arg-name])))) import-member-args) #let [arg-classes (: (List Text) - (list@map (|>> product.right (simple-class$ (list@compose type-params import-member-tvars))) + (list\map (|>> product.right (simple-class$ (list\compose type-params import-member-tvars))) import-member-args)) - arg-types (list@map (: (-> [Bit GenericType] Code) + arg-types (list\map (: (-> [Bit GenericType] Code) (function (_ [maybe? arg]) (let [arg-type (class->type (get@ #import-member-mode commons) type-params arg)] (if maybe? @@ -1479,12 +1479,12 @@ (def: (jvm-extension-inputs mode classes inputs) (-> Primitive-Mode (List Text) (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 type-params kind class [arg-function-inputs arg-classes arg-types] member method-prefix) (-> (List Type-Parameter) Class-Kind Class-Declaration [(List [Bit Code]) (List Text) (List Code)] Import-Member-Declaration Text (Meta (List Code))) @@ -1492,7 +1492,7 @@ full-name (sanitize full-name) all-params (|> (member-type-vars class-tvars member) (list.filter free-type-param?) - (list@map type-param->type-arg))] + (list\map type-param->type-arg))] (case member (#EnumDecl enum-members) (do {! meta.monad} @@ -1504,7 +1504,7 @@ _ (let [=class-tvars (|> class-tvars (list.filter free-type-param?) - (list@map type-param->type-arg))] + (list\map type-param->type-arg))] (` (All [(~+ =class-tvars)] (primitive (~ (code.text full-name)) [(~+ =class-tvars)])))))) getter-interop (: (-> Text Code) (function (_ name) @@ -1512,7 +1512,7 @@ (` (def: (~ getter-name) (~ enum-type) ((~ (code.text (format "jvm getstatic" ":" full-name ":" name)))))))))]] - (wrap (list@map getter-interop enum-members))) + (wrap (list\map getter-interop enum-members))) (#ConstructorDecl [commons _]) (do meta.monad @@ -1523,7 +1523,7 @@ (decorate-return-maybe member) (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]) @@ -1550,13 +1550,13 @@ ))) jvm-extension (code.text (format "jvm " jvm-op ":" full-name ":" import-method-name ":" (text.join-with "," arg-classes))) jvm-interop (|> [(simple-class$ (list) (get@ #import-method-return method)) - (` ((~ jvm-extension) (~+ (list@map un-quote object-ast)) + (` ((~ jvm-extension) (~+ (list\map un-quote object-ast)) (~+ (jvm-extension-inputs (get@ #import-member-mode commons) arg-classes arg-function-inputs))))] (auto-convert-output (get@ #import-member-mode commons)) (decorate-return-maybe member) (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) @@ -1570,7 +1570,7 @@ tvar-asts (: (List Code) (|> class-tvars (list.filter free-type-param?) - (list@map type-param->type-arg))) + (list\map type-param->type-arg))) getter-name (code.identifier ["" (format method-prefix member-separator import-field-name)]) setter-name (code.identifier ["" (format method-prefix member-separator import-field-name "!")])] getter-interop (with-gensyms [g!obj] @@ -1693,7 +1693,7 @@ (do {! meta.monad} [kind (class-kind class-decl) =members (monad.map ! (member-import$ (product.right class-decl) kind class-decl) members)] - (wrap (list& (class-import$ class-decl) (list@join =members))))) + (wrap (list& (class-import$ class-decl) (list\join =members))))) (syntax: #export (array {type (..generic-type^ (list))} size) @@ -1722,7 +1722,7 @@ (def: (type->class-name type) (-> Type (Meta Text)) - (if (type@= Any type) + (if (type\= Any type) (:: meta.monad wrap "java.lang.Object") (case type (#.Primitive name params) diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux index 07cd29140..34d8005e1 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux @@ -11,16 +11,16 @@ [data ["." product] ["." maybe] - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] [number ["n" nat] ["i" int] ["r" rev] ["f" frac]] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ Format format)]] [collection - ["." list ("#@." functor fold)]]] + ["." list ("#\." functor fold)]]] [meta ["." location]]] [// @@ -116,17 +116,17 @@ (^template [<tag> <=>] [[(<tag> reference) (<tag> sample)] (<=> reference sample)]) - ([#Bit bit@=] + ([#Bit bit\=] [#Nat n.=] [#Int i.=] [#Rev r.=] [#Frac f.=] - [#Text text@=]) + [#Text text\=]) _ false))) -(structure: #export (composite-equivalence (^open "/@.")) +(structure: #export (composite-equivalence (^open "/\.")) (All [a] (-> (Equivalence a) (Equivalence (Composite a)))) (def: (= reference sample) @@ -134,11 +134,11 @@ [(#Variant [reference-lefts reference-right? reference-value]) (#Variant [sample-lefts sample-right? sample-value])] (and (n.= reference-lefts sample-lefts) - (bit@= reference-right? sample-right?) - (/@= reference-value sample-value)) + (bit\= reference-right? sample-right?) + (/\= reference-value sample-value)) [(#Tuple reference) (#Tuple sample)] - (:: (list.equivalence /@=) = reference sample) + (:: (list.equivalence /\=) = reference sample) _ false))) @@ -260,7 +260,7 @@ (def: #export (apply [abstraction inputs]) (-> (Application Analysis) Analysis) - (list@fold (function (_ input abstraction') + (list\fold (function (_ input abstraction') (#Apply input abstraction')) abstraction inputs)) @@ -352,7 +352,7 @@ (#Tuple members) (|> members - (list@map %analysis) + (list\map %analysis) (text.join-with " ") (text.enclose ["[" "]"]))) @@ -366,7 +366,7 @@ (|> (%analysis body) (format " ") (format (|> environment - (list@map %analysis) + (list\map %analysis) (text.join-with " ") (text.enclose ["[" "]"]))) (text.enclose ["(" ")"])) @@ -375,13 +375,13 @@ (|> analysis ..application #.Cons - (list@map %analysis) + (list\map %analysis) (text.join-with " ") (text.enclose ["(" ")"])) (#Extension name parameters) (|> parameters - (list@map %analysis) + (list\map %analysis) (text.join-with " ") (format (%.text name) " ") (text.enclose ["(" ")"])))) @@ -445,7 +445,7 @@ (def: #export (with-location location action) (All [a] (-> Location (Operation a) (Operation a))) - (if (text@= "" (product.left location)) + (if (text\= "" (product.left location)) action (function (_ [bundle state]) (let [old-location (get@ #.location state)] diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis/macro.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis/macro.lux index b81f8f227..e9c260789 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/analysis/macro.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/analysis/macro.lux @@ -7,10 +7,7 @@ ["." exception (#+ exception:)]] [data ["." text - ["%" format (#+ format)]] - [collection - [array (#+ Array)] - ["." list ("#@." functor)]]] + ["%" format (#+ format)]]] ["." meta]] [///// ["." phase]]) diff --git a/stdlib/source/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/lux/tool/compiler/language/lux/generation.lux index 64e66be2d..0b4ab70b2 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/generation.lux @@ -10,13 +10,13 @@ [binary (#+ Binary)] ["." product] ["." name] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [number ["n" nat]] [collection ["." row (#+ Row)] - ["." list ("#@." functor)]]]] + ["." list ("#\." functor)]]]] [// [synthesis (#+ Synthesis)] [phase @@ -223,7 +223,7 @@ [?buffer (extension.read (get@ #buffer))] (case ?buffer (#.Some buffer) - (if (row.any? (|>> product.left (text@= name)) buffer) + (if (row.any? (|>> product.left (text\= name)) buffer) (phase.throw ..cannot-overwrite-output [name]) (extension.update (set@ #buffer (#.Some (row.add [name code] buffer))))) @@ -260,7 +260,7 @@ (let [[_module _name] name] (do try.monad [module-id (archive.id _module archive) - registry (if (text@= (get@ #module state) _module) + registry (if (text\= (get@ #module state) _module) (#try.Success (get@ #registry state)) (do try.monad [[descriptor document] (archive.find _module archive)] 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 b04c02674..8c1ba3644 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 @@ -42,9 +42,15 @@ [cannot-declare-tags-for-foreign-type] ) -(exception: #export (cannot-define-more-than-once {name Name}) +(exception: #export (cannot-define-more-than-once {name Name} {already-existing Global}) (exception.report - ["Definition" (%.name name)])) + ["Definition" (%.name name)] + ["Original" (case already-existing + (#.Alias alias) + (format "alias " (%.name alias)) + + (#.Definition definition) + (format "definition " (%.name name)))])) (exception: #export (can-only-change-state-of-active-module {module Text} {state Module-State}) (exception.report @@ -144,7 +150,7 @@ []]) (#.Some already-existing) - ((/.throw' ..cannot-define-more-than-once [self-name name]) state)))))) + ((/.throw' ..cannot-define-more-than-once [[self-name name] already-existing]) state)))))) (def: #export (create hash name) (-> Nat Text (Operation Any)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux index 855d1cf9f..2bde38a7d 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux @@ -8,7 +8,7 @@ [text ["%" format (#+ format)]] [collection - ["." list ("#@." fold monoid)]]] + ["." list ("#\." fold monoid)]]] ["." meta]] ["." // #_ ["#." extension] @@ -66,12 +66,12 @@ (case expansion (^ (list& <lux_def_module> referrals)) (|> (recur archive <lux_def_module>) - (:: ! map (update@ #/.referrals (list@compose referrals)))) + (:: ! map (update@ #/.referrals (list\compose referrals)))) _ (|> expansion (monad.map ! (recur archive)) - (:: ! map (list@fold /.merge-requirements /.no-requirements))))) + (:: ! map (list\fold /.merge-requirements /.no-requirements))))) _ (//.throw ..not-a-directive code)))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux index e9ecc6435..8477134a0 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux @@ -10,7 +10,7 @@ [runtime (#+ Phase Phase!)] ["#." primitive] ["#." structure] - ["#." reference ("#@." system)] + ["#." reference ("#\." system)] ["#." case] ["#." loop] ["#." function] @@ -22,7 +22,7 @@ [analysis (#+)] ["." synthesis] ["//#" /// #_ - ["#." phase ("#@." monad)]]]]]]) + ["#." phase ("#\." monad)]]]]]]) (exception: #export cannot-recur-as-an-expression) @@ -31,7 +31,7 @@ (case synthesis (^template [<tag>] [(^ (<tag> value)) - (//////phase@map _.return (expression archive synthesis))]) + (//////phase\map _.return (expression archive synthesis))]) ([synthesis.bit] [synthesis.i64] [synthesis.f64] @@ -59,7 +59,7 @@ (/loop.recur! statement expression archive updates) (^ (synthesis.function/abstraction abstraction)) - (//////phase@map _.return (/function.function statement expression archive abstraction)) + (//////phase\map _.return (/function.function statement expression archive abstraction)) )) (def: (expression archive synthesis) @@ -67,7 +67,7 @@ (case synthesis (^template [<tag> <generator>] [(^ (<tag> value)) - (//////phase@wrap (<generator> value))]) + (//////phase\wrap (<generator> value))]) ([synthesis.bit /primitive.bit] [synthesis.i64 /primitive.i64] [synthesis.f64 /primitive.f64] diff --git a/stdlib/source/lux/tool/compiler/language/lux/program.lux b/stdlib/source/lux/tool/compiler/language/lux/program.lux index 85cb03670..fc384c178 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/program.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/program.lux @@ -11,7 +11,7 @@ [text ["%" format (#+ format)]] [collection - ["." list ("#@." functor)]]]] + ["." list ("#\." functor)]]]] [// [generation (#+ Context)] [/// @@ -52,5 +52,5 @@ #.None (|> registries - (list@map (|>> product.left product.left)) + (list\map (|>> product.left product.left)) (exception.throw ..cannot-find-program))))) diff --git a/stdlib/source/lux/tool/compiler/meta/archive.lux b/stdlib/source/lux/tool/compiler/meta/archive.lux index 7ac12f55e..eaabf6aee 100644 --- a/stdlib/source/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/lux/tool/compiler/meta/archive.lux @@ -18,9 +18,9 @@ [format ["." binary (#+ Writer)]] [number - ["n" nat ("#@." equivalence)]] + ["n" nat ("#\." equivalence)]] [collection - ["." list ("#@." functor fold)] + ["." list ("#\." functor fold)] ["." dictionary (#+ Dictionary)] ["." set]]] [type @@ -178,7 +178,7 @@ (|>> :representation (get@ #resolver) dictionary.entries - (list@map (function (_ [module [id _]]) + (list\map (function (_ [module [id _]]) [module id])))) (def: #export (merge additions archive) @@ -188,7 +188,7 @@ :representation (update@ #next (n.max +next)) (update@ #resolver (function (_ resolver) - (list@fold (function (_ [module [id entry]] resolver) + (list\fold (function (_ [module [id entry]] resolver) (case entry (#.Some _) (dictionary.put module [id entry] resolver) @@ -239,7 +239,7 @@ (-> (List Reservation) Bit) (n.= (list.size reservations) (|> reservations - (list@map product.left) + (list\map product.left) (set.from-list text.hash) set.size))) @@ -247,7 +247,7 @@ (-> (List Reservation) Bit) (n.= (list.size reservations) (|> reservations - (list@map product.right) + (list\map product.right) (set.from-list n.hash) set.size))) @@ -261,12 +261,12 @@ (do try.monad [[actual next reservations] (<b>.run ..reader binary) _ (exception.assert ..version-mismatch [expected actual] - (n@= expected actual)) + (n\= expected actual)) _ (exception.assert ..corrupt-data [] (correct-reservations? reservations))] (wrap (:abstraction {#next next - #resolver (list@fold (function (_ [module id] archive) + #resolver (list\fold (function (_ [module id] archive) (dictionary.put module [id #.None] archive)) (get@ #resolver (:representation ..empty)) reservations)})))) diff --git a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux index 1af87d6fc..dec8938b3 100644 --- a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux +++ b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux @@ -13,7 +13,7 @@ ["%" format (#+ format)]] [collection ["." list] - ["." row (#+ Row) ("#@." functor fold)] + ["." row (#+ Row) ("#\." functor fold)] ["." dictionary (#+ Dictionary)]] [format ["." binary (#+ Writer)]]] @@ -114,7 +114,7 @@ (binary.row/64 category))] (|>> :representation (get@ #artifacts) - (row@map (get@ #category)) + (row\map (get@ #category)) artifacts))) (exception: #export (invalid-category {tag Nat}) @@ -135,7 +135,7 @@ 5 (:: ! map (|>> #Directive) <b>.text) _ (<>.fail (exception.construct ..invalid-category [tag])))))] (|> (<b>.row/64 category) - (:: <>.monad map (row@fold (function (_ artifact registry) + (:: <>.monad map (row\fold (function (_ artifact registry) (product.right (case artifact #Anonymous diff --git a/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux b/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux index 0105d0ccd..55bde3869 100644 --- a/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux +++ b/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux @@ -8,11 +8,11 @@ ["." function ["." memo (#+ Memo)]]] [data - ["." maybe ("#@." functor)] + ["." maybe ("#\." functor)] ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." functor fold)] + ["." list ("#\." functor fold)] ["." dictionary (#+ Dictionary)] ["." set (#+ Set)]]]] [/// @@ -45,7 +45,7 @@ (def: #export graph (-> (List Dependency) Graph) - (list@fold (function (_ [module imports] graph) + (list\fold (function (_ [module imports] graph) (dictionary.put module imports graph)) ..empty)) @@ -61,9 +61,9 @@ (#try.Failure error) ..fresh)] ancestors (monad.map ! recur (set.to-list parents))] - (wrap (list@fold set.union parents ancestors))))) + (wrap (list\fold set.union parents ancestors))))) ancestry (memo.open memo)] - (list@fold (function (_ module memory) + (list\fold (function (_ module memory) (if (dictionary.contains? module memory) memory (let [[memory _] (ancestry [memory module])] diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux index 1533816fc..63639f444 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux @@ -8,7 +8,7 @@ ["." try (#+ Try)] ["." exception (#+ exception:)] [concurrency - ["." promise (#+ Promise) ("#@." monad)]] + ["." promise (#+ Promise) ("#\." monad)]] [security ["!" capability (#+ capability:)]] ["<>" parser @@ -16,10 +16,10 @@ [data [binary (#+ Binary)] ["." product] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection - ["." list ("#@." functor fold)] + ["." list ("#\." functor fold)] ["." dictionary (#+ Dictionary)] ["." row (#+ Row)] ["." set]] @@ -191,10 +191,10 @@ [module-dir (!.use (:: system directory) (..module system static module-id)) cached-files (!.use (:: module-dir files) [])] (|> cached-files - (list@map (function (_ file) + (list\map (function (_ file) [(!.use (:: file name) []) (!.use (:: file path) [])])) - (list.filter (|>> product.left (text@= ..module-descriptor-file) not)) + (list.filter (|>> product.left (text\= ..module-descriptor-file) not)) (monad.map ! (function (_ [name path]) (do ! [file (: (Promise (Try (File Promise))) @@ -251,7 +251,7 @@ directives]])) (#artifact.Definition name) - (if (text@= $/program.name name) + (if (text\= $/program.name name) (wrap [definitions [analysers synthesizers @@ -331,7 +331,7 @@ (do (try.with promise.monad) [actual (cached-artifacts system static module-id) #let [expected (|> descriptor (get@ #descriptor.registry) artifact.artifacts)] - [document bundles] (promise@wrap (loaded-document (get@ #static.artifact-extension static) host-environment module-id expected actual document))] + [document bundles] (promise\wrap (loaded-document (get@ #static.artifact-extension static) host-environment module-id expected actual document))] (wrap [[descriptor document] bundles]))) (def: (purge! system static [module-name module-id]) @@ -346,9 +346,9 @@ (def: (valid-cache? expected actual) (-> Descriptor Input Bit) - (and (text@= (get@ #descriptor.name expected) + (and (text\= (get@ #descriptor.name expected) (get@ #////.module actual)) - (text@= (get@ #descriptor.file expected) + (text\= (get@ #descriptor.file expected) (get@ #////.file actual)) (n.= (get@ #descriptor.hash expected) (get@ #////.hash actual)))) @@ -369,7 +369,7 @@ (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module)]]]]) dependency.Order Purge) - (list@fold (function (_ [module-name [module-id [descriptor document]]] purge) + (list\fold (function (_ [module-name [module-id [descriptor document]]] purge) (let [purged? (: (Predicate Module) (function (_ module) (dictionary.contains? module purge)))] @@ -394,8 +394,8 @@ (monad.map ! (function (_ [module-name module-id]) (do ! [data (..read-module-descriptor system static module-id) - [descriptor document] (promise@wrap (<b>.run ..parser data))] - (if (text@= archive.runtime-module module-name) + [descriptor document] (promise\wrap (<b>.run ..parser data))] + (if (text\= archive.runtime-module module-name) (wrap [true [module-name [module-id [descriptor document]]]]) (do ! @@ -403,14 +403,14 @@ (wrap [(..valid-cache? descriptor input) [module-name [module-id [descriptor document]]]]))))))) load-order (|> pre-loaded-caches - (list@map product.right) + (list\map product.right) (monad.fold try.monad (function (_ [module [module-id descriptor,document]] archive) (archive.add module descriptor,document archive)) archive) (:: try.monad map (dependency.load-order $.key)) (:: try.monad join) - promise@wrap) + promise\wrap) #let [purge (..full-purge pre-loaded-caches load-order)] _ (|> purge dictionary.entries @@ -423,7 +423,7 @@ [[descriptor,document bundles] (..load-definitions system static module-id host-environment descriptor,document)] (wrap [[module-name descriptor,document] bundles])))))] - (promise@wrap + (promise\wrap (do {! try.monad} [archive (monad.fold ! (function (_ [[module descriptor,document] _bundle] archive) @@ -433,7 +433,7 @@ analysis-state (..analysis-state (get@ #static.host static) archive)] (wrap [archive analysis-state - (list@fold (function (_ [_ [+analysers +synthesizers +generators +directives]] + (list\fold (function (_ [_ [+analysers +synthesizers +generators +directives]] [analysers synthesizers generators directives]) [(dictionary.merge +analysers analysers) (dictionary.merge +synthesizers synthesizers) @@ -452,7 +452,7 @@ (#try.Success file) (do (try.with promise.monad) [binary (!.use (:: file content) []) - archive (promise@wrap (archive.import ///.version binary))] + archive (promise\wrap (archive.import ///.version binary))] (..load-every-reserved-module host-environment system static import contexts archive)) (#try.Failure error) diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux index c524f605f..572905325 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux @@ -10,10 +10,10 @@ [security ["!" capability]] [concurrency - ["." promise (#+ Promise) ("#@." monad)]]] + ["." promise (#+ Promise) ("#\." monad)]]] [data [binary (#+ Binary)] - ["." text ("#@." hash) + ["." text ("#\." hash) ["%" format (#+ format)] ["." encoding]] [collection @@ -56,7 +56,7 @@ (Promise (Try [Path (File Promise)]))) (case contexts #.Nil - (promise@wrap (exception.throw ..cannot-find-module [module])) + (promise\wrap (exception.throw ..cannot-find-module [module])) (#.Cons context contexts') (do promise.monad @@ -131,11 +131,11 @@ (#try.Success code) (wrap {#////.module module #////.file path - #////.hash (text@hash code) + #////.hash (text\hash code) #////.code code}) (#try.Failure _) - (promise@wrap (exception.throw ..cannot-read-module [module]))))) + (promise\wrap (exception.throw ..cannot-read-module [module]))))) (type: #export Enumeration (Dictionary Path Binary)) @@ -167,9 +167,9 @@ (let [path (!.use (:: file path) [])] (if (text.ends-with? ..lux-extension path) (do ! - [path (promise@wrap (..clean-path system context path)) + [path (promise\wrap (..clean-path system context path)) source-code (!.use (:: file content) [])] - (promise@wrap + (promise\wrap (dictionary.try-put path source-code enumeration))) (wrap enumeration)))) enumeration diff --git a/stdlib/source/lux/tool/compiler/meta/packager.lux b/stdlib/source/lux/tool/compiler/meta/packager.lux index 732ae18c0..f2737e168 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager.lux @@ -8,7 +8,7 @@ [binary (#+ Binary)] [collection ["." row] - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [world ["." file (#+ Path)]]] [program @@ -33,10 +33,10 @@ (def: #export order (-> dependency.Order Order) - (list@map (function (_ [module [module-id [descriptor document]]]) + (list\map (function (_ [module [module-id [descriptor document]]]) (|> descriptor (get@ #descriptor.registry) artifact.artifacts row.to-list - (list@map (|>> (get@ #artifact.id))) + (list\map (|>> (get@ #artifact.id))) [module-id])))) diff --git a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux index c807e5279..f5838cf80 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux @@ -18,7 +18,7 @@ ["n" nat]] [collection ["." row (#+ Row)] - ["." list ("#@." functor fold)]]] + ["." list ("#\." functor)]]] [target [jvm [encoding @@ -147,7 +147,7 @@ (get@ #descriptor.registry) artifact.artifacts row.to-list - (list@map (|>> (get@ #artifact.id))) + (list\map (|>> (get@ #artifact.id))) [module-id]))))) (:: monad wrap)) #let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi-byte)) diff --git a/stdlib/source/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/lux/tool/compiler/meta/packager/script.lux index a80c28af1..b40873ace 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/script.lux @@ -14,7 +14,7 @@ ["." encoding]] [collection ["." row] - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [world ["." file (#+ File Directory)]]] [program @@ -76,12 +76,12 @@ [cache (!.use (:: file-system directory) [(get@ #static.target static)]) order (:: monad wrap (dependency.load-order $.key archive))] (|> order - (list@map (function (_ [module [module-id [descriptor document]]]) + (list\map (function (_ [module [module-id [descriptor document]]]) [module-id (|> descriptor (get@ #descriptor.registry) artifact.artifacts row.to-list - (list@map (|>> (get@ #artifact.id))))])) + (list\map (|>> (get@ #artifact.id))))])) (monad.fold ! (..write-module monad file-system static sequence) header) (:: ! map (|>> to-code encoding.to-utf8)))))) diff --git a/stdlib/source/lux/tool/compiler/phase.lux b/stdlib/source/lux/tool/compiler/phase.lux index 68d6a4848..312428ff7 100644 --- a/stdlib/source/lux/tool/compiler/phase.lux +++ b/stdlib/source/lux/tool/compiler/phase.lux @@ -4,7 +4,7 @@ [monad (#+ Monad do)]] [control ["." state] - ["." try (#+ Try) ("#@." functor)] + ["." try (#+ Try) ("#\." functor)] ["ex" exception (#+ Exception exception:)] ["." io] [parser @@ -77,7 +77,7 @@ (def: #export (lift error) (All [s a] (-> (Try a) (Operation s a))) (function (_ state) - (try@map (|>> [state]) error))) + (try\map (|>> [state]) error))) (syntax: #export (assert exception message test) (wrap (list (` (if (~ test) diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index 01b4bf05a..1d390b8b6 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -10,13 +10,13 @@ ["<c>" code (#+ Parser)]]] [data ["." maybe] - ["." text ("#@." monoid equivalence)] - ["." name ("#@." equivalence codec)] + ["." text ("#\." monoid equivalence)] + ["." name ("#\." equivalence codec)] [number - ["n" nat ("#@." decimal)]] + ["n" nat ("#\." decimal)]] [collection ["." array] - ["." list ("#@." functor monoid fold)]]] + ["." list ("#\." functor monoid fold)]]] [macro [syntax (#+ syntax:)] ["." code]] @@ -54,7 +54,7 @@ (case type (#.Apply arg func') (let [[func args] (flatten-application func')] - [func (list@compose args (list arg))]) + [func (list\compose args (list arg))]) _ [type (list)])) @@ -77,64 +77,64 @@ (-> Type Text) (case type (#.Primitive name params) - ($_ text@compose + ($_ text\compose "(primitive " (text.enclose' text.double-quote name) (|> params - (list@map (|>> format (text@compose " "))) - (list@fold (function.flip text@compose) "")) + (list\map (|>> format (text\compose " "))) + (list\fold (function.flip text\compose) "")) ")") (^template [<tag> <open> <close> <flatten>] [(<tag> _) - ($_ text@compose <open> + ($_ text\compose <open> (|> (<flatten> type) - (list@map format) + (list\map format) list.reverse (list.interpose " ") - (list@fold text@compose "")) + (list\fold text\compose "")) <close>)]) ([#.Sum "(| " ")" flatten-variant] [#.Product "[" "]" flatten-tuple]) (#.Function input output) (let [[ins out] (flatten-function type)] - ($_ text@compose "(-> " + ($_ text\compose "(-> " (|> ins - (list@map format) + (list\map format) list.reverse (list.interpose " ") - (list@fold text@compose "")) + (list\fold text\compose "")) " " (format out) ")")) (#.Parameter idx) - (n@encode idx) + (n\encode idx) (#.Var id) - ($_ text@compose "⌈v:" (n@encode id) "⌋") + ($_ text\compose "⌈v:" (n\encode id) "⌋") (#.Ex id) - ($_ text@compose "⟨e:" (n@encode id) "⟩") + ($_ text\compose "⟨e:" (n\encode id) "⟩") (#.Apply param fun) (let [[type-func type-args] (flatten-application type)] - ($_ text@compose "(" (format type-func) " " (|> type-args (list@map format) list.reverse (list.interpose " ") (list@fold text@compose "")) ")")) + ($_ text\compose "(" (format type-func) " " (|> type-args (list\map format) list.reverse (list.interpose " ") (list\fold text\compose "")) ")")) (^template [<tag> <desc>] [(<tag> env body) - ($_ text@compose "(" <desc> " {" (|> env (list@map format) (text.join-with " ")) "} " (format body) ")")]) + ($_ text\compose "(" <desc> " {" (|> env (list\map format) (text.join-with " ")) "} " (format body) ")")]) ([#.UnivQ "All"] [#.ExQ "Ex"]) (#.Named [module name] type) - ($_ text@compose module "." name) + ($_ text\compose module "." name) )) (def: (beta-reduce env type) (-> (List Type) Type Type) (case type (#.Primitive name params) - (#.Primitive name (list@map (beta-reduce env) params)) + (#.Primitive name (list\map (beta-reduce env) params)) (^template [<tag>] [(<tag> left right) @@ -149,21 +149,21 @@ (<tag> env def) _ - (<tag> (list@map (beta-reduce env) old-env) def))]) + (<tag> (list\map (beta-reduce env) old-env) def))]) ([#.UnivQ] [#.ExQ]) (#.Parameter idx) - (maybe.default (error! ($_ text@compose + (maybe.default (error! ($_ text\compose "Unknown type parameter" text.new-line - " Index: " (n@encode idx) text.new-line + " Index: " (n\encode idx) text.new-line "Environment: " (|> env list.enumeration - (list@map (.function (_ [index type]) - ($_ text@compose - (n@encode index) + (list\map (.function (_ [index type]) + ($_ text\compose + (n\encode index) " " (..format type)))) - (text.join-with (text@compose text.new-line " "))))) + (text.join-with (text\compose text.new-line " "))))) (list.nth idx env)) _ @@ -177,9 +177,9 @@ (or (is? x y) (case [x y] [(#.Primitive xname xparams) (#.Primitive yname yparams)] - (and (text@= xname yname) + (and (text\= xname yname) (n.= (list.size yparams) (list.size xparams)) - (list@fold (.function (_ [x y] prev) (and prev (= x y))) + (list\fold (.function (_ [x y] prev) (and prev (= x y))) #1 (list.zip/2 xparams yparams))) @@ -194,7 +194,7 @@ (= xright yright)) [(#.Named xname xtype) (#.Named yname ytype)] - (and (name@= xname yname) + (and (name\= xname yname) (= xtype ytype)) (^template [<tag>] @@ -206,7 +206,7 @@ [(#.ExQ xenv xbody) (#.ExQ yenv ybody)]) (and (n.= (list.size yenv) (list.size xenv)) (= xbody ybody) - (list@fold (.function (_ [x y] prev) (and prev (= x y))) + (list\fold (.function (_ [x y] prev) (and prev (= x y))) #1 (list.zip/2 xenv yenv))) @@ -243,7 +243,7 @@ (case type (#.Primitive name params) (` (#.Primitive (~ (code.text name)) - (.list (~+ (list@map to-code params))))) + (.list (~+ (list\map to-code params))))) (^template [<tag>] [(<tag> idx) @@ -261,7 +261,7 @@ (^template [<tag>] [(<tag> env body) - (` (<tag> (.list (~+ (list@map to-code env))) + (` (<tag> (.list (~+ (list\map to-code env))) (~ (to-code body))))]) ([#.UnivQ] [#.ExQ]) )) @@ -369,14 +369,14 @@ (do meta.monad [location meta.location valueT (meta.find-type valueN) - #let [_ (log! ($_ text@compose - (name@encode (name-of ..:log!)) " " (location.format location) text.new-line + #let [_ (log! ($_ text\compose + (name\encode (name-of ..:log!)) " " (location.format location) text.new-line "Expression: " (case valueC (#.Some valueC) (code.format valueC) #.None - (name@encode valueN)) + (name\encode valueN)) text.new-line " Type: " (..format valueT)))]] (wrap (list (code.identifier valueN)))) @@ -394,7 +394,7 @@ input output {value (<>.maybe <c>.any)}) - (let [casterC (` (: (All [(~+ (list@map code.local-identifier type-vars))] + (let [casterC (` (: (All [(~+ (list\map code.local-identifier type-vars))] (-> (~ input) (~ output))) (|>> :assume)))] (case value @@ -417,7 +417,7 @@ {exemplar typed} {computation typed}) (meta.with-gensyms [g!_] - (let [shareC (` (: (All [(~+ (list@map code.local-identifier type-vars))] + (let [shareC (` (: (All [(~+ (list\map code.local-identifier type-vars))] (-> (~ (get@ #type exemplar)) (~ (get@ #type computation)))) (.function ((~ g!_) (~ g!_)) @@ -428,7 +428,7 @@ {exemplar typed} {extraction <c>.any}) (wrap (list (` (:of ((~! :share) - [(~+ (list@map code.local-identifier type-vars))] + [(~+ (list\map code.local-identifier type-vars))] {(~ (get@ #type exemplar)) (~ (get@ #expression exemplar))} {(~ extraction) diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux index 46cbd641b..e89f33774 100644 --- a/stdlib/source/lux/type/abstract.lux +++ b/stdlib/source/lux/type/abstract.lux @@ -4,13 +4,13 @@ [monad (#+ Monad do)]] [control ["." exception (#+ exception:)] - ["<>" parser ("#@." monad) + ["<>" parser ("#\." monad) ["<c>" code (#+ Parser)]]] [data - ["." name ("#@." codec)] - ["." text ("#@." equivalence monoid)] + ["." name ("#\." codec)] + ["." text ("#\." equivalence monoid)] [collection - ["." list ("#@." functor monoid)]]] + ["." list ("#\." functor monoid)]]] ["." meta] [macro ["." code] @@ -48,7 +48,7 @@ (loop [entries <source>] (case entries (#.Cons [head-name head] tail) - (if (text@= <reference> head-name) + (if (text\= <reference> head-name) <then> (recur tail)) @@ -80,7 +80,7 @@ (case (case frame (#.Some frame) (list.find (function (_ [actual _]) - (text@= frame actual)) + (text\= frame actual)) current-frames) #.None @@ -103,7 +103,7 @@ (loop [entries <source>] (case entries (#.Cons [head-name head] tail) - (if (text@= <reference> head-name) + (if (text\= <reference> head-name) (#.Cons [head-name <then>] tail) (#.Cons [head-name head] @@ -172,7 +172,7 @@ (def: cast (Parser [(Maybe Text) Code]) (<>.either (<>.and (<>.maybe <c>.local-identifier) <c>.any) - (<>.and (<>@wrap #.None) <c>.any))) + (<>.and (<>\wrap #.None) <c>.any))) (template [<name> <from> <to>] [(syntax: #export (<name> {[frame value] ..cast}) @@ -187,15 +187,15 @@ (def: abstraction-type-name (-> Name Text) - (|>> name@encode - ($_ text@compose - (name@encode (name-of #..Abstraction)) + (|>> name\encode + ($_ text\compose + (name\encode (name-of #..Abstraction)) " "))) (def: representation-definition-name (-> Text Text) - (|>> ($_ text@compose - (name@encode (name-of #Representation)) + (|>> ($_ text\compose + (name\encode (name-of #Representation)) " "))) (def: declaration @@ -213,7 +213,7 @@ {primitives (<>.some <c>.any)}) (do meta.monad [current-module meta.current-module-name - #let [type-varsC (list@map code.local-identifier type-vars) + #let [type-varsC (list\map code.local-identifier type-vars) abstraction-declaration (` ((~ (code.local-identifier name)) (~+ type-varsC))) representation-declaration (` ((~ (code.local-identifier (representation-definition-name name))) (~+ type-varsC)))] @@ -227,7 +227,7 @@ [(~+ type-varsC)]))) (` (type: (~ representation-declaration) (~ representation-type))) - ($_ list@compose + ($_ list\compose primitives (list (` ((~! ..pop!))))))))) diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux index 2d4ea30c9..28c73b124 100644 --- a/stdlib/source/lux/type/check.lux +++ b/stdlib/source/lux/type/check.lux @@ -11,26 +11,26 @@ ["." maybe] ["." product] [number - ["n" nat ("#@." decimal)]] - ["." text ("#@." monoid equivalence)] + ["n" nat ("#\." decimal)]] + ["." text ("#\." monoid equivalence)] [collection ["." list] ["." set (#+ Set)]]]] - ["." // ("#@." equivalence)]) + ["." // ("#\." equivalence)]) (template: (!n/= reference subject) ("lux i64 =" reference subject)) -(template: (!text@= reference subject) +(template: (!text\= reference subject) ("lux text =" reference subject)) (exception: #export (unknown-type-var {id Nat}) (exception.report - ["ID" (n@encode id)])) + ["ID" (n\encode id)])) (exception: #export (unbound-type-var {id Nat}) (exception.report - ["ID" (n@encode id)])) + ["ID" (n\encode id)])) (exception: #export (invalid-type-application {funcT Type} {argT Type}) (exception.report @@ -39,7 +39,7 @@ (exception: #export (cannot-rebind-var {id Nat} {type Type} {bound Type}) (exception.report - ["Var" (n@encode id)] + ["Var" (n\encode id)] ["Wanted Type" (//.format type)] ["Current Type" (//.format bound)])) @@ -113,7 +113,7 @@ ))) ) -(open: "check@." ..monad) +(open: "check\." ..monad) (def: (var::new id plist) (-> Var Type-Vars Type-Vars) @@ -276,7 +276,7 @@ _ (case (//.apply (list argT) funcT) (#.Some output) - (check@wrap output) + (check\wrap output) _ (throw ..invalid-type-application [funcT argT])))) @@ -337,8 +337,8 @@ (def: (assumed? [e a] assumptions) (-> Assumption (List Assumption) Bit) (list.any? (function (_ [e' a']) - (and (//@= e e') - (//@= a a'))) + (and (//\= e e') + (//\= a a'))) assumptions)) (def: (assume! assumption assumptions) @@ -381,7 +381,7 @@ (def: (check-vars check' assumptions idE idA) (-> (Checker Type) (Checker Var)) (if (!n/= idE idA) - (check@wrap assumptions) + (check\wrap assumptions) (do {! ..monad} [ebound (attempt (peek idE)) abound (attempt (peek idA))] @@ -540,7 +540,7 @@ {#.doc "Type-check to ensure that the 'expected' type subsumes the 'actual' type."} (Checker Type) (if (is? expected actual) - (check@wrap assumptions) + (check\wrap assumptions) (with type-check-failed [expected actual] (case [expected actual] [(#.Var idE) (#.Var idA)] @@ -548,13 +548,13 @@ [(#.Var id) _] (if-bind id actual - (check@wrap assumptions) + (check\wrap assumptions) (function (_ bound) (check' assumptions bound actual))) [_ (#.Var id)] (if-bind id expected - (check@wrap assumptions) + (check\wrap assumptions) (function (_ bound) (check' assumptions expected bound))) @@ -569,7 +569,7 @@ [(#.Apply A F) _] (let [new-assumption [expected actual]] (if (assumed? new-assumption assumptions) - (check@wrap assumptions) + (check\wrap assumptions) (do ..monad [expected' (apply-type! F A)] (check' (assume! new-assumption assumptions) expected' actual)))) @@ -600,13 +600,13 @@ [#.ExQ ..existential]) [(#.Primitive e-name e-params) (#.Primitive a-name a-params)] - (if (!text@= e-name a-name) + (if (!text\= e-name a-name) (loop [assumptions assumptions e-params e-params a-params a-params] (case [e-params a-params] [#.Nil #.Nil] - (check@wrap assumptions) + (check\wrap assumptions) [(#.Cons e-head e-tail) (#.Cons a-head a-tail)] (do ..monad @@ -632,7 +632,7 @@ [(#.Ex e!id) (#.Ex a!id)] (if (!n/= e!id a!id) - (check@wrap assumptions) + (check\wrap assumptions) (fail "")) [(#.Named _ ?etype) _] @@ -670,17 +670,17 @@ (#.Primitive name paramsT+) (|> paramsT+ (monad.map ..monad clean) - (check@map (|>> (#.Primitive name)))) + (check\map (|>> (#.Primitive name)))) (^or (#.Parameter _) (#.Ex _) (#.Named _)) - (check@wrap inputT) + (check\wrap inputT) (^template [<tag>] [(<tag> leftT rightT) (do ..monad [leftT' (clean leftT)] (|> (clean rightT) - (check@map (|>> (<tag> leftT')))))]) + (check\map (|>> (<tag> leftT')))))]) ([#.Sum] [#.Product] [#.Function] [#.Apply]) (#.Var id) diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux index afd1f68c6..cf2068839 100644 --- a/stdlib/source/lux/type/implicit.lux +++ b/stdlib/source/lux/type/implicit.lux @@ -12,10 +12,10 @@ ["." maybe] ["." number ["n" nat]] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection - ["." list ("#@." monad fold)] + ["." list ("#\." monad fold)] ["dict" dictionary (#+ Dictionary)]]] ["." meta] [macro @@ -93,8 +93,8 @@ [this-module-name meta.current-module-name imp-mods (meta.imported-modules this-module-name) tag-lists (monad.map ! meta.tag-lists imp-mods) - #let [tag-lists (|> tag-lists list@join (list@map product.left) list@join) - candidates (list.filter (|>> product.right (text@= simple-name)) + #let [tag-lists (|> tag-lists list\join (list\map product.left) list\join) + candidates (list.filter (|>> product.right (text\= simple-name)) tag-lists)]] (case candidates #.Nil @@ -121,7 +121,7 @@ (do list.monad [[name [exported? def-type def-anns def-value]] constants] (if (and (annotation.structure? def-anns) - (or (text@= target-module source-module) + (or (text\= target-module source-module) exported?)) (list [[source-module name] def-type]) (list)))) @@ -130,14 +130,14 @@ (Meta (List [Name Type])) (do meta.monad [local-batches meta.locals - #let [total-locals (list@fold (function (_ [name type] table) + #let [total-locals (list\fold (function (_ [name type] table) (try.default table (dict.try-put name type table))) (: (Dictionary Text Type) (dict.new text.hash)) - (list@join local-batches))]] + (list\join local-batches))]] (wrap (|> total-locals dict.entries - (list@map (function (_ [name type]) [["" name] type])))))) + (list\map (function (_ [name type]) [["" name] type])))))) (def: local-structs (Meta (List [Name Type])) @@ -155,7 +155,7 @@ (:: ! map (prepare-definitions imp-mod this-module-name) (meta.definitions imp-mod))) imp-mods)] - (wrap (list@join export-batches)))) + (wrap (list\join export-batches)))) (def: (apply-function-type func arg) (-> Type Type (Check Type)) @@ -211,7 +211,7 @@ (do meta.monad [compiler meta.get-compiler] (case (|> alts - (list@map (function (_ [alt-name alt-type]) + (list\map (function (_ [alt-name alt-type]) (case (check.run context (do {! check.monad} [[tvars alt-type] (concrete-type alt-type) @@ -225,7 +225,7 @@ (#.Right =deps) (list [alt-name =deps])))) - list@join) + list\join) #.Nil (meta.fail (format "No candidates for provisioning: " (%.type dep))) @@ -260,7 +260,7 @@ [compiler meta.get-compiler context meta.type-context] (case (|> alts - (list@map (function (_ [alt-name alt-type]) + (list\map (function (_ [alt-name alt-type]) (case (check.run context (do {! check.monad} [[tvars alt-type] (concrete-type alt-type) @@ -276,7 +276,7 @@ (#.Right =deps) (list [alt-name =deps])))) - list@join) + list\join) #.Nil (meta.fail (format "No alternatives for " (%.type (type.function input-types output-type)))) @@ -311,7 +311,7 @@ (code.identifier constructor) _ - (` ((~ (code.identifier constructor)) (~+ (list@map instance$ dependencies)))))) + (` ((~ (code.identifier constructor)) (~+ (list\map instance$ dependencies)))))) (syntax: #export (::: {member s.identifier} @@ -354,19 +354,19 @@ (#.Cons chosen #.Nil) (wrap (list (` (:: (~ (instance$ chosen)) (~ (code.local-identifier (product.right member))) - (~+ (list@map code.identifier args)))))) + (~+ (list\map code.identifier args)))))) _ (meta.fail (format "Too many options available: " (|> chosen-ones - (list@map (|>> product.left %.name)) + (list\map (|>> product.left %.name)) (text.join-with ", ")) " --- for type: " (%.type sig-type))))) (#.Right [args _]) (do {! meta.monad} [labels (|> (meta.gensym "") (list.repeat (list.size args)) (monad.seq !))] - (wrap (list (` (let [(~+ (|> (list.zip/2 labels args) (list@map join-pair) list@join))] + (wrap (list (` (let [(~+ (|> (list.zip/2 labels args) (list\map join-pair) list\join))] (..::: (~ (code.identifier member)) (~+ labels))))))) )) @@ -384,14 +384,14 @@ (do meta.monad [g!implicit+ (implicit-bindings (list.size structures))] (wrap (list (` (let [(~+ (|> (list.zip/2 g!implicit+ structures) - (list@map (function (_ [g!implicit structure]) + (list\map (function (_ [g!implicit structure]) (list g!implicit structure))) - list@join))] + list\join))] (~ body))))))) (syntax: #export (implicit: {structures ..implicits}) (do meta.monad [g!implicit+ (implicit-bindings (list.size structures))] (wrap (|> (list.zip/2 g!implicit+ structures) - (list@map (function (_ [g!implicit structure]) + (list\map (function (_ [g!implicit structure]) (` (def: (~ g!implicit) (~ structure))))))))) diff --git a/stdlib/source/lux/type/resource.lux b/stdlib/source/lux/type/resource.lux index 8b87ef50b..60698b85f 100644 --- a/stdlib/source/lux/type/resource.lux +++ b/stdlib/source/lux/type/resource.lux @@ -21,7 +21,7 @@ [collection ["." set] ["." row (#+ Row)] - ["." list ("#@." functor fold)]]] + ["." list ("#\." functor fold)]]] ["." meta] [macro [syntax (#+ syntax:)]] @@ -162,7 +162,7 @@ (#.Cons head tail) (do {! meta.monad} - [#let [max-idx (list@fold n.max head tail)] + [#let [max-idx (list\fold n.max head tail)] g!inputs (<| (monad.seq !) (list.repeat (inc max-idx)) (meta.gensym "input")) #let [g!outputs (|> (monad.fold maybe.monad (function (_ from to) @@ -173,8 +173,8 @@ swaps) maybe.assume row.to-list) - g!inputsT+ (list@map (|>> (~) ..CK (`)) g!inputs) - g!outputsT+ (list@map (|>> (~) ..CK (`)) g!outputs)]] + g!inputsT+ (list\map (|>> (~) ..CK (`)) g!inputs) + g!outputsT+ (list\map (|>> (~) ..CK (`)) g!outputs)]] (wrap (list (` (: (All [(~+ g!inputs) (~ g!context)] (Procedure (~! <m>) [(~+ g!inputsT+) (~ g!context)] diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index a05dee430..6f98c7651 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -23,7 +23,8 @@ ["." xml]] [collection ["." set] - ["." dictionary (#+ Dictionary)]]] + ["." dictionary (#+ Dictionary)] + ["." list ("#\." functor)]]] [tool [compiler [language @@ -40,7 +41,7 @@ ["#." pom] ["#." cli] ["#." cache] - ["#." repository (#+ Address)] + ["#." repository (#+ Address Repository)] ["#." dependency #_ ["#" resolution]] ["#." command (#+ Command) @@ -53,10 +54,16 @@ ["#/." auto] ["#/." deploy]]]) +(def: repositories + (-> /.Profile (List (Repository Promise))) + (|>> (get@ #/.repositories) + set.to-list + (list\map (|>> /repository.remote /repository.async)))) + (def: (with-dependencies command profile) (All [a] (-> (Command a) (Command a))) (do /action.monad - [_ (/command/deps.do! profile)] + [_ (/command/deps.do! (file.async file.default) (..repositories profile) profile)] (command profile))) (exception: (cannot-find-repository {repository Text} @@ -103,7 +110,7 @@ (wrap [])) #/cli.Dependencies - (exec (/command/deps.do! profile) + (exec (/command/deps.do! (file.async file.default) (..repositories profile) profile) (wrap [])) (#/cli.Compilation compilation) diff --git a/stdlib/source/program/aedifex/cache.lux b/stdlib/source/program/aedifex/cache.lux index ef72dc988..dca14b496 100644 --- a/stdlib/source/program/aedifex/cache.lux +++ b/stdlib/source/program/aedifex/cache.lux @@ -72,7 +72,7 @@ (do {! (try.with promise.monad)} [] (|> (dictionary.entries resolution) - (list.filter (|>> product.right //package.local?)) + (list.filter (|>> product.right //package.local? not)) (monad.map ! (function (_ [dependency package]) (..write-one system dependency package))) (:: ! map (set.from-list //artifact.hash))))) diff --git a/stdlib/source/program/aedifex/command/deps.lux b/stdlib/source/program/aedifex/command/deps.lux index 91bbf0ec1..bc4d88f6c 100644 --- a/stdlib/source/program/aedifex/command/deps.lux +++ b/stdlib/source/program/aedifex/command/deps.lux @@ -4,34 +4,28 @@ [monad (#+ do)]] [control [concurrency - ["." promise]]] + ["." promise (#+ Promise)]]] [data [collection - ["." set (#+ Set)] - ["." list ("#\." functor)]]] + ["." set (#+ Set)]]] [world ["." file]]] ["." /// #_ [command (#+ Command)] [artifact (#+ Artifact)] + [repository (#+ Repository)] ["#" profile] ["#." action (#+ Action)] ["#." cache] - ["#." repository] ["#." dependency #_ - ["#" resolution]]]) + ["#/." resolution]]]) -(def: #export (do! profile) - (Command (Set Artifact)) +(def: #export (do! fs repositories profile) + (-> (file.System Promise) (List (Repository Promise)) (Command (Set Artifact))) (do ///action.monad - [cache (///cache.read-all (file.async file.default) - (set.to-list (get@ #///.dependencies profile)) - ///dependency.empty) - resolution (///dependency.all (list\map (|>> ///repository.remote ///repository.async) - (set.to-list (get@ #///.repositories profile))) - (set.to-list (get@ #///.dependencies profile)) - cache) - cached (///cache.write-all (file.async file.default) - resolution) + [#let [dependencies (set.to-list (get@ #///.dependencies profile))] + cache (///cache.read-all fs dependencies ///dependency/resolution.empty) + resolution (///dependency/resolution.all repositories dependencies cache) + cached (///cache.write-all fs resolution) #let [_ (log! "Successfully resolved dependencies!")]] (wrap cached))) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 8becf87dd..f5dbb0d54 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -107,7 +107,7 @@ ["Artifact" (%.text (///artifact.format (get@ #//.artifact dependency)))] ["Type" (%.text (get@ #//.type dependency))])) -(def: (any repositories dependency) +(def: #export (any repositories dependency) (-> (List (Repository Promise)) Dependency (Promise (Try Package))) (case repositories #.Nil diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index e3a2717cd..708834481 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -12,10 +12,12 @@ ["#/." clean] ["#/." pom] ["#/." install] - ["#/." deploy]] + ["#/." deploy] + ["#/." deps]] ["#." local] ["#." cache] - ["#." dependency] + ["#." dependency + ["#/." resolution]] ["#." package] ["#." profile] ["#." project] @@ -34,9 +36,11 @@ /command/pom.test /command/install.test /command/deploy.test + /command/deps.test /local.test /cache.test /dependency.test + /dependency/resolution.test /package.test /profile.test /project.test diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index 9a4607306..94fd9a5f0 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -11,7 +11,7 @@ [concurrency [promise (#+ Promise)]]] [data - ["." text ("#@." equivalence)]] + ["." text ("#\." equivalence)]] [math ["." random (#+ Random)]] [world @@ -47,7 +47,7 @@ (_.cover [/.uri /.path] (|> (/.path fs sample) (text.replace-all uri.separator (:: fs separator)) - (text@= (/.uri sample))))) + (text\= (/.uri sample))))) /type.test /extension.test diff --git a/stdlib/source/test/aedifex/artifact/extension.lux b/stdlib/source/test/aedifex/artifact/extension.lux index c3da8465c..e098b0f9c 100644 --- a/stdlib/source/test/aedifex/artifact/extension.lux +++ b/stdlib/source/test/aedifex/artifact/extension.lux @@ -4,7 +4,7 @@ [abstract [monad (#+ do)]] [data - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [number ["n" nat]] [collection @@ -30,7 +30,7 @@ (set.size uniques)))) (_.cover [/.extension] (`` (and (~~ (template [<type> <extension>] - [(text@= <extension> + [(text\= <extension> (/.extension <type>))] [//.lux-library /.lux-library] diff --git a/stdlib/source/test/aedifex/cache.lux b/stdlib/source/test/aedifex/cache.lux index e1b4abfc5..7dff44202 100644 --- a/stdlib/source/test/aedifex/cache.lux +++ b/stdlib/source/test/aedifex/cache.lux @@ -18,7 +18,7 @@ ["." set] ["." dictionary]]] [math - ["." random (#+ Random) ("#@." monad)]] + ["." random (#+ Random) ("#\." monad)]] [world ["." file]]] [// @@ -42,8 +42,8 @@ (def: type (Random Type) ($_ random.either - (random@wrap //artifact/type.lux-library) - (random@wrap //artifact/type.jvm-library))) + (random\wrap //artifact/type.lux-library) + (random\wrap //artifact/type.jvm-library))) (def: profile (Random [Artifact Profile XML]) @@ -69,7 +69,7 @@ content ..content] (wrap [{#//dependency.artifact identity #//dependency.type type} - (//package.local pom content)]))) + (set@ #//package.origin #//package.Remote (//package.local pom content))]))) (def: resolution (Random Resolution) @@ -89,7 +89,7 @@ ..profile) content ..content] (wrap [dependency - (//package.local pom content)])))))] + (set@ #//package.origin #//package.Remote (//package.local pom content))])))))] (wrap (dictionary.from-list //dependency.hash (list& [main-dependency main-package] dependencies))))) (def: singular @@ -107,7 +107,7 @@ [_ wrote! actual-package read!] (wrap (:: //package.equivalence = - expected-package + (set@ #//package.origin #//package.Local expected-package) actual-package))))))))) (def: plural @@ -125,7 +125,9 @@ [_ wrote! actual read!] (wrap (:: //dependency/resolution.equivalence = - expected + (:: dictionary.functor map + (set@ #//package.origin #//package.Local) + expected) actual))))))))) (def: #export test diff --git a/stdlib/source/test/aedifex/cli.lux b/stdlib/source/test/aedifex/cli.lux index b7be4e8bf..5dacd4f16 100644 --- a/stdlib/source/test/aedifex/cli.lux +++ b/stdlib/source/test/aedifex/cli.lux @@ -12,9 +12,9 @@ [parser ["." cli]]] [data - ["." text ("#@." equivalence)]] + ["." text ("#\." equivalence)]] [math - ["." random (#+ Random) ("#@." monad)]]] + ["." random (#+ Random) ("#\." monad)]]] {#program ["." / ["/#" // #_ @@ -23,20 +23,20 @@ (def: compilation (Random /.Compilation) - (random.or (random@wrap []) - (random@wrap []))) + (random.or (random\wrap []) + (random\wrap []))) (def: command (Random /.Command) ($_ random.or ## #Clean - (random@wrap []) + (random\wrap []) ## #POM - (random@wrap []) + (random\wrap []) ## #Dependencies - (random@wrap []) + (random\wrap []) ## #Install - (random@wrap []) + (random\wrap []) ## #Deploy ($_ random.and (random.ascii/alpha 1) @@ -73,7 +73,7 @@ ..format (cli.run /.command) (case> (#try.Success [name actual]) - (and (text@= //.default name) + (and (text\= //.default name) (:: /.equivalence = expected actual)) (#try.Failure error) @@ -90,7 +90,7 @@ (list& "with" expected-profile) (cli.run /.command) (case> (#try.Success [actual-profile actual-command]) - (and (text@= expected-profile actual-profile) + (and (text\= expected-profile actual-profile) (:: /.equivalence = expected-command actual-command)) (#try.Failure error) diff --git a/stdlib/source/test/aedifex/command/clean.lux b/stdlib/source/test/aedifex/command/clean.lux index 73207fa14..ba9431b95 100644 --- a/stdlib/source/test/aedifex/command/clean.lux +++ b/stdlib/source/test/aedifex/command/clean.lux @@ -17,7 +17,7 @@ [number ["n" nat]] [collection - ["." list ("#@." functor)] + ["." list ("#\." functor)] ["." set]]] [math ["." random (#+ Random)]] @@ -45,7 +45,7 @@ [count (:: ! map (n.% 10) random.nat) names (random.set text.hash count ..node-name) contents (random.list count (_binary.random 100))] - (wrap (list.zip/2 (list@map (|>> (format prefix)) (set.to-list names)) + (wrap (list.zip/2 (list\map (|>> (format prefix)) (set.to-list names)) contents)))) (def: (create-file! fs [path content]) @@ -77,7 +77,7 @@ [directory-exists? (..directory-exists? fs directory-path) files-exist? (: (Action (List Bit)) (|> files - (list@map product.left) + (list\map product.left) (monad.map ///action.monad (..file-exists? fs))))] (wrap (and directory-exists? (list.every? (|>>) files-exist?))))) diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index 20718f915..b27d3c0a7 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -4,7 +4,7 @@ [abstract ["." monad (#+ do)]] [control - ["." try (#+ Try) ("#@." functor)] + ["." try (#+ Try) ("#\." functor)] ["." exception] [concurrency ["." promise (#+ Promise)]] @@ -13,7 +13,7 @@ [data ["." maybe] ["." binary] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)] ["." encoding]] ["." format #_ diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux new file mode 100644 index 000000000..c0617188d --- /dev/null +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -0,0 +1,88 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + ["." predicate]] + [control + ["." try] + [concurrency + ["." promise]]] + [data + [text + ["%" format (#+ format)]] + [collection + ["." dictionary] + ["." set]]] + [math + ["." random (#+ Random)]] + [world + ["." file]]] + ["$." /// #_ + ["#." package] + ["#." artifact] + ["#." dependency #_ + ["#/." resolution]]] + {#program + ["." / + ["//#" /// #_ + ["#" profile] + ["#." action] + ["#." pom] + ["#." package] + ["#." cache] + ["#." repository] + ["#." artifact + ["#/." type]] + ["#." dependency + ["#/." resolution]]]]}) + +(def: #export test + Test + (<| (_.covering /._) + (do random.monad + [dependee-artifact $///artifact.random + depender-artifact (random.filter (predicate.complement + (:: ///artifact.equivalence = dependee-artifact)) + $///artifact.random) + + [_ dependee-package] $///package.random + [_ depender-package] $///package.random + + #let [dependee {#///dependency.artifact dependee-artifact + #///dependency.type ///artifact/type.lux-library} + depender {#///dependency.artifact depender-artifact + #///dependency.type ///artifact/type.lux-library} + + dependee-pom (|> (:: ///.monoid identity) + (set@ #///.identity (#.Some dependee-artifact)) + ///pom.write + try.assume) + depender-pom (|> (:: ///.monoid identity) + (set@ #///.identity (#.Some depender-artifact)) + (set@ #///.dependencies (set.from-list ///dependency.hash (list dependee))) + ///pom.write + try.assume) + + dependee-package (|> dependee-package + (set@ #///package.origin #///package.Remote) + (set@ #///package.pom dependee-pom)) + depender-package (|> depender-package + (set@ #///package.origin #///package.Remote) + (set@ #///package.pom depender-pom)) + + fs (file.mock (:: file.default separator))]] + (wrap (do promise.monad + [verdict (do ///action.monad + [pre (|> ///dependency/resolution.empty + (dictionary.put dependee dependee-package) + (///cache.write-all fs)) + post (|> (:: ///.monoid identity) + (set@ #///.dependencies (set.from-list ///dependency.hash (list dependee depender))) + (/.do! fs (list (///repository.mock ($///dependency/resolution.single depender-artifact depender-package) []))))] + (wrap (and (and (set.member? pre dependee-artifact) + (not (set.member? pre depender-artifact))) + (and (not (set.member? post dependee-artifact)) + (set.member? post depender-artifact)))))] + (_.claim [/.do!] + (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index 60a46116d..bcc6bb039 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -4,7 +4,7 @@ [abstract ["." monad (#+ do)]] [control - ["." try (#+ Try) ("#@." functor)] + ["." try (#+ Try)] ["." exception] [concurrency ["." promise (#+ Promise)]] @@ -13,7 +13,7 @@ [data ["." maybe] ["." binary] - ["." text ("#@." equivalence) + ["." text ["%" format (#+ format)] ["." encoding]] [format diff --git a/stdlib/source/test/aedifex/command/pom.lux b/stdlib/source/test/aedifex/command/pom.lux index c973678cc..dc05cced0 100644 --- a/stdlib/source/test/aedifex/command/pom.lux +++ b/stdlib/source/test/aedifex/command/pom.lux @@ -4,14 +4,14 @@ [abstract [monad (#+ do)]] [control - ["." try (#+ Try) ("#@." functor)] + ["." try (#+ Try) ("#\." functor)] [concurrency ["." promise (#+ Promise)]] [security ["!" capability]]] [data ["." binary] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["." encoding]] [format ["." xml]]] @@ -41,14 +41,14 @@ (do ! [verdict (do ///action.monad [expected (|> (///pom.write sample) - (try@map (|>> (:: xml.codec encode) encoding.to-utf8)) + (try\map (|>> (:: xml.codec encode) encoding.to-utf8)) (:: ! wrap)) file (: (Promise (Try (File Promise))) (file.get-file promise.monad fs path)) actual (!.use (:: file content) []) #let [expected-path! - (text@= ///pom.file path) + (text\= ///pom.file path) expected-content! (:: binary.equivalence = expected actual)]] diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux new file mode 100644 index 000000000..0b2fbe2e2 --- /dev/null +++ b/stdlib/source/test/aedifex/dependency/resolution.lux @@ -0,0 +1,371 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + ["." predicate] + {[0 #spec] + [/ + ["$." equivalence]]}] + [control + ["." try] + ["." exception] + [concurrency + ["." promise]]] + [data + ["." product] + ["." binary] + ["." text ("#\." equivalence) + ["." encoding]] + [format + ["." xml]] + [collection + ["." dictionary] + ["." set]]] + [math + ["." random (#+ Random)]]] + ["$." /// #_ + ["#." package] + ["#." repository] + ["#." artifact] + [// + [lux + [data + ["$." binary]]]]] + {#program + ["." / + ["//#" /// #_ + ["#" profile] + ["#." package (#+ Package)] + ["#." hash] + ["#." repository (#+ Simulation)] + ["#." dependency] + ["#." pom] + ["#." artifact (#+ Artifact) + ["#/." type] + ["#/." extension]]]]}) + +(def: random + (Random /.Resolution) + (do {! random.monad} + [artifact $///artifact.random + [_ package] $///package.random] + (wrap (dictionary.put {#///dependency.artifact artifact + #///dependency.type ///artifact/type.lux-library} + package + /.empty)))) + +(def: #export (single artifact package) + (-> Artifact Package (Simulation Any)) + (structure + (def: (on-download request extension state) + (if (:: ///artifact.equivalence = artifact request) + (cond (text\= extension ///artifact/extension.lux-library) + (#try.Success [state (get@ #///package.library package)]) + + (text\= extension ///artifact/extension.pom) + (#try.Success [state (|> package + (get@ #///package.pom) + (:: xml.codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.sha-1) + (#try.Success [state (|> package + (get@ #///package.sha-1) + (:: ///hash.sha-1-codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.md5) + (#try.Success [state (|> package + (get@ #///package.md5) + (:: ///hash.md5-codec encode) + encoding.to-utf8)]) + + ## else + (#try.Failure "NOPE")) + (#try.Failure "NOPE"))) + (def: (on-upload identity artifact extension binary state) + (#try.Failure "NOPE")))) + +(def: one + Test + (do {! random.monad} + [expected-artifact $///artifact.random + [_ expected-package] $///package.random + [_ dummy-package] (random.filter (|>> product.right + (set@ #///package.pom (get@ #///package.pom expected-package)) + (:: ///package.equivalence = expected-package) + not) + $///package.random) + #let [good (..single expected-artifact expected-package) + bad-sha-1 (: (Simulation Any) + (structure + (def: (on-download actual-artifact extension state) + (if (:: ///artifact.equivalence = expected-artifact actual-artifact) + (cond (text\= extension ///artifact/extension.lux-library) + (#try.Success [state (get@ #///package.library expected-package)]) + + (text\= extension ///artifact/extension.pom) + (#try.Success [state (|> expected-package + (get@ #///package.pom) + (:: xml.codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.sha-1) + (#try.Success [state (|> dummy-package + (get@ #///package.sha-1) + (:: ///hash.sha-1-codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.md5) + (#try.Success [state (|> expected-package + (get@ #///package.md5) + (:: ///hash.md5-codec encode) + encoding.to-utf8)]) + + ## else + (#try.Failure "NOPE")) + (#try.Failure "NOPE"))) + (def: (on-upload identity artifact extension binary state) + (#try.Failure "NOPE")))) + bad-md5 (: (Simulation Any) + (structure + (def: (on-download actual-artifact extension state) + (if (:: ///artifact.equivalence = expected-artifact actual-artifact) + (cond (text\= extension ///artifact/extension.lux-library) + (#try.Success [state (get@ #///package.library expected-package)]) + + (text\= extension ///artifact/extension.pom) + (#try.Success [state (|> expected-package + (get@ #///package.pom) + (:: xml.codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.sha-1) + (#try.Success [state (|> expected-package + (get@ #///package.sha-1) + (:: ///hash.sha-1-codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.md5) + (#try.Success [state (|> dummy-package + (get@ #///package.md5) + (:: ///hash.md5-codec encode) + encoding.to-utf8)]) + + ## else + (#try.Failure "NOPE")) + (#try.Failure "NOPE"))) + (def: (on-upload identity artifact extension binary state) + (#try.Failure "NOPE"))))]] + (`` ($_ _.and + (wrap + (do promise.monad + [actual-package (/.one (///repository.mock good []) + {#///dependency.artifact expected-artifact + #///dependency.type ///artifact/type.lux-library})] + (_.claim [/.one] + (case actual-package + (#try.Success actual-package) + (:: ///package.equivalence = + (set@ #///package.origin #///package.Remote expected-package) + actual-package) + + (#try.Failure _) + false)))) + (~~ (template [<exception> <bad>] + [(wrap + (do promise.monad + [actual-package (/.one (///repository.mock <bad> []) + {#///dependency.artifact expected-artifact + #///dependency.type ///artifact/type.lux-library})] + (_.claim [<exception>] + (case actual-package + (#try.Failure error) + (exception.match? <exception> error) + + (#try.Success _) + false))))] + + [/.sha-1-does-not-match bad-sha-1] + [/.md5-does-not-match bad-md5] + )) + )))) + +(def: any + Test + (do {! random.monad} + [expected-artifact $///artifact.random + [_ expected-package] $///package.random + [_ dummy-package] (random.filter (|>> product.right + (set@ #///package.pom (get@ #///package.pom expected-package)) + (:: ///package.equivalence = expected-package) + not) + $///package.random) + #let [good (..single expected-artifact expected-package) + bad-sha-1 (: (Simulation Any) + (structure + (def: (on-download actual-artifact extension state) + (if (:: ///artifact.equivalence = expected-artifact actual-artifact) + (cond (text\= extension ///artifact/extension.lux-library) + (#try.Success [state (get@ #///package.library expected-package)]) + + (text\= extension ///artifact/extension.pom) + (#try.Success [state (|> expected-package + (get@ #///package.pom) + (:: xml.codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.sha-1) + (#try.Success [state (|> dummy-package + (get@ #///package.sha-1) + (:: ///hash.sha-1-codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.md5) + (#try.Success [state (|> expected-package + (get@ #///package.md5) + (:: ///hash.md5-codec encode) + encoding.to-utf8)]) + + ## else + (#try.Failure "NOPE")) + (#try.Failure "NOPE"))) + (def: (on-upload identity artifact extension binary state) + (#try.Failure "NOPE")))) + bad-md5 (: (Simulation Any) + (structure + (def: (on-download actual-artifact extension state) + (if (:: ///artifact.equivalence = expected-artifact actual-artifact) + (cond (text\= extension ///artifact/extension.lux-library) + (#try.Success [state (get@ #///package.library expected-package)]) + + (text\= extension ///artifact/extension.pom) + (#try.Success [state (|> expected-package + (get@ #///package.pom) + (:: xml.codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.sha-1) + (#try.Success [state (|> expected-package + (get@ #///package.sha-1) + (:: ///hash.sha-1-codec encode) + encoding.to-utf8)]) + + (text\= extension ///artifact/extension.md5) + (#try.Success [state (|> dummy-package + (get@ #///package.md5) + (:: ///hash.md5-codec encode) + encoding.to-utf8)]) + + ## else + (#try.Failure "NOPE")) + (#try.Failure "NOPE"))) + (def: (on-upload identity artifact extension binary state) + (#try.Failure "NOPE"))))]] + ($_ _.and + (wrap + (do promise.monad + [actual-package (/.any (list (///repository.mock bad-sha-1 []) + (///repository.mock bad-md5 []) + (///repository.mock good [])) + {#///dependency.artifact expected-artifact + #///dependency.type ///artifact/type.lux-library})] + (_.claim [/.any] + (case actual-package + (#try.Success actual-package) + (:: ///package.equivalence = + (set@ #///package.origin #///package.Remote expected-package) + actual-package) + + (#try.Failure _) + false)))) + (wrap + (do promise.monad + [actual-package (/.any (list (///repository.mock bad-sha-1 []) + (///repository.mock bad-md5 [])) + {#///dependency.artifact expected-artifact + #///dependency.type ///artifact/type.lux-library})] + (_.claim [/.cannot-resolve] + (case actual-package + (#try.Failure error) + (exception.match? /.cannot-resolve error) + + (#try.Success _) + false)))) + ))) + +(def: all + Test + (do {! random.monad} + [dependee-artifact $///artifact.random + depender-artifact (random.filter (predicate.complement + (:: ///artifact.equivalence = dependee-artifact)) + $///artifact.random) + ignored-artifact (random.filter (predicate.complement + (predicate.unite (:: ///artifact.equivalence = dependee-artifact) + (:: ///artifact.equivalence = depender-artifact))) + $///artifact.random) + + [_ dependee-package] $///package.random + [_ depender-package] $///package.random + [_ ignored-package] $///package.random + + #let [dependee {#///dependency.artifact dependee-artifact + #///dependency.type ///artifact/type.lux-library} + depender {#///dependency.artifact depender-artifact + #///dependency.type ///artifact/type.lux-library} + ignored {#///dependency.artifact ignored-artifact + #///dependency.type ///artifact/type.lux-library} + + dependee-pom (|> (:: ///.monoid identity) + (set@ #///.identity (#.Some dependee-artifact)) + ///pom.write + try.assume) + depender-pom (|> (:: ///.monoid identity) + (set@ #///.identity (#.Some depender-artifact)) + (set@ #///.dependencies (set.from-list ///dependency.hash (list dependee))) + ///pom.write + try.assume) + ignored-pom (|> (:: ///.monoid identity) + (set@ #///.identity (#.Some ignored-artifact)) + ///pom.write + try.assume) + + dependee-package (set@ #///package.pom dependee-pom dependee-package) + depender-package (set@ #///package.pom depender-pom depender-package) + ignored-package (set@ #///package.pom ignored-pom ignored-package)]] + ($_ _.and + (wrap + (do promise.monad + [resolution (/.all (list (///repository.mock (..single dependee-artifact dependee-package) []) + (///repository.mock (..single depender-artifact depender-package) []) + (///repository.mock (..single ignored-artifact ignored-package) [])) + (list depender) + /.empty)] + (_.claim [/.all] + (case resolution + (#try.Success resolution) + (and (dictionary.contains? depender resolution) + (dictionary.contains? dependee resolution) + (not (dictionary.contains? ignored resolution))) + + (#try.Failure error) + false)))) + ))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Resolution]) + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (_.cover [/.empty] + (dictionary.empty? /.empty)) + + ..one + ..any + ..all + ))) diff --git a/stdlib/source/test/aedifex/input.lux b/stdlib/source/test/aedifex/input.lux index b05d0afcb..c25d6fe36 100644 --- a/stdlib/source/test/aedifex/input.lux +++ b/stdlib/source/test/aedifex/input.lux @@ -4,14 +4,14 @@ [abstract [monad (#+ do)]] [control - ["." try (#+ Try) ("#@." functor)] + ["." try (#+ Try)] [concurrency ["." promise (#+ Promise)]] [security ["!" capability]]] [data ["." binary] - ["." text ("#@." equivalence) + ["." text ["%" format] ["." encoding]]] [math diff --git a/stdlib/source/test/aedifex/package.lux b/stdlib/source/test/aedifex/package.lux index b85f6ce4a..5400d4953 100644 --- a/stdlib/source/test/aedifex/package.lux +++ b/stdlib/source/test/aedifex/package.lux @@ -31,31 +31,36 @@ ["#." pom] ["#." hash]]]}) +(def: #export random + (Random [//.Profile /.Package]) + (do {! random.monad} + [content-size (:: ! map (n.% 100) random.nat) + content (_binary.random content-size) + [profile pom] (random.one (function (_ profile) + (try.to-maybe + (do try.monad + [pom (//pom.write profile)] + (wrap [profile pom])))) + @profile.random)] + (wrap [profile (/.local pom content)]))) + (def: #export test Test (<| (_.covering /._) (_.with-cover [/.Package]) (do {! random.monad} - [content-size (:: ! map (n.% 100) random.nat) - content (_binary.random content-size) - [profile pom] (random.one (function (_ profile) - (try.to-maybe - (do try.monad - [pom (//pom.write profile)] - (wrap [profile pom])))) - @profile.random)] + [[profile package] ..random] ($_ _.and (_.cover [/.local] - (let [package (/.local pom content)] - (and (:: //hash.equivalence = - (//hash.sha-1 content) - (get@ #/.sha-1 package)) - (:: //hash.equivalence = - (//hash.md5 content) - (get@ #/.md5 package))))) + (and (:: //hash.equivalence = + (//hash.sha-1 (get@ #/.library package)) + (get@ #/.sha-1 package)) + (:: //hash.equivalence = + (//hash.md5 (get@ #/.library package)) + (get@ #/.md5 package)))) (_.cover [/.dependencies] (let [expected (get@ #//.dependencies profile)] - (case (/.dependencies (/.local pom content)) + (case (/.dependencies package) (#try.Success actual) (:: set.equivalence = expected actual) diff --git a/stdlib/source/test/aedifex/parser.lux b/stdlib/source/test/aedifex/parser.lux index 12fa349bb..394f93977 100644 --- a/stdlib/source/test/aedifex/parser.lux +++ b/stdlib/source/test/aedifex/parser.lux @@ -16,9 +16,9 @@ [collection ["." set (#+ Set)] ["." dictionary (#+ Dictionary)] - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [math - ["." random (#+ Random) ("#@." monad)]] + ["." random (#+ Random)]] [macro ["." code]]] [// @@ -98,7 +98,7 @@ (|> expected ..with-empty-profile dictionary.entries - (list@map (function (_ [name profile]) + (list\map (function (_ [name profile]) [name (..with-default-sources profile)])) (dictionary.from-list text.hash) (:: //project.equivalence = actual)) diff --git a/stdlib/source/test/aedifex/profile.lux b/stdlib/source/test/aedifex/profile.lux index 10d921f94..b49bd7f36 100644 --- a/stdlib/source/test/aedifex/profile.lux +++ b/stdlib/source/test/aedifex/profile.lux @@ -14,14 +14,14 @@ [parser ["." cli]]] [data - ["." text ("#@." equivalence)] + ["." text] [number ["n" nat]] [collection ["." set (#+ Set)] ["." dictionary (#+ Dictionary)]]] [math - ["." random (#+ Random) ("#@." monad)]]] + ["." random (#+ Random) ("#\." monad)]]] [// ["@." artifact] ["@." dependency]] @@ -34,8 +34,8 @@ (def: distribution (Random /.Distribution) - (random.or (random@wrap []) - (random@wrap []))) + (random.or (random\wrap []) + (random\wrap []))) (def: license (Random /.License) diff --git a/stdlib/source/test/aedifex/project.lux b/stdlib/source/test/aedifex/project.lux index f2c2917a2..ab8cc438f 100644 --- a/stdlib/source/test/aedifex/project.lux +++ b/stdlib/source/test/aedifex/project.lux @@ -8,15 +8,15 @@ ["$." equivalence] ["$." monoid]]}] [control - ["." try ("#@." functor)] + ["." try ("#\." functor)] ["." exception]] [data ["." product] - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [number ["n" nat]]] [math - ["." random (#+ Random) ("#@." monad)]]] + ["." random (#+ Random) ("#\." monad)]]] [// ["@." profile]] {#program @@ -27,7 +27,7 @@ (def: profile (Random [//.Name //.Profile]) (|> @profile.random - (random@map (set@ #//.parents (list))) + (random\map (set@ #//.parents (list))) (random.and (random.ascii/alpha 1)))) (def: #export random @@ -48,16 +48,16 @@ (do random.monad [[super-name super-profile] ..profile - [dummy-name dummy-profile] (random.filter (|>> product.left (text@= super-name) not) + [dummy-name dummy-profile] (random.filter (|>> product.left (text\= super-name) not) ..profile) [sub-name sub-profile] (random.filter (function (_ [name profile]) - (and (not (text@= super-name name)) - (not (text@= dummy-name name)))) + (and (not (text\= super-name name)) + (not (text\= dummy-name name)))) ..profile) fake-name (random.filter (function (_ name) - (and (not (text@= super-name name)) - (not (text@= dummy-name name)) - (not (text@= sub-name name)))) + (and (not (text\= super-name name)) + (not (text\= dummy-name name)) + (not (text\= sub-name name)))) (random.ascii/alpha 1)) #let [project ($_ (:: /.monoid compose) (/.project super-name super-profile) @@ -70,13 +70,13 @@ ($_ _.and (_.cover [/.profile] (and (|> (/.profile super-name project) - (try@map (:: //.equivalence = super-profile)) + (try\map (:: //.equivalence = super-profile)) (try.default false)) (|> (/.profile dummy-name project) - (try@map (:: //.equivalence = dummy-profile)) + (try\map (:: //.equivalence = dummy-profile)) (try.default false)) (|> (/.profile sub-name project) - (try@map (:: //.equivalence = (:: //.monoid compose sub-profile super-profile))) + (try\map (:: //.equivalence = (:: //.monoid compose sub-profile super-profile))) (try.default false)))) (_.cover [/.unknown-profile] (case (/.profile fake-name project) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 809e906fb..61e4489f3 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -27,7 +27,7 @@ [territory (#+)]] ["%" data/text/format (#+ format)] [math - ["." random (#+ Random) ("#@." functor)]] + ["." random (#+ Random) ("#\." functor)]] ## TODO: Test these modules ## [data ## [format @@ -239,8 +239,8 @@ Test ($_ _.and (do random.monad - [factor (random@map (|>> (n.% 10) (n.max 1)) random.nat) - iterations (random@map (n.% 100) random.nat) + [factor (random\map (|>> (n.% 10) (n.max 1)) random.nat) + iterations (random\map (n.% 100) random.nat) #let [expected (n.* factor iterations)]] (_.test "Can write loops." (n.= expected @@ -362,10 +362,10 @@ " " (%.name (name-of <backward>)))) (..conversion <gen> <forward> <backward> <=>))] - [i.= .nat .int (random@map (i.% +1,000,000) random.int)] - [n.= .int .nat (random@map (n.% 1,000,000) random.nat)] - [i.= i.frac f.int (random@map (i.% +1,000,000) random.int)] - [f.= f.int i.frac (random@map (|>> (i.% +1,000,000) i.frac) random.int)] + [i.= .nat .int (random\map (i.% +1,000,000) random.int)] + [n.= .int .nat (random\map (n.% 1,000,000) random.nat)] + [i.= i.frac f.int (random\map (i.% +1,000,000) random.int)] + [f.= f.int i.frac (random\map (|>> (i.% +1,000,000) i.frac) random.int)] [r.= r.frac f.rev frac-rev] ))))) (<| (_.context "Prelude macros.") diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index cbf390441..a8c91fbaf 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -249,7 +249,8 @@ [expected random.nat even (random.filter n.even? random.nat) odd (random.filter n.odd? random.nat) - #let [even^ (/.filter n.even? s.nat) + #let [nat^ s.nat + even^ (/.filter n.even? s.nat) odd^ (/.filter n.odd? s.nat)]] ($_ _.and (_.cover [/.rec] @@ -289,6 +290,22 @@ (|> (/.run (/.parses? even^) (list (code.nat odd))) (match verdict (not verdict))))) + (_.cover [/.parses] + (and (|> (/.run (/.parses even^) + (list (code.nat even))) + (match [] true)) + (|> (/.run (/.parses even^) + (list (code.nat odd))) + fails?))) + (_.cover [/.speculative] + (and (|> (/.run (/.and (/.speculative even^) nat^) + (list (code.nat even))) + (match [speculation actual] + (and (n.= speculation actual) + (n.= expected actual)))) + (|> (/.run (/.and (/.speculative even^) nat^) + (list (code.nat odd))) + fails?))) (_.cover [/.codec] (|> (/.run (/.codec n.decimal s.text) (list (code.text (%.nat expected)))) diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux index 6ae68a061..c65567c23 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -8,7 +8,6 @@ ["." / #_ ["#." binary] ["#." bit] - ["#." color] ["#." identity] ["#." lazy] ["#." maybe] @@ -16,6 +15,12 @@ ["#." number] ["#." product] ["#." sum] + ["#." color + ["#/." named]] + [format + ["#." json] + ["#." tar] + ["#." xml]] [number ["#." i8] ["#." i16] @@ -29,10 +34,6 @@ ["#." complex]] ["#." text ["#/." regex]] - [format - ["#." json] - ["#." tar] - ["#." xml]] ["#." collection]]) ## TODO: Get rid of this ASAP @@ -62,6 +63,7 @@ /binary.test /bit.test /color.test + /color/named.test /identity.test) test1 ($_ _.and /lazy.test diff --git a/stdlib/source/test/lux/data/collection/dictionary.lux b/stdlib/source/test/lux/data/collection/dictionary.lux index 181d6efa4..6d35fd15b 100644 --- a/stdlib/source/test/lux/data/collection/dictionary.lux +++ b/stdlib/source/test/lux/data/collection/dictionary.lux @@ -16,7 +16,7 @@ [number ["n" nat]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [math ["." random]]] {1 @@ -58,7 +58,7 @@ (let [merging-with-oneself (let [(^open ".") (/.equivalence n.equivalence)] (= dict (/.merge dict dict))) overwritting-keys (let [dict' (|> dict /.entries - (list@map (function (_ [k v]) [k (inc v)])) + (list\map (function (_ [k v]) [k (inc v)])) (/.from-list n.hash)) (^open ".") (/.equivalence n.equivalence)] (= dict' (/.merge dict' dict)))] diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index 8b32295d9..a1d776d10 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -10,15 +10,15 @@ ["$." equivalence]]}] [data ["." product] - ["." bit ("#@." equivalence)] - ["." maybe ("#@." monad)] + ["." bit ("#\." equivalence)] + ["." maybe ("#\." monad)] [number ["n" nat]] [collection ["." set] - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [math - ["." random (#+ Random) ("#@." monad)]]] + ["." random (#+ Random) ("#\." monad)]]] {1 ["." /]}) @@ -27,7 +27,7 @@ (-> (Order k) (Random k) (Random v) Nat (Random (/.Dictionary k v)))) (case size 0 - (random@wrap (/.new order)) + (random\wrap (/.new order)) _ (do random.monad @@ -56,12 +56,12 @@ sorted-pairs (list.sort (function (_ [left _] [right _]) (n.< left right)) pairs) - sorted-values (list@map product.right sorted-pairs) - (^open "list@.") (list.equivalence (: (Equivalence [Nat Nat]) + sorted-values (list\map product.right sorted-pairs) + (^open "list\.") (list.equivalence (: (Equivalence [Nat Nat]) (function (_ [kr vr] [ks vs]) (and (n.= kr ks) (n.= vr vs))))) - (^open "/@.") (/.equivalence n.equivalence)]] + (^open "/\.") (/.equivalence n.equivalence)]] ($_ _.and (_.with-cover [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (..dictionary n.order random.nat random.nat size))) @@ -69,7 +69,7 @@ (_.cover [/.size] (n.= size (/.size sample))) (_.cover [/.empty?] - (bit@= (n.= 0 (/.size sample)) + (bit\= (n.= 0 (/.size sample)) (/.empty? sample))) (_.cover [/.new] (/.empty? (/.new n.order))) @@ -94,15 +94,15 @@ _ #0)) (_.cover [/.entries] - (list@= (/.entries sample) + (list\= (/.entries sample) sorted-pairs)) (_.cover [/.keys /.values] - (list@= (/.entries sample) + (list\= (/.entries sample) (list.zip/2 (/.keys sample) (/.values sample)))) (_.cover [/.from-list] (|> sample /.entries (/.from-list n.order) - (/@= sample))) + (/\= sample))) (_.cover [/.contains?] (and (list.every? (function (_ key) (/.contains? key sample)) (/.keys sample)) @@ -126,12 +126,12 @@ (|> sample (/.put extra-key extra-value) (/.remove extra-key) - (/@= sample))) + (/\= sample))) (_.cover [/.update] (|> sample (/.put extra-key extra-value) (/.update extra-key (n.+ shift)) (/.get extra-key) - (maybe@map (n.= (n.+ shift extra-value))) + (maybe\map (n.= (n.+ shift extra-value))) (maybe.default false))) )))) diff --git a/stdlib/source/test/lux/data/collection/dictionary/plist.lux b/stdlib/source/test/lux/data/collection/dictionary/plist.lux index cac27e0cf..3ffcc816c 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/plist.lux @@ -7,8 +7,8 @@ [/ ["$." equivalence]]}] [data - ["." bit ("#@." equivalence)] - ["." maybe ("#@." monad)] + ["." bit ("#\." equivalence)] + ["." maybe ("#\." monad)] ["." text] [number ["n" nat]] @@ -50,7 +50,7 @@ (_.cover [/.size] (n.= size (/.size sample))) (_.cover [/.empty?] - (bit@= (n.= 0 (/.size sample)) + (bit\= (n.= 0 (/.size sample)) (/.empty? sample))) (_.cover [/.empty] (/.empty? /.empty)) @@ -74,14 +74,14 @@ (|> sample (/.put extra-key extra-value) (/.get extra-key) - (maybe@map (n.= extra-value)) + (maybe\map (n.= extra-value)) (maybe.default false))) (_.cover [/.update] (|> sample (/.put extra-key extra-value) (/.update extra-key (n.+ shift)) (/.get extra-key) - (maybe@map (n.= (n.+ shift extra-value))) + (maybe\map (n.= (n.+ shift extra-value))) (maybe.default false))) (_.cover [/.remove] (|> sample diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index 2190c2fe2..ca432bcb4 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -21,7 +21,7 @@ ["." bit] ["." product] ["." maybe] - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [number ["n" nat] ["." int]] @@ -30,7 +30,7 @@ [math ["." random (#+ Random)]]] {1 - ["." / ("#@." monad)]}) + ["." / ("#\." monad)]}) (def: bounded-size (Random Nat) @@ -53,23 +53,23 @@ (_.with-cover [/.monoid] ($monoid.spec (/.equivalence n.equivalence) /.monoid ..random)) (_.with-cover [/.fold] - ($fold.spec /@wrap /.equivalence /.fold)) + ($fold.spec /\wrap /.equivalence /.fold)) (_.with-cover [/.functor] - ($functor.spec /@wrap /.equivalence /.functor)) + ($functor.spec /\wrap /.equivalence /.functor)) (_.with-cover [/.apply] - ($apply.spec /@wrap /.equivalence /.apply)) + ($apply.spec /\wrap /.equivalence /.apply)) (_.with-cover [/.monad] - ($monad.spec /@wrap /.equivalence /.monad)) + ($monad.spec /\wrap /.equivalence /.monad)) (do {! random.monad} [parameter random.nat subject random.nat] (let [lift (/.lift io.monad) - (^open "io@.") io.monad + (^open "io\.") io.monad expected (n.+ parameter subject)] (_.cover [/.with /.lift] (|> (io.run (do (/.with io.monad) - [a (lift (io@wrap parameter)) + [a (lift (io\wrap parameter)) b (wrap subject)] (wrap (n.+ a b)))) (case> (^ (list actual)) @@ -83,7 +83,7 @@ Test (do {! random.monad} [size ..bounded-size - #let [(^open "/@.") (/.equivalence n.equivalence)] + #let [(^open "/\.") (/.equivalence n.equivalence)] sample (:: ! map set.to-list (random.set n.hash size random.nat))] ($_ _.and (_.cover [/.size] @@ -97,11 +97,11 @@ (_.cover [/.reverse] (or (n.< 2 (/.size sample)) (let [not-same! - (not (/@= sample + (not (/\= sample (/.reverse sample))) self-symmetry! - (/@= sample + (/\= sample (/.reverse (/.reverse sample)))] (and not-same! self-symmetry!)))) @@ -117,7 +117,7 @@ (/.size (/.sort <<< sample))) symmetry! - (/@= (/.sort <<< sample) + (/\= (/.sort <<< sample) (/.reverse (/.sort (function.flip <<<) sample)))] (and size-preservation! symmetry!))) @@ -125,8 +125,8 @@ (def: indices Test - (let [(^open "/@.") (/.equivalence n.equivalence) - (^open "/@.") /.functor] + (let [(^open "/\.") (/.equivalence n.equivalence) + (^open "/\.") /.functor] (do {! random.monad} [sample ..random #let [size (/.size sample)]] @@ -138,7 +138,7 @@ (n.= size (/.size indices)) already-sorted! - (/@= indices + (/\= indices (/.sort n.< indices)) expected-numbers! @@ -153,12 +153,12 @@ (let [enumeration (/.enumeration sample) has-correct-indices! - (/@= (/.indices (/.size enumeration)) - (/@map product.left enumeration)) + (/\= (/.indices (/.size enumeration)) + (/\map product.left enumeration)) has-correct-values! - (/@= sample - (/@map product.right enumeration))] + (/\= sample + (/\map product.right enumeration))] (and has-correct-indices! has-correct-values!))) (_.cover [/.nth] @@ -174,8 +174,8 @@ (def: slice Test - (let [(^open "/@.") (/.equivalence n.equivalence) - (^open "/@.") /.monoid] + (let [(^open "/\.") (/.equivalence n.equivalence) + (^open "/\.") /.monoid] (do {! random.monad} [sample (random.filter (|>> /.size (n.> 0)) ..random) @@ -194,36 +194,36 @@ (/.size negatives)))))) (_.cover [/.partition] (let [[positives negatives] (/.partition n.even? sample)] - (and (/@= (/.filter n.even? sample) + (and (/\= (/.filter n.even? sample) positives) - (/@= (/.filter (bit.complement n.even?) sample) + (/\= (/.filter (bit.complement n.even?) sample) negatives)))) (_.cover [/.split] (let [[left right] (/.split idx sample)] - (/@= sample - (/@compose left right)))) + (/\= sample + (/\compose left right)))) (_.cover [/.split-with] (let [[left right] (/.split-with n.even? sample)] - (/@= sample - (/@compose left right)))) + (/\= sample + (/\compose left right)))) (_.cover [/.take /.drop] - (/@= sample - (/@compose (/.take idx sample) + (/\= sample + (/\compose (/.take idx sample) (/.drop idx sample)))) (_.cover [/.take-while /.drop-while] - (/@= sample - (/@compose (/.take-while n.even? sample) + (/\= sample + (/\compose (/.take-while n.even? sample) (/.drop-while n.even? sample)))) (_.cover [/.chunk] (let [chunks (/.chunk chunk-size sample)] (and (/.every? (|>> /.size (n.<= chunk-size)) chunks) - (/@= sample + (/\= sample (/.concat chunks))))) )))) (def: member Test - (let [(^open "/@.") (/.equivalence n.equivalence)] + (let [(^open "/\.") (/.equivalence n.equivalence)] (do {! random.monad} [sample ..random] (`` ($_ _.and @@ -245,7 +245,7 @@ (_.cover [<tail>] (case [(<pre> sample) (<tail> sample)] [(#.Cons _ expected) (#.Some actual)] - (/@= (<pre> expected) actual) + (/\= (<pre> expected) actual) [#.Nil #.None] true @@ -261,9 +261,9 @@ (def: grouping Test - (let [(^open "/@.") (/.equivalence n.equivalence) - (^open "/@.") /.functor - (^open "/@.") /.monoid + (let [(^open "/\.") (/.equivalence n.equivalence) + (^open "/\.") /.functor + (^open "/\.") /.monoid +/2 (: (-> Nat Nat Nat) (function (_ left right) @@ -288,10 +288,10 @@ (n.min (/.size sample/0) (/.size sample/1))) can-extract-values! - (and (/@= (/.take zipped::size sample/0) - (/@map product.left zipped)) - (/@= (/.take zipped::size sample/1) - (/@map product.right zipped)))] + (and (/\= (/.take zipped::size sample/0) + (/\map product.left zipped)) + (/\= (/.take zipped::size sample/1) + (/\map product.right zipped)))] (and size-of-smaller-list! can-extract-values!))) (_.cover [/.zip/3] @@ -306,12 +306,12 @@ (/.size sample/2))) can-extract-values! - (and (/@= (/.take zipped::size sample/0) - (/@map product.left zipped)) - (/@= (/.take zipped::size sample/1) - (/@map (|>> product.right product.left) zipped)) - (/@= (/.take zipped::size sample/2) - (/@map (|>> product.right product.right) zipped)))] + (and (/\= (/.take zipped::size sample/0) + (/\map product.left zipped)) + (/\= (/.take zipped::size sample/1) + (/\map (|>> product.right product.left) zipped)) + (/\= (/.take zipped::size sample/2) + (/\map (|>> product.right product.right) zipped)))] (and size-of-smaller-list! can-extract-values!))) (_.cover [/.zip] @@ -323,30 +323,30 @@ ((/.zip 3) sample/0 sample/1 sample/2)))) (_.cover [/.zip-with/2] - (/@= (/@map (function (_ [left right]) + (/\= (/\map (function (_ [left right]) (+/2 left right)) (/.zip/2 sample/0 sample/1)) (/.zip-with/2 +/2 sample/0 sample/1))) (_.cover [/.zip-with/3] - (/@= (/@map (function (_ [left mid right]) + (/\= (/\map (function (_ [left mid right]) (+/3 left mid right)) (/.zip/3 sample/0 sample/1 sample/2)) (/.zip-with/3 +/3 sample/0 sample/1 sample/2))) (_.cover [/.zip-with] - (and (/@= (/.zip-with/2 +/2 sample/0 sample/1) + (and (/\= (/.zip-with/2 +/2 sample/0 sample/1) ((/.zip-with 2) +/2 sample/0 sample/1)) - (/@= (/.zip-with/3 +/3 sample/0 sample/1 sample/2) + (/\= (/.zip-with/3 +/3 sample/0 sample/1 sample/2) ((/.zip-with 3) +/3 sample/0 sample/1 sample/2)))) (_.cover [/.concat] - (and (/@= (/@compose sample/0 sample/1) + (and (/\= (/\compose sample/0 sample/1) (/.concat (list sample/0 sample/1))) - (/@= ($_ /@compose sample/0 sample/1 sample/2) + (/\= ($_ /\compose sample/0 sample/1 sample/2) (/.concat (list sample/0 sample/1 sample/2))))) )))) (def: search Test - (let [(^open "/@.") /.functor + (let [(^open "/\.") /.functor choose (: (-> Nat (Maybe Text)) (function (_ value) @@ -359,11 +359,11 @@ (_.cover [/.one] (case [(|> sample (/.filter n.even?) - (/@map (:: n.decimal encode)) + (/\map (:: n.decimal encode)) /.head) (/.one choose sample)] [(#.Some expected) (#.Some actual)] - (text@= expected actual) + (text\= expected actual) [#.None #.None] true @@ -374,7 +374,7 @@ (:: (/.equivalence text.equivalence) = (|> sample (/.filter n.even?) - (/@map (:: n.decimal encode))) + (/\map (:: n.decimal encode))) (/.all choose sample))) (_.cover [/.find] (case (/.find n.even? sample) @@ -389,8 +389,8 @@ Test (<| (_.covering /._) (_.with-cover [.List]) - (let [(^open "/@.") (/.equivalence n.equivalence) - (^open "/@.") /.functor] + (let [(^open "/\.") (/.equivalence n.equivalence) + (^open "/\.") /.functor] (do {! random.monad} [sample ..random separator random.nat] @@ -412,14 +412,14 @@ (_.cover [/.iterate] (or (/.empty? sample) (let [size (/.size sample)] - (/@= (/.indices size) + (/\= (/.indices size) (/.iterate (function (_ index) (if (n.< size index) (#.Some (inc index)) #.None)) 0))))) (_.cover [/.folds] - (/@= (/@map (function (_ index) + (/\= (/\map (function (_ index) (:: /.fold fold n.+ 0 (/.take index sample))) (/.indices (inc (/.size sample)))) (/.folds n.+ 0 sample))) diff --git a/stdlib/source/test/lux/data/collection/queue.lux b/stdlib/source/test/lux/data/collection/queue.lux index 9cc7c4500..3cd4d6db2 100644 --- a/stdlib/source/test/lux/data/collection/queue.lux +++ b/stdlib/source/test/lux/data/collection/queue.lux @@ -8,13 +8,13 @@ ["$." equivalence] ["$." functor (#+ Injection)]]}] [data - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] ["%" text/format (#+ format)] [number ["n" nat]] [collection ["." set] - ["." list ("#@." monoid)]]] + ["." list ("#\." monoid)]]] [math ["." random]]] {1 @@ -47,13 +47,13 @@ (_.cover [/.size] (n.= size (/.size sample))) (_.cover [/.empty?] - (bit@= (n.= 0 size) (/.empty? sample))) + (bit\= (n.= 0 size) (/.empty? sample))) (_.cover [/.empty] (let [empty-is-empty! (/.empty? /.empty) all-empty-queues-look-the-same! - (bit@= (/.empty? sample) + (bit\= (/.empty? sample) (:: (/.equivalence n.equivalence) = sample /.empty))] @@ -89,7 +89,7 @@ has-expected-order! (:: (list.equivalence n.equivalence) = - (list@compose (/.to-list sample) (list non-member)) + (list\compose (/.to-list sample) (list non-member)) (/.to-list pushed))] (and size-increases! new-member-is-identified! diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux index 073ce2c8d..37e52d598 100644 --- a/stdlib/source/test/lux/data/collection/queue/priority.lux +++ b/stdlib/source/test/lux/data/collection/queue/priority.lux @@ -4,8 +4,8 @@ [abstract ["." monad (#+ do)]] [data - ["." maybe ("#@." functor)] - ["." bit ("#@." equivalence)] + ["." maybe ("#\." functor)] + ["." bit ("#\." equivalence)] [number ["n" nat]]] [math @@ -41,7 +41,7 @@ (_.cover [/.size] (n.= size (/.size sample))) (_.cover [/.empty?] - (bit@= (n.= 0 (/.size sample)) + (bit\= (n.= 0 (/.size sample)) (/.empty? sample))) (_.cover [/.empty] (/.empty? /.empty)) @@ -78,7 +78,7 @@ (/.push /.min min-member) (/.push /.max max-member) /.peek - (maybe@map (n.= max-member)) + (maybe\map (n.= max-member)) (maybe.default false))) (_.cover [/.min] (|> /.empty @@ -86,7 +86,7 @@ (/.push /.min min-member) /.pop /.peek - (maybe@map (n.= min-member)) + (maybe\map (n.= min-member)) (maybe.default false))) )) )))) diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux index 716b03168..7a51ff797 100644 --- a/stdlib/source/test/lux/data/collection/row.lux +++ b/stdlib/source/test/lux/data/collection/row.lux @@ -15,16 +15,16 @@ ["." try (#+ Try)] ["." exception]] [data - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] [number ["n" nat]] [collection - ["." list ("#@." fold)] + ["." list ("#\." fold)] ["." set]]] [math ["." random]]] {1 - ["." / ("#@." monad)]}) + ["." / ("#\." monad)]}) (def: signatures Test @@ -36,13 +36,13 @@ (_.with-cover [/.monoid] ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.row size random.nat))) (_.with-cover [/.fold] - ($fold.spec /@wrap /.equivalence /.fold)) + ($fold.spec /\wrap /.equivalence /.fold)) (_.with-cover [/.functor] - ($functor.spec /@wrap /.equivalence /.functor)) + ($functor.spec /\wrap /.equivalence /.functor)) (_.with-cover [/.apply] - ($apply.spec /@wrap /.equivalence /.apply)) + ($apply.spec /\wrap /.equivalence /.apply)) (_.with-cover [/.monad] - ($monad.spec /@wrap /.equivalence /.monad)) + ($monad.spec /\wrap /.equivalence /.monad)) ))) (def: whole @@ -51,24 +51,24 @@ [size (:: ! map (n.% 100) random.nat) sample (random.set n.hash size random.nat) #let [sample (|> sample set.to-list /.from-list)] - #let [(^open "/@.") (/.equivalence n.equivalence)]] + #let [(^open "/\.") (/.equivalence n.equivalence)]] ($_ _.and (_.cover [/.size] (n.= size (/.size sample))) (_.cover [/.empty?] - (bit@= (/.empty? sample) (n.= 0 (/.size sample)))) + (bit\= (/.empty? sample) (n.= 0 (/.size sample)))) (_.cover [/.empty] (/.empty? /.empty)) (_.cover [/.to-list /.from-list] - (|> sample /.to-list /.from-list (/@= sample))) + (|> sample /.to-list /.from-list (/\= sample))) (_.cover [/.reverse] (or (n.< 2 (/.size sample)) (let [not-same! - (not (/@= sample + (not (/\= sample (/.reverse sample))) self-symmetry! - (/@= sample + (/\= sample (/.reverse (/.reverse sample)))] (and not-same! self-symmetry!)))) @@ -145,14 +145,14 @@ non-member (random.filter (|>> (set.member? sample) not) random.nat) #let [sample (|> sample set.to-list /.from-list)] - #let [(^open "/@.") (/.equivalence n.equivalence)]] + #let [(^open "/\.") (/.equivalence n.equivalence)]] ($_ _.and (do ! [value/0 random.nat value/1 random.nat value/2 random.nat] (_.cover [/.row] - (/@= (/.from-list (list value/0 value/1 value/2)) + (/\= (/.from-list (list value/0 value/1 value/2)) (/.row value/0 value/1 value/2)))) (_.cover [/.member?] (and (list.every? (/.member? n.equivalence sample) @@ -180,7 +180,7 @@ (|> sample (/.add non-member) /.pop - (/@= sample))] + (/\= sample))] (and expected-size! symmetry!)))) )) diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index ad1dd0448..e255fd5f5 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -17,7 +17,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [math ["." random]]] {1 @@ -35,7 +35,7 @@ Test (<| (_.covering /._) (_.with-cover [/.Sequence]) - (let [(^open "list@.") (list.equivalence n.equivalence)]) + (let [(^open "list\.") (list.equivalence n.equivalence)]) (do {! random.monad} [repeated random.nat index (:: ! map (n.% 100) random.nat) @@ -56,38 +56,38 @@ (n.= repeated (/.nth index (/.repeat repeated)))) (_.cover [/.take] - (list@= (enum.range n.enum offset (dec (n.+ size offset))) + (list\= (enum.range n.enum offset (dec (n.+ size offset))) (/.take size (/.iterate inc offset)))) (_.cover [/.drop] - (list@= (enum.range n.enum offset (dec (n.+ size offset))) + (list\= (enum.range n.enum offset (dec (n.+ size offset))) (/.take size (/.drop offset (/.iterate inc 0))))) (_.cover [/.split] (let [[drops takes] (/.split size (/.iterate inc 0))] - (and (list@= (enum.range n.enum 0 (dec size)) + (and (list\= (enum.range n.enum 0 (dec size)) drops) - (list@= (enum.range n.enum size (dec (n.* 2 size))) + (list\= (enum.range n.enum size (dec (n.* 2 size))) (/.take size takes))))) (_.cover [/.take-while] - (list@= (enum.range n.enum 0 (dec size)) + (list\= (enum.range n.enum 0 (dec size)) (/.take-while (n.< size) (/.iterate inc 0)))) (_.cover [/.drop-while] - (list@= (enum.range n.enum offset (dec (n.+ size offset))) + (list\= (enum.range n.enum offset (dec (n.+ size offset))) (/.take-while (n.< (n.+ size offset)) (/.drop-while (n.< offset) (/.iterate inc 0))))) (_.cover [/.split-while] (let [[drops takes] (/.split-while (n.< size) (/.iterate inc 0))] - (and (list@= (enum.range n.enum 0 (dec size)) + (and (list\= (enum.range n.enum 0 (dec size)) drops) - (list@= (enum.range n.enum size (dec (n.* 2 size))) + (list\= (enum.range n.enum size (dec (n.* 2 size))) (/.take-while (n.< (n.* 2 size)) takes))))) (_.cover [/.head] (n.= offset (/.head (/.iterate inc offset)))) (_.cover [/.tail] - (list@= (enum.range n.enum (inc offset) (n.+ size offset)) + (list\= (enum.range n.enum (inc offset) (n.+ size offset)) (/.take size (/.tail (/.iterate inc offset))))) (_.cover [/.filter] - (list@= (list@map (n.* 2) (enum.range n.enum 0 (dec size))) + (list\= (list\map (n.* 2) (enum.range n.enum 0 (dec size))) (/.take size (/.filter n.even? (/.iterate inc 0))))) (_.cover [/.partition] (let [[evens odds] (/.partition n.even? (/.iterate inc 0))] @@ -96,16 +96,16 @@ (n.= (inc (n.* 2 offset)) (/.nth offset odds))))) (_.cover [/.unfold] - (let [(^open "/@.") /.functor - (^open "list@.") (list.equivalence text.equivalence)] - (list@= (/.take size - (/@map %.nat (/.iterate inc offset))) + (let [(^open "/\.") /.functor + (^open "list\.") (list.equivalence text.equivalence)] + (list\= (/.take size + (/\map %.nat (/.iterate inc offset))) (/.take size (/.unfold (function (_ n) [(inc n) (%.nat n)]) offset))))) (_.cover [/.cycle] (let [cycle (list& cycle-start cycle-next)] - (list@= (list.concat (list.repeat size cycle)) + (list\= (list.concat (list.repeat size cycle)) (/.take (n.* size (list.size cycle)) (/.cycle [cycle-start cycle-next]))))) (_.cover [/.^sequence&] diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux index 93549712f..3525a5fc8 100644 --- a/stdlib/source/test/lux/data/collection/set.lux +++ b/stdlib/source/test/lux/data/collection/set.lux @@ -9,7 +9,7 @@ ["$." equivalence] ["$." monoid]]}] [data - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] [number ["n" nat]] [collection @@ -28,7 +28,7 @@ Test (<| (_.covering /._) (_.with-cover [/.Set]) - (let [(^open "/@.") /.equivalence]) + (let [(^open "/\.") /.equivalence]) (do random.monad [size ..gen-nat] ($_ _.and @@ -48,10 +48,10 @@ (_.cover [/.size] (n.= sizeL (/.size setL))) (_.cover [/.empty?] - (bit@= (/.empty? setL) + (bit\= (/.empty? setL) (n.= 0 (/.size setL)))) (_.cover [/.to-list /.from-list] - (|> setL /.to-list (/.from-list n.hash) (/@= setL))) + (|> setL /.to-list (/.from-list n.hash) (/\= setL))) (_.cover [/.member?] (and (list.every? (/.member? setL) (/.to-list setL)) (not (/.member? setL non-memberL)))) @@ -72,12 +72,12 @@ (|> setL (/.add non-memberL) (/.remove non-memberL) - (/@= setL)) + (/\= setL)) idempotency! (|> setL (/.remove non-memberL) - (/@= setL))] + (/\= setL))] (and symmetry! idempotency!))) (_.cover [/.union /.sub?] @@ -90,7 +90,7 @@ union-with-empty-set! (|> setL (/.union (/.new n.hash)) - (/@= setL))] + (/\= setL))] (and sets-are-subs-of-their-unions! union-with-empty-set!))) (_.cover [/.intersection /.super?] diff --git a/stdlib/source/test/lux/data/collection/set/multi.lux b/stdlib/source/test/lux/data/collection/set/multi.lux index 039f67200..8e376ba17 100644 --- a/stdlib/source/test/lux/data/collection/set/multi.lux +++ b/stdlib/source/test/lux/data/collection/set/multi.lux @@ -9,12 +9,12 @@ [/ ["$." equivalence]]}] [data - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] [number ["n" nat]] [collection ["." set] - ["." list ("#@." fold)]]] + ["." list ("#\." fold)]]] [math ["." random (#+ Random)]]] {1 @@ -29,7 +29,7 @@ (do {! random.monad} [elements (random.set hash size element) element-counts (random.list size ..count)] - (wrap (list@fold (function (_ [count element] set) + (wrap (list\fold (function (_ [count element] set) (/.add count element set)) (/.new hash) (list.zip/2 element-counts @@ -60,7 +60,7 @@ (n.= (list.size (/.to-list sample)) (/.size sample))) (_.cover [/.empty?] - (bit@= (/.empty? sample) + (bit\= (/.empty? sample) (n.= 0 (/.size sample)))) (_.cover [/.new] (/.empty? (/.new n.hash))) diff --git a/stdlib/source/test/lux/data/collection/stack.lux b/stdlib/source/test/lux/data/collection/stack.lux index 80b7fce63..bc2082846 100644 --- a/stdlib/source/test/lux/data/collection/stack.lux +++ b/stdlib/source/test/lux/data/collection/stack.lux @@ -9,7 +9,7 @@ ["$." functor (#+ Injection)]]}] [data ["." maybe] - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] [number ["n" nat]]] [math @@ -38,7 +38,7 @@ (_.cover [/.size] (n.= size (/.size sample))) (_.cover [/.empty?] - (bit@= (n.= 0 (/.size sample)) + (bit\= (n.= 0 (/.size sample)) (/.empty? sample))) (_.cover [/.empty] (/.empty? /.empty)) diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux index ccd4a1d70..9224e5654 100644 --- a/stdlib/source/test/lux/data/collection/tree.lux +++ b/stdlib/source/test/lux/data/collection/tree.lux @@ -13,7 +13,7 @@ [number ["n" nat]] [collection - ["." list ("#@." functor fold)]]] + ["." list ("#\." functor fold)]]] [math ["." random (#+ Random)]]] {1 @@ -26,10 +26,10 @@ num-children (:: ! map (n.% 2) random.nat) children (random.list num-children (tree gen-value))] (wrap [(|> children - (list@map product.left) - (list@fold n.+ 1)) + (list\map product.left) + (list\fold n.+ 1)) {#/.value value - #/.children (list@map product.right children)}]))) + #/.children (list\map product.right children)}]))) (def: #export test Test @@ -63,7 +63,7 @@ (_.cover [/.branch] (:: (list.equivalence n.equivalence) = (list& value children) - (/.flatten (/.branch value (list@map /.leaf children)))))) + (/.flatten (/.branch value (list\map /.leaf children)))))) (do random.monad [expected/0 random.nat expected/1 random.nat diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index ca84d8b07..d81ff7220 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -20,8 +20,7 @@ ["." math ["." random (#+ Random)]]] {1 - ["." / (#+ Color) - ["." named]]}) + ["." / (#+ Color)]}) (def: #export color (Random Color) diff --git a/stdlib/source/test/lux/data/color/named.lux b/stdlib/source/test/lux/data/color/named.lux new file mode 100644 index 000000000..609c847cf --- /dev/null +++ b/stdlib/source/test/lux/data/color/named.lux @@ -0,0 +1,240 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [data + [number + ["n" nat]] + [collection + ["." list] + ["." set]]] + [macro + ["." template]] + [math + ["." random (#+ Random)]]] + {1 + ["." / + ["/#" //]]}) + +(with-expansions [<colors> (as-is [letter/a + [/.alice-blue + /.antique-white + ## /.aqua + /.aquamarine + /.azure]] + + [letter/b + [/.beige + /.bisque + /.black + /.blanched-almond + /.blue + /.blue-violet + /.brown + /.burly-wood]] + + [letter/c + [/.cadet-blue + /.chartreuse + /.chocolate + /.coral + /.cornflower-blue + /.cornsilk + /.crimson + /.cyan]] + + [letter/d + [/.dark-blue + /.dark-cyan + /.dark-goldenrod + /.dark-gray + /.dark-green + /.dark-khaki + /.dark-magenta + /.dark-olive-green + /.dark-orange + /.dark-orchid + /.dark-red + /.dark-salmon + /.dark-sea-green + /.dark-slate-blue + /.dark-slate-gray + /.dark-turquoise + /.dark-violet + /.deep-pink + /.deep-sky-blue + /.dim-gray + /.dodger-blue]] + + [letter/f + [/.fire-brick + /.floral-white + /.forest-green + ## /.fuchsia + ]] + + [letter/g + [/.gainsboro + /.ghost-white + /.gold + /.goldenrod + /.gray + /.green + /.green-yellow]] + + [letter/h + [/.honey-dew + /.hot-pink]] + + [letter/i + [/.indian-red + /.indigo + /.ivory]] + + [letter/k + [/.khaki]] + + [letter/l + [/.lavender + /.lavender-blush + /.lawn-green + /.lemon-chiffon + /.light-blue + /.light-coral + /.light-cyan + /.light-goldenrod-yellow + /.light-gray + /.light-green + /.light-pink + /.light-salmon + /.light-sea-green + /.light-sky-blue + /.light-slate-gray + /.light-steel-blue + /.light-yellow + /.lime + /.lime-green + /.linen]] + + [letter/m + [/.magenta + /.maroon + /.medium-aquamarine + /.medium-blue + /.medium-orchid + /.medium-purple + /.medium-sea-green + /.medium-slate-blue + /.medium-spring-green + /.medium-turquoise + /.medium-violet-red + /.midnight-blue + /.mint-cream + /.misty-rose + /.moccasin]] + + [letter/n + [/.navajo-white + /.navy]] + + [letter/o + [/.old-lace + /.olive + /.olive-drab + /.orange + /.orange-red + /.orchid]] + + [letter/p + [/.pale-goldenrod + /.pale-green + /.pale-turquoise + /.pale-violet-red + /.papaya-whip + /.peach-puff + /.peru + /.pink + /.plum + /.powder-blue + /.purple]] + + [letter/r + [/.rebecca-purple + /.red + /.rosy-brown + /.royal-blue]] + + [letter/s + [/.saddle-brown + /.salmon + /.sandy-brown + /.sea-green + /.sea-shell + /.sienna + /.silver + /.sky-blue + /.slate-blue + /.slate-gray + /.snow + /.spring-green + /.steel-blue]] + + [letter/t + [/.tan + /.teal + /.thistle + /.tomato + /.turquoise]] + + [letter/v + [/.violet]] + + [letter/w + [/.wheat + /.white + /.white-smoke]] + + [letter/y + [/.yellow + /.yellow-green]] + ) + <named> (template [<definition> <by-letter>] + [((: (-> Any (List //.Color)) + (function (_ _) + (`` (list (~~ (template.splice <by-letter>)))))) + 123)] + + <colors>)] + (def: all-colors + (list.concat (list <named>))) + + (def: unique-colors + (set.from-list //.hash ..all-colors)) + + (def: verdict + (n.= (list.size ..all-colors) + (set.size ..unique-colors))) + + (template [<definition> <by-letter>] + [(def: <definition> + Test + (`` (_.cover <by-letter> + ..verdict)))] + + <colors>) + + (def: #export test + Test + (<| (_.covering /._) + (`` ($_ _.and + (~~ (template [<definition> <by-letter>] + [<definition>] + + <colors>)) + (_.cover [/.aqua] + (:: //.equivalence = /.cyan /.aqua)) + (_.cover [/.fuchsia] + (:: //.equivalence = /.magenta /.fuchsia)) + )))) + ) diff --git a/stdlib/source/test/lux/data/maybe.lux b/stdlib/source/test/lux/data/maybe.lux index 24114f6c0..139c63e4c 100644 --- a/stdlib/source/test/lux/data/maybe.lux +++ b/stdlib/source/test/lux/data/maybe.lux @@ -11,7 +11,7 @@ ["$." apply] ["$." monad]]}] [control - ["." io ("#@." monad)] + ["." io ("#\." monad)] pipe] [data ["." text] @@ -22,7 +22,7 @@ [math ["." random (#+ Random)]]] {1 - ["." / ("#@." monoid monad)]}) + ["." / ("#\." monoid monad)]}) (def: #export test Test @@ -34,11 +34,11 @@ (_.with-cover [/.monoid] ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.maybe random.nat))) (_.with-cover [/.functor] - ($functor.spec /@wrap /.equivalence /.functor)) + ($functor.spec /\wrap /.equivalence /.functor)) (_.with-cover [/.apply] - ($apply.spec /@wrap /.equivalence /.apply)) + ($apply.spec /\wrap /.equivalence /.apply)) (_.with-cover [/.monad] - ($monad.spec /@wrap /.equivalence /.monad)) + ($monad.spec /\wrap /.equivalence /.monad)) (do random.monad [left random.nat @@ -47,7 +47,7 @@ (let [lift (/.lift io.monad)] (_.cover [/.with /.lift] (|> (io.run (do (/.with io.monad) - [a (lift (io@wrap left)) + [a (lift (io\wrap left)) b (wrap right)] (wrap (n.+ a b)))) (case> (#.Some actual) diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux index bf5c6e876..e3778202c 100644 --- a/stdlib/source/test/lux/data/name.lux +++ b/stdlib/source/test/lux/data/name.lux @@ -13,7 +13,7 @@ [data [number ["n" nat]] - ["." text ("#@." equivalence)]] + ["." text ("#\." equivalence)]] [math ["." random (#+ Random)]]] {1 @@ -49,10 +49,10 @@ ($order.spec /.order (..name sizeM1 sizeS1))) (_.with-cover [/.codec] (_.and ($codec.spec /.equivalence /.codec (..name sizeM1 sizeS1)) - (let [(^open "/@.") /.codec] + (let [(^open "/\.") /.codec] (_.test "Encoding an name without a module component results in text equal to the short of the name." (if (text.empty? module1) - (text@= short1 (/@encode name1)) + (text\= short1 (/\encode name1)) #1))))) (_.cover [/.module /.short] @@ -60,16 +60,16 @@ (is? short1 (/.short name1)))) (_.with-cover [.name-of] - (let [(^open "/@.") /.equivalence] + (let [(^open "/\.") /.equivalence] ($_ _.and (_.test "Can obtain Name from identifier." - (and (/@= ["lux" "yolo"] (.name-of .yolo)) - (/@= ["test/lux/data/name" "yolo"] (.name-of ..yolo)) - (/@= ["" "yolo"] (.name-of yolo)) - (/@= ["lux/test" "yolo"] (.name-of lux/test.yolo)))) + (and (/\= ["lux" "yolo"] (.name-of .yolo)) + (/\= ["test/lux/data/name" "yolo"] (.name-of ..yolo)) + (/\= ["" "yolo"] (.name-of yolo)) + (/\= ["lux/test" "yolo"] (.name-of lux/test.yolo)))) (_.test "Can obtain Name from tag." - (and (/@= ["lux" "yolo"] (.name-of #.yolo)) - (/@= ["test/lux/data/name" "yolo"] (.name-of #..yolo)) - (/@= ["" "yolo"] (.name-of #yolo)) - (/@= ["lux/test" "yolo"] (.name-of #lux/test.yolo))))))) + (and (/\= ["lux" "yolo"] (.name-of #.yolo)) + (/\= ["test/lux/data/name" "yolo"] (.name-of #..yolo)) + (/\= ["" "yolo"] (.name-of #yolo)) + (/\= ["lux/test" "yolo"] (.name-of #lux/test.yolo))))))) ))))) diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/data/number/complex.lux index 091814105..13497bfa5 100644 --- a/stdlib/source/test/lux/data/number/complex.lux +++ b/stdlib/source/test/lux/data/number/complex.lux @@ -15,7 +15,7 @@ ["." int] ["f" frac]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] ["." math ["r" random (#+ Random)]]] {1 @@ -189,7 +189,7 @@ (_.test "Can calculate the N roots for any complex number." (|> sample (/.roots degree) - (list@map (/.pow' (|> degree .int int.frac))) + (list\map (/.pow' (|> degree .int int.frac))) (list.every? (within? margin-of-error sample)))))) (def: #export test diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index 6a4130229..3ae126887 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -13,7 +13,7 @@ [number ["n" nat]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [math ["." random]]] {1 @@ -65,7 +65,7 @@ ($_ _.and (_.cover [/.lefts] (let [actual (: (List (| Nat Nat)) - (list@map /.left expected))] + (list\map /.left expected))] (and (:: (list.equivalence n.equivalence) = expected (/.lefts actual)) @@ -74,7 +74,7 @@ (/.rights actual))))) (_.cover [/.rights] (let [actual (: (List (| Nat Nat)) - (list@map /.right expected))] + (list\map /.right expected))] (and (:: (list.equivalence n.equivalence) = expected (/.rights actual)) @@ -83,7 +83,7 @@ (/.lefts actual))))) (_.cover [/.partition] (let [[lefts rights] (|> expected - (list@map (function (_ value) + (list\map (function (_ value) (if (n.even? value) (/.left value) (/.right value)))) diff --git a/stdlib/source/test/lux/math/infix.lux b/stdlib/source/test/lux/math/infix.lux index 8085d5f98..87f1c9d57 100644 --- a/stdlib/source/test/lux/math/infix.lux +++ b/stdlib/source/test/lux/math/infix.lux @@ -5,7 +5,7 @@ ["r" math/random] ["_" test (#+ Test)] [data - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] [number ["n" nat] ["f" frac]]]] @@ -35,11 +35,11 @@ (n.= (n.gcd extra (n.* parameter subject)) (/.infix [(n.* parameter subject) n.gcd extra]))) (_.test "Can use non-numerical functions/macros as operators." - (bit@= (and (n.< parameter subject) (n.< extra parameter)) + (bit\= (and (n.< parameter subject) (n.< extra parameter)) (/.infix [[subject n.< parameter] and [parameter n.< extra]]))) (_.test "Can combine bit operations in special ways via special keywords." - (and (bit@= (and (n.< parameter subject) (n.< extra parameter)) + (and (bit\= (and (n.< parameter subject) (n.< extra parameter)) (/.infix [#and subject n.< parameter n.< extra])) - (bit@= (and (n.< parameter subject) (n.> extra parameter)) + (bit\= (and (n.< parameter subject) (n.> extra parameter)) (/.infix [#and subject n.< parameter n.> extra])))) )))) diff --git a/stdlib/source/test/lux/math/logic/fuzzy.lux b/stdlib/source/test/lux/math/logic/fuzzy.lux index 16e9116c1..56e03277a 100644 --- a/stdlib/source/test/lux/math/logic/fuzzy.lux +++ b/stdlib/source/test/lux/math/logic/fuzzy.lux @@ -8,7 +8,7 @@ ["." random (#+ Random)]] ["_" test (#+ Test)] [data - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] [number ["n" nat] ["r" rev]] @@ -47,11 +47,11 @@ (and (r.= //.false (/.membership bottom triangle)) (r.= //.false (/.membership top triangle)))) (_.test "Values within range, will have membership > 0." - (bit@= (r.> //.false (/.membership sample triangle)) + (bit\= (r.> //.false (/.membership sample triangle)) (and (<gt> bottom sample) (<lt> top sample)))) (_.test "Values outside of range, will have membership = 0." - (bit@= (r.= //.false (/.membership sample triangle)) + (bit\= (r.= //.false (/.membership sample triangle)) (or (<lte> bottom sample) (<gte> top sample)))) ))))] @@ -87,15 +87,15 @@ (and (r.= //.false (/.membership bottom trapezoid)) (r.= //.false (/.membership top trapezoid)))) (_.test "Values within inner range will have membership = 1" - (bit@= (r.= //.true (/.membership sample trapezoid)) + (bit\= (r.= //.true (/.membership sample trapezoid)) (and (<gte> middle-bottom sample) (<lte> middle-top sample)))) (_.test "Values within range, will have membership > 0." - (bit@= (r.> //.false (/.membership sample trapezoid)) + (bit\= (r.> //.false (/.membership sample trapezoid)) (and (<gt> bottom sample) (<lt> top sample)))) (_.test "Values outside of range, will have membership = 0." - (bit@= (r.= //.false (/.membership sample trapezoid)) + (bit\= (r.= //.false (/.membership sample trapezoid)) (or (<lte> bottom sample) (<gte> top sample)))) ))))] @@ -148,10 +148,10 @@ sample (|> random.nat (:: ! map (n.% 20)))] ($_ _.and (_.test (%.name (name-of /.from-predicate)) - (bit@= (r.= //.true (/.membership sample (/.from-predicate n.even?))) + (bit\= (r.= //.true (/.membership sample (/.from-predicate n.even?))) (n.even? sample))) (_.test (%.name (name-of /.from-set)) - (bit@= (r.= //.true (/.membership sample (/.from-set set-10))) + (bit\= (r.= //.true (/.membership sample (/.from-set set-10))) (set.member? set-10 sample))) ))) @@ -166,10 +166,10 @@ (<| (_.context (%.name (name-of /.cut))) ($_ _.and (_.test "Can increase the threshold of membership of a fuzzy set." - (bit@= (r.> //.false (/.membership sample vip-fuzzy)) + (bit\= (r.> //.false (/.membership sample vip-fuzzy)) (r.> threshold (/.membership sample fuzzy)))) (_.test "Can turn fuzzy sets into predicates through a threshold." - (bit@= (member? sample) + (bit\= (member? sample) (r.> threshold (/.membership sample fuzzy)))) )))) diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/modular.lux index 96a80dc4c..27cb63f68 100644 --- a/stdlib/source/test/lux/math/modular.lux +++ b/stdlib/source/test/lux/math/modular.lux @@ -8,10 +8,10 @@ ["." try]] [data ["." product] - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] [number ["i" int]]] - ["." type ("#@." equivalence)]] + ["." type ("#\." equivalence)]] {1 ["." /]}) @@ -44,7 +44,7 @@ (-> Int Int Bit) (-> (/.Mod m) (/.Mod m) Bit))) (function (_ param subject) - (bit@= (m/? param subject) + (bit\= (m/? param subject) (i/? (value param) (value subject))))) @@ -73,11 +73,11 @@ #let [copyM (|> normalM /.to-int /.from-int try.assume)]] ($_ _.and (_.test "Every modulus has a unique type, even if the numeric value is the same as another." - (and (type@= (:of normalM) + (and (type\= (:of normalM) (:of normalM)) - (not (type@= (:of normalM) + (not (type\= (:of normalM) (:of alternativeM))) - (not (type@= (:of normalM) + (not (type\= (:of normalM) (:of copyM))))) (_.test "Can extract the original integer from the modulus." (i.= _normalM @@ -90,11 +90,11 @@ ((comparison /.> i.>) param subject) ((comparison /.>= i.>=) param subject))) (_.test "Mod'ed values are ordered." - (and (bit@= (/.< param subject) + (and (bit\= (/.< param subject) (not (/.>= param subject))) - (bit@= (/.> param subject) + (bit\= (/.> param subject) (not (/.<= param subject))) - (bit@= (/.= param subject) + (bit\= (/.= param subject) (not (or (/.< param subject) (/.> param subject)))))) (_.test "Can do arithmetic." @@ -137,6 +137,6 @@ (_.test "All numbers are congruent to themselves." (/.congruent? normalM _subject _subject)) (_.test "If 2 numbers are congruent under a modulus, then they must also be equal under the same modulus." - (bit@= (/.congruent? normalM _param _subject) + (bit\= (/.congruent? normalM _param _subject) (/.= param subject))) )))) diff --git a/stdlib/source/test/lux/time/day.lux b/stdlib/source/test/lux/time/day.lux index a654b069c..ffe896cdc 100644 --- a/stdlib/source/test/lux/time/day.lux +++ b/stdlib/source/test/lux/time/day.lux @@ -9,19 +9,19 @@ ["$." order] ["$." enum]]}] [math - ["r" random (#+ Random) ("#@." monad)]]] + ["r" random (#+ Random) ("#\." monad)]]] {1 ["." / (#+ Day)]}) (def: #export day (Random Day) - (r.either (r.either (r.either (r@wrap #/.Sunday) - (r@wrap #/.Monday)) - (r.either (r@wrap #/.Tuesday) - (r@wrap #/.Wednesday))) - (r.either (r.either (r@wrap #/.Thursday) - (r@wrap #/.Friday)) - (r@wrap #/.Saturday)))) + (r.either (r.either (r.either (r\wrap #/.Sunday) + (r\wrap #/.Monday)) + (r.either (r\wrap #/.Tuesday) + (r\wrap #/.Wednesday))) + (r.either (r.either (r\wrap #/.Thursday) + (r\wrap #/.Friday)) + (r\wrap #/.Saturday)))) (def: #export test Test diff --git a/stdlib/source/test/lux/time/month.lux b/stdlib/source/test/lux/time/month.lux index 180bdb604..1ebd3810c 100644 --- a/stdlib/source/test/lux/time/month.lux +++ b/stdlib/source/test/lux/time/month.lux @@ -9,24 +9,24 @@ ["$." order] ["$." enum]]}] [math - ["r" random (#+ Random) ("#@." monad)]]] + ["r" random (#+ Random) ("#\." monad)]]] {1 ["." / (#+ Month)]}) (def: #export month (Random Month) - (r.either (r.either (r.either (r@wrap #/.January) - (r.either (r@wrap #/.February) - (r@wrap #/.March))) - (r.either (r@wrap #/.April) - (r.either (r@wrap #/.May) - (r@wrap #/.June)))) - (r.either (r.either (r@wrap #/.July) - (r.either (r@wrap #/.August) - (r@wrap #/.September))) - (r.either (r@wrap #/.October) - (r.either (r@wrap #/.November) - (r@wrap #/.December)))))) + (r.either (r.either (r.either (r\wrap #/.January) + (r.either (r\wrap #/.February) + (r\wrap #/.March))) + (r.either (r\wrap #/.April) + (r.either (r\wrap #/.May) + (r\wrap #/.June)))) + (r.either (r.either (r\wrap #/.July) + (r.either (r\wrap #/.August) + (r\wrap #/.September))) + (r.either (r\wrap #/.October) + (r.either (r\wrap #/.November) + (r\wrap #/.December)))))) (def: #export test Test |