diff options
84 files changed, 1235 insertions, 1153 deletions
diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 267ea3465..6a1521909 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -195,19 +195,6 @@ analyse-frac-encode ["f64" "encode"] analyse-frac-decode ["f64" "decode"] &type/Frac ) -(do-template [<name> <type> <op>] - (defn- <name> [analyse exo-type ?values] - (|do [:let [(&/$Nil) ?values] - _ (&type/check exo-type <type>) - _location &/location] - (return (&/|list (&&/|meta exo-type _location - (&&/$proc (&/T <op>) (&/|list) (&/|list))))))) - - analyse-frac-smallest &type/Frac ["f64" "smallest"] - analyse-frac-min &type/Frac ["f64" "min"] - analyse-frac-max &type/Frac ["f64" "max"] - ) - (do-template [<name> <from-type> <to-type> <op>] (defn- <name> [analyse exo-type ?values] (|do [:let [(&/$Cons x (&/$Nil)) ?values] @@ -300,9 +287,6 @@ "lux f64 <" (analyse-frac-lt analyse exo-type ?values) "lux f64 encode" (analyse-frac-encode analyse exo-type ?values) "lux f64 decode" (analyse-frac-decode analyse exo-type ?values) - "lux f64 smallest" (analyse-frac-smallest analyse exo-type ?values) - "lux f64 min" (analyse-frac-min analyse exo-type ?values) - "lux f64 max" (analyse-frac-max analyse exo-type ?values) "lux f64 i64" (analyse-frac-int analyse exo-type ?values) ;; Special extensions for performance reasons diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index d7023bae0..d4c825282 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -146,20 +146,6 @@ ^:private compile-frac-lt Opcodes/DCMPG -1 &&/unwrap-double ) -(do-template [<name> <instr>] - (defn <name> [compile ?values special-args] - (|do [:let [(&/$Nil) ?values] - ^MethodVisitor *writer* &/get-writer - :let [_ (doto *writer* - (.visitLdcInsn <instr>) - &&/wrap-double)]] - (return nil))) - - ^:private compile-frac-smallest Double/MIN_VALUE - ^:private compile-frac-min (* -1.0 Double/MAX_VALUE) - ^:private compile-frac-max Double/MAX_VALUE - ) - (defn ^:private compile-frac-encode [compile ?values special-args] (|do [:let [(&/$Cons ?input (&/$Nil)) ?values] ^MethodVisitor *writer* &/get-writer @@ -458,19 +444,16 @@ "f64" (case proc - "+" (compile-frac-add compile ?values special-args) - "-" (compile-frac-sub compile ?values special-args) - "*" (compile-frac-mul compile ?values special-args) - "/" (compile-frac-div compile ?values special-args) - "%" (compile-frac-rem compile ?values special-args) - "=" (compile-frac-eq compile ?values special-args) - "<" (compile-frac-lt compile ?values special-args) - "smallest" (compile-frac-smallest compile ?values special-args) - "max" (compile-frac-max compile ?values special-args) - "min" (compile-frac-min compile ?values special-args) + "+" (compile-frac-add compile ?values special-args) + "-" (compile-frac-sub compile ?values special-args) + "*" (compile-frac-mul compile ?values special-args) + "/" (compile-frac-div compile ?values special-args) + "%" (compile-frac-rem compile ?values special-args) + "=" (compile-frac-eq compile ?values special-args) + "<" (compile-frac-lt compile ?values special-args) "i64" (compile-frac-int compile ?values special-args) - "encode" (compile-frac-encode compile ?values special-args) - "decode" (compile-frac-decode compile ?values special-args) + "encode" (compile-frac-encode compile ?values special-args) + "decode" (compile-frac-decode compile ?values special-args) ) ;; else diff --git a/stdlib/source/lux/data/collection/queue/priority.lux b/stdlib/source/lux/data/collection/queue/priority.lux index 555c7b8d3..36f827f86 100644 --- a/stdlib/source/lux/data/collection/queue/priority.lux +++ b/stdlib/source/lux/data/collection/queue/priority.lux @@ -8,104 +8,111 @@ [number ["n" nat ("#@." interval)]] [collection - [tree - ["." finger (#+ Tree)]]]]]) + ["." tree #_ + ["#" finger (#+ Tree)]]]] + [type (#+ :by-example) + [abstract (#+ abstract: :abstraction :representation)]]]) -(type: #export Priority Nat) - -(type: #export (Queue a) - (Maybe (Tree Priority a))) +(type: #export Priority + Nat) (def: #export max Priority n@top) (def: #export min Priority n@bottom) -(def: #export empty - Queue - #.None) +(def: builder + (tree.builder n.maximum)) -(def: #export (peek queue) - (All [a] (-> (Queue a) (Maybe a))) - (do maybe.monad - [fingers queue] - (wrap (maybe.assume (finger.search (n.= (finger.tag fingers)) fingers))))) +(def: :@: + (:by-example [@] + {(tree.Builder @ Priority) + ..builder} + @)) -(def: #export (size queue) - (All [a] (-> (Queue a) Nat)) - (case queue - #.None - 0 +(abstract: #export (Queue a) + (Maybe (Tree :@: Priority a)) - (#.Some fingers) - (loop [node (get@ #finger.node fingers)] - (case node - (#finger.Leaf _ _) - 1 + (def: #export empty + Queue + (:abstraction #.None)) - (#finger.Branch _ left right) - (n.+ (recur left) (recur right)))))) + (def: #export (peek queue) + (All [a] (-> (Queue a) (Maybe a))) + (do maybe.monad + [tree (:representation queue)] + (tree.search (n.= (tree.tag tree)) + tree))) -(def: #export empty? - (All [a] (-> (Queue a) Bit)) - (|>> ..size (n.= 0))) + (def: #export (size queue) + (All [a] (-> (Queue a) Nat)) + (case (:representation queue) + #.None + 0 -(def: #export (member? equivalence queue member) - (All [a] (-> (Equivalence a) (Queue a) a Bit)) - (case queue - #.None - #0 - - (#.Some fingers) - (loop [node (get@ #finger.node fingers)] - (case node - (#finger.Leaf _ reference) - (:: equivalence = reference member) - - (#finger.Branch _ left right) - (or (recur left) - (recur right)))))) - -(def: #export (pop queue) - (All [a] (-> (Queue a) (Queue a))) - (do maybe.monad - [fingers queue - #let [highest-priority (finger.tag fingers)] - node' (loop [node (get@ #finger.node fingers)] - (case node - (#finger.Leaf priority reference) - (if (n.= highest-priority priority) - #.None - (#.Some node)) - - (#finger.Branch priority left right) - (if (n.= highest-priority (finger.tag (set@ #finger.node left fingers))) - (case (recur left) - #.None - (#.Some right) - - (#.Some =left) - (|> (finger.branch (set@ #finger.node =left fingers) - (set@ #finger.node right fingers)) - (get@ #finger.node) - #.Some)) - (case (recur right) - #.None - (#.Some left) - - (#.Some =right) - (|> (finger.branch (set@ #finger.node left fingers) - (set@ #finger.node =right fingers)) - (get@ #finger.node) - #.Some)) - )))] - (wrap (set@ #finger.node node' fingers)))) - -(def: #export (push priority value queue) - (All [a] (-> Priority a (Queue a) (Queue a))) - (let [addition {#finger.monoid n.maximum - #finger.node (#finger.Leaf priority value)}] - (case queue + (#.Some tree) + (loop [node tree] + (case (tree.root node) + (0 #0 _) + 1 + + (0 #1 [left right]) + (n.+ (recur left) (recur right)))))) + + (def: #export (member? equivalence queue member) + (All [a] (-> (Equivalence a) (Queue a) a Bit)) + (case (:representation queue) #.None - (#.Some addition) + false + + (#.Some tree) + (loop [node tree] + (case (tree.root node) + (0 #0 reference) + (:: equivalence = reference member) + + (0 #1 [left right]) + (or (recur left) + (recur right)))))) + + (def: #export (pop queue) + (All [a] (-> (Queue a) (Queue a))) + (:abstraction + (do maybe.monad + [tree (:representation queue) + #let [highest-priority (tree.tag tree)]] + (loop [node tree] + (case (tree.root node) + (0 #0 reference) + (if (n.= highest-priority (tree.tag node)) + #.None + (#.Some node)) + + (0 #1 left right) + (if (n.= highest-priority (tree.tag left)) + (case (recur left) + #.None + (#.Some right) + + (#.Some =left) + (#.Some (:: ..builder branch =left right))) + (case (recur right) + #.None + (#.Some left) + + (#.Some =right) + (#.Some (:: ..builder branch left =right))))))))) + + (def: #export (push priority value queue) + (All [a] (-> Priority a (Queue a) (Queue a))) + (let [addition (:: ..builder leaf priority value)] + (:abstraction + (case (:representation queue) + #.None + (#.Some addition) + + (#.Some tree) + (#.Some (:: ..builder branch tree addition)))))) + ) - (#.Some fingers) - (#.Some (finger.branch fingers addition))))) +(def: #export empty? + (All [a] (-> (Queue a) Bit)) + (|>> ..size (n.= 0))) diff --git a/stdlib/source/lux/data/collection/tree/finger.lux b/stdlib/source/lux/data/collection/tree/finger.lux index 3a6e52948..e120b068a 100644 --- a/stdlib/source/lux/data/collection/tree/finger.lux +++ b/stdlib/source/lux/data/collection/tree/finger.lux @@ -2,62 +2,83 @@ [lux #* [abstract [predicate (#+ Predicate)] - ["." monoid (#+ Monoid)]]]) - -(type: #export (Node m a) - (#Leaf m a) - (#Branch m (Node m a) (Node m a))) - -(type: #export (Tree m a) - {#monoid (Monoid m) - #node (Node m a)}) - -(def: #export (tag tree) - (All [m a] (-> (Tree m a) m)) - (case (get@ #node tree) - (^or (#Leaf tag _) - (#Branch tag _ _)) - tag)) - -(def: #export (value tree) - (All [m a] (-> (Tree m a) a)) - (case (get@ #node tree) - (#Leaf tag value) - value - - (#Branch tag left right) - (value (set@ #node left tree)))) - -(def: #export (branch left right) - (All [m a] (-> (Tree m a) (Tree m a) (Tree m a))) - (let [Monoid<m> (get@ #monoid right)] - {#monoid Monoid<m> - #node (#Branch (:: Monoid<m> compose (tag left) (tag right)) - (get@ #node left) - (get@ #node right))})) - -(def: #export (search pred tree) - (All [m a] (-> (-> m Bit) (Tree m a) (Maybe a))) - (let [tag@compose (get@ [#monoid #monoid.compose] tree)] - (if (pred (tag tree)) - (loop [_tag (get@ [#monoid #monoid.identity] tree) - _node (get@ #node tree)] - (case _node - (#Leaf _ value) - (#.Some value) - - (#Branch _ left right) - (let [shifted-tag (tag@compose _tag (tag (set@ #node left tree)))] - (if (pred shifted-tag) - (recur _tag left) - (recur shifted-tag right))))) - #.None))) + ["." monoid (#+ Monoid)]] + [type (#+ :by-example) + [abstract (#+ abstract: :abstraction :representation)]]]) + +(abstract: #export (Tree @ t v) + {#monoid (Monoid t) + #tag t + #root (| v + [(Tree @ t v) (Tree @ t v)])} + + (signature: #export (Builder @ t) + (: (All [v] + (-> t v (Tree @ t v))) + leaf) + (: (All [v] + (-> (Tree @ t v) + (Tree @ t v) + (Tree @ t v))) + branch)) + + (template [<name> <tag> <output>] + [(def: #export <name> + (All [@ t v] (-> (Tree @ t v) <output>)) + (|>> :representation (get@ <tag>)))] + + [tag #tag t] + [root #root (Either v [(Tree @ t v) (Tree @ t v)])] + ) + + (structure: #export (builder monoid) + (All [t] (Ex [@] (-> (Monoid t) (Builder @ t)))) + + (def: (leaf tag value) + (:abstraction + {#monoid monoid + #tag tag + #root (0 #0 value)})) + + (def: (branch left right) + (:abstraction + {#monoid monoid + #tag (:: monoid compose (..tag left) (..tag right)) + #root (0 #1 [left right])}))) + + (def: #export (value tree) + (All [@ t v] (-> (Tree @ t v) v)) + (case (get@ #root (:representation tree)) + (0 #0 value) + value + + (0 #1 [left right]) + (value left))) + + (def: #export (search predicate tree) + (All [@ t v] (-> (Predicate t) (Tree @ t v) (Maybe v))) + (let [[monoid tag root] (:representation tree)] + (if (predicate tag) + (let [(^open "tag//.") monoid] + (loop [_tag tag//identity + _node root] + (case _node + (0 #0 value) + (#.Some value) + + (0 #1 [left right]) + (let [shifted-tag (tag//compose _tag (..tag left))] + (if (predicate shifted-tag) + (recur _tag (get@ #root (:representation left))) + (recur shifted-tag (get@ #root (:representation right)))))))) + #.None))) + ) (def: #export (found? predicate tree) - (All [m a] (-> (Predicate m) (Tree m a) Bit)) - (case (search predicate tree) + (All [@ t v] (-> (Predicate t) (Tree @ t v) Bit)) + (case (..search predicate tree) (#.Some _) - #1 + true #.None - #0)) + false)) diff --git a/stdlib/source/lux/data/number/frac.lux b/stdlib/source/lux/data/number/frac.lux index 633872f9c..099d01d39 100644 --- a/stdlib/source/lux/data/number/frac.lux +++ b/stdlib/source/lux/data/number/frac.lux @@ -135,6 +135,18 @@ (def: &equivalence ..equivalence) (def: < ..<)) +(def: #export smallest + Frac + (math.pow -1074.0 +2.0)) + +(def: #export biggest + Frac + (let [f2^-52 (math.pow -52.0 +2.0) + f2^+1023 (math.pow +1023.0 +2.0)] + (|> +2.0 + (..- f2^-52) + (..* f2^+1023)))) + (template [<name> <compose> <identity>] [(structure: #export <name> (Monoid Frac) @@ -144,8 +156,8 @@ [addition ..+ +0.0] [multiplication ..* +1.0] - [maximum ..max ("lux f64 min")] - [minimum ..min ("lux f64 max")] + [maximum ..max (..* -1.0 ..biggest)] + [minimum ..min ..biggest] ) (template [<name> <numerator> <doc>] @@ -390,13 +402,12 @@ (let [sign (..signum value) raw-bin (:: ..binary encode value) dot-idx (maybe.assume ("lux text index" 0 "." raw-bin)) - whole-part ("lux text clip" (if (..= -1.0 sign) 1 0) dot-idx raw-bin) - decimal-part ("lux text clip" (inc dot-idx) ("lux text size" raw-bin) raw-bin) - hex-output (|> (<from> #0 decimal-part) - ("lux text concat" ".") - ("lux text concat" (<from> #1 whole-part)) - ("lux text concat" (if (..= -1.0 sign) "-" "")))] - hex-output)) + whole-part ("lux text clip" 1 dot-idx raw-bin) + decimal-part ("lux text clip" (inc dot-idx) ("lux text size" raw-bin) raw-bin)] + (|> (<from> #0 decimal-part) + ("lux text concat" ".") + ("lux text concat" (<from> #1 whole-part)) + ("lux text concat" (if (..= -1.0 sign) "-" "+"))))) (def: (decode repr) (let [sign (case ("lux text index" 0 "-" repr) diff --git a/stdlib/source/lux/data/text/unicode.lux b/stdlib/source/lux/data/text/unicode.lux index 234309ddf..e173034a9 100644 --- a/stdlib/source/lux/data/text/unicode.lux +++ b/stdlib/source/lux/data/text/unicode.lux @@ -8,9 +8,9 @@ ["n" nat ("#@." interval)]] [collection ["." list ("#@." fold functor)] - [tree - ["." finger (#+ Tree)]]]] - [type + ["." tree #_ + ["#" finger (#+ Tree)]]]] + [type (#+ :by-example) abstract]] [// (#+ Char)]) @@ -189,20 +189,29 @@ [basic-latin/lower-alpha "0061" "007A"] ) +(def: builder + (tree.builder ..monoid)) + +(def: :@: + (:by-example [@] + {(tree.Builder @ Segment) + ..builder} + @)) + (abstract: #export Set - (Tree Segment []) + (Tree :@: Segment []) (def: #export (compose left right) (-> Set Set Set) (:abstraction - (finger.branch (:representation left) - (:representation right)))) + (:: builder branch + (:representation left) + (:representation right)))) (def: (singleton segment) (-> Segment Set) (:abstraction - {#finger.monoid ..monoid - #finger.node (#finger.Leaf segment [])})) + (:: builder leaf segment []))) (def: #export (set [head tail]) (-> [Segment (List Segment)] Set) @@ -341,21 +350,22 @@ (def: #export (range set) (-> Set [Char Char]) - (let [tag (finger.tag (:representation set))] + (let [tag (tree.tag (:representation set))] [(..start tag) (..end tag)])) (def: #export (member? set character) (-> Set Char Bit) - (let [[_monoid node] (:representation set)] - (loop [node node] - (case node - (#finger.Leaf segment _) - (..within? segment character) + (loop [tree (:representation set)] + (if (..within? (tree.tag tree) character) + (case (tree.root tree) + (0 #0 _) + true - (#finger.Branch _ left right) + (0 #1 left right) (or (recur left) - (recur right)))))) + (recur right))) + false))) ) (template [<name> <segments>] diff --git a/stdlib/source/lux/extension.lux b/stdlib/source/lux/extension.lux index b880d6e7d..cb9013f11 100644 --- a/stdlib/source/lux/extension.lux +++ b/stdlib/source/lux/extension.lux @@ -3,14 +3,14 @@ [abstract ["." monad]] [control - ["<>" parser ("#@." monad) + ["<>" parser ("#//." monad) ["<c>" code (#+ Parser)] ["<a>" analysis] ["<s>" synthesis]]] [data ["." product] [collection - ["." list ("#@." functor)]]] + ["." list ("#//." functor)]]] [meta (#+ with-gensyms)] [macro ["." code] @@ -27,7 +27,7 @@ (-> Code (Parser Input)) ($_ <>.and <c>.local-identifier - (<>@wrap default))) + (<>//wrap default))) (def: complex (Parser Input) @@ -60,7 +60,7 @@ [(syntax: #export (<name> {[name extension phase archive inputs] (..declaration (` <any>))} body) - (let [g!parser (case (list@map product.right inputs) + (let [g!parser (case (list//map product.right inputs) #.Nil (` <end>) @@ -73,9 +73,9 @@ (wrap (list (` (<extension> (~ name) (.function ((~ g!handler) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs)) (.case ((~! <run>) (~ g!parser) (~ g!inputs)) - (#.Right [(~+ (list@map (|>> product.left - code.local-identifier) - inputs))]) + (#.Right [(~+ (list//map (|>> product.left + code.local-identifier) + inputs))]) (~ body) (#.Left (~ g!error)) diff --git a/stdlib/source/lux/locale.lux b/stdlib/source/lux/locale.lux index b49909be6..9946753b7 100644 --- a/stdlib/source/lux/locale.lux +++ b/stdlib/source/lux/locale.lux @@ -4,7 +4,7 @@ [equivalence (#+ Equivalence)] [hash (#+ Hash)]] [data - ["." maybe ("#@." functor)] + ["." maybe ("#//." functor)] ["." text ["%" format (#+ format)] ["." encoding (#+ Encoding)]]] @@ -24,10 +24,10 @@ (-> Language (Maybe Territory) (Maybe Encoding) Locale) (:abstraction (format (language.code language) (|> territory - (maybe@map (|>> territory.long-code (format ..territory-separator))) + (maybe//map (|>> territory.long-code (format ..territory-separator))) (maybe.default "")) (|> encoding - (maybe@map (|>> encoding.name (format ..encoding-separator))) + (maybe//map (|>> encoding.name (format ..encoding-separator))) (maybe.default ""))))) (def: #export code diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux index 82ccd1f9d..e2d528dad 100644 --- a/stdlib/source/lux/macro/code.lux +++ b/stdlib/source/lux/macro/code.lux @@ -10,9 +10,9 @@ ["." int] ["." rev] ["." frac]] - ["." text ("#@." monoid equivalence)] + ["." text ("#//." monoid equivalence)] [collection - ["." list ("#@." functor fold)]]] + ["." list ("#//." functor fold)]]] [meta ["." location]]]) @@ -106,33 +106,33 @@ (text.encode value) [_ (#.Tag name)] - (text@compose "#" (:: name.codec encode name)) + (text//compose "#" (:: name.codec encode name)) (^template [<tag> <open> <close>] [_ (<tag> members)] - ($_ text@compose + ($_ text//compose <open> - (list@fold (function (_ next prev) - (let [next (format next)] - (if (text@= "" prev) - next - ($_ text@compose prev " " next)))) - "" - members) + (list//fold (function (_ next prev) + (let [next (format next)] + (if (text//= "" prev) + next + ($_ text//compose prev " " next)))) + "" + members) <close>)) ([#.Form "(" ")"] [#.Tuple "[" "]"]) [_ (#.Record pairs)] - ($_ text@compose + ($_ text//compose "{" - (list@fold (function (_ [left right] prev) - (let [next ($_ text@compose (format left) " " (format right))] - (if (text@= "" prev) - next - ($_ text@compose prev " " next)))) - "" - pairs) + (list//fold (function (_ [left right] prev) + (let [next ($_ text//compose (format left) " " (format right))] + (if (text//= "" prev) + next + ($_ text//compose prev " " next)))) + "" + pairs) "}") )) @@ -144,15 +144,15 @@ (case ast (^template [<tag>] [location (<tag> parts)] - [location (<tag> (list@map (replace original substitute) parts))]) + [location (<tag> (list//map (replace original substitute) parts))]) ([#.Form] [#.Tuple]) [location (#.Record parts)] - [location (#.Record (list@map (function (_ [left right]) - [(replace original substitute left) - (replace original substitute right)]) - parts))] + [location (#.Record (list//map (function (_ [left right]) + [(replace original substitute left) + (replace original substitute right)]) + parts))] _ ast))) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 31f56f16b..328e74ef1 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -13,7 +13,7 @@ [number ["n" nat]] [collection - ["." list ("#@." fold functor)] + ["." list ("#//." fold functor)] ["." dictionary]]] ["." meta (#+ with-gensyms)] [macro @@ -50,7 +50,7 @@ (def: (derivation-name poly args) (-> Text (List Text) (Maybe Text)) (if (common-poly-name? poly) - (#.Some (list@fold (text.replace-once "?") poly args)) + (#.Some (list//fold (text.replace-once "?") poly args)) #.None)) (syntax: #export (derived: {export csr.export} @@ -64,7 +64,7 @@ (wrap name) (^multi #.None - [(derivation-name (product.right poly-func) (list@map product.right poly-args)) + [(derivation-name (product.right poly-func) (list//map product.right poly-args)) (#.Some derived-name)]) (wrap derived-name) @@ -75,7 +75,7 @@ custom-impl #.None - (` ((~ (code.identifier poly-func)) (~+ (list@map code.identifier poly-args)))))]] + (` ((~ (code.identifier poly-func)) (~+ (list//map code.identifier poly-args)))))]] (wrap (.list (` (def: (~+ (csw.export export)) (~ (code.identifier ["" name])) {#.struct? #1} @@ -86,7 +86,7 @@ (case type (#.Primitive name params) (` (#.Primitive (~ (code.text name)) - (list (~+ (list@map (to-code env) params))))) + (list (~+ (list//map (to-code env) params))))) (^template [<tag>] (<tag> idx) @@ -113,7 +113,7 @@ (^template [<macro> <tag> <flattener>] (<tag> left right) - (` (<macro> (~+ (list@map (to-code env) (<flattener> type)))))) + (` (<macro> (~+ (list//map (to-code env) (<flattener> type)))))) ([| #.Sum type.flatten-variant] [& #.Product type.flatten-tuple]) @@ -122,7 +122,7 @@ (^template [<tag>] (<tag> scope body) - (` (<tag> (list (~+ (list@map (to-code env) scope))) + (` (<tag> (list (~+ (list//map (to-code env) scope))) (~ (to-code env body))))) ([#.UnivQ] [#.ExQ]) )) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 6488be2be..78ae223d2 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -8,14 +8,14 @@ ["</>" code (#+ Parser)]]] [data ["." maybe] - ["." text ("#@." monoid)] + ["." text ("#//." monoid)] [number ["." nat] ["." int] ["." rev] ["." frac]] [collection - ["." list ("#@." functor)]]] + ["." list ("#//." functor)]]] ["." meta (#+ with-gensyms)]] [// ["." code]]) @@ -28,7 +28,7 @@ (#try.Success [tokens output]) (#try.Failure error) - (#try.Failure ($_ text@compose + (#try.Failure ($_ text//compose "Failed to parse: " (code.format binding) text.new-line error))))) @@ -49,11 +49,11 @@ {interfaces (tuple (some (super-class-decl^ imports class-vars)))} {constructor-args (constructor-args^ imports class-vars)} {methods (some (overriden-method-def^ imports))}) - (let [def-code ($_ text@compose "anon-class:" + (let [def-code ($_ text//compose "anon-class:" (spaced (list (super-class-decl$ (maybe.default object-super-class 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$ id) 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$ id) methods))))))] (wrap (list (` ((~ (code.text def-code)))))))))} (let [[exported? tokens] (: [Bit (List Code)] (case tokens diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux index 4d0e6b97e..776674926 100644 --- a/stdlib/source/lux/macro/syntax/common/reader.lux +++ b/stdlib/source/lux/macro/syntax/common/reader.lux @@ -3,10 +3,10 @@ [abstract monad] [control - ["p" parser ("#@." monad) + ["p" parser ("#//." monad) ["s" code (#+ Parser)]]] [data - ["." name ("#@." equivalence)] + ["." name ("#//." equivalence)] ["." product] ["." maybe] [collection @@ -18,8 +18,8 @@ (def: #export export (Parser Bit) - (p.either (p.after (s.tag! (name-of #export)) (p@wrap #1)) - (p@wrap #0))) + (p.either (p.after (s.tag! (name-of #export)) (p//wrap #1)) + (p//wrap #0))) (def: #export declaration {#.doc (doc "A reader for declaration syntax." @@ -28,7 +28,7 @@ (foo bar baz))} (Parser //.Declaration) (p.either (p.and s.local-identifier - (p@wrap (list))) + (p//wrap (list))) (s.form (p.and s.local-identifier (p.some s.local-identifier))))) @@ -44,7 +44,7 @@ type s.any value s.any] (wrap [(#.Some type) value]))) - (p.and (p@wrap #.None) + (p.and (p//wrap #.None) s.any))) (def: _definition-anns-tag^ @@ -90,7 +90,7 @@ (-> (List [Name Code]) (List Text)) (<| (maybe.default (list)) (: (Maybe (List Text))) - (case (list.find (|>> product.left (name@= ["lux" "func-args"])) meta-data) + (case (list.find (|>> product.left (name//= ["lux" "func-args"])) meta-data) (^multi (#.Some [_ value]) [(p.run tuple-meta^ (list value)) (#.Right [_ args])] diff --git a/stdlib/source/lux/macro/syntax/common/writer.lux b/stdlib/source/lux/macro/syntax/common/writer.lux index a067f0c10..e2e10f319 100644 --- a/stdlib/source/lux/macro/syntax/common/writer.lux +++ b/stdlib/source/lux/macro/syntax/common/writer.lux @@ -5,7 +5,7 @@ ["." function]] [data [collection - ["." list ("#@." functor)]] + ["." list ("#//." functor)]] ["." product]] [macro ["." code]]] @@ -20,12 +20,12 @@ (def: #export (declaration declaration) (-> //.Declaration Code) (` ((~ (code.local-identifier (get@ #//.declaration-name declaration))) - (~+ (list@map code.local-identifier - (get@ #//.declaration-args declaration)))))) + (~+ (list//map code.local-identifier + (get@ #//.declaration-args declaration)))))) (def: #export annotations (-> //.Annotations Code) - (|>> (list@map (product.both code.tag function.identity)) + (|>> (list//map (product.both code.tag function.identity)) code.record)) (def: #export (typed-input value) @@ -35,4 +35,4 @@ (def: #export type-variables (-> (List //.Type-Var) (List Code)) - (list@map code.local-identifier)) + (list//map code.local-identifier)) diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux index ed6d3a66b..c54f11d8c 100644 --- a/stdlib/source/lux/macro/template.lux +++ b/stdlib/source/lux/macro/template.lux @@ -3,18 +3,18 @@ [abstract ["." monad (#+ do)]] [control - ["<>" parser ("#@." functor) + ["<>" parser ("#//." functor) ["<.>" code (#+ Parser)]]] [data - ["." bit ("#@." codec)] + ["." bit ("#//." codec)] ["." text] [number - ["." nat ("#@." decimal)] - ["." int ("#@." decimal)] - ["." rev ("#@." decimal)] - ["." frac ("#@." decimal)]] + ["." nat ("#//." decimal)] + ["." int ("#//." decimal)] + ["." rev ("#//." decimal)] + ["." frac ("#//." decimal)]] [collection - ["." list ("#@." monad)]]] + ["." list ("#//." monad)]]] ["." meta]] [// [syntax (#+ syntax:)] @@ -30,12 +30,12 @@ body) (do {! meta.monad} [g!locals (|> locals - (list@map meta.gensym) + (list//map meta.gensym) (monad.seq !))] (wrap (list (` (.with-expansions [(~+ (|> (list.zip/2 locals g!locals) - (list@map (function (_ [name identifier]) - (list (code.local-identifier name) (as-is identifier)))) - list@join))] + (list//map (function (_ [name identifier]) + (list (code.local-identifier name) (as-is identifier)))) + list//join))] (~ body))))))) (def: (name-side module-side? parser) @@ -62,11 +62,11 @@ full-tag (<>.either <code>.local-tag full-tag)) - (<>@map bit@encode <code>.bit) - (<>@map nat@encode <code>.nat) - (<>@map int@encode <code>.int) - (<>@map rev@encode <code>.rev) - (<>@map frac@encode <code>.frac) + (<>//map bit//encode <code>.bit) + (<>//map nat//encode <code>.nat) + (<>//map int//encode <code>.int) + (<>//map rev//encode <code>.rev) + (<>//map frac//encode <code>.frac) ))) (def: (part module-side?) diff --git a/stdlib/source/lux/math/logic/continuous.lux b/stdlib/source/lux/math/logic/continuous.lux index b959593ea..3ec4103e1 100644 --- a/stdlib/source/lux/math/logic/continuous.lux +++ b/stdlib/source/lux/math/logic/continuous.lux @@ -2,10 +2,10 @@ [lux (#- false true or and not) [data [number - ["r" rev ("#@." interval)]]]]) + ["r" rev ("#//." interval)]]]]) -(def: #export true Rev r@top) -(def: #export false Rev r@bottom) +(def: #export true Rev r//top) +(def: #export false Rev r//bottom) (template [<name> <chooser>] [(def: #export <name> diff --git a/stdlib/source/lux/math/modular.lux b/stdlib/source/lux/math/modular.lux index c00fceb0c..e93569638 100644 --- a/stdlib/source/lux/math/modular.lux +++ b/stdlib/source/lux/math/modular.lux @@ -11,8 +11,8 @@ ["s" code]]] [data [number - ["i" int ("#@." decimal)]] - ["." text ("#@." monoid)]] + ["i" int ("#//." decimal)]] + ["." text ("#//." monoid)]] [type abstract] [macro @@ -40,13 +40,13 @@ (exception: #export [m] (incorrect-modulus {modulus (Modulus m)} {parsed Int}) - (ex.report ["Expected" (i@encode (to-int modulus))] - ["Actual" (i@encode parsed)])) + (ex.report ["Expected" (i//encode (to-int modulus))] + ["Actual" (i//encode parsed)])) (exception: #export [rm sm] (cannot-equalize-moduli {reference (Modulus rm)} {sample (Modulus sm)}) - (ex.report ["Reference" (i@encode (to-int reference))] - ["Sample" (i@encode (to-int sample))])) + (ex.report ["Reference" (i//encode (to-int reference))] + ["Sample" (i//encode (to-int sample))])) (def: #export (congruent? modulus reference sample) (All [m] (-> (Modulus m) Int Int Bit)) @@ -91,10 +91,10 @@ (def: (encode modular) (let [[remainder modulus] (:representation modular)] - ($_ text@compose - (i@encode remainder) + ($_ text//compose + (i//encode remainder) separator - (i@encode (to-int modulus))))) + (i//encode (to-int modulus))))) (def: decode (l.run (do p.monad diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index 8f2ef6006..e1a51bcaf 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -15,10 +15,10 @@ ["r" ratio] ["c" complex] ["f" frac]] - ["." text (#+ Char) ("#@." monoid) + ["." text (#+ Char) ("#//." monoid) ["." unicode]] [collection - ["." list ("#@." fold)] + ["." list ("#//." fold)] ["." array (#+ Array)] ["." dictionary (#+ Dictionary)] ["." queue (#+ Queue)] @@ -166,7 +166,7 @@ (do ..monad [x char-gen xs (text char-gen (dec size))] - (wrap (text@compose (text.from-code x) xs))))) + (wrap (text//compose (text.from-code x) xs))))) (template [<name> <set>] [(def: #export <name> @@ -263,7 +263,7 @@ [array Array array.from-list] [queue Queue queue.from-list] - [stack Stack (list@fold stack.push stack.empty)] + [stack Stack (list//fold stack.push stack.empty)] ) (def: #export (set Hash<a> size value-gen) @@ -309,30 +309,30 @@ (def: #export month (Random Month) - (let [(^open "/@.") ..monad] - (..either (..either (..either (/@wrap #month.January) - (..either (/@wrap #month.February) - (/@wrap #month.March))) - (..either (/@wrap #month.April) - (..either (/@wrap #month.May) - (/@wrap #month.June)))) - (..either (..either (/@wrap #month.July) - (..either (/@wrap #month.August) - (/@wrap #month.September))) - (..either (/@wrap #month.October) - (..either (/@wrap #month.November) - (/@wrap #month.December))))))) + (let [(^open "//.") ..monad] + (..either (..either (..either (//wrap #month.January) + (..either (//wrap #month.February) + (//wrap #month.March))) + (..either (//wrap #month.April) + (..either (//wrap #month.May) + (//wrap #month.June)))) + (..either (..either (//wrap #month.July) + (..either (//wrap #month.August) + (//wrap #month.September))) + (..either (//wrap #month.October) + (..either (//wrap #month.November) + (//wrap #month.December))))))) (def: #export day (Random Day) - (let [(^open "/@.") ..monad] - (..either (..either (/@wrap #day.Sunday) - (..either (/@wrap #day.Monday) - (/@wrap #day.Tuesday))) - (..either (..either (/@wrap #day.Wednesday) - (/@wrap #day.Thursday)) - (..either (/@wrap #day.Friday) - (/@wrap #day.Saturday)))))) + (let [(^open "//.") ..monad] + (..either (..either (//wrap #day.Sunday) + (..either (//wrap #day.Monday) + (//wrap #day.Tuesday))) + (..either (..either (//wrap #day.Wednesday) + (//wrap #day.Thursday)) + (..either (//wrap #day.Friday) + (//wrap #day.Saturday)))))) (def: #export (run prng calc) (All [a] (-> PRNG (Random a) [PRNG a])) diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux index 47e7a5721..73d5fee2f 100644 --- a/stdlib/source/lux/meta.lux +++ b/stdlib/source/lux/meta.lux @@ -9,13 +9,13 @@ [data ["." product] ["." maybe] - ["." text ("#@." monoid equivalence)] - ["." name ("#@." codec equivalence)] + ["." text ("#//." monoid equivalence)] + ["." name ("#//." codec equivalence)] [number ["n" nat] ["i" int]] [collection - ["." list ("#@." monoid monad)]]] + ["." list ("#//." monoid monad)]]] [macro ["." code]]] [/ @@ -81,7 +81,7 @@ #.None (#.Cons [k' v] plist') - (if (text@= k k') + (if (text//= k k') (#.Some v) (get k plist')))) @@ -132,7 +132,7 @@ (#try.Success [compiler module]) _ - (#try.Failure ($_ text@compose "Unknown module: " name))))) + (#try.Failure ($_ text//compose "Unknown module: " name))))) (def: #export current-module-name (Meta Text) @@ -231,7 +231,7 @@ (do ..monad [expansion ((:coerce Macro' macro) args) expansion' (monad.map ..monad expand expansion)] - (wrap (list@join expansion'))) + (wrap (list//join expansion'))) #.None (:: ..monad wrap (list syntax)))) @@ -251,23 +251,23 @@ (do ..monad [expansion ((:coerce Macro' macro) args) expansion' (monad.map ..monad expand-all expansion)] - (wrap (list@join expansion'))) + (wrap (list//join expansion'))) #.None (do ..monad [parts' (monad.map ..monad expand-all (list& (code.identifier name) args))] - (wrap (list (code.form (list@join parts'))))))) + (wrap (list (code.form (list//join parts'))))))) [_ (#.Form (#.Cons [harg targs]))] (do ..monad [harg+ (expand-all harg) targs+ (monad.map ..monad expand-all targs)] - (wrap (list (code.form (list@compose harg+ (list@join (: (List (List Code)) targs+))))))) + (wrap (list (code.form (list//compose harg+ (list//join (: (List (List Code)) targs+))))))) [_ (#.Tuple members)] (do ..monad [members' (monad.map ..monad expand-all members)] - (wrap (list (code.tuple (list@join members'))))) + (wrap (list (code.tuple (list//join members'))))) _ (:: ..monad wrap (list syntax)))) @@ -286,7 +286,7 @@ [id ..count] (wrap (|> id (:: n.decimal encode) - ($_ text@compose "__gensym__" prefix) + ($_ text//compose "__gensym__" prefix) [""] code.identifier)))) (def: (get-local-identifier ast) @@ -296,12 +296,12 @@ (:: ..monad wrap name) _ - (fail (text@compose "Code is not a local identifier: " (code.format ast))))) + (fail (text//compose "Code is not a local identifier: " (code.format ast))))) (def: #export wrong-syntax-error (-> Name Text) - (|>> name@encode - (text@compose "Wrong syntax for "))) + (|>> name//encode + (text//compose "Wrong syntax for "))) (macro: #export (with-gensyms tokens) {#.doc (doc "Creates new identifiers and offers them to the body expression." @@ -317,9 +317,9 @@ (^ (list [_ (#.Tuple identifiers)] body)) (do {! ..monad} [identifier-names (monad.map ! get-local-identifier identifiers) - #let [identifier-defs (list@join (list@map (: (-> Text (List Code)) - (function (_ name) (list (code.identifier ["" name]) (` (gensym (~ (code.text name))))))) - identifier-names))]] + #let [identifier-defs (list//join (list//map (: (-> Text (List Code)) + (function (_ name) (list (code.identifier ["" name]) (` (gensym (~ (code.text name))))))) + identifier-names))]] (wrap (list (` ((~! do) (~! ..monad) [(~+ identifier-defs)] (~ body)))))) @@ -389,7 +389,7 @@ (-> Text (Meta Type)) (function (_ compiler) (let [test (: (-> [Text [Type Any]] Bit) - (|>> product.left (text@= name)))] + (|>> product.left (text//= name)))] (case (do maybe.monad [scope (list.find (function (_ env) (or (list.any? test (: (List [Text [Type Any]]) @@ -407,7 +407,7 @@ ((clean-type var-type) compiler) #.None - (#try.Failure ($_ text@compose "Unknown variable: " name)))))) + (#try.Failure ($_ text//compose "Unknown variable: " name)))))) (def: #export (find-def name) {#.doc "Looks-up a definition's whole data in the available modules (including the current one)."} @@ -425,19 +425,19 @@ _ (let [current-module (|> compiler (get@ #.current-module) (maybe.default "???")) - separator ($_ text@compose text.new-line " ")] - (#try.Failure ($_ text@compose - "Unknown definition: " (name@encode name) text.new-line + separator ($_ text//compose text.new-line " ")] + (#try.Failure ($_ text//compose + "Unknown definition: " (name//encode name) text.new-line " Current module: " current-module text.new-line (case (get current-module (get@ #.modules compiler)) (#.Some this-module) - ($_ text@compose + ($_ text//compose " Imports: " (|> this-module (get@ #.imports) (text.join-with separator)) text.new-line - " Aliases: " (|> this-module (get@ #.module-aliases) (list@map (function (_ [alias real]) ($_ text@compose alias " => " real))) (text.join-with separator)) text.new-line) + " Aliases: " (|> this-module (get@ #.module-aliases) (list//map (function (_ [alias real]) ($_ text//compose alias " => " real))) (text.join-with separator)) text.new-line) _ "") - " All Known modules: " (|> compiler (get@ #.modules) (list@map product.left) (text.join-with separator)) text.new-line))))))) + " All Known modules: " (|> compiler (get@ #.modules) (list//map product.left) (text.join-with separator)) text.new-line))))))) (def: #export (find-export name) {#.doc "Looks-up a definition's type in the available modules (including the current one)."} @@ -446,15 +446,15 @@ [definition (..find-def name)] (case definition (#.Left de-aliased) - (fail ($_ text@compose + (fail ($_ text//compose "Aliases are not considered exports: " - (name@encode name))) + (name//encode name))) (#.Right definition) (let [[exported? def-type def-data def-value] definition] (if exported? (wrap definition) - (fail ($_ text@compose "Definition is not an export: " (name@encode name)))))))) + (fail ($_ text//compose "Definition is not an export: " (name//encode name)))))))) (def: #export (find-def-type name) {#.doc "Looks-up a definition's type in the available modules (including the current one)."} @@ -499,7 +499,7 @@ (function (_ compiler) (case (get module (get@ #.modules compiler)) #.None - (#try.Failure ($_ text@compose "Unknown module: " module)) + (#try.Failure ($_ text//compose "Unknown module: " module)) (#.Some module) (#try.Success [compiler (get@ #.definitions module)])))) @@ -578,14 +578,14 @@ (-> Text Text (Meta Bit)) (do ..monad [(^slots [#.imports]) (..find-module module)] - (wrap (list.any? (text@= import) imports)))) + (wrap (list.any? (text//= import) imports)))) (def: #export (imported? import) (-> Text (Meta Bit)) (let [(^open ".") ..monad] (|> ..current-module-name (map ..find-module) join - (map (|>> (get@ #.imports) (list.any? (text@= import))))))) + (map (|>> (get@ #.imports) (list.any? (text//= import))))))) (def: #export (resolve-tag tag) {#.doc "Given a tag, finds out what is its index, its related tag-list and it's associated type."} @@ -597,17 +597,17 @@ imported! (..imported? module)] (case (get name (get@ #.tags =module)) (#.Some [idx tag-list exported? type]) - (if (or (text@= this-module-name module) + (if (or (text//= this-module-name module) (and imported! exported?)) (wrap [idx tag-list type]) - (..fail ($_ text@compose "Cannot access tag: " (name@encode tag) " from module " this-module-name))) + (..fail ($_ text//compose "Cannot access tag: " (name//encode tag) " from module " this-module-name))) _ - (..fail ($_ text@compose - "Unknown tag: " (name@encode tag) text.new-line + (..fail ($_ text//compose + "Unknown tag: " (name//encode tag) text.new-line " Known tags: " (|> =module (get@ #.tags) - (list@map (|>> product.left [module] name@encode (text.prefix text.new-line))) + (list//map (|>> product.left [module] name//encode (text.prefix text.new-line))) (text.join-with "")) ))))) @@ -620,9 +620,9 @@ (wrap (|> (get@ #.types =module) (list.filter (function (_ [type-name [tag-list exported? type]]) (or exported? - (text@= this-module-name module)))) - (list@map (function (_ [type-name [tag-list exported? type]]) - [tag-list type])))))) + (text//= this-module-name module)))) + (list//map (function (_ [type-name [tag-list exported? type]]) + [tag-list type])))))) (def: #export locals {#.doc "All the local variables currently in scope, separated in different scopes."} @@ -634,10 +634,10 @@ (#.Some scopes) (#try.Success [compiler - (list@map (|>> (get@ [#.locals #.mappings]) - (list@map (function (_ [name [type _]]) - [name type]))) - scopes)])))) + (list//map (|>> (get@ [#.locals #.mappings]) + (list//map (function (_ [name [type _]]) + [name type]))) + scopes)])))) (def: #export (un-alias def-name) {#.doc "Given an aliased definition's name, returns the original definition being referenced."} @@ -686,9 +686,9 @@ (do ..monad [location ..location output (<func> token) - #let [_ (log! ($_ text@compose (name@encode (name-of <macro>)) " @ " (location.format location))) - _ (list@map (|>> code.format log!) - output) + #let [_ (log! ($_ text//compose (name//encode (name-of <macro>)) " @ " (location.format location))) + _ (list//map (|>> code.format log!) + output) _ (log! "")]] (wrap (if omit? (list) diff --git a/stdlib/source/lux/target/common-lisp.lux b/stdlib/source/lux/target/common-lisp.lux index b38ec0fee..b1853a42f 100644 --- a/stdlib/source/lux/target/common-lisp.lux +++ b/stdlib/source/lux/target/common-lisp.lux @@ -8,7 +8,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." monad fold)]]] + ["." list ("#//." monad fold)]]] [macro ["." template]] [type @@ -141,7 +141,7 @@ (def: #export args (-> (List Var/1) Var/*) - (|>> (list@map ..code) + (|>> (list//map ..code) (text.join-with " ") ..as-form :abstraction)) @@ -149,7 +149,7 @@ (def: #export (args& singles rest) (-> (List Var/1) Var/1 Var/*) (|> (format (|> singles - (list@map ..code) + (list//map ..code) (text.join-with " ")) " &rest " (:representation rest)) ..as-form @@ -157,7 +157,7 @@ (def: form (-> (List (Expression Any)) Expression) - (|>> (list@map ..code) + (|>> (list//map ..code) (text.join-with " ") ..as-form :abstraction)) @@ -178,9 +178,9 @@ (def: #export (labels definitions body) (-> (List [Var/1 Lambda]) (Expression Any) (Computation Any)) (..form (list (..var "labels") - (..form (list@map (function (_ [def-name [def-args def-body]]) - (..form (list def-name (:transmutation def-args) def-body))) - definitions)) + (..form (list//map (function (_ [def-name [def-args def-body]]) + (..form (list def-name (:transmutation def-args) def-body))) + definitions)) body))) (def: #export (destructuring-bind [bindings expression] body) @@ -334,8 +334,8 @@ (-> (List [Var/1 (Expression Any)]) (Expression Any) (Computation Any)) (..form (list (..var <host-name>) (|> bindings - (list@map (function (_ [name value]) - (..form (list name value)))) + (list//map (function (_ [name value]) + (..form (list name value)))) ..form) body)))] @@ -372,11 +372,11 @@ (-> (List Handler) (Expression Any) (Computation Any)) (..form (list& (..var "handler-case") body - (list@map (function (_ [type condition handler]) - (..form (list type - (:transmutation (..args (list condition))) - handler))) - handlers)))) + (list//map (function (_ [type condition handler]) + (..form (list type + (:transmutation (..args (list condition))) + handler))) + handlers)))) (template [<name> <prefix>] [(def: #export (<name> conditions expression) @@ -391,7 +391,7 @@ _ (:abstraction - (format <prefix> (|> conditions (list@map ..symbol) + (format <prefix> (|> conditions (list//map ..symbol) (list& (..symbol "or")) ..form :representation) " " (:representation expression)))))] @@ -413,10 +413,10 @@ (def: #export (cond clauses else) (-> (List [(Expression Any) (Expression Any)]) (Expression Any) (Computation Any)) - (list@fold (function (_ [test then] next) - (..if test then next)) - (:transmutation else) - (list.reverse clauses))) + (list//fold (function (_ [test then] next) + (..if test then next)) + (:transmutation else) + (list.reverse clauses))) ) (def: #export (while condition body) diff --git a/stdlib/source/lux/target/js.lux b/stdlib/source/lux/target/js.lux index bc4b3949d..41eba97bb 100644 --- a/stdlib/source/lux/target/js.lux +++ b/stdlib/source/lux/target/js.lux @@ -9,7 +9,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." functor fold)]]] + ["." list ("#//." functor fold)]]] [macro ["." template]] [type @@ -110,7 +110,7 @@ (def: #export array (-> (List Expression) Computation) - (|>> (list@map ..code) + (|>> (list//map ..code) (text.join-with ..argument-separator) ..element :abstraction)) @@ -130,7 +130,7 @@ (def: #export (apply/* function inputs) (-> Expression (List Expression) Computation) (|> inputs - (list@map ..code) + (list//map ..code) (text.join-with ..argument-separator) ..expression (format (:representation function)) @@ -142,8 +142,8 @@ (def: #export object (-> (List [Text Expression]) Computation) - (|>> (list@map (.function (_ [key val]) - (format (:representation (..string key)) ..field-separator (:representation val)))) + (|>> (list//map (.function (_ [key val]) + (format (:representation (..string key)) ..field-separator (:representation val)))) (text.join-with ..argument-separator) (text.enclose ["{" "}"]) ..expression @@ -175,7 +175,7 @@ ..block (format "function " (:representation name) (|> inputs - (list@map ..code) + (list//map ..code) (text.join-with ..argument-separator) ..expression) " ") @@ -194,7 +194,7 @@ ..block (format "function" (|> inputs - (list@map ..code) + (list//map ..code) (text.join-with ..argument-separator) ..expression) " ") @@ -276,7 +276,7 @@ (-> Expression (List Expression) Computation) (|> (format "new " (:representation constructor) (|> inputs - (list@map ..code) + (list//map ..code) (text.join-with ..argument-separator) ..expression)) ..expression @@ -399,11 +399,11 @@ (-> Expression (List [(List Literal) Statement]) (Maybe Statement) Statement) (:abstraction (format "switch (" (:representation input) ") " (|> (format (|> cases - (list@map (.function (_ [when then]) - (format (|> when - (list@map (|>> :representation (text.enclose ["case " ":"]))) - (text.join-with text.new-line)) - (..nest (:representation then))))) + (list//map (.function (_ [when then]) + (format (|> when + (list//map (|>> :representation (text.enclose ["case " ":"]))) + (text.join-with text.new-line)) + (..nest (:representation then))))) (text.join-with text.new-line)) text.new-line (case default @@ -418,10 +418,10 @@ (def: #export (cond clauses else!) (-> (List [Expression Statement]) Statement Statement) - (list@fold (.function (_ [test then!] next!) - (..if test then! next!)) - else! - (list.reverse clauses))) + (list//fold (.function (_ [test then!] next!) + (..if test then! next!)) + else! + (list.reverse clauses))) (template [<apply> <arg>+ <type>+ <function>+] [(`` (def: #export (<apply> function) diff --git a/stdlib/source/lux/target/jvm/attribute.lux b/stdlib/source/lux/target/jvm/attribute.lux index 083ebaa15..99ceeafb5 100644 --- a/stdlib/source/lux/target/jvm/attribute.lux +++ b/stdlib/source/lux/target/jvm/attribute.lux @@ -11,7 +11,7 @@ [number ["n" nat]] [format - [".F" binary (#+ Writer) ("#@." monoid)]]]] + [".F" binary (#+ Writer)]]]] ["." // #_ ["#." index (#+ Index)] [encoding diff --git a/stdlib/source/lux/target/jvm/attribute/code.lux b/stdlib/source/lux/target/jvm/attribute/code.lux index 3a9629c1f..012c25809 100644 --- a/stdlib/source/lux/target/jvm/attribute/code.lux +++ b/stdlib/source/lux/target/jvm/attribute/code.lux @@ -8,9 +8,9 @@ [number ["n" nat]] [format - [".F" binary (#+ Writer) ("#@." monoid)]] + [".F" binary (#+ Writer) ("#//." monoid)]] [collection - ["." row (#+ Row) ("#@." functor fold)]]]] + ["." row (#+ Row) ("#//." functor fold)]]]] ["." /// #_ [bytecode [environment @@ -48,8 +48,8 @@ ## attribute_info attributes[attributes_count]; (|> code (get@ #attributes) - (row@map length) - (row@fold n.+ 0)))) + (row//map length) + (row//fold n.+ 0)))) (def: #export (equivalence attribute-equivalence) (All [attribute] @@ -64,7 +64,7 @@ ## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.3 (def: #export (writer writer code) (All [Attribute] (-> (Writer Attribute) (Writer (Code Attribute)))) - ($_ binaryF@compose + ($_ binaryF//compose ## u2 max_stack; ## u2 max_locals; (///limit.writer (get@ #limit code)) diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux index 2b3d600f7..31b99e9cf 100644 --- a/stdlib/source/lux/target/jvm/bytecode.lux +++ b/stdlib/source/lux/target/jvm/bytecode.lux @@ -20,7 +20,7 @@ ["i" int] ["." i32 (#+ I32)]] [collection - ["." list ("#@." functor fold)] + ["." list ("#//." functor fold)] ["." dictionary (#+ Dictionary)] ["." row (#+ Row)]]] [macro @@ -28,7 +28,7 @@ ["." / #_ ["#." address (#+ Address)] ["#." jump (#+ Jump Big-Jump)] - ["_" instruction (#+ Primitive-Array-Type Instruction Estimator) ("#@." monoid)] + ["_" instruction (#+ Primitive-Array-Type Instruction Estimator) ("#//." monoid)] ["#." environment (#+ Environment) [limit ["/." registry (#+ Register Registry)] @@ -93,7 +93,7 @@ [[left-exceptions left-instruction] (left resolver) [right-exceptions right-instruction] (right resolver)] (wrap [(:: row.monoid compose left-exceptions right-exceptions) - (_@compose left-instruction right-instruction)])))))) + (_//compose left-instruction right-instruction)])))))) (type: #export (Bytecode a) (State' Try [Pool Environment Tracker] (Writer Relative a))) @@ -843,7 +843,7 @@ (wrap (let [@from (get@ #program-counter tracker)] [[pool environment' - (|> (list@fold (..acknowledge-label actual) tracker (list& default at-minimum afterwards)) + (|> (list//fold (..acknowledge-label actual) tracker (list& default at-minimum afterwards)) (set@ #program-counter program-counter'))] [(function (_ resolver) (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) @@ -886,7 +886,7 @@ (wrap (let [@from (get@ #program-counter tracker)] [[pool environment' - (|> (list@fold (..acknowledge-label actual) tracker (list& default (list@map product.right cases))) + (|> (list//fold (..acknowledge-label actual) tracker (list& default (list//map product.right cases))) (set@ #program-counter program-counter'))] [(function (_ resolver) (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) @@ -903,7 +903,7 @@ [>default (:: ! map ..big-jump (..jump @from @default)) >cases (|> @cases (monad.map ! (|>> (..jump @from) (:: ! map ..big-jump))) - (:: ! map (|>> (list.zip/2 (list@map product.left cases)))))] + (:: ! map (|>> (list.zip/2 (list//map product.left cases)))))] (wrap [..no-exceptions (bytecode >default >cases)])) #.None @@ -970,8 +970,8 @@ {#//constant/pool.name method #//constant/pool.descriptor (type.descriptor type)}) #let [consumption (|> inputs - (list@map ..type-size) - (list@fold n.+ (if <static?> 0 1)) + (list//map ..type-size) + (list//fold n.+ (if <static?> 0 1)) //unsigned.u1 try.assume) production (|> output ..type-size //unsigned.u1 try.assume)]] diff --git a/stdlib/source/lux/target/jvm/bytecode/environment/limit.lux b/stdlib/source/lux/target/jvm/bytecode/environment/limit.lux index 1bbb40e15..7ca0f0e83 100644 --- a/stdlib/source/lux/target/jvm/bytecode/environment/limit.lux +++ b/stdlib/source/lux/target/jvm/bytecode/environment/limit.lux @@ -9,7 +9,7 @@ [number ["n" nat]] ["." format #_ - ["#" binary (#+ Writer) ("#@." monoid)]]]] + ["#" binary (#+ Writer) ("#//." monoid)]]]] ["." / #_ ["#." stack (#+ Stack)] ["#." registry (#+ Registry)] @@ -49,7 +49,7 @@ (def: #export (writer limit) (Writer Limit) - ($_ format@compose + ($_ format//compose (/stack.writer (get@ #stack limit)) (/registry.writer (get@ #registry limit)) )) diff --git a/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux b/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux index 8156c46c0..c192a3fdd 100644 --- a/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux +++ b/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux @@ -3,14 +3,14 @@ [abstract ["." equivalence (#+ Equivalence)]] [control - ["." try (#+ Try) ("#@." functor)]] + ["." try (#+ Try) ("#//." functor)]] [data [number ["n" nat]] [format [binary (#+ Writer)]] [collection - ["." list ("#@." functor fold)]]] + ["." list ("#//." functor fold)]]] [type abstract]] ["." ///// #_ @@ -36,12 +36,12 @@ (-> (Type Method) Nat) (let [[inputs output exceptions] (/////type/parser.method type)] (|> inputs - (list@map (function (_ input) - (if (or (is? /////type.long input) - (is? /////type.double input)) - ..wide - ..normal))) - (list@fold n.+ 0)))) + (list//map (function (_ input) + (if (or (is? /////type.long input) + (is? /////type.double input)) + ..wide + ..normal))) + (list//fold n.+ 0)))) (template [<start> <name>] [(def: #export <name> @@ -49,7 +49,7 @@ (|>> ..minimal (n.+ <start>) /////unsigned.u2 - (try@map ..registry)))] + (try//map ..registry)))] [0 static] [1 virtual] diff --git a/stdlib/source/lux/target/jvm/class.lux b/stdlib/source/lux/target/jvm/class.lux index 5a975cf8a..08bd81e56 100644 --- a/stdlib/source/lux/target/jvm/class.lux +++ b/stdlib/source/lux/target/jvm/class.lux @@ -11,7 +11,7 @@ [number (#+) [i64 (#+)]] [format - [".F" binary (#+ Writer) ("#@." monoid)]] + [".F" binary (#+ Writer) ("#//." monoid)]] [collection ["." row (#+ Row)]]] [type @@ -115,7 +115,7 @@ (def: #export (writer class) (Writer Class) - (`` ($_ binaryF@compose + (`` ($_ binaryF//compose (~~ (template [<writer> <slot>] [(<writer> (get@ <slot> class))] diff --git a/stdlib/source/lux/target/jvm/constant.lux b/stdlib/source/lux/target/jvm/constant.lux index b114ba945..d62100634 100644 --- a/stdlib/source/lux/target/jvm/constant.lux +++ b/stdlib/source/lux/target/jvm/constant.lux @@ -13,7 +13,7 @@ ["." frac]] ["." text] [format - [".F" binary (#+ Writer) ("#@." monoid)]] + [".F" binary (#+ Writer) ("#//." monoid)]] [collection ["." row (#+ Row)]]] [type @@ -234,7 +234,7 @@ (case value (^template [<case> <tag> <writer>] (<case> value) - (binaryF@compose (/tag.writer <tag>) - (<writer> value))) + (binaryF//compose (/tag.writer <tag>) + (<writer> value))) (<constants>) )))) diff --git a/stdlib/source/lux/target/jvm/constant/pool.lux b/stdlib/source/lux/target/jvm/constant/pool.lux index 2d2b1b940..17e3f0302 100644 --- a/stdlib/source/lux/target/jvm/constant/pool.lux +++ b/stdlib/source/lux/target/jvm/constant/pool.lux @@ -15,9 +15,9 @@ ["." frac]] ["." text] ["." format #_ - ["#" binary (#+ Writer) ("specification@." monoid)]] + ["#" binary (#+ Writer) ("specification//." monoid)]] [collection - ["." row (#+ Row) ("#@." fold)]]] + ["." row (#+ Row) ("#//." fold)]]] [type abstract] [macro @@ -144,10 +144,10 @@ (def: #export writer (Writer Pool) (function (_ [next pool]) - (row@fold (function (_ [_index post] pre) - (specification@compose pre (//.writer post))) - (format.bits/16 (!index next)) - pool))) + (row//fold (function (_ [_index post] pre) + (specification//compose pre (//.writer post))) + (format.bits/16 (!index next)) + pool))) (def: #export empty Pool diff --git a/stdlib/source/lux/target/jvm/constant/tag.lux b/stdlib/source/lux/target/jvm/constant/tag.lux index ce1b7d20a..fc2311ab9 100644 --- a/stdlib/source/lux/target/jvm/constant/tag.lux +++ b/stdlib/source/lux/target/jvm/constant/tag.lux @@ -11,7 +11,7 @@ abstract]] ["." /// #_ [encoding - ["#." unsigned (#+ U1) ("u1@." equivalence)]]]) + ["#." unsigned (#+ U1) ("u1//." equivalence)]]]) (abstract: #export Tag U1 @@ -19,8 +19,8 @@ (structure: #export equivalence (Equivalence Tag) (def: (= reference sample) - (u1@= (:representation reference) - (:representation sample)))) + (u1//= (:representation reference) + (:representation sample)))) (template [<code> <name>] [(def: #export <name> diff --git a/stdlib/source/lux/target/jvm/field.lux b/stdlib/source/lux/target/jvm/field.lux index 8541076f7..c5231ea26 100644 --- a/stdlib/source/lux/target/jvm/field.lux +++ b/stdlib/source/lux/target/jvm/field.lux @@ -8,7 +8,7 @@ [number (#+) [i64 (#+)]] [format - [".F" binary (#+ Writer) ("#@." monoid)]] + [".F" binary (#+ Writer) ("#//." monoid)]] [collection ["." row (#+ Row)]]] [type @@ -51,7 +51,7 @@ (def: #export (writer field) (Writer Field) - (`` ($_ binaryF@compose + (`` ($_ binaryF//compose (~~ (template [<writer> <slot>] [(<writer> (get@ <slot> field))] diff --git a/stdlib/source/lux/target/jvm/method.lux b/stdlib/source/lux/target/jvm/method.lux index daae88521..823cb1e11 100644 --- a/stdlib/source/lux/target/jvm/method.lux +++ b/stdlib/source/lux/target/jvm/method.lux @@ -10,13 +10,13 @@ [number (#+) [i64 (#+)]] ["." format #_ - ["#" binary (#+ Writer) ("#@." monoid)]] + ["#" binary (#+ Writer) ("#//." monoid)]] [collection ["." row (#+ Row)]]] [type [abstract (#+)]]] ["." // #_ - ["#." modifier (#+ Modifier modifiers:) ("#@." monoid)] + ["#." modifier (#+ Modifier modifiers:)] ["#." index (#+ Index)] ["#." attribute (#+ Attribute) ["#/." code]] @@ -95,7 +95,7 @@ (def: #export (writer field) (Writer Method) - (`` ($_ format@compose + (`` ($_ format//compose (~~ (template [<writer> <slot>] [(<writer> (get@ <slot> field))] diff --git a/stdlib/source/lux/target/jvm/modifier.lux b/stdlib/source/lux/target/jvm/modifier.lux index c9fd34125..cd6d2671f 100644 --- a/stdlib/source/lux/target/jvm/modifier.lux +++ b/stdlib/source/lux/target/jvm/modifier.lux @@ -11,9 +11,7 @@ ["." number (#+ hex) ["." i64]] [format - [".F" binary (#+ Writer)]] - [collection - ["." list ("#@." functor)]]] + [".F" binary (#+ Writer)]]] [type abstract] [meta (#+ with-gensyms)] diff --git a/stdlib/source/lux/target/jvm/reflection.lux b/stdlib/source/lux/target/jvm/reflection.lux index 9cbcd4535..b87230b07 100644 --- a/stdlib/source/lux/target/jvm/reflection.lux +++ b/stdlib/source/lux/target/jvm/reflection.lux @@ -12,10 +12,10 @@ [data [number ["n" nat]] - ["." text ("#@." equivalence) + ["." text ("#//." equivalence) ["%" format (#+ format)]] [collection - ["." list ("#@." fold functor)] + ["." list ("#//." fold functor)] ["." array] ["." dictionary]]]] ["." // #_ @@ -131,8 +131,8 @@ (:coerce (java/lang/Class java/lang/Object)) java/lang/Class::getName)] (`` (if (or (~~ (template [<reflection>] - [(text@= (/reflection.reflection <reflection>) - class-name)] + [(text//= (/reflection.reflection <reflection>) + class-name)] [/reflection.boolean] [/reflection.byte] @@ -210,8 +210,8 @@ (:coerce (java/lang/Class java/lang/Object)) java/lang/Class::getName)] (`` (cond (~~ (template [<reflection> <type>] - [(text@= (/reflection.reflection <reflection>) - class-name) + [(text//= (/reflection.reflection <reflection>) + class-name) (#try.Success <type>)] [/reflection.boolean /.boolean] @@ -244,8 +244,8 @@ (let [class-name (|> reflection (:coerce (java/lang/Class java/lang/Object)) java/lang/Class::getName)] - (if (text@= (/reflection.reflection /reflection.void) - class-name) + (if (text//= (/reflection.reflection /reflection.void) + class-name) (#try.Success /.void) <else>)) @@ -280,14 +280,14 @@ class-params (array.to-list (java/lang/Class::getTypeParameters class)) num-class-params (list.size class-params) num-type-params (list.size params)] - (if (text@= class-name name) + (if (text//= class-name name) (if (n.= num-class-params num-type-params) (|> params - (list.zip/2 (list@map (|>> java/lang/reflect/TypeVariable::getName) - class-params)) - (list@fold (function (_ [name paramT] mapping) - (dictionary.put name paramT mapping)) - /lux.fresh) + (list.zip/2 (list//map (|>> java/lang/reflect/TypeVariable::getName) + class-params)) + (list//fold (function (_ [name paramT] mapping) + (dictionary.put name paramT mapping)) + /lux.fresh) #try.Success) (exception.throw ..type-parameter-mismatch [num-class-params num-type-params class type])) (exception.throw ..cannot-correspond [class type]))) diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux index 613c8f5c3..9dbcb12c2 100644 --- a/stdlib/source/lux/target/jvm/type.lux +++ b/stdlib/source/lux/target/jvm/type.lux @@ -10,7 +10,7 @@ [number ["n" nat]] [collection - ["." list ("#@." functor)]]] + ["." list ("#//." functor)]]] [type abstract]] ["." // #_ @@ -79,14 +79,14 @@ (def: #export (class name parameters) (-> External (List (Type Parameter)) (Type Class)) (:abstraction - [(/signature.class name (list@map ..signature parameters)) + [(/signature.class name (list//map ..signature parameters)) (/descriptor.class name) (/reflection.class name)])) (def: #export (declaration name variables) (-> External (List (Type Var)) (Type Declaration)) (:abstraction - [(/signature.declaration name (list@map ..signature variables)) + [(/signature.declaration name (list//map ..signature variables)) (/descriptor.declaration name) (/reflection.declaration name)])) @@ -134,10 +134,10 @@ (List (Type Class))] (Type Method)) (:abstraction - [(/signature.method [(list@map ..signature inputs) + [(/signature.method [(list//map ..signature inputs) (..signature output) - (list@map ..signature exceptions)]) - (/descriptor.method [(list@map ..descriptor inputs) + (list//map ..signature exceptions)]) + (/descriptor.method [(list//map ..descriptor inputs) (..descriptor output)]) (:assume ..void)])) diff --git a/stdlib/source/lux/target/jvm/type/alias.lux b/stdlib/source/lux/target/jvm/type/alias.lux index d21cbc1c2..f384a0ea1 100644 --- a/stdlib/source/lux/target/jvm/type/alias.lux +++ b/stdlib/source/lux/target/jvm/type/alias.lux @@ -5,7 +5,7 @@ [control ["." try] ["." exception (#+ exception:)] - ["<>" parser ("#@." monad) + ["<>" parser ["<t>" text (#+ Parser)]]] [data ["." maybe] diff --git a/stdlib/source/lux/target/jvm/type/descriptor.lux b/stdlib/source/lux/target/jvm/type/descriptor.lux index abcbfbbb9..27e44ec7f 100644 --- a/stdlib/source/lux/target/jvm/type/descriptor.lux +++ b/stdlib/source/lux/target/jvm/type/descriptor.lux @@ -6,10 +6,10 @@ ["." maybe] [number ["n" nat]] - ["." text ("#@." equivalence) + ["." text ("#//." equivalence) ["%" format (#+ format)]] [collection - ["." list ("#@." functor)]]] + ["." list ("#//." functor)]]] [type abstract]] ["." // #_ @@ -92,7 +92,7 @@ (Descriptor Method)) (:abstraction (format (|> inputs - (list@map ..descriptor) + (list//map ..descriptor) (text.join-with "") (text.enclose ["(" ")"])) (:representation output)))) @@ -101,7 +101,7 @@ (All [category] (Equivalence (Descriptor category))) (def: (= parameter subject) - (text@= (:representation parameter) (:representation subject)))) + (text//= (:representation parameter) (:representation subject)))) (def: #export class-name (-> (Descriptor Object) Internal) diff --git a/stdlib/source/lux/target/jvm/type/lux.lux b/stdlib/source/lux/target/jvm/type/lux.lux index 83a61de01..cbaf50a99 100644 --- a/stdlib/source/lux/target/jvm/type/lux.lux +++ b/stdlib/source/lux/target/jvm/type/lux.lux @@ -5,18 +5,18 @@ [control ["." try] ["." exception (#+ exception:)] - ["<>" parser ("#@." monad) + ["<>" parser ("#//." monad) ["<t>" text (#+ Parser)]]] [data ["." product] - ["." text ("#@." equivalence) + ["." text ("#//." equivalence) ["%" format (#+ format)]] [collection ["." array] ["." dictionary (#+ Dictionary)]]] [type abstract - ["." check (#+ Check) ("#@." monad)]]] + ["." check (#+ Check) ("#//." monad)]]] ["." // [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)] ["#." descriptor] @@ -47,13 +47,13 @@ (def: void (Parser (Check Type)) (<>.after //parser.void - (<>@wrap (check@wrap .Any)))) + (<>//wrap (check//wrap .Any)))) (template [<name> <parser> <reflection>] [(def: <name> (Parser (Check Type)) (<>.after <parser> - (<>@wrap (check@wrap (#.Primitive (//reflection.reflection <reflection>) #.Nil)))))] + (<>//wrap (check//wrap (#.Primitive (//reflection.reflection <reflection>) #.Nil)))))] [boolean //parser.boolean //reflection.boolean] [byte //parser.byte //reflection.byte] @@ -81,8 +81,8 @@ (def: wildcard (Parser (Check Type)) (<>.after //parser.wildcard - (<>@wrap (check@map product.right - check.existential)))) + (<>//wrap (check//map product.right + check.existential)))) (def: (var mapping) (-> Mapping (Parser (Check Type))) @@ -93,7 +93,7 @@ (check.throw ..unknown-var [var]) (#.Some type) - (check@wrap type))))) + (check//wrap type))))) (def: (class' parameter) (-> (Parser (Check Type)) (Parser (Check Type))) @@ -114,7 +114,7 @@ (-> (Parser (Check Type)) (Parser (Check Type))) (|> (<>.after (<t>.this <prefix>)) ## TODO: Re-enable Lower and Upper, instead of using the simplified limit. - ## (<>@map (check@map (|>> <ctor> .type))) + ## (<>//map (check//map (|>> <ctor> .type))) ))] [lower //signature.lower-prefix ..Lower] @@ -140,25 +140,25 @@ (def: array (-> (Parser (Check Type)) (Parser (Check Type))) - (|>> (<>@map (check@map (function (_ elementT) - (case elementT - (#.Primitive name #.Nil) - (if (`` (or (~~ (template [<reflection>] - [(text@= (//reflection.reflection <reflection>) name)] - - [//reflection.boolean] - [//reflection.byte] - [//reflection.short] - [//reflection.int] - [//reflection.long] - [//reflection.float] - [//reflection.double] - [//reflection.char])))) - (#.Primitive (|> name //reflection.class //reflection.array //reflection.reflection) #.Nil) - (|> elementT array.Array .type)) - - _ - (|> elementT array.Array .type))))) + (|>> (<>//map (check//map (function (_ elementT) + (case elementT + (#.Primitive name #.Nil) + (if (`` (or (~~ (template [<reflection>] + [(text//= (//reflection.reflection <reflection>) name)] + + [//reflection.boolean] + [//reflection.byte] + [//reflection.short] + [//reflection.int] + [//reflection.long] + [//reflection.float] + [//reflection.double] + [//reflection.char])))) + (#.Primitive (|> name //reflection.class //reflection.array //reflection.reflection) #.Nil) + (|> elementT array.Array .type)) + + _ + (|> elementT array.Array .type))))) (<>.after (<t>.this //descriptor.array-prefix)))) (def: #export (type mapping) diff --git a/stdlib/source/lux/target/jvm/type/parser.lux b/stdlib/source/lux/target/jvm/type/parser.lux index 499776376..d57bd41a3 100644 --- a/stdlib/source/lux/target/jvm/type/parser.lux +++ b/stdlib/source/lux/target/jvm/type/parser.lux @@ -5,7 +5,7 @@ [control ["." try] ["." function] - ["<>" parser ("#@." monad) + ["<>" parser ("#//." monad) ["<t>" text (#+ Parser)]]] [data ["." product] @@ -25,7 +25,7 @@ [(def: #export <name> (Parser (Type <category>)) (<>.after (<t>.this (//signature.signature <signature>)) - (<>@wrap <type>)))] + (<>//wrap <type>)))] [Void void //signature.void //.void] [Primitive boolean //signature.boolean //.boolean] @@ -86,7 +86,7 @@ (def: #export var (Parser (Type Var)) - (<>@map //.var ..var')) + (<>//map //.var ..var')) (def: #export var? (-> (Type Value) (Maybe Text)) @@ -106,7 +106,7 @@ [(def: <name> (-> (Parser (Type Class)) (Parser (Type Parameter))) (|>> (<>.after (<t>.this <prefix>)) - (<>@map <constructor>)))] + (<>//map <constructor>)))] [lower //signature.lower-prefix //.lower] [upper //signature.upper-prefix //.upper] @@ -145,7 +145,7 @@ (def: #export array' (-> (Parser (Type Value)) (Parser (Type Array))) (|>> (<>.after (<t>.this //descriptor.array-prefix)) - (<>@map //.array))) + (<>//map //.array))) (def: #export class (Parser (Type Class)) diff --git a/stdlib/source/lux/target/jvm/type/reflection.lux b/stdlib/source/lux/target/jvm/type/reflection.lux index 4ad2caf70..a0e0b0f5e 100644 --- a/stdlib/source/lux/target/jvm/type/reflection.lux +++ b/stdlib/source/lux/target/jvm/type/reflection.lux @@ -3,7 +3,7 @@ [abstract [equivalence (#+ Equivalence)]] [data - ["." text ("#@." equivalence) + ["." text ("#//." equivalence) ["%" format (#+ format)]]] [type abstract]] @@ -25,7 +25,7 @@ (All [category] (Equivalence (Reflection category))) (def: (= parameter subject) - (text@= (:representation parameter) (:representation subject)))) + (text//= (:representation parameter) (:representation subject)))) (template [<category> <name> <reflection>] [(def: #export <name> diff --git a/stdlib/source/lux/target/jvm/type/signature.lux b/stdlib/source/lux/target/jvm/type/signature.lux index 5fd3c3487..2fc8aa7c7 100644 --- a/stdlib/source/lux/target/jvm/type/signature.lux +++ b/stdlib/source/lux/target/jvm/type/signature.lux @@ -4,10 +4,10 @@ [equivalence (#+ Equivalence)] [hash (#+ Hash)]] [data - ["." text ("#@." hash) + ["." text ("#//." hash) ["%" format (#+ format)]] [collection - ["." list ("#@." functor)]]] + ["." list ("#//." functor)]]] [type abstract]] ["." // #_ @@ -84,7 +84,7 @@ _ (format ..parameters-start (|> parameters - (list@map ..signature) + (list//map ..signature) (text.join-with "")) ..parameters-end)) //descriptor.class-suffix))) @@ -109,25 +109,25 @@ (Signature Method)) (:abstraction (format (|> inputs - (list@map ..signature) + (list//map ..signature) (text.join-with "") (text.enclose [..arguments-start ..arguments-end])) (:representation output) (|> exceptions - (list@map (|>> :representation (format ..exception-prefix))) + (list//map (|>> :representation (format ..exception-prefix))) (text.join-with ""))))) (structure: #export equivalence (All [category] (Equivalence (Signature category))) (def: (= parameter subject) - (text@= (:representation parameter) - (:representation subject)))) + (text//= (:representation parameter) + (:representation subject)))) (structure: #export hash (All [category] (Hash (Signature category))) (def: &equivalence ..equivalence) - (def: hash (|>> :representation text@hash))) + (def: hash (|>> :representation text//hash))) ) diff --git a/stdlib/source/lux/target/lua.lux b/stdlib/source/lux/target/lua.lux index 37db0694f..68c961ef7 100644 --- a/stdlib/source/lux/target/lua.lux +++ b/stdlib/source/lux/target/lua.lux @@ -11,7 +11,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." functor fold)]]] + ["." list ("#//." functor fold)]]] [macro ["." template] ["." code] @@ -114,15 +114,15 @@ (def: #export array (-> (List (Expression Any)) Literal) - (|>> (list@map ..code) + (|>> (list//map ..code) (text.join-with ..input-separator) (text.enclose ["{" "}"]) :abstraction)) (def: #export table (-> (List [Text (Expression Any)]) Literal) - (|>> (list@map (.function (_ [key value]) - (format key " = " (:representation value)))) + (|>> (list//map (.function (_ [key value]) + (format key " = " (:representation value)))) (text.join-with ..input-separator) (text.enclose ["{" "}"]) :abstraction)) @@ -144,7 +144,7 @@ (def: #export (apply/* args func) (-> (List (Expression Any)) (Expression Any) (Computation Any)) (|> args - (list@map ..code) + (list//map ..code) (text.join-with ..input-separator) (text.enclose ["(" ")"]) (format (:representation func)) @@ -153,7 +153,7 @@ (def: #export (do method table args) (-> Text (Expression Any) (List (Expression Any)) (Computation Any)) (|> args - (list@map ..code) + (list//map ..code) (text.join-with ..input-separator) (text.enclose ["(" ")"]) (format (:representation table) ":" method) @@ -212,7 +212,7 @@ (def: locations (-> (List (Location Any)) Text) - (|>> (list@map ..code) + (|>> (list//map ..code) (text.join-with ..input-separator))) (def: #export (local vars) @@ -253,7 +253,7 @@ (-> (List Var) (Expression Any) Statement Statement) (:abstraction (format "for " (|> vars - (list@map ..code) + (list//map ..code) (text.join-with ..input-separator)) " in " (:representation source) " do" (..nest (:representation body!)) @@ -303,7 +303,7 @@ (def: #export (cond clauses else!) (-> (List [(Expression Any) Statement]) Statement Statement) - (list@fold (.function (_ [test then!] next!) - (..if test then! next!)) - else! - (list.reverse clauses))) + (list//fold (.function (_ [test then!] next!) + (..if test then! next!)) + else! + (list.reverse clauses))) diff --git a/stdlib/source/lux/target/php.lux b/stdlib/source/lux/target/php.lux index 308183868..67a893bab 100644 --- a/stdlib/source/lux/target/php.lux +++ b/stdlib/source/lux/target/php.lux @@ -8,7 +8,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." functor fold)]]] + ["." list ("#//." functor fold)]]] [macro ["." template]] [type @@ -137,7 +137,7 @@ (def: arguments (-> (List (Expression Any)) Text) - (|>> (list@map ..code) (text.join-with ..input-separator) ..group)) + (|>> (list//map ..code) (text.join-with ..input-separator) ..group)) (def: #export (apply/* args func) (-> (List (Expression Any)) (Expression Any) (Computation Any)) @@ -146,10 +146,10 @@ (def: parameters (-> (List Argument) Text) - (|>> (list@map (function (_ [reference? var]) - (.if reference? - (format "&" (:representation var)) - (:representation var)))) + (|>> (list//map (function (_ [reference? var]) + (.if reference? + (format "&" (:representation var)) + (:representation var)))) (text.join-with ..input-separator) ..group)) @@ -220,7 +220,7 @@ (def: #export (array/* values) (-> (List (Expression Any)) Literal) (|> values - (list@map ..code) + (list//map ..code) (text.join-with ..input-separator) ..group (format "array") @@ -233,8 +233,8 @@ (def: #export (array/** kvs) (-> (List [(Expression Any) (Expression Any)]) Literal) (|> kvs - (list@map (function (_ [key value]) - (format (:representation key) " => " (:representation value)))) + (list//map (function (_ [key value]) + (format (:representation key) " => " (:representation value)))) (text.join-with ..input-separator) ..group (format "array") @@ -386,7 +386,7 @@ (format "try " (..block (:representation body!)) text.new-line (|> excepts - (list@map catch) + (list//map catch) (text.join-with text.new-line))))) (template [<name> <keyword>] @@ -432,10 +432,10 @@ (def: #export (cond clauses else!) (-> (List [(Expression Any) Statement]) Statement Statement) - (list@fold (function (_ [test then!] next!) - (..if test then! next!)) - else! - (list.reverse clauses))) + (list//fold (function (_ [test then!] next!) + (..if test then! next!)) + else! + (list.reverse clauses))) (def: #export command-line-arguments Var diff --git a/stdlib/source/lux/target/python.lux b/stdlib/source/lux/target/python.lux index 2d7ff89a2..393ac68cf 100644 --- a/stdlib/source/lux/target/python.lux +++ b/stdlib/source/lux/target/python.lux @@ -13,7 +13,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." functor fold)]]] + ["." list ("#//." functor fold)]]] [macro ["." template] ["." code] @@ -151,7 +151,7 @@ ..expression (format left-delimiter (|> entries - (list@map entry-serializer) + (list//map entry-serializer) (text.join-with ", ")) right-delimiter)))) @@ -184,7 +184,7 @@ (-> (Expression Any) (List (Expression Any)) (Computation Any)) (<| :abstraction ..expression - (format (:representation func) "(" (text.join-with ", " (list@map ..code args)) ")"))) + (format (:representation func) "(" (text.join-with ", " (list//map ..code args)) ")"))) (template [<name> <brand> <prefix>] [(def: (<name> var) @@ -202,7 +202,7 @@ ..expression (format (:representation func) (format "(" (|> args - (list@map (function (_ arg) (format (:representation arg) ", "))) + (list//map (function (_ arg) (format (:representation arg) ", "))) (text.join-with "")) (<splat> extra) ")"))))] @@ -277,13 +277,13 @@ (-> (List (Var Any)) (Expression Any) (Computation Any)) (<| :abstraction ..expression - (format "lambda " (|> arguments (list@map ..code) (text.join-with ", ")) ": " + (format "lambda " (|> arguments (list//map ..code) (text.join-with ", ")) ": " (:representation body)))) (def: #export (set vars value) (-> (List (Location Any)) (Expression Any) (Statement Any)) (:abstraction - (format (|> vars (list@map ..code) (text.join-with ", ")) + (format (|> vars (list//map ..code) (text.join-with ", ")) " = " (:representation value)))) @@ -352,10 +352,10 @@ (format "try:" (..nest (:representation body!)) (|> excepts - (list@map (function (_ [classes exception catch!]) - (format text.new-line "except (" (text.join-with ", " (list@map ..code classes)) - ") as " (:representation exception) ":" - (..nest (:representation catch!))))) + (list//map (function (_ [classes exception catch!]) + (format text.new-line "except (" (text.join-with ", " (list//map ..code classes)) + ") as " (:representation exception) ":" + (..nest (:representation catch!))))) (text.join-with ""))))) (template [<name> <keyword>] @@ -373,7 +373,7 @@ (-> SVar (List (Ex [k] (Var k))) (Statement Any) (Statement Any)) (:abstraction (format "def " (:representation name) - "(" (|> args (list@map ..code) (text.join-with ", ")) "):" + "(" (|> args (list//map ..code) (text.join-with ", ")) "):" (..nest (:representation body))))) (def: #export (import module-name) @@ -388,17 +388,17 @@ (def: #export (cond clauses else!) (-> (List [(Expression Any) (Statement Any)]) (Statement Any) (Statement Any)) - (list@fold (.function (_ [test then!] next!) - (..if test then! next!)) - else! - (list.reverse clauses))) + (list//fold (.function (_ [test then!] next!) + (..if test then! next!)) + else! + (list.reverse clauses))) (syntax: (arity-inputs {arity s.nat}) (wrap (case arity 0 (.list) _ (|> (dec arity) (enum.range n.enum 0) - (list@map (|>> %.nat code.local-identifier)))))) + (list//map (|>> %.nat code.local-identifier)))))) (syntax: (arity-types {arity s.nat}) (wrap (list.repeat arity (` (Expression Any))))) diff --git a/stdlib/source/lux/target/ruby.lux b/stdlib/source/lux/target/ruby.lux index 9ac60c6c0..21ac6f73d 100644 --- a/stdlib/source/lux/target/ruby.lux +++ b/stdlib/source/lux/target/ruby.lux @@ -8,7 +8,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." functor fold)]]] + ["." list ("#//." functor fold)]]] [macro ["." template]] [type @@ -171,15 +171,15 @@ (def: #export array (-> (List (Expression Any)) Literal) - (|>> (list@map (|>> :representation)) + (|>> (list//map (|>> :representation)) (text.join-with ..input-separator) (text.enclose ["[" "]"]) :abstraction)) (def: #export hash (-> (List [(Expression Any) (Expression Any)]) Literal) - (|>> (list@map (.function (_ [k v]) - (format (:representation k) " => " (:representation v)))) + (|>> (list//map (.function (_ [k v]) + (format (:representation k) " => " (:representation v)))) (text.join-with ..input-separator) (text.enclose ["{" "}"]) :abstraction)) @@ -187,7 +187,7 @@ (def: #export (apply/* args func) (-> (List (Expression Any)) (Expression Any) (Computation Any)) (|> args - (list@map (|>> :representation)) + (list//map (|>> :representation)) (text.join-with ..input-separator) (text.enclose ["(" ")"]) (format (:representation func)) @@ -229,7 +229,7 @@ (-> (List (Location Any)) (Expression Any) (Statement Any)) (:abstraction (format (|> vars - (list@map (|>> :representation)) + (list//map (|>> :representation)) (text.join-with ..input-separator)) " = " (:representation value) ..statement-suffix))) @@ -280,10 +280,10 @@ (format "begin" text.new-line (:representation body!) (|> rescues - (list@map (.function (_ [classes exception rescue]) - (format text.new-line "rescue " (text.join-with ..input-separator classes) - " => " (:representation exception) - text.new-line (..nest (:representation rescue))))) + (list//map (.function (_ [classes exception rescue]) + (format text.new-line "rescue " (text.join-with ..input-separator classes) + " => " (:representation exception) + text.new-line (..nest (:representation rescue))))) (text.join-with text.new-line))))) (def: #export (return value) @@ -312,7 +312,7 @@ ..block (format "def " (:representation name) (|> args - (list@map (|>> :representation)) + (list//map (|>> :representation)) (text.join-with ..input-separator) (text.enclose ["(" ")"])) text.new-line (:representation body!)))) @@ -320,7 +320,7 @@ (def: #export (lambda name args body!) (-> (Maybe LVar) (List (Var Any)) (Statement Any) Literal) (let [proc (|> (format (|> args - (list@map (|>> :representation)) + (list//map (|>> :representation)) (text.join-with ..input-separator) (text.enclose' "|")) " " @@ -380,7 +380,7 @@ (def: #export (cond clauses else!) (-> (List [(Expression Any) (Statement Any)]) (Statement Any) (Statement Any)) - (list@fold (.function (_ [test then!] next!) - (..if test then! next!)) - else! - (list.reverse clauses))) + (list//fold (.function (_ [test then!] next!) + (..if test then! next!)) + else! + (list.reverse clauses))) diff --git a/stdlib/source/lux/target/scheme.lux b/stdlib/source/lux/target/scheme.lux index c218367fa..342338450 100644 --- a/stdlib/source/lux/target/scheme.lux +++ b/stdlib/source/lux/target/scheme.lux @@ -8,7 +8,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." functor fold)]]] + ["." list ("#//." functor fold)]]] [macro ["." template]] [type @@ -52,14 +52,14 @@ _ (|> (format " . " (:representation rest)) (format (|> mandatory - (list@map ..code) + (list//map ..code) (text.join-with " "))) (text.enclose ["(" ")"]) :abstraction)) #.None (|> mandatory - (list@map ..code) + (list//map ..code) (text.join-with " ") (text.enclose ["(" ")"]) :abstraction))) @@ -127,7 +127,7 @@ (def: form (-> (List (Code Any)) Code) - (|>> (list@map ..code) + (|>> (list//map ..code) (text.join-with " ") (text.enclose ["(" ")"]) :abstraction)) @@ -264,9 +264,9 @@ (-> (List [<var> Expression]) Expression Computation) (..form (list (..global <scheme-name>) (|> bindings - (list@map (.function (_ [binding/name binding/value]) - (..form (list (|> binding/name <pre>) - binding/value)))) + (list//map (.function (_ [binding/name binding/value]) + (..form (list (|> binding/name <pre>) + binding/value)))) ..form) body)))] @@ -288,10 +288,10 @@ (def: #export (cond clauses else) (-> (List [Expression Expression]) Expression Computation) - (|> (list@fold (.function (_ [test then] next) - (if test then next)) - else - (list.reverse clauses)) + (|> (list//fold (.function (_ [test then] next) + (if test then next)) + else + (list.reverse clauses)) :representation :abstraction)) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 2f54866c0..24b05c1fa 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -7,7 +7,7 @@ ["." exception (#+ exception:)] ["." io] [concurrency - ["." promise (#+ Promise) ("#@." monad)]] + ["." promise (#+ Promise) ("#//." monad)]] ["<>" parser ["<c>" code]]] [data @@ -20,13 +20,13 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." functor fold)] + ["." list ("#//." functor fold)] ["." set (#+ Set)]]] [time ["." instant] ["." duration (#+ Duration)]] [math - ["." random (#+ Random) ("#@." monad)]] + ["." random (#+ Random) ("#//." monad)]] ["." meta] [macro [syntax (#+ syntax:)] @@ -90,12 +90,12 @@ (def: #export (context description) (-> Text Test Test) - (random@map (promise@map (function (_ [counters documentation]) - [counters (|> documentation - (text.split-all-with ..separator) - (list@map (|>> (format context-prefix))) - (text.join-with ..separator) - (format description ..separator))])))) + (random//map (promise//map (function (_ [counters documentation]) + [counters (|> documentation + (text.split-all-with ..separator) + (list//map (|>> (format context-prefix))) + (text.join-with ..separator) + (format description ..separator))])))) (def: failure-prefix "[Failure] ") (def: success-prefix "[Success] ") @@ -104,13 +104,13 @@ (-> Text Test) (|>> (format ..failure-prefix) [failure] - promise@wrap - random@wrap)) + promise//wrap + random//wrap)) (def: #export (assert message condition) {#.doc "Check that a condition is #1, and fail with the given message otherwise."} (-> Text Bit Assertion) - (<| promise@wrap + (<| promise//wrap (if condition [success (format ..success-prefix message)] [failure (format ..failure-prefix message)]))) @@ -239,13 +239,13 @@ (def: (claim' coverage condition) (-> (List Name) Bit Assertion) (let [message (|> coverage - (list@map %.name) + (list//map %.name) (text.join-with " & ")) coverage (set.from-list name.hash coverage)] (|> (..assert message condition) - (promise@map (function (_ [counters documentation]) - [(update@ #actual-coverage (set.union coverage) counters) - documentation]))))) + (promise//map (function (_ [counters documentation]) + [(update@ #actual-coverage (set.union coverage) counters) + documentation]))))) (def: (cover' coverage condition) (-> (List Name) Bit Test) @@ -255,13 +255,13 @@ (def: (with-cover' coverage test) (-> (List Name) Test Test) (let [context (|> coverage - (list@map %.name) + (list//map %.name) (text.join-with " & ")) coverage (set.from-list name.hash coverage)] - (random@map (promise@map (function (_ [counters documentation]) - [(update@ #actual-coverage (set.union coverage) counters) - documentation])) - (..context context test)))) + (random//map (promise//map (function (_ [counters documentation]) + [(update@ #actual-coverage (set.union coverage) counters) + documentation])) + (..context context test)))) (def: (name-code name) (-> Name Code) @@ -276,9 +276,9 @@ (template [<macro> <function>] [(syntax: #export (<macro> {coverage (<c>.tuple (<>.many <c>.any))} condition) - (let [coverage (list@map (function (_ definition) - (` ((~! ..reference) (~ definition)))) - coverage)] + (let [coverage (list//map (function (_ definition) + (` ((~! ..reference) (~ definition)))) + coverage)] (wrap (list (` ((~! <function>) (: (.List .Name) (.list (~+ coverage))) @@ -290,9 +290,9 @@ (syntax: #export (with-cover {coverage (<c>.tuple (<>.many <c>.any))} test) - (let [coverage (list@map (function (_ definition) - (` ((~! ..reference) (~ definition)))) - coverage)] + (let [coverage (list//map (function (_ definition) + (` ((~! ..reference) (~ definition)))) + coverage)] (wrap (list (` ((~! ..with-cover') (: (.List .Name) (.list (~+ coverage))) @@ -306,12 +306,12 @@ (-> Text Text Test Test) (let [coverage (|> coverage (text.split-all-with ..coverage-separator) - (list@map (|>> [module])) + (list//map (|>> [module])) (set.from-list name.hash))] (|> (..context module test) - (random@map (promise@map (function (_ [counters documentation]) - [(update@ #expected-coverage (set.union coverage) counters) - documentation])))))) + (random//map (promise//map (function (_ [counters documentation]) + [(update@ #expected-coverage (set.union coverage) counters) + documentation])))))) (syntax: #export (covering {module <c>.identifier} test) @@ -320,7 +320,7 @@ definitions (meta.definitions module) #let [coverage (|> definitions (list.filter (|>> product.right product.left)) - (list@map product.left) + (list//map product.left) (text.join-with ..coverage-separator))]] (wrap (list (` ((~! ..covering') (~ (code.text module)) @@ -350,12 +350,12 @@ (..assert (exception.construct ..error-during-execution [error]) false)) io.io promise.future - promise@join)))]] + promise//join)))]] (wrap (do {! promise.monad} - [assertions (monad.seq ! (list@map run! tests))] + [assertions (monad.seq ! (list//map run! tests))] (wrap [(|> assertions - (list@map product.left) - (list@fold ..add-counters ..start)) + (list//map product.left) + (list//fold ..add-counters ..start)) (|> assertions - (list@map product.right) + (list//map product.right) (text.join-with ..separator))]))))) diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux index a3eaa03e3..441be4bed 100644 --- a/stdlib/source/lux/tool/compiler/default/init.lux +++ b/stdlib/source/lux/tool/compiler/default/init.lux @@ -9,13 +9,13 @@ [data [binary (#+ Binary)] ["." product] - ["." text ("#@." hash) + ["." text ("#//." hash) ["%" format (#+ format)]] [collection - ["." list ("#@." functor)] + ["." list ("#//." functor)] ["." dictionary] ["." set] - ["." row ("#@." functor)]]] + ["." row ("#//." functor)]]] ["." meta] [world ["." file]]] @@ -208,7 +208,7 @@ (def: (default-dependencies prelude input) (-> Module ///.Input (List Module)) (list& archive.runtime-module - (if (text@= prelude (get@ #///.module input)) + (if (text//= prelude (get@ #///.module input)) (list) (list prelude)))) @@ -226,7 +226,7 @@ {#///.dependencies dependencies #///.process (function (_ state archive) (do {! try.monad} - [#let [hash (text@hash (get@ #///.code input))] + [#let [hash (text//hash (get@ #///.code input))] [state [source buffer]] (<| (///phase.run' state) (..begin dependencies hash input)) #let [module (get@ #///.module input)]] @@ -247,15 +247,15 @@ (wrap [state (#.Right [[descriptor (document.write key analysis-module)] (|> final-buffer - (row@map (function (_ [name directive]) - [name (write-directive directive)])))])])) + (row//map (function (_ [name directive]) + [name (write-directive directive)])))])])) (#.Some [source requirements temporary-payload]) (let [[temporary-buffer temporary-registry] temporary-payload] (wrap [state (#.Left {#///.dependencies (|> requirements (get@ #///directive.imports) - (list@map product.left)) + (list//map product.left)) #///.process (function (_ state archive) (recur (<| (///phase.run' state) (do {! ///phase.monad} diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index 5e3ad19f9..3e9d7a647 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -9,20 +9,20 @@ ["." try (#+ Try)] ["." exception (#+ exception:)] [concurrency - ["." promise (#+ Promise Resolver) ("#@." monad)] + ["." promise (#+ Promise Resolver) ("#//." monad)] ["." stm (#+ Var STM)]]] [data ["." binary (#+ Binary)] ["." bit] ["." product] ["." maybe] - ["." text ("#@." equivalence) + ["." text ("#//." equivalence) ["%" format (#+ format)]] [collection ["." dictionary (#+ Dictionary)] - ["." row (#+ Row) ("#@." fold)] + ["." row (#+ Row) ("#//." fold)] ["." set (#+ Set)] - ["." list ("#@." monoid functor fold)]] + ["." list ("#//." monoid functor fold)]] [format ["_" binary (#+ Writer)]]] [world @@ -210,13 +210,13 @@ extender)] _ (ioW.enable (get@ #&file-system platform) static) [archive analysis-state bundles] (ioW.thaw (get@ #host platform) (get@ #&file-system platform) static import compilation-sources) - state (promise@wrap (initialize-state extender bundles analysis-state state))] + state (promise//wrap (initialize-state extender bundles analysis-state state))] (if (archive.archived? archive archive.runtime-module) (wrap [state archive]) (do (try.with promise.monad) [[state [archive payload]] (|> (..process-runtime archive platform) (///phase.run' state) - promise@wrap) + promise//wrap) _ (..cache-module static platform 0 payload)] (wrap [state archive]))))) @@ -228,9 +228,9 @@ #///directive.state #extension.state #///generation.log]) - (row@fold (function (_ right left) - (format left text.new-line right)) - ""))) + (row//fold (function (_ right left) + (format left text.new-line right)) + ""))) (def: with-reset-log (All [<type-vars>] @@ -277,10 +277,10 @@ (|> mapping (dictionary.upsert source ..empty (set.add target)) (dictionary.update source (set.union forward)))] - (list@fold (function (_ previous) - (dictionary.upsert previous ..empty (set.add target))) - with-dependence+transitives - (set.to-list backward))))))] + (list//fold (function (_ previous) + (dictionary.upsert previous ..empty (set.add target))) + with-dependence+transitives + (set.to-list backward))))))] (|> dependence (update@ #depends-on (update-dependence @@ -315,7 +315,7 @@ (def: (verify-dependencies importer importee dependence) (-> Module Module Dependence (Try Any)) - (cond (text@= importer importee) + (cond (text//= importer importee) (exception.throw ..module-cannot-import-itself [importer]) (..circular-dependency? importer importee dependence) @@ -355,7 +355,7 @@ (:assume (stm.commit (do {! stm.monad} - [dependence (if (text@= archive.runtime-module importer) + [dependence (if (text//= archive.runtime-module importer) (stm.read dependence) (do ! [[_ dependence] (stm.update (..depend importer module) dependence)] @@ -369,7 +369,7 @@ (do ! [[archive state] (stm.read current)] (if (archive.archived? archive module) - (wrap [(promise@wrap (#try.Success [archive state])) + (wrap [(promise//wrap (#try.Success [archive state])) #.None]) (do ! [@pending (stm.read pending)] @@ -399,7 +399,7 @@ signal])])) (#try.Failure error) - (wrap [(promise@wrap (#try.Failure error)) + (wrap [(promise//wrap (#try.Failure error)) #.None]))))))))))}) _ (case signal #.None @@ -435,7 +435,7 @@ (wrap [module lux-module]))) (archive.archived archive)) #let [additions (|> modules - (list@map product.left) + (list//map product.left) (set.from-list text.hash))]] (wrap (update@ [#extension.state #///directive.analysis @@ -445,11 +445,11 @@ (|> analysis-state (:coerce .Lux) (update@ #.modules (function (_ current) - (list@compose (list.filter (|>> product.left - (set.member? additions) - not) - current) - modules))) + (list//compose (list.filter (|>> product.left + (set.member? additions) + not) + current) + modules))) :assume)) state)))) @@ -486,7 +486,7 @@ all-dependencies (: (List Module) (list))] (let [new-dependencies (get@ #///.dependencies compilation) - all-dependencies (list@compose new-dependencies all-dependencies) + all-dependencies (list//compose new-dependencies all-dependencies) continue! (:share [<type-vars>] {<Platform> platform} @@ -502,11 +502,11 @@ (#.Cons _) (do ! [archive,document+ (|> new-dependencies - (list@map (import! module)) + (list//map (import! module)) (monad.seq ..monad)) #let [archive (|> archive,document+ - (list@map product.left) - (list@fold archive.merge archive))]] + (list//map product.left) + (list//fold archive.merge archive))]] (wrap [archive (try.assume (..updated-state archive state))])))] (case ((get@ #///.process compilation) @@ -533,11 +533,11 @@ (..with-reset-log state)]) (#try.Failure error) - (promise@wrap (#try.Failure error))))) + (promise//wrap (#try.Failure error))))) (#try.Failure error) (do ! [_ (ioW.freeze (get@ #&file-system platform) static archive)] - (promise@wrap (#try.Failure error))))))))))] + (promise//wrap (#try.Failure error))))))))))] (compiler archive.runtime-module compilation-module))) )) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index 0e6d9ba7d..1c50d6eb5 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -273,9 +273,6 @@ (///bundle.install "%" (binary Frac Frac Frac)) (///bundle.install "=" (binary Frac Frac Bit)) (///bundle.install "<" (binary Frac Frac Bit)) - (///bundle.install "smallest" (nullary Frac)) - (///bundle.install "min" (nullary Frac)) - (///bundle.install "max" (nullary Frac)) (///bundle.install "i64" (unary Frac Int)) (///bundle.install "encode" (unary Frac Text)) (///bundle.install "decode" (unary Text (type (Maybe Frac))))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux index 13d67f8fa..2122a38a4 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux @@ -1,6 +1,5 @@ (.module: [lux #* - [host (#+ import:)] [abstract ["." monad (#+ do)]] [control @@ -57,37 +56,6 @@ ) ## [[Numbers]] -(for {@.old - (as-is (import: java/lang/Double - (#static MIN_VALUE double) - (#static MAX_VALUE double)) - - (template [<name> <const>] - [(def: (<name> _) - (Nullary Expression) - (//primitive.f64 <const>))] - - [f64//smallest (java/lang/Double::MIN_VALUE)] - [f64//min (f.* -1.0 (java/lang/Double::MAX_VALUE))] - [f64//max (java/lang/Double::MAX_VALUE)] - )) - - @.js - (as-is (import: Number - (#static MIN_VALUE Frac) - (#static MAX_VALUE Frac)) - - (template [<name> <const>] - [(def: (<name> _) - (Nullary Expression) - (//primitive.f64 <const>))] - - [f64//smallest (Number::MIN_VALUE)] - [f64//min (f.* -1.0 (Number::MAX_VALUE))] - [f64//max (Number::MAX_VALUE)] - ) - )}) - (def: f64//decode (Unary Expression) (|>> list @@ -212,9 +180,6 @@ (/.install "%" (binary (product.uncurry _.%))) (/.install "=" (binary (product.uncurry _.=))) (/.install "<" (binary (product.uncurry _.<))) - (/.install "smallest" (nullary f64//smallest)) - (/.install "min" (nullary f64//min)) - (/.install "max" (nullary f64//max)) (/.install "i64" (unary //runtime.i64//from-number)) (/.install "encode" (unary (_.do "toString" (list)))) (/.install "decode" (unary f64//decode))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux index 68c69d153..5c98aeba1 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux @@ -1,6 +1,5 @@ (.module: [lux (#- Type) - [host (#+ import:)] [abstract ["." monad (#+ do)]] [control @@ -187,22 +186,6 @@ [i64::logical-right-shift _.lushr] ) -(import: java/lang/Double - (#static MIN_VALUE double) - (#static MAX_VALUE double)) - -(template [<name> <const>] - [(def: (<name> _) - (Nullary (Bytecode Any)) - ($_ _.compose - (_.double <const>) - (///value.wrap type.double)))] - - [f64::smallest (java/lang/Double::MIN_VALUE)] - [f64::min (f.* -1.0 (java/lang/Double::MAX_VALUE))] - [f64::max (java/lang/Double::MAX_VALUE)] - ) - (template [<name> <type> <op>] [(def: (<name> [paramG subjectG]) (Binary (Bytecode Any)) @@ -313,9 +296,6 @@ (/////bundle.install "%" (binary ..f64::%)) (/////bundle.install "=" (binary ..f64::=)) (/////bundle.install "<" (binary ..f64::<)) - (/////bundle.install "smallest" (nullary ..f64::smallest)) - (/////bundle.install "min" (nullary ..f64::min)) - (/////bundle.install "max" (nullary ..f64::max)) (/////bundle.install "i64" (unary ..f64::i64)) (/////bundle.install "encode" (unary ..f64::encode)) (/////bundle.install "decode" (unary ..f64::decode))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux index eb3529f6d..b9db6e702 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux @@ -1,6 +1,5 @@ (.module: [lux #* - [host (#+ import:)] [abstract ["." monad (#+ do)]] [control @@ -57,20 +56,6 @@ (/.install "frac" (unary (_./ (_.float +1.0)))) (/.install "char" (unary (!unary "string.char")))))) -(import: java/lang/Double - (#static MIN_VALUE double) - (#static MAX_VALUE double)) - -(template [<name> <const>] - [(def: (<name> _) - (Nullary Literal) - (_.float <const>))] - - [frac//smallest (java/lang/Double::MIN_VALUE)] - [frac//min (f.* -1.0 (java/lang/Double::MAX_VALUE))] - [frac//max (java/lang/Double::MAX_VALUE)] - ) - (def: frac//decode (Unary (Expression Any)) (|>> list _.apply/* (|> (_.var "tonumber")) _.return (_.closure (list)) //runtime.lux//try)) @@ -86,9 +71,6 @@ (/.install "%" (binary (product.uncurry _.%))) (/.install "=" (binary (product.uncurry _.=))) (/.install "<" (binary (product.uncurry _.<))) - (/.install "smallest" (nullary frac//smallest)) - (/.install "min" (nullary frac//min)) - (/.install "max" (nullary frac//max)) (/.install "int" (unary (!unary "math.floor"))) (/.install "encode" (unary (!unary "tostring"))) (/.install "decode" (unary ..frac//decode))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux index 2c43370a6..1c58fec4c 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux @@ -1,6 +1,5 @@ (.module: [lux #* - [host (#+ import:)] [abstract ["." monad (#+ do)]] [control @@ -54,20 +53,6 @@ (/.install "frac" (unary _.float/1)) (/.install "char" (unary _.chr/1))))) -(import: java/lang/Double - (#static MIN_VALUE double) - (#static MAX_VALUE double)) - -(template [<name> <const>] - [(def: (<name> _) - (Nullary (Expression Any)) - (_.float <const>))] - - [frac//smallest (java/lang/Double::MIN_VALUE)] - [frac//min (f.* -1.0 (java/lang/Double::MAX_VALUE))] - [frac//max (java/lang/Double::MAX_VALUE)] - ) - (def: frac-procs Bundle (<| (/.prefix "frac") @@ -79,9 +64,6 @@ (/.install "%" (binary (product.uncurry _.%))) (/.install "=" (binary (product.uncurry _.=))) (/.install "<" (binary (product.uncurry _.<))) - (/.install "smallest" (nullary frac//smallest)) - (/.install "min" (nullary frac//min)) - (/.install "max" (nullary frac//max)) (/.install "int" (unary _.int/1)) (/.install "encode" (unary _.repr/1)) (/.install "decode" (unary //runtime.frac//decode))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux index ec5ba8e26..0ab831668 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux @@ -1,6 +1,5 @@ (.module: [lux #* - [host (#+ import:)] [abstract ["." monad (#+ do)]] [control @@ -50,20 +49,6 @@ (/.install "-" (binary (..keep-i64 (product.uncurry _.-)))) ))) -(import: java/lang/Double - (#static MIN_VALUE double) - (#static MAX_VALUE double)) - -(template [<name> <const>] - [(def: (<name> _) - (Nullary (Expression Any)) - (_.float <const>))] - - [frac//smallest (java/lang/Double::MIN_VALUE)] - [frac//min (f.* -1.0 (java/lang/Double::MAX_VALUE))] - [frac//max (java/lang/Double::MAX_VALUE)] - ) - (def: int-procs Bundle (<| (/.prefix "int") @@ -86,9 +71,6 @@ (/.install "%" (binary (product.uncurry _.%))) (/.install "=" (binary (product.uncurry _.=))) (/.install "<" (binary (product.uncurry _.<))) - (/.install "smallest" (nullary frac//smallest)) - (/.install "min" (nullary frac//min)) - (/.install "max" (nullary frac//max)) (/.install "int" (unary (_.do "floor" (list)))) (/.install "encode" (unary (_.do "to_s" (list)))) (/.install "decode" (unary //runtime.f64//decode))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/extension/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/extension/common.lux index 701738854..750688dd6 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/extension/common.lux @@ -1,6 +1,5 @@ (.module: [lux #* - [host (#+ import:)] [abstract ["." monad (#+ do)]] [control @@ -64,20 +63,6 @@ (bundle.install "char" (unary (|>> _.code-char/1 _.string/1))) ))) -(import: java/lang/Double - (#static MIN_VALUE double) - (#static MAX_VALUE double)) - -(template [<name> <const>] - [(def: (<name> _) - (Nullary (Expression Any)) - (_.double <const>))] - - [f64//smallest (java/lang/Double::MIN_VALUE)] - [f64//min (f.* -1.0 (java/lang/Double::MAX_VALUE))] - [f64//max (java/lang/Double::MAX_VALUE)] - ) - (def: f64-procs Bundle (<| (bundle.prefix "f64") @@ -89,9 +74,6 @@ (bundle.install "%" (binary (product.uncurry _.mod))) (bundle.install "=" (binary (product.uncurry _.=))) (bundle.install "<" (binary (product.uncurry _.<))) - (bundle.install "smallest" (nullary f64//smallest)) - (bundle.install "min" (nullary f64//min)) - (bundle.install "max" (nullary f64//max)) (bundle.install "i64" (unary _.floor/1)) (bundle.install "encode" (unary _.write-to-string/1)) (bundle.install "decode" (unary (let [@temp (_.var "temp")] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/extension/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/extension/common.lux index 234192ede..2a4c4c50d 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/extension/common.lux @@ -1,6 +1,5 @@ (.module: [lux #* - [host (#+ import:)] [abstract ["." monad (#+ do)]] [control @@ -56,20 +55,6 @@ (bundle.install "frac" (unary _.floatval/1)) (bundle.install "char" (unary _.chr/1))))) -(import: java/lang/Double - (#static MIN_VALUE double) - (#static MAX_VALUE double)) - -(template [<name> <const>] - [(def: (<name> _) - (Nullary (Expression Any)) - (_.float <const>))] - - [frac//smallest (java/lang/Double::MIN_VALUE)] - [frac//min (f.* -1.0 (java/lang/Double::MAX_VALUE))] - [frac//max (java/lang/Double::MAX_VALUE)] - ) - (def: frac-procs Bundle (<| (bundle.prefix "frac") @@ -81,9 +66,6 @@ (bundle.install "%" (binary (product.uncurry _.%))) (bundle.install "=" (binary (product.uncurry _.=))) (bundle.install "<" (binary (product.uncurry _.<))) - (bundle.install "smallest" (nullary frac//smallest)) - (bundle.install "min" (nullary frac//min)) - (bundle.install "max" (nullary frac//max)) (bundle.install "int" (unary _.intval/1)) (bundle.install "encode" (unary _.strval/1)) (bundle.install "decode" (unary (|>> _.floatval/1 ///runtime.some))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux index b13bc5834..782838b92 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux @@ -1,6 +1,5 @@ (.module: [lux #* - [host (#+ import:)] [abstract ["." monad (#+ do)]] [control @@ -100,20 +99,6 @@ Binary (///runtime.i64//logical-right-shift (_.remainder/2 (_.int +64) paramO) subjectO)) -(import: java/lang/Double - (#static MIN_VALUE double) - (#static MAX_VALUE double)) - -(template [<name> <const> <encode>] - [(def: (<name> _) - Nullary - (<encode> <const>))] - - [f64::smallest (Double::MIN_VALUE) _.float] - [f64::min (f.* -1.0 (Double::MAX_VALUE)) _.float] - [f64::max (Double::MAX_VALUE) _.float] - ) - (template [<name> <op>] [(def: (<name> [subjectO paramO]) Binary @@ -185,9 +170,6 @@ (bundle.install "%" (binary f64::%)) (bundle.install "=" (binary f64::=)) (bundle.install "<" (binary f64::<)) - (bundle.install "smallest" (nullary f64::smallest)) - (bundle.install "min" (nullary f64::min)) - (bundle.install "max" (nullary f64::max)) (bundle.install "i64" (unary _.exact/1)) (bundle.install "encode" (unary _.number->string/1)) (bundle.install "decode" (unary ///runtime.frac//decode))))) diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux index 8826b9ed9..a4d139aa4 100644 --- a/stdlib/source/poly/lux/abstract/equivalence.lux +++ b/stdlib/source/poly/lux/abstract/equivalence.lux @@ -11,14 +11,14 @@ ["." bit] ["." maybe] [number - ["." nat ("#@." decimal)] + ["." nat ("#//." decimal)] ["." int] ["." rev] ["." frac]] - ["." text ("#@." monoid) + ["." text ("#//." monoid) ["%" format (#+ format)]] [collection - ["." list ("#@." monad)] + ["." list ("#//." monad)] ["." row] ["." array] ["." queue] @@ -115,15 +115,15 @@ (wrap (` (: (~ (@Equivalence inputT)) (function ((~ g!_) (~ g!left) (~ g!right)) (case [(~ g!left) (~ g!right)] - (~+ (list@join (list@map (function (_ [tag g!eq]) - (if (nat.= last tag) - (list (` [((~ (code.nat (dec tag))) #1 (~ g!left)) - ((~ (code.nat (dec tag))) #1 (~ g!right))]) - (` ((~ g!eq) (~ g!left) (~ g!right)))) - (list (` [((~ (code.nat tag)) #0 (~ g!left)) - ((~ (code.nat tag)) #0 (~ g!right))]) - (` ((~ g!eq) (~ g!left) (~ g!right)))))) - (list.enumeration members)))) + (~+ (list//join (list//map (function (_ [tag g!eq]) + (if (nat.= last tag) + (list (` [((~ (code.nat (dec tag))) #1 (~ g!left)) + ((~ (code.nat (dec tag))) #1 (~ g!right))]) + (` ((~ g!eq) (~ g!left) (~ g!right)))) + (list (` [((~ (code.nat tag)) #0 (~ g!left)) + ((~ (code.nat tag)) #0 (~ g!right))]) + (` ((~ g!eq) (~ g!left) (~ g!right)))))) + (list.enumeration members)))) (~ g!_) #0)))))) ## Tuples @@ -131,13 +131,13 @@ [g!eqs (<type>.tuple (p.many equivalence)) #let [g!_ (code.local-identifier "_____________") indices (list.indices (list.size g!eqs)) - g!lefts (list@map (|>> nat@encode (text@compose "left") code.local-identifier) indices) - g!rights (list@map (|>> nat@encode (text@compose "right") code.local-identifier) indices)]] + g!lefts (list//map (|>> nat//encode (text//compose "left") code.local-identifier) indices) + g!rights (list//map (|>> nat//encode (text//compose "right") code.local-identifier) indices)]] (wrap (` (: (~ (@Equivalence inputT)) (function ((~ g!_) [(~+ g!lefts)] [(~+ g!rights)]) (and (~+ (|> (list.zip/3 g!eqs g!lefts g!rights) - (list@map (function (_ [g!eq g!left g!right]) - (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) + (list//map (function (_ [g!eq g!left g!right]) + (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) ## Type recursion (do ! [[g!self bodyC] (<type>.recursive equivalence) @@ -156,7 +156,7 @@ (do ! [[funcC varsC bodyC] (<type>.polymorphic equivalence)] (wrap (` (: (All [(~+ varsC)] - (-> (~+ (list@map (|>> (~) ((~! /.Equivalence)) (`)) varsC)) + (-> (~+ (list//map (|>> (~) ((~! /.Equivalence)) (`)) varsC)) ((~! /.Equivalence) ((~ (poly.to-code *env* inputT)) (~+ varsC))))) (function ((~ funcC) (~+ varsC)) (~ bodyC)))))) diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index 9cc39c994..afe34c404 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -18,14 +18,14 @@ ["." product] [number ["." i64] - ["n" nat ("#@." decimal)] + ["n" nat ("#//." decimal)] ["." int] - ["." frac ("#@." decimal)]] - ["." text ("#@." equivalence) + ["." frac ("#//." decimal)]] + ["." text ("#//." equivalence) ["%" format (#+ format)]] [collection - ["." list ("#@." fold monad)] - ["." row (#+ Row row) ("#@." monad)] + ["." list ("#//." fold monad)] + ["." row (#+ Row row) ("#//." monad)] ["d" dictionary]]] [time ## ["." instant] @@ -146,8 +146,8 @@ codec//encode))] (wrap (` (: (~ (@JSON//encode inputT)) (|>> ((~! d.entries)) - ((~! list@map) (function ((~ g!_) [(~ g!key) (~ g!val)]) - [(~ g!key) ((~ =val=) (~ g!val))])) + ((~! list//map) (function ((~ g!_) [(~ g!key) (~ g!val)]) + [(~ g!key) ((~ =val=) (~ g!val))])) ((~! d.from-list) (~! text.hash)) #/.Object))))) (do ! @@ -161,7 +161,7 @@ (<type>.exactly .List) codec//encode))] (wrap (` (: (~ (@JSON//encode inputT)) - (|>> ((~! list@map) (~ =sub=)) ((~! row.from-list)) #/.Array))))) + (|>> ((~! list//map) (~ =sub=)) ((~! row.from-list)) #/.Array))))) (do ! [#let [g!_ (code.local-identifier "_______") g!input (code.local-identifier "_______input")] @@ -170,28 +170,28 @@ (wrap (` (: (~ (@JSON//encode inputT)) (function ((~ g!_) (~ g!input)) (case (~ g!input) - (~+ (list@join (list@map (function (_ [tag g!encode]) - (if (n.= last tag) - (list (` ((~ (code.nat (dec tag))) #1 (~ g!input))) - (` ((~! /.json) [(~ (code.frac (..tag (dec tag)))) - #1 - ((~ g!encode) (~ g!input))]))) - (list (` ((~ (code.nat tag)) #0 (~ g!input))) - (` ((~! /.json) [(~ (code.frac (..tag tag))) - #0 - ((~ g!encode) (~ g!input))]))))) - (list.enumeration members)))))))))) + (~+ (list//join (list//map (function (_ [tag g!encode]) + (if (n.= last tag) + (list (` ((~ (code.nat (dec tag))) #1 (~ g!input))) + (` ((~! /.json) [(~ (code.frac (..tag (dec tag)))) + #1 + ((~ g!encode) (~ g!input))]))) + (list (` ((~ (code.nat tag)) #0 (~ g!input))) + (` ((~! /.json) [(~ (code.frac (..tag tag))) + #0 + ((~ g!encode) (~ g!input))]))))) + (list.enumeration members)))))))))) (do ! [g!encoders (<type>.tuple (p.many codec//encode)) #let [g!_ (code.local-identifier "_______") g!members (|> (list.size g!encoders) list.indices - (list@map (|>> n@encode code.local-identifier)))]] + (list//map (|>> n//encode code.local-identifier)))]] (wrap (` (: (~ (@JSON//encode inputT)) (function ((~ g!_) [(~+ g!members)]) - ((~! /.json) [(~+ (list@map (function (_ [g!member g!encode]) - (` ((~ g!encode) (~ g!member)))) - (list.zip/2 g!members g!encoders)))])))))) + ((~! /.json) [(~+ (list//map (function (_ [g!member g!encode]) + (` ((~ g!encode) (~ g!member)))) + (list.zip/2 g!members g!encoders)))])))))) ## Type recursion (do ! [[selfC non-recC] (<type>.recursive codec//encode) @@ -208,8 +208,8 @@ (do ! [[funcC varsC bodyC] (<type>.polymorphic codec//encode)] (wrap (` (: (All [(~+ varsC)] - (-> (~+ (list@map (function (_ varC) (` (-> (~ varC) /.JSON))) - varsC)) + (-> (~+ (list//map (function (_ varC) (` (-> (~ varC) /.JSON))) + varsC)) (-> ((~ (poly.to-code *env* inputT)) (~+ varsC)) /.JSON))) (function ((~ funcC) (~+ varsC)) @@ -281,17 +281,17 @@ #let [last (dec (list.size members))]] (wrap (` (: (~ (@JSON//decode inputT)) ($_ ((~! p.or)) - (~+ (list@map (function (_ [tag memberC]) - (if (n.= last tag) - (` (|> (~ memberC) - ((~! p.after) ((~! </>.boolean!) (~ (code.bit #1)))) - ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag (dec tag)))))) - ((~! </>.array)))) - (` (|> (~ memberC) - ((~! p.after) ((~! </>.boolean!) (~ (code.bit #0)))) - ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag tag))))) - ((~! </>.array)))))) - (list.enumeration members)))))))) + (~+ (list//map (function (_ [tag memberC]) + (if (n.= last tag) + (` (|> (~ memberC) + ((~! p.after) ((~! </>.boolean!) (~ (code.bit #1)))) + ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag (dec tag)))))) + ((~! </>.array)))) + (` (|> (~ memberC) + ((~! p.after) ((~! </>.boolean!) (~ (code.bit #0)))) + ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag tag))))) + ((~! </>.array)))))) + (list.enumeration members)))))))) (do ! [g!decoders (<type>.tuple (p.many codec//decode))] (wrap (` (: (~ (@JSON//decode inputT)) @@ -312,7 +312,7 @@ (do ! [[funcC varsC bodyC] (<type>.polymorphic codec//decode)] (wrap (` (: (All [(~+ varsC)] - (-> (~+ (list@map (|>> (~) </>.Parser (`)) varsC)) + (-> (~+ (list//map (|>> (~) </>.Parser (`)) varsC)) (</>.Parser ((~ (poly.to-code *env* inputT)) (~+ varsC))))) (function ((~ funcC) (~+ varsC)) (~ bodyC)))))) diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index d4c9036f3..a9b4c9514 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -4,15 +4,16 @@ [monad (#+ do)]] [control [pipe (#+ do>)] - ["." try (#+ Try)] ["." io (#+ IO)] + ["." try (#+ Try)] + ["." exception (#+ exception:)] [parser ["." cli (#+ program:)] ["<c>" code]] [security ["!" capability]] [concurrency - ["." promise (#+ Promise)]]] + ["." promise (#+ Promise) ("#@." monad)]]] [data [binary (#+ Binary)] ["." text @@ -21,7 +22,8 @@ [format ["." xml]] [collection - ["." set]]] + ["." set] + ["." dictionary (#+ Dictionary)]]] [tool [compiler [language @@ -38,6 +40,7 @@ ["#." pom] ["#." cli] ["#." cache] + ["#." repository (#+ Address)] ["#." dependency #_ ["#" resolution]] ["#." command @@ -70,6 +73,14 @@ (log! (format "Could not resolve dependencies:" text.new-line error)))))) +(exception: (cannot-find-repository {repository Text} + {options (Dictionary Text Address)}) + (exception.report + ["Repository" (%.text repository)] + ["Options" (exception.enumerate (function (_ [name repo]) + (format (%.text name) " := " (%.text repo))) + (dictionary.entries options))])) + (program: [{[profile operation] /cli.command}] (do {! io.monad} [?profile (/input.read io.monad file.default profile)] @@ -92,10 +103,23 @@ (exec (/command/install.do! (file.async file.default) profile) (wrap [])) - (#/cli.Deploy repository user password) - (exec (/command/deploy.do! repository user password profile) - (wrap [])) + (#/cli.Deploy repository identity) + (exec (case [(get@ #/.identity profile) + (dictionary.get repository (get@ #/.deploy-repositories profile))] + [(#.Some artifact) (#.Some repository)] + (/command/deploy.do! (/repository.async (/repository.default repository)) + (file.async file.default) + identity + artifact + profile) + [#.None _] + (promise@wrap (exception.throw /.no-identity [])) + + [_ #.None] + (promise@wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)]))) + (wrap [])) + (#/cli.Compilation compilation) (case compilation #/cli.Build (exec (/command/build.do! profile) diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux index efc261189..adf52a18b 100644 --- a/stdlib/source/program/aedifex/cli.lux +++ b/stdlib/source/program/aedifex/cli.lux @@ -8,7 +8,7 @@ [data ["." text]]] [// - [repository (#+ User Password)] + [repository (#+ Identity)] ["/" profile (#+ Name)]]) (type: #export Compilation @@ -36,7 +36,7 @@ #POM #Dependencies #Install - (#Deploy Text User Password) + (#Deploy Text Identity) (#Compilation Compilation) (#Auto Compilation)) @@ -69,10 +69,9 @@ (cli.this "deps") (cli.this "install") (<>.after (cli.this "deploy") - ($_ <>.and - cli.any - cli.any - cli.any)) + (<>.and cli.any + (<>.and cli.any + cli.any))) ..compilation (<>.after (cli.this "auto") ..compilation) diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux index aa48946bf..a083d8f53 100644 --- a/stdlib/source/program/aedifex/command/deploy.lux +++ b/stdlib/source/program/aedifex/command/deploy.lux @@ -3,16 +3,13 @@ [abstract [monad (#+ do)]] [control - ["." exception (#+ exception:)] [concurrency - ["." promise ("#@." monad)]]] + ["." promise (#+ Promise) ("#@." monad)]]] [data [binary (#+ Binary)] [text - ["%" format (#+ format)] ["." encoding]] [collection - ["." dictionary (#+ Dictionary)] ["." set]] [format ["." binary] @@ -24,53 +21,28 @@ [compositor ["." export]]] ["." /// #_ - ["/" profile (#+ Profile)] - ["//" upload] + [repository (#+ Identity Repository)] + [command (#+ Command)] + ["/" profile] ["#." action (#+ Action)] - ["#." command (#+ Command)] ["#." pom] ["#." hash] - ["#." repository (#+ User Password)] - ["#." artifact - ["#/." type]] - ["#." dependency - ["#/." resolution]]]) + ["#." artifact (#+ Artifact) + ["#/." extension (#+ Extension)]]]) -(exception: #export (cannot-find-repository {repository Text} - {options (Dictionary Text ///repository.Address)}) - (exception.report - ["Repository" (%.text repository)] - ["Options" (exception.enumerate (function (_ [name repo]) - (format (%.text name) " := " (%.text repo))) - (dictionary.entries options))])) - -(def: #export (do! repository user password profile) - (-> Text User Password (Command Any)) - (case [(get@ #/.identity profile) - (dictionary.get repository (get@ #/.deploy-repositories profile))] - [#.None _] - (promise@wrap (exception.throw /.no-identity [])) - - [_ #.None] - (promise@wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)])) - - [(#.Some identity) (#.Some repository)] - (let [deploy! (: (-> ///artifact/type.Type Binary (Action Any)) - (function (_ type content) - (promise.future - (//.upload repository - user - password - {#///dependency.artifact identity - #///dependency.type type} - content))))] - (do {! ///action.monad} - [library (:: ! map (binary.run tar.writer) - (export.library (file.async file.default) - (set.to-list (get@ #/.sources profile)))) - pom (promise@wrap (///pom.write profile)) - _ (deploy! ///artifact/type.pom (|> pom (:: xml.codec encode) encoding.to-utf8)) - _ (deploy! ///artifact/type.lux-library library) - _ (deploy! ///artifact/type.sha-1 (///hash.data (///hash.sha-1 library))) - _ (deploy! ///artifact/type.md5 (///hash.data (///hash.md5 library)))] - (wrap []))))) +(def: #export (do! repository fs identity artifact profile) + (-> (Repository Promise) (file.System Promise) Identity Artifact (Command Any)) + (let [deploy! (: (-> Extension Binary (Action Any)) + (:: repository upload identity artifact))] + (do {! ///action.monad} + [library (|> profile + (get@ #/.sources) + set.to-list + (export.library fs) + (:: ! map (binary.run tar.writer))) + pom (promise@wrap (///pom.write profile)) + _ (deploy! ///artifact/extension.pom (|> pom (:: xml.codec encode) encoding.to-utf8)) + _ (deploy! ///artifact/extension.lux-library library) + _ (deploy! ///artifact/extension.sha-1 (///hash.data (///hash.sha-1 library))) + _ (deploy! ///artifact/extension.md5 (///hash.data (///hash.md5 library)))] + (wrap [])))) diff --git a/stdlib/source/program/aedifex/dependency.lux b/stdlib/source/program/aedifex/dependency.lux index 629618620..db997ef3b 100644 --- a/stdlib/source/program/aedifex/dependency.lux +++ b/stdlib/source/program/aedifex/dependency.lux @@ -1,30 +1,26 @@ (.module: [lux (#- Type) [abstract - ["." equivalence (#+ Equivalence)] + [equivalence (#+ Equivalence)] ["." hash (#+ Hash)]] [data - ["." text]] - [world - [net (#+ URL)]]] + ["." text + ["%" format (#+ format)]]]] ["." // #_ - ["#." artifact (#+ Artifact) + ["#" artifact (#+ Artifact) [type (#+ Type)]]]) (type: #export Dependency {#artifact Artifact #type Type}) -(def: #export equivalence - (Equivalence Dependency) - ($_ equivalence.product - //artifact.equivalence - text.equivalence - )) - (def: #export hash (Hash Dependency) ($_ hash.product - //artifact.hash + //.hash text.hash )) + +(def: #export equivalence + (Equivalence Dependency) + (:: hash &equivalence)) diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux index f92b1e5b9..0c8f92993 100644 --- a/stdlib/source/program/aedifex/repository.lux +++ b/stdlib/source/program/aedifex/repository.lux @@ -1,17 +1,23 @@ (.module: [lux #* + ["." host (#+ import:)] [abstract [monad (#+ do)]] [control ["." io (#+ IO)] ["." try (#+ Try)] + ["." exception (#+ exception:)] [concurrency ["." promise (#+ Promise)] ["." stm]]] [data - [binary (#+ Binary)]] + [binary (#+ Binary)] + ["." text + ["%" format (#+ format)] + ["." encoding]]] [world - [net (#+ URL)]]] + [net (#+ URL) + ["." uri]]]] ["." // #_ ["#." artifact (#+ Artifact) ["#/." extension (#+ Extension)]]]) @@ -83,3 +89,69 @@ (#try.Failure error) (wrap (#try.Failure error)))))) ))) + +(import: java/lang/AutoCloseable + (close [] #io #try void)) + +(import: java/io/OutputStream + (flush [] #io #try void) + (write [[byte]] #io #try void)) + +(import: java/lang/String) + +(import: java/net/URLConnection + (setDoOutput [boolean] #io #try void) + (setRequestProperty [java/lang/String java/lang/String] #io #try void) + (getOutputStream [] #io #try java/io/OutputStream)) + +(import: java/net/HttpURLConnection + (setRequestMethod [java/lang/String] #io #try void) + (getResponseCode [] #io #try int)) + +(import: java/net/URL + (new [java/lang/String]) + (openConnection [] #io #try java/net/URLConnection)) + +(import: java/util/Base64$Encoder + (encodeToString [[byte]] java/lang/String)) + +(import: java/util/Base64 + (#static getEncoder [] java/util/Base64$Encoder)) + +(exception: #export (failure {code Int}) + (exception.report + ["Code" (%.int code)])) + +(def: (basic-auth user password) + (-> User Password Text) + (format "Basic " (java/util/Base64$Encoder::encodeToString (encoding.to-utf8 (format user ":" password)) + (java/util/Base64::getEncoder)))) + +(def: (url address artifact extension) + (-> Address Artifact Extension URL) + (format address uri.separator (//artifact.uri artifact) extension)) + +(structure: #export (default address) + (All [s] (-> Address (Repository IO))) + + (def: (download artifact extension) + (io.io (#try.Failure "YOLO"))) + + (def: (upload [user password] artifact extension content) + (do (try.with io.monad) + [connection (|> (..url address artifact extension) + java/net/URL::new + java/net/URL::openConnection) + #let [connection (:coerce java/net/HttpURLConnection connection)] + _ (java/net/HttpURLConnection::setRequestMethod "PUT" connection) + _ (java/net/URLConnection::setDoOutput true connection) + _ (java/net/URLConnection::setRequestProperty "Authorization" (..basic-auth user password) connection) + stream (java/net/URLConnection::getOutputStream connection) + _ (java/io/OutputStream::write content stream) + _ (java/io/OutputStream::flush stream) + _ (java/lang/AutoCloseable::close stream) + code (java/net/HttpURLConnection::getResponseCode connection)] + (case code + +200 (wrap []) + _ (:: io.monad wrap (exception.throw ..failure [code]))))) + ) diff --git a/stdlib/source/program/aedifex/upload.lux b/stdlib/source/program/aedifex/upload.lux deleted file mode 100644 index 391413f03..000000000 --- a/stdlib/source/program/aedifex/upload.lux +++ /dev/null @@ -1,95 +0,0 @@ -(.module: - [lux #* - ["." host (#+ import:)] - [abstract - [monad (#+ Monad do)]] - [control - ["." io (#+ IO)] - ["." try (#+ Try)] - ["." exception (#+ exception:)]] - [data - ["." binary (#+ Binary)] - ["." text - ["%" format (#+ format)] - ["." encoding]]] - [time - ["." instant]] - [world - [net (#+ URL) - ["." uri]]]] - ["." // #_ - ["#." repository (#+ Address User Password)] - ["#." dependency (#+ Dependency)] - ["#." artifact]]) - -(type: #export (Action a) - (IO (Try a))) - -(def: #export monad - (:coerce (Monad Action) - (try.with io.monad))) - -(def: (url repository dependency) - (-> Address Dependency URL) - (format repository - uri.separator - (//artifact.uri (get@ #//dependency.artifact dependency)) - "." - (get@ #//dependency.type dependency))) - -(import: java/lang/AutoCloseable - (close [] #io #try void)) - -(import: java/io/OutputStream - (flush [] #io #try void) - (write [[byte]] #io #try void)) - -(import: java/lang/String) - -(import: java/net/URLConnection - (setDoOutput [boolean] #io #try void) - (setRequestProperty [java/lang/String java/lang/String] #io #try void) - (getOutputStream [] #io #try java/io/OutputStream)) - -(import: java/net/HttpURLConnection - (setRequestMethod [java/lang/String] #io #try void) - (getResponseCode [] #io #try int)) - -(import: java/net/URL - (new [java/lang/String]) - (openConnection [] #io #try java/net/URLConnection)) - -(import: java/util/Base64$Encoder - (encodeToString [[byte]] java/lang/String)) - -(import: java/util/Base64 - (#static getEncoder [] java/util/Base64$Encoder)) - -(exception: #export (failure {code Int}) - (exception.report - ["Code" (%.int code)])) - -(def: (basic-auth user password) - (-> User Password Text) - (format "Basic " (java/util/Base64$Encoder::encodeToString (encoding.to-utf8 (format user ":" password)) - (java/util/Base64::getEncoder)))) - -(def: #export (upload repository user password dependency content) - (-> Address User Password Dependency Binary - (Action Any)) - (do {! ..monad} - [connection (|> (..url repository dependency) - java/net/URL::new - java/net/URL::openConnection) - #let [connection (:coerce java/net/HttpURLConnection connection)] - _ (java/net/HttpURLConnection::setRequestMethod "PUT" connection) - _ (java/net/URLConnection::setDoOutput true connection) - _ (java/net/URLConnection::setRequestProperty "Authorization" (..basic-auth user password) connection) - stream (java/net/URLConnection::getOutputStream connection) - _ (java/io/OutputStream::write content stream) - _ (java/io/OutputStream::flush stream) - _ (java/lang/AutoCloseable::close stream) - code (java/net/HttpURLConnection::getResponseCode connection)] - (case code - +200 (wrap []) - _ (:: io.monad wrap (exception.throw ..failure [code]))))) diff --git a/stdlib/source/spec/lux/abstract/apply.lux b/stdlib/source/spec/lux/abstract/apply.lux index a9925b928..399e69e9e 100644 --- a/stdlib/source/spec/lux/abstract/apply.lux +++ b/stdlib/source/spec/lux/abstract/apply.lux @@ -15,36 +15,36 @@ [// [functor (#+ Injection Comparison)]]) -(def: (identity injection comparison (^open "_@.")) +(def: (identity injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) (do {! random.monad} [sample (:: ! map injection random.nat)] (_.test "Identity." ((comparison n.=) - (_@apply (injection function.identity) sample) + (_//apply (injection function.identity) sample) sample)))) -(def: (homomorphism injection comparison (^open "_@.")) +(def: (homomorphism injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) (do {! random.monad} [sample random.nat increase (:: ! map n.+ random.nat)] (_.test "Homomorphism." ((comparison n.=) - (_@apply (injection increase) (injection sample)) + (_//apply (injection increase) (injection sample)) (injection (increase sample)))))) -(def: (interchange injection comparison (^open "_@.")) +(def: (interchange injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) (do {! random.monad} [sample random.nat increase (:: ! map n.+ random.nat)] (_.test "Interchange." ((comparison n.=) - (_@apply (injection increase) (injection sample)) - (_@apply (injection (function (_ f) (f sample))) (injection increase)))))) + (_//apply (injection increase) (injection sample)) + (_//apply (injection (function (_ f) (f sample))) (injection increase)))))) -(def: (composition injection comparison (^open "_@.")) +(def: (composition injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) (do {! random.monad} [sample random.nat @@ -52,12 +52,12 @@ decrease (:: ! map n.- random.nat)] (_.test "Composition." ((comparison n.=) - (_$ _@apply + (_$ _//apply (injection function.compose) (injection increase) (injection decrease) (injection sample)) - ($_ _@apply + ($_ _//apply (injection increase) (injection decrease) (injection sample)))))) diff --git a/stdlib/source/spec/lux/abstract/codec.lux b/stdlib/source/spec/lux/abstract/codec.lux index ece213c31..e5740cf53 100644 --- a/stdlib/source/spec/lux/abstract/codec.lux +++ b/stdlib/source/spec/lux/abstract/codec.lux @@ -12,15 +12,15 @@ [// [equivalence (#+ Equivalence)]]]}) -(def: #export (spec (^open "/@.") (^open "/@.") generator) +(def: #export (spec (^open "@//.") (^open "@//.") generator) (All [m a] (-> (Equivalence a) (/.Codec m a) (Random a) Test)) (do random.monad [expected generator] (_.with-cover [/.Codec] (_.test "Isomorphism." - (case (|> expected /@encode /@decode) + (case (|> expected @//encode @//decode) (#try.Success actual) - (/@= expected actual) + (@//= expected actual) (#try.Failure _) false))))) diff --git a/stdlib/source/spec/lux/abstract/comonad.lux b/stdlib/source/spec/lux/abstract/comonad.lux index b69581037..a45c89e26 100644 --- a/stdlib/source/spec/lux/abstract/comonad.lux +++ b/stdlib/source/spec/lux/abstract/comonad.lux @@ -13,19 +13,19 @@ [// [functor (#+ Injection Comparison)]]) -(def: (left-identity injection (^open "_@.")) +(def: (left-identity injection (^open "_//.")) (All [f] (-> (Injection f) (CoMonad f) Test)) (do {! random.monad} [sample random.nat morphism (:: ! map (function (_ diff) - (|>> _@unwrap (n.+ diff))) + (|>> _//unwrap (n.+ diff))) random.nat) #let [start (injection sample)]] (_.test "Left identity." (n.= (morphism start) - (|> start _@split (_@map morphism) _@unwrap))))) + (|> start _//split (_//map morphism) _//unwrap))))) -(def: (right-identity injection comparison (^open "_@.")) +(def: (right-identity injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (CoMonad f) Test)) (do random.monad [sample random.nat @@ -33,23 +33,23 @@ == (comparison n.=)]] (_.test "Right identity." (== start - (|> start _@split (_@map _@unwrap)))))) + (|> start _//split (_//map _//unwrap)))))) -(def: (associativity injection comparison (^open "_@.")) +(def: (associativity injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (CoMonad f) Test)) (do {! random.monad} [sample random.nat increase (:: ! map (function (_ diff) - (|>> _@unwrap (n.+ diff))) + (|>> _//unwrap (n.+ diff))) random.nat) decrease (:: ! map (function (_ diff) - (|>> _@unwrap(n.- diff))) + (|>> _//unwrap(n.- diff))) random.nat) #let [start (injection sample) == (comparison n.=)]] (_.test "Associativity." - (== (|> start _@split (_@map (|>> _@split (_@map increase) decrease))) - (|> start _@split (_@map increase) _@split (_@map decrease)))))) + (== (|> start _//split (_//map (|>> _//split (_//map increase) decrease))) + (|> start _//split (_//map increase) _//split (_//map decrease)))))) (def: #export (spec injection comparison subject) (All [f] (-> (Injection f) (Comparison f) (CoMonad f) Test)) diff --git a/stdlib/source/spec/lux/abstract/enum.lux b/stdlib/source/spec/lux/abstract/enum.lux index 198d3da50..7f541b0e9 100644 --- a/stdlib/source/spec/lux/abstract/enum.lux +++ b/stdlib/source/spec/lux/abstract/enum.lux @@ -8,19 +8,19 @@ {1 ["." /]}) -(def: #export (spec (^open "/@.") gen-sample) +(def: #export (spec (^open "@//.") gen-sample) (All [a] (-> (/.Enum a) (Random a) Test)) (do random.monad [sample gen-sample] (<| (_.with-cover [/.Enum]) ($_ _.and (_.test "Successor and predecessor are inverse functions." - (and (/@= (|> sample /@succ /@pred) - sample) - (/@= (|> sample /@pred /@succ) - sample) - (not (/@= (/@succ sample) - sample)) - (not (/@= (/@pred sample) - sample)))) + (and (@//= (|> sample @//succ @//pred) + sample) + (@//= (|> sample @//pred @//succ) + sample) + (not (@//= (@//succ sample) + sample)) + (not (@//= (@//pred sample) + sample)))) )))) diff --git a/stdlib/source/spec/lux/abstract/equivalence.lux b/stdlib/source/spec/lux/abstract/equivalence.lux index b511ba176..1d8db459c 100644 --- a/stdlib/source/spec/lux/abstract/equivalence.lux +++ b/stdlib/source/spec/lux/abstract/equivalence.lux @@ -8,7 +8,7 @@ {1 ["." / (#+ Equivalence)]}) -(def: #export (spec (^open "_@.") generator) +(def: #export (spec (^open "_//.") generator) (All [a] (-> (Equivalence a) (Random a) Test)) (do random.monad [left generator @@ -16,8 +16,8 @@ (<| (_.with-cover [/.Equivalence]) ($_ _.and (_.test "Reflexivity." - (_@= left left)) + (_//= left left)) (_.test "Symmetry." - (if (_@= left right) - (_@= right left) - (not (_@= right left)))))))) + (if (_//= left right) + (_//= right left) + (not (_//= right left)))))))) diff --git a/stdlib/source/spec/lux/abstract/fold.lux b/stdlib/source/spec/lux/abstract/fold.lux index 71377f991..c1d87dba1 100644 --- a/stdlib/source/spec/lux/abstract/fold.lux +++ b/stdlib/source/spec/lux/abstract/fold.lux @@ -12,11 +12,11 @@ [functor (#+ Injection Comparison)]] {1 ["." /]}) -(def: #export (spec injection comparison (^open "/@.")) +(def: #export (spec injection comparison (^open "@//.")) (All [f] (-> (Injection f) (Comparison f) (/.Fold f) Test)) (do random.monad [subject random.nat parameter random.nat] (_.cover [/.Fold] - (n.= (/@fold n.+ parameter (injection subject)) + (n.= (@//fold n.+ parameter (injection subject)) (n.+ parameter subject))))) diff --git a/stdlib/source/spec/lux/abstract/functor.lux b/stdlib/source/spec/lux/abstract/functor.lux index d40ded1a2..b237a388e 100644 --- a/stdlib/source/spec/lux/abstract/functor.lux +++ b/stdlib/source/spec/lux/abstract/functor.lux @@ -22,26 +22,26 @@ (-> (Equivalence a) (Equivalence (f a))))) -(def: (identity injection comparison (^open "/@.")) +(def: (identity injection comparison (^open "@//.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) (do {! random.monad} [sample (:: ! map injection random.nat)] (_.test "Identity." ((comparison n.=) - (/@map function.identity sample) + (@//map function.identity sample) sample)))) -(def: (homomorphism injection comparison (^open "/@.")) +(def: (homomorphism injection comparison (^open "@//.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) (do {! random.monad} [sample random.nat increase (:: ! map n.+ random.nat)] (_.test "Homomorphism." ((comparison n.=) - (/@map increase (injection sample)) + (@//map increase (injection sample)) (injection (increase sample)))))) -(def: (composition injection comparison (^open "/@.")) +(def: (composition injection comparison (^open "@//.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) (do {! random.monad} [sample (:: ! map injection random.nat) @@ -49,8 +49,8 @@ decrease (:: ! map n.- random.nat)] (_.test "Composition." ((comparison n.=) - (|> sample (/@map increase) (/@map decrease)) - (|> sample (/@map (|>> increase decrease))))))) + (|> sample (@//map increase) (@//map decrease)) + (|> sample (@//map (|>> increase decrease))))))) (def: #export (spec injection comparison functor) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) diff --git a/stdlib/source/spec/lux/abstract/functor/contravariant.lux b/stdlib/source/spec/lux/abstract/functor/contravariant.lux index b21e28e68..8adf0139d 100644 --- a/stdlib/source/spec/lux/abstract/functor/contravariant.lux +++ b/stdlib/source/spec/lux/abstract/functor/contravariant.lux @@ -14,11 +14,11 @@ {1 ["." / (#+ Functor)]}) -(def: (identity equivalence value (^open "/@.")) +(def: (identity equivalence value (^open "@//.")) (All [f a] (-> (Equivalence (f a)) (f a) (Functor f) Test)) (_.test "Law of identity." (equivalence - (/@map function.identity value) + (@//map function.identity value) value))) (def: #export (spec equivalence value functor) diff --git a/stdlib/source/spec/lux/abstract/interval.lux b/stdlib/source/spec/lux/abstract/interval.lux index 1541f1cee..0cd255eb2 100644 --- a/stdlib/source/spec/lux/abstract/interval.lux +++ b/stdlib/source/spec/lux/abstract/interval.lux @@ -9,14 +9,14 @@ {1 ["." /]}) -(def: #export (spec (^open "/@.") gen-sample) +(def: #export (spec (^open "@//.") gen-sample) (All [a] (-> (/.Interval a) (Random a) Test)) (<| (_.with-cover [/.Interval]) (do random.monad [sample gen-sample] ($_ _.and (_.test "No value is bigger than the top." - (/@< /@top sample)) + (@//< @//top sample)) (_.test "No value is smaller than the bottom." - (order.> /@&order /@bottom sample)) + (order.> @//&order @//bottom sample)) )))) diff --git a/stdlib/source/spec/lux/abstract/monad.lux b/stdlib/source/spec/lux/abstract/monad.lux index c9abf9b25..21ccafe75 100644 --- a/stdlib/source/spec/lux/abstract/monad.lux +++ b/stdlib/source/spec/lux/abstract/monad.lux @@ -11,41 +11,41 @@ [// [functor (#+ Injection Comparison)]]) -(def: (left-identity injection comparison (^open "_@.")) +(def: (left-identity injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) (do {! random.monad} [sample random.nat morphism (:: ! map (function (_ diff) - (|>> (n.+ diff) _@wrap)) + (|>> (n.+ diff) _//wrap)) random.nat)] (_.test "Left identity." ((comparison n.=) - (|> (injection sample) (_@map morphism) _@join) + (|> (injection sample) (_//map morphism) _//join) (morphism sample))))) -(def: (right-identity injection comparison (^open "_@.")) +(def: (right-identity injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) (do random.monad [sample random.nat] (_.test "Right identity." ((comparison n.=) - (|> (injection sample) (_@map _@wrap) _@join) + (|> (injection sample) (_//map _//wrap) _//join) (injection sample))))) -(def: (associativity injection comparison (^open "_@.")) +(def: (associativity injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) (do {! random.monad} [sample random.nat increase (:: ! map (function (_ diff) - (|>> (n.+ diff) _@wrap)) + (|>> (n.+ diff) _//wrap)) random.nat) decrease (:: ! map (function (_ diff) - (|>> (n.- diff) _@wrap)) + (|>> (n.- diff) _//wrap)) random.nat)] (_.test "Associativity." ((comparison n.=) - (|> (injection sample) (_@map increase) _@join (_@map decrease) _@join) - (|> (injection sample) (_@map (|>> increase (_@map decrease) _@join)) _@join))))) + (|> (injection sample) (_//map increase) _//join (_//map decrease) _//join) + (|> (injection sample) (_//map (|>> increase (_//map decrease) _//join)) _//join))))) (def: #export (spec injection comparison monad) (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) diff --git a/stdlib/source/spec/lux/abstract/monoid.lux b/stdlib/source/spec/lux/abstract/monoid.lux index eca057360..23e35d0db 100644 --- a/stdlib/source/spec/lux/abstract/monoid.lux +++ b/stdlib/source/spec/lux/abstract/monoid.lux @@ -10,7 +10,7 @@ [// [equivalence (#+ Equivalence)]]]}) -(def: #export (spec (^open "/@.") (^open "/@.") gen-sample) +(def: #export (spec (^open "@//.") (^open "@//.") gen-sample) (All [a] (-> (Equivalence a) (/.Monoid a) (Random a) Test)) (do random.monad [sample gen-sample @@ -20,12 +20,12 @@ (<| (_.with-cover [/.Monoid]) ($_ _.and (_.test "Left identity." - (/@= sample - (/@compose /@identity sample))) + (@//= sample + (@//compose @//identity sample))) (_.test "Right identity." - (/@= sample - (/@compose sample /@identity))) + (@//= sample + (@//compose sample @//identity))) (_.test "Associativity." - (/@= (/@compose left (/@compose mid right)) - (/@compose (/@compose left mid) right))) + (@//= (@//compose left (@//compose mid right)) + (@//compose (@//compose left mid) right))) )))) diff --git a/stdlib/source/spec/lux/abstract/order.lux b/stdlib/source/spec/lux/abstract/order.lux index 35aef0c9d..7fa8c618c 100644 --- a/stdlib/source/spec/lux/abstract/order.lux +++ b/stdlib/source/spec/lux/abstract/order.lux @@ -8,7 +8,7 @@ {1 ["." /]}) -(def: #export (spec (^open "/@.") generator) +(def: #export (spec (^open "@//.") generator) (All [a] (-> (/.Order a) (Random a) Test)) (<| (_.with-cover [/.Order]) ($_ _.and @@ -16,41 +16,41 @@ [parameter generator subject generator] (_.test "Values are either ordered, or they are equal. All options are mutually exclusive." - (cond (/@< parameter subject) - (not (or (/@< subject parameter) - (/@= parameter subject))) + (cond (@//< parameter subject) + (not (or (@//< subject parameter) + (@//= parameter subject))) - (/@< subject parameter) - (not (/@= parameter subject)) + (@//< subject parameter) + (not (@//= parameter subject)) ## else - (/@= parameter subject)))) + (@//= parameter subject)))) (do random.monad [parameter generator - subject (random.filter (|>> (/@= parameter) not) + subject (random.filter (|>> (@//= parameter) not) generator) extra (random.filter (function (_ value) - (not (or (/@= parameter value) - (/@= subject value)))) + (not (or (@//= parameter value) + (@//= subject value)))) generator)] (_.test "Transitive property." - (if (/@< parameter subject) - (let [greater? (and (/@< subject extra) - (/@< parameter extra)) - lesser? (and (/@< extra parameter) - (/@< extra subject)) - in-between? (and (/@< parameter extra) - (/@< extra subject))] + (if (@//< parameter subject) + (let [greater? (and (@//< subject extra) + (@//< parameter extra)) + lesser? (and (@//< extra parameter) + (@//< extra subject)) + in-between? (and (@//< parameter extra) + (@//< extra subject))] (or greater? lesser? in-between?)) - ## (/@< subject parameter) - (let [greater? (and (/@< extra subject) - (/@< extra parameter)) - lesser? (and (/@< parameter extra) - (/@< subject extra)) - in-between? (and (/@< subject extra) - (/@< extra parameter))] + ## (@//< subject parameter) + (let [greater? (and (@//< extra subject) + (@//< extra parameter)) + lesser? (and (@//< parameter extra) + (@//< subject extra)) + in-between? (and (@//< subject extra) + (@//< extra parameter))] (or greater? lesser? in-between?))))) diff --git a/stdlib/source/spec/lux/world/shell.lux b/stdlib/source/spec/lux/world/shell.lux index 286cc7ce2..d0b62ddc6 100644 --- a/stdlib/source/spec/lux/world/shell.lux +++ b/stdlib/source/spec/lux/world/shell.lux @@ -11,7 +11,7 @@ ["." promise (#+ Promise)]]] [data ["." product] - ["." text ("#@." equivalence) + ["." text ("#//." equivalence) ["%" format (#+ format)]] [number ["n" nat] @@ -41,7 +41,7 @@ (_.claim [/.Can-Read] (case ?read (#try.Success actual) - (text@= expected actual) + (text//= expected actual) (#try.Failure error) false)) diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index c9994aafa..e3a2717cd 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -11,7 +11,8 @@ ["#." command #_ ["#/." clean] ["#/." pom] - ["#/." install]] + ["#/." install] + ["#/." deploy]] ["#." local] ["#." cache] ["#." dependency] @@ -32,6 +33,7 @@ /command/clean.test /command/pom.test /command/install.test + /command/deploy.test /local.test /cache.test /dependency.test diff --git a/stdlib/source/test/aedifex/cli.lux b/stdlib/source/test/aedifex/cli.lux index 1edfb381f..b7be4e8bf 100644 --- a/stdlib/source/test/aedifex/cli.lux +++ b/stdlib/source/test/aedifex/cli.lux @@ -60,7 +60,7 @@ #/.POM (list "pom") #/.Dependencies (list "deps") #/.Install (list "install") - (#/.Deploy repository user password) (list "deploy" repository user password) + (#/.Deploy repository [user password]) (list "deploy" repository user password) (#/.Compilation compilation) (..format-compilation compilation) (#/.Auto compilation) (list& "auto" (..format-compilation compilation)))) diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux new file mode 100644 index 000000000..20718f915 --- /dev/null +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -0,0 +1,129 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + ["." monad (#+ do)]] + [control + ["." try (#+ Try) ("#@." functor)] + ["." exception] + [concurrency + ["." promise (#+ Promise)]] + [security + ["!" capability]]] + [data + ["." maybe] + ["." binary] + ["." text ("#@." equivalence) + ["%" format (#+ format)] + ["." encoding]] + ["." format #_ + ["#" binary] + ["." tar] + ["." xml]] + [collection + ["." set (#+ Set)] + ["." dictionary (#+ Dictionary)]]] + [math + ["." random (#+ Random)]] + [world + ["." file (#+ Path File)]]] + [program + [compositor + ["." export]]] + [/// + ["@." profile] + ["@." repository]] + {#program + ["." / + ["//#" /// #_ + ["#" profile] + ["#." action] + ["#." pom] + ["#." local] + ["#." hash] + ["#." repository (#+ Identity Repository)] + ["#." artifact (#+ Artifact) + ["#/." extension]]]]}) + +(def: (make-sources! fs sources) + (-> (file.System Promise) (Set Path) (Promise (Try Any))) + (loop [sources (set.to-list sources)] + (case sources + #.Nil + (|> [] + (:: try.monad wrap) + (:: promise.monad wrap)) + + (#.Cons head tail) + (do (try.with promise.monad) + [_ (: (Promise (Try Path)) + (file.make-directories promise.monad fs head)) + _ (: (Promise (Try (File Promise))) + (file.get-file promise.monad fs (format head (:: fs separator) head ".lux")))] + (recur tail))))) + +(def: (execute! repository fs identity artifact profile) + (-> (Repository Promise) (file.System Promise) + Identity Artifact ///.Profile + (Promise (Try Any))) + (do ///action.monad + [_ (..make-sources! fs (get@ #///.sources profile)) + _ (: (Promise (Try Path)) + (file.make-directories promise.monad fs (///local.repository fs)))] + (/.do! repository fs identity artifact profile))) + +(def: #export test + Test + (<| (_.covering /._) + (do {! random.monad} + [[artifact expected-pom profile] + (random.one (function (_ profile) + (do maybe.monad + [artifact (get@ #///.identity profile) + expected-pom (try.to-maybe (///pom.write profile))] + (wrap [artifact expected-pom profile]))) + @profile.random) + + identity @repository.identity + #let [repository (///repository.mock (@repository.simulation identity) + @repository.empty) + fs (file.mock (:: file.default separator))]] + (wrap (do {! promise.monad} + [verdict (do {! ///action.monad} + [_ (..execute! repository fs identity artifact profile) + expected-library (|> profile + (get@ #///.sources) + set.to-list + (export.library fs) + (:: ! map (format.run tar.writer))) + + actual-pom (:: repository download artifact ///artifact/extension.pom) + actual-library (:: repository download artifact ///artifact/extension.lux-library) + actual-sha-1 (:: repository download artifact ///artifact/extension.sha-1) + actual-md5 (:: repository download artifact ///artifact/extension.md5) + + #let [deployed-library! + (:: binary.equivalence = + expected-library + actual-library) + + deployed-pom! + (:: binary.equivalence = + (|> expected-pom (:: xml.codec encode) encoding.to-utf8) + actual-pom) + + deployed-sha-1! + (:: binary.equivalence = + (///hash.data (///hash.sha-1 expected-library)) + actual-sha-1) + + deployed-md5! + (:: binary.equivalence = + (///hash.data (///hash.md5 expected-library)) + actual-md5)]] + (wrap (and deployed-library! + deployed-pom! + deployed-sha-1! + deployed-md5!)))] + (_.claim [/.do!] + (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/repository.lux b/stdlib/source/test/aedifex/repository.lux index 4f96d9329..5f05d342e 100644 --- a/stdlib/source/test/aedifex/repository.lux +++ b/stdlib/source/test/aedifex/repository.lux @@ -27,7 +27,7 @@ ["#." artifact (#+ Version Artifact) ["#/." extension (#+ Extension)]]]]}) -(def: identity +(def: #export identity (Random Identity) (random.and (random.ascii/alpha 10) (random.ascii/alpha 10))) @@ -59,11 +59,11 @@ (type: Store (Dictionary [Artifact Extension] Binary)) -(def: empty +(def: #export empty Store (dictionary.new ..item-hash)) -(structure: (simulation identity) +(structure: #export (simulation identity) (-> Identity (/.Simulation Store)) (def: (on-download artifact extension state) diff --git a/stdlib/source/test/lux/data/collection.lux b/stdlib/source/test/lux/data/collection.lux index 497123614..bcbda46b9 100644 --- a/stdlib/source/test/lux/data/collection.lux +++ b/stdlib/source/test/lux/data/collection.lux @@ -17,6 +17,7 @@ ["#/." multi] ["#/." ordered]] ["#." tree + ["#/." finger] ["#/." zipper]]]) (def: dictionary @@ -46,6 +47,7 @@ Test ($_ _.and /tree.test + /tree/finger.test /tree/zipper.test )) diff --git a/stdlib/source/test/lux/data/collection/tree/finger.lux b/stdlib/source/test/lux/data/collection/tree/finger.lux new file mode 100644 index 000000000..a0dfabb54 --- /dev/null +++ b/stdlib/source/test/lux/data/collection/tree/finger.lux @@ -0,0 +1,133 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [data + ["." maybe ("#@." functor)] + ["." text ("#@." equivalence monoid)] + [number + ["n" nat]]] + [math + ["." random]] + [type (#+ :by-example)]] + {1 + ["." /]}) + +(def: builder + (/.builder text.monoid)) + +(def: :@: + (:by-example [@] + {(/.Builder @ Text) + ..builder} + @)) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Tree]) + (do {! random.monad} + [tag-left (random.ascii/alpha-num 1) + tag-right (random.filter (|>> (text@= tag-left) not) + (random.ascii/alpha-num 1)) + expected-left random.nat + expected-right random.nat] + ($_ _.and + (_.cover [/.Builder /.builder] + (exec (/.builder text.monoid) + true)) + (_.cover [/.tag] + (and (text@= tag-left + (/.tag (:: ..builder leaf tag-left expected-left))) + (text@= (text@compose tag-left tag-right) + (/.tag (:: ..builder branch + (:: ..builder leaf tag-left expected-left) + (:: ..builder leaf tag-right expected-right)))))) + (_.cover [/.root] + (and (case (/.root (:: ..builder leaf tag-left expected-left)) + (#.Left actual) + (n.= expected-left actual) + + (#.Right _) + false) + (case (/.root (:: ..builder branch + (:: ..builder leaf tag-left expected-left) + (:: ..builder leaf tag-right expected-right))) + (#.Left _) + false + + (#.Right [left right]) + (case [(/.root left) + (/.root right)] + [(#.Left actual-left) (#.Left actual-right)] + (and (n.= expected-left actual-left) + (n.= expected-right actual-right)) + + _ + false)))) + (_.cover [/.value] + (and (n.= expected-left + (/.value (:: ..builder leaf tag-left expected-left))) + (n.= expected-left + (/.value (:: ..builder branch + (:: ..builder leaf tag-left expected-left) + (:: ..builder leaf tag-right expected-right)))))) + (_.cover [/.search] + (let [can-find-correct-one! + (|> (:: ..builder leaf tag-left expected-left) + (/.search (text.contains? tag-left)) + (maybe@map (n.= expected-left)) + (maybe.default false)) + + cannot-find-incorrect-one! + (|> (:: ..builder leaf tag-right expected-right) + (/.search (text.contains? tag-left)) + (maybe@map (n.= expected-left)) + (maybe.default false) + not) + + can-find-left! + (|> (:: ..builder branch + (:: ..builder leaf tag-left expected-left) + (:: ..builder leaf tag-right expected-right)) + (/.search (text.contains? tag-left)) + (maybe@map (n.= expected-left)) + (maybe.default false)) + + can-find-right! + (|> (:: ..builder branch + (:: ..builder leaf tag-left expected-left) + (:: ..builder leaf tag-right expected-right)) + (/.search (text.contains? tag-right)) + (maybe@map (n.= expected-right)) + (maybe.default false))] + (and can-find-correct-one! + cannot-find-incorrect-one! + can-find-left! + can-find-right!))) + (_.cover [/.found?] + (let [can-find-correct-one! + (/.found? (text.contains? tag-left) + (:: ..builder leaf tag-left expected-left)) + + cannot-find-incorrect-one! + (not (/.found? (text.contains? tag-left) + (:: ..builder leaf tag-right expected-right))) + + can-find-left! + (/.found? (text.contains? tag-left) + (:: ..builder branch + (:: ..builder leaf tag-left expected-left) + (:: ..builder leaf tag-right expected-right))) + + can-find-right! + (/.found? (text.contains? tag-right) + (:: ..builder branch + (:: ..builder leaf tag-left expected-left) + (:: ..builder leaf tag-right expected-right)))] + (and can-find-correct-one! + cannot-find-incorrect-one! + can-find-left! + can-find-right!))) + )))) |