diff options
57 files changed, 394 insertions, 394 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 58f8d342a..480bc3468 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1464,12 +1464,12 @@ (#Cons [token tokens']) (_meta (#Form (list (_meta (#Tag ["lux" "Cons"])) token (untemplate-list tokens')))))) -(def:''' (List/append xs ys) +(def:''' (List/compose xs ys) #Nil (All [a] (-> ($' List a) ($' List a) ($' List a))) (_lux_case xs (#Cons x xs') - (#Cons x (List/append xs' ys)) + (#Cons x (List/compose xs' ys)) #Nil ys)) @@ -1490,17 +1490,17 @@ (-> Code Code Code Code) (_lux_case op [_ (#Form parts)] - (form$ (List/append parts (list a1 a2))) + (form$ (List/compose parts (list a1 a2))) _ (form$ (list op a1 a2)))) (macro:' #export (_$ tokens) (#Cons [["lux" "doc"] (#TextA "## Left-association for the application of binary functions over variadic arguments. - (_$ Text/append \"Hello, \" name \".\\nHow are you?\") + (_$ Text/compose \"Hello, \" name \".\\nHow are you?\") ## => - (Text/append (Text/append \"Hello, \" name) \".\\nHow are you?\")")] + (Text/compose (Text/compose \"Hello, \" name) \".\\nHow are you?\")")] #;Nil) (_lux_case tokens (#Cons op tokens') @@ -1516,10 +1516,10 @@ (macro:' #export ($_ tokens) (#Cons [["lux" "doc"] (#TextA "## Right-association for the application of binary functions over variadic arguments. - ($_ Text/append \"Hello, \" name \".\\nHow are you?\") + ($_ Text/compose \"Hello, \" name \".\\nHow are you?\") ## => - (Text/append \"Hello, \" (Text/append name \".\\nHow are you?\"))")] + (Text/compose \"Hello, \" (Text/compose name \".\\nHow are you?\"))")] #;Nil) (_lux_case tokens (#Cons op tokens') @@ -1676,7 +1676,7 @@ (-> Text Unit) (_lux_proc ["io" "log"] [message])) -(def:''' (Text/append x y) +(def:''' (Text/compose x y) #Nil (-> Text Text Text) (_lux_proc ["text" "append"] [x y])) @@ -1687,7 +1687,7 @@ (let' [[module name] ident] (_lux_case module "" name - _ ($_ Text/append module ";" name)))) + _ ($_ Text/compose module ";" name)))) (def:''' (get-meta tag def-meta) #Nil @@ -1726,10 +1726,10 @@ (#Right [state ident])) #None - (#Left ($_ Text/append "Unknown definition: " (Ident/encode ident)))) + (#Left ($_ Text/compose "Unknown definition: " (Ident/encode ident)))) #None - (#Left ($_ Text/append "Unknown module: " module " @ " (Ident/encode ident)))))) + (#Left ($_ Text/compose "Unknown module: " module " @ " (Ident/encode ident)))))) (def:''' (splice replace? untemplate tag elems) #Nil @@ -1922,10 +1922,10 @@ (macro:' #export (|> tokens) (list [["lux" "doc"] (#TextA "## Piping macro. - (|> elems (map Int/encode) (interpose \" \") (fold Text/append \"\")) + (|> elems (map Int/encode) (interpose \" \") (fold Text/compose \"\")) ## => - (fold Text/append \"\" + (fold Text/compose \"\" (interpose \" \" (map Int/encode elems)))")]) (_lux_case tokens @@ -1934,10 +1934,10 @@ (function' [app acc] (_lux_case app [_ (#Tuple parts)] - (tuple$ (List/append parts (list acc))) + (tuple$ (List/compose parts (list acc))) [_ (#Form parts)] - (form$ (List/append parts (list acc))) + (form$ (List/compose parts (list acc))) _ (` ((~ app) (~ acc)))))) @@ -1949,10 +1949,10 @@ (macro:' #export (<| tokens) (list [["lux" "doc"] (#TextA "## Reverse piping macro. - (<| (fold Text/append \"\") (interpose \" \") (map Int/encode) elems) + (<| (fold Text/compose \"\") (interpose \" \") (map Int/encode) elems) ## => - (fold Text/append \"\" + (fold Text/compose \"\" (interpose \" \" (map Int/encode elems)))")]) (_lux_case (reverse tokens) @@ -1961,10 +1961,10 @@ (function' [app acc] (_lux_case app [_ (#Tuple parts)] - (tuple$ (List/append parts (list acc))) + (tuple$ (List/compose parts (list acc))) [_ (#Form parts)] - (form$ (List/append parts (list acc))) + (form$ (List/compose parts (list acc))) _ (` ((~ app) (~ acc)))))) @@ -2057,7 +2057,7 @@ #Nil (#Cons [x xs']) - (List/append (f x) (join-map f xs')))) + (List/compose (f x) (join-map f xs')))) (def:''' (every? p xs) #Nil @@ -2349,7 +2349,7 @@ #Nil (All [a] (-> ($' List ($' List a)) ($' List a))) - (fold List/append #Nil (reverse xs))) + (fold List/compose #Nil (reverse xs))) (def:''' (interpose sep xs) #Nil @@ -2593,7 +2593,7 @@ #seed (n.+ +1 seed) #expected expected #cursor cursor #scope-type-vars scope-type-vars} - (symbol$ ["" ($_ Text/append "__gensym__" prefix (Nat/encode seed))])))) + (symbol$ ["" ($_ Text/compose "__gensym__" prefix (Nat/encode seed))])))) (macro:' #export (Rec tokens) (list [["lux" "doc"] (#TextA "## Parameter-less recursive types. @@ -2696,38 +2696,38 @@ (Frac/encode value) [_ (#Text value)] - ($_ Text/append "\"" value "\"") + ($_ Text/compose "\"" value "\"") [_ (#Symbol [prefix name])] (if (Text/= "" prefix) name - ($_ Text/append prefix ";" name)) + ($_ Text/compose prefix ";" name)) [_ (#Tag [prefix name])] (if (Text/= "" prefix) - ($_ Text/append "#" name) - ($_ Text/append "#" prefix ";" name)) + ($_ Text/compose "#" name) + ($_ Text/compose "#" prefix ";" name)) [_ (#Form xs)] - ($_ Text/append "(" (|> xs - (map ast-to-text) - (interpose " ") - reverse - (fold Text/append "")) ")") + ($_ Text/compose "(" (|> xs + (map ast-to-text) + (interpose " ") + reverse + (fold Text/compose "")) ")") [_ (#Tuple xs)] - ($_ Text/append "[" (|> xs - (map ast-to-text) - (interpose " ") - reverse - (fold Text/append "")) "]") + ($_ Text/compose "[" (|> xs + (map ast-to-text) + (interpose " ") + reverse + (fold Text/compose "")) "]") [_ (#Record kvs)] - ($_ Text/append "{" (|> kvs - (map (function' [kv] (_lux_case kv [k v] ($_ Text/append (ast-to-text k) " " (ast-to-text v))))) - (interpose " ") - reverse - (fold Text/append "")) "}") + ($_ Text/compose "{" (|> kvs + (map (function' [kv] (_lux_case kv [k v] ($_ Text/compose (ast-to-text k) " " (ast-to-text v))))) + (interpose " ") + reverse + (fold Text/compose "")) "}") )) (def:' (expander branches) @@ -2757,11 +2757,11 @@ (do Monad<Lux> [] (wrap (list))) _ - (fail ($_ Text/append "\"lux;case\" expects an even number of tokens: " (|> branches - (map ast-to-text) - (interpose " ") - reverse - (fold Text/append "")))))) + (fail ($_ Text/compose "\"lux;case\" expects an even number of tokens: " (|> branches + (map ast-to-text) + (interpose " ") + reverse + (fold Text/compose "")))))) (macro:' #export (case tokens) (list [["lux" "doc"] (#TextA "## The pattern-matching macro. @@ -2834,7 +2834,7 @@ (let' [pairs (|> patterns (map (function' [pattern] (list pattern body))) (List/join))] - (return (List/append pairs branches)))) + (return (List/compose pairs branches)))) _ (fail "Wrong syntax for ^or"))) @@ -2951,7 +2951,7 @@ (wrap (tuple$ (list (text$ =k) =v)))) _ - (fail (Text/append "Wrong syntax for DictA key: " (ast-to-text k)))))) + (fail (Text/compose "Wrong syntax for DictA key: " (ast-to-text k)))))) kvs)] (wrap (form$ (list (tag$ ["lux" "DictA"]) (untemplate-list =xs))))) )) @@ -2972,12 +2972,12 @@ =v)))) _ - (fail (Text/append "Wrong syntax for Anns: " (ast-to-text ast)))))) + (fail (Text/compose "Wrong syntax for Anns: " (ast-to-text ast)))))) kvs)] (wrap (untemplate-list =kvs))) _ - (fail (Text/append "Wrong syntax for Anns: " (ast-to-text ast))))) + (fail (Text/compose "Wrong syntax for Anns: " (ast-to-text ast))))) (def:' (with-func-args args meta) (-> (List Code) Code Code) @@ -3297,10 +3297,10 @@ (#;Some idx) (#Cons (default (error! "UNDEFINED") - (clip2 +0 idx input)) + (clip2 +0 idx input)) (split-text splitter (default (error! "UNDEFINED") - (clip1 (n.+ +1 idx) input)))))) + (clip1 (n.+ +1 idx) input)))))) (def: (split-module-contexts module) (-> Text (List Text)) @@ -3310,7 +3310,7 @@ (#;Some idx) (split-module-contexts (default (error! "UNDEFINED") - (clip2 +0 idx module)))))) + (clip2 +0 idx module)))))) (def: (split-module module) (-> Text (List Text)) @@ -3320,9 +3320,9 @@ (#;Some idx) (list& (default (error! "UNDEFINED") - (clip2 +0 idx module)) + (clip2 +0 idx module)) (split-module (default (error! "UNDEFINED") - (clip1 (n.+ +1 idx) module)))))) + (clip1 (n.+ +1 idx) module)))))) (def: (nth idx xs) (All [a] @@ -3466,7 +3466,7 @@ (#Right state module) _ - (#Left ($_ Text/append "Unknown module: " name)))))) + (#Left ($_ Text/compose "Unknown module: " name)))))) (def: get-current-module (Lux Module) @@ -3484,7 +3484,7 @@ (return output) _ - (fail (Text/append "Unknown tag: " (Ident/encode [module name])))))) + (fail (Text/compose "Unknown tag: " (Ident/encode [module name])))))) (def: (resolve-type-tags type) (-> Type (Lux (Maybe [(List Ident) (List Type)]))) @@ -3557,7 +3557,7 @@ (wrap [tag value]) _ - (fail (Text/append "Unknown structure member: " tag-name))) + (fail (Text/compose "Unknown structure member: " tag-name))) _ (fail "Invalid structure member.")))) @@ -3566,7 +3566,7 @@ (def: (Text/join parts) (-> (List Text) Text) - (|> parts reverse (fold Text/append ""))) + (|> parts reverse (fold Text/compose ""))) (macro: #export (struct: tokens) {#;doc "## Definition of structures ala ML. @@ -3616,7 +3616,7 @@ #;None)) sig-args)) (^ (#;Some params)) - (#;Some (symbol$ ["" ($_ Text/append sig-name "<" (|> params (interpose ",") Text/join) ">")])) + (#;Some (symbol$ ["" ($_ Text/compose sig-name "<" (|> params (interpose ",") Text/join) ">")])) _ #;None) @@ -3947,7 +3947,7 @@ #import-alias _alias #import-refer {#refer-defs _referrals #refer-open _openings}} importation] - {#import-name ($_ Text/append super-name "/" _name) + {#import-name ($_ Text/compose super-name "/" _name) #import-alias _alias #import-refer {#refer-defs _referrals #refer-open _openings}}))))) @@ -3962,7 +3962,7 @@ [current-module current-module-name] (case (split-module module) (^ (list& "." parts)) - (return (|> (list& current-module parts) (interpose "/") reverse (fold Text/append ""))) + (return (|> (list& current-module parts) (interpose "/") reverse (fold Text/compose ""))) parts (let [[ups parts'] (split-with (Text/= "..") parts) @@ -3971,10 +3971,10 @@ (return module) (case (nth num-ups (split-module-contexts current-module)) #None - (fail (Text/append "Cannot clean module: " module)) + (fail (Text/compose "Cannot clean module: " module)) (#Some top-module) - (return (|> (list& top-module parts') (interpose "/") reverse (fold Text/append "")))) + (return (|> (list& top-module parts') (interpose "/") reverse (fold Text/compose "")))) ))) )) @@ -4037,7 +4037,7 @@ _ (do Monad<Lux> [current-module current-module-name] - (fail (Text/append "Wrong syntax for import @ " current-module)))))) + (fail (Text/compose "Wrong syntax for import @ " current-module)))))) imports)] (wrap (List/join imports')))) @@ -4066,7 +4066,7 @@ (#Right state (List/join to-alias))) #None - (#Left ($_ Text/append "Unknown module: " module))) + (#Left ($_ Text/compose "Unknown module: " module))) )) (def: (filter p xs) @@ -4147,12 +4147,12 @@ #scope-type-vars scope-type-vars} state] (case (get v-prefix modules) #None - (#Left (Text/append "Unknown definition: " (Ident/encode name))) + (#Left (Text/compose "Unknown definition: " (Ident/encode name))) (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-anns _ #module-state _}) (case (get v-name defs) #None - (#Left (Text/append "Unknown definition: " (Ident/encode name))) + (#Left (Text/compose "Unknown definition: " (Ident/encode name))) (#Some [def-type def-meta def-value]) (#Right [state [def-type def-value]]))))) @@ -4174,13 +4174,13 @@ (#Right state struct-type) _ - (#Left ($_ Text/append "Unknown var: " (Ident/encode ident))))) + (#Left ($_ Text/compose "Unknown var: " (Ident/encode ident))))) (case (find-def-type ident state) (#Some struct-type) (#Right state struct-type) _ - (#Left ($_ Text/append "Unknown var: " (Ident/encode ident))))) + (#Left ($_ Text/compose "Unknown var: " (Ident/encode ident))))) ))) (def: (zip2 xs ys) @@ -4206,7 +4206,7 @@ name _ - ($_ Text/append "(" name " " (|> params (map Type/show) (interpose " ") reverse (fold Text/append "")) ")")) + ($_ Text/compose "(" name " " (|> params (map Type/show) (interpose " ") reverse (fold Text/compose "")) ")")) #Void "Void" @@ -4215,38 +4215,38 @@ "Unit" (#Sum _) - ($_ Text/append "(| " (|> (flatten-variant type) (map Type/show) (interpose " ") reverse (fold Text/append "")) ")") + ($_ Text/compose "(| " (|> (flatten-variant type) (map Type/show) (interpose " ") reverse (fold Text/compose "")) ")") (#Product _) - ($_ Text/append "[" (|> (flatten-tuple type) (map Type/show) (interpose " ") reverse (fold Text/append "")) "]") + ($_ Text/compose "[" (|> (flatten-tuple type) (map Type/show) (interpose " ") reverse (fold Text/compose "")) "]") (#Function _) - ($_ Text/append "(-> " (|> (flatten-lambda type) (map Type/show) (interpose " ") reverse (fold Text/append "")) ")") + ($_ Text/compose "(-> " (|> (flatten-lambda type) (map Type/show) (interpose " ") reverse (fold Text/compose "")) ")") (#Bound id) (Nat/encode id) (#Var id) - ($_ Text/append "⌈v:" (Nat/encode id) "⌋") + ($_ Text/compose "⌈v:" (Nat/encode id) "⌋") (#Ex id) - ($_ Text/append "⟨e:" (Nat/encode id) "⟩") + ($_ Text/compose "⟨e:" (Nat/encode id) "⟩") (#UnivQ env body) - ($_ Text/append "(All " (Type/show body) ")") + ($_ Text/compose "(All " (Type/show body) ")") (#ExQ env body) - ($_ Text/append "(Ex " (Type/show body) ")") + ($_ Text/compose "(Ex " (Type/show body) ")") (#Apply _) (let [[func args] (flatten-app type)] - ($_ Text/append + ($_ Text/compose "(" (Type/show func) " " - (|> args (map Type/show) (interpose " ") reverse (fold Text/append "")) + (|> args (map Type/show) (interpose " ") reverse (fold Text/compose "")) ")")) (#Named [prefix name] _) - ($_ Text/append prefix ";" name) + ($_ Text/compose prefix ";" name) )) (def: (foldM Monad<m> f init inputs) @@ -4271,7 +4271,7 @@ struct-evidence (resolve-type-tags init-type)] (case struct-evidence #;None - (fail (Text/append "Can only \"open\" structs: " (Type/show init-type))) + (fail (Text/compose "Can only \"open\" structs: " (Type/show init-type))) (#;Some tags&members) (do Monad<Lux> @@ -4279,7 +4279,7 @@ (function recur [source [tags members] target] (let [pattern (record$ (map (function [[t-module t-name]] [(tag$ [t-module t-name]) - (symbol$ ["" (Text/append prefix t-name)])]) + (symbol$ ["" (Text/compose prefix t-name)])]) tags))] (do Monad<Lux> [enhanced-target (foldM Monad<Lux> @@ -4288,7 +4288,7 @@ [m-structure (resolve-type-tags m-type)] (case m-structure (#;Some m-tags&members) - (recur ["" (Text/append prefix m-name)] + (recur ["" (Text/compose prefix m-name)] m-tags&members enhanced-target) @@ -4416,7 +4416,7 @@ (return (List/join decls'))) _ - (return (list (` (;_lux_def (~ (symbol$ ["" (Text/append prefix name)])) (~ source+) + (return (list (` (;_lux_def (~ (symbol$ ["" (Text/compose prefix name)])) (~ source+) #Nil))))))) (macro: #export (open tokens) @@ -4450,17 +4450,17 @@ (return (List/join decls'))) _ - (fail (Text/append "Can only \"open\" structs: " (Type/show struct-type))))) + (fail (Text/compose "Can only \"open\" structs: " (Type/show struct-type))))) _ (fail "Wrong syntax for open"))) (macro: #export (|>. tokens) {#;doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it. - (|>. (map Int/encode) (interpose \" \") (fold Text/append \"\")) + (|>. (map Int/encode) (interpose \" \") (fold Text/compose \"\")) ## => (function [<arg>] - (fold Text/append \"\" + (fold Text/compose \"\" (interpose \" \" (map Int/encode <arg>))))"} (do Monad<Lux> @@ -4469,10 +4469,10 @@ (macro: #export (<|. tokens) {#;doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it. - (<|. (fold Text/append \"\") (interpose \" \") (map Int/encode)) + (<|. (fold Text/compose \"\") (interpose \" \") (map Int/encode)) ## => (function [<arg>] - (fold Text/append \"\" + (fold Text/compose \"\" (interpose \" \" (map Int/encode <arg>))))"} (do Monad<Lux> @@ -4501,7 +4501,7 @@ (function [_def] (if (is-member? all-defs _def) (return []) - (fail ($_ Text/append _def " is not defined in module " module-name " @ " current-module))))) + (fail ($_ Text/compose _def " is not defined in module " module-name " @ " current-module))))) referred-defs)))]] (case options #;Nil @@ -4509,11 +4509,11 @@ #refer-open openings}) _ - (fail ($_ Text/append "Wrong syntax for refer @ " current-module + (fail ($_ Text/compose "Wrong syntax for refer @ " current-module "\n" (|> options (map ast-to-text) (interpose " ") - (fold Text/append ""))))))) + (fold Text/compose ""))))))) (def: (write-refer module-name [r-defs r-opens]) (-> Text Refer (Lux (List Code))) @@ -4526,7 +4526,7 @@ (function [_def] (if (is-member? all-defs _def) (return []) - (fail ($_ Text/append _def " is not defined in module " module-name " @ " current-module))))) + (fail ($_ Text/compose _def " is not defined in module " module-name " @ " current-module))))) referred-defs)))] defs' (case r-defs #All @@ -4558,7 +4558,7 @@ (map (function [[_ name]] (` (open (~ (symbol$ [module-name name])) (~ (text$ prefix))))) structs))) r-opens)]] - (wrap (List/append defs openings)) + (wrap (List/compose defs openings)) )) (macro: #hidden (refer tokens) @@ -4870,7 +4870,7 @@ wrap)) #;None))) (#Some output) - (return (List/append output branches)) + (return (List/compose output branches)) #None (fail "Wrong syntax for ^template")) @@ -4910,8 +4910,8 @@ [[_ _ column] (#Record pairs)] (fold n.min column - (List/append (map (. find-baseline-column first) pairs) - (map (. find-baseline-column second) pairs))) + (List/compose (map (. find-baseline-column first) pairs) + (map (. find-baseline-column second) pairs))) )) (type: Doc-Fragment @@ -4939,7 +4939,7 @@ (replace-all "\"" "\\\"") (replace-all "\\" "\\\\") )] - ($_ Text/append "\"" escaped "\""))) + ($_ Text/compose "\"" escaped "\""))) (do-template [<name> <op> <one> <type> <doc>] [(def: #export (<name> value) @@ -4955,7 +4955,7 @@ (def: Tag/encode (-> Ident Text) - (. (Text/append "#") Ident/encode)) + (. (Text/compose "#") Ident/encode)) (do-template [<name> <op> <from> <to>] [(def: #export (<name> input) @@ -4980,7 +4980,7 @@ (Text/join (repeat (nat-to-int (n.- old-column new-column)) " ")) (let [extra-lines (Text/join (repeat (nat-to-int (n.- old-line new-line)) "\n")) space-padding (Text/join (repeat (nat-to-int (n.- baseline new-column)) " "))] - (Text/append extra-lines space-padding)))) + (Text/compose extra-lines space-padding)))) (def: (Text/size x) (-> Text Nat) @@ -5009,8 +5009,8 @@ [new-cursor (<tag> value)] (let [as-text (<show> value)] [(update-cursor new-cursor as-text) - (Text/append (cursor-padding baseline prev-cursor new-cursor) - as-text)])) + (Text/compose (cursor-padding baseline prev-cursor new-cursor) + as-text)])) ([#Bool Bool/encode] [#Nat Nat/encode] [#Int Int/encode] @@ -5023,11 +5023,11 @@ [group-cursor (<tag> parts)] (let [[group-cursor' parts-text] (fold (function [part [last-cursor text-accum]] (let [[part-cursor part-text] (doc-example->Text last-cursor baseline part)] - [part-cursor (Text/append text-accum part-text)])) + [part-cursor (Text/compose text-accum part-text)])) [(delim-update-cursor group-cursor) ""] (<prep> parts))] [(delim-update-cursor group-cursor') - ($_ Text/append (cursor-padding baseline prev-cursor group-cursor) + ($_ Text/compose (cursor-padding baseline prev-cursor group-cursor) <open> parts-text <close>)])) @@ -5049,14 +5049,14 @@ (#Doc-Comment comment) (|> comment (split-text "\n") - (map (function [line] ($_ Text/append "## " line "\n"))) + (map (function [line] ($_ Text/compose "## " line "\n"))) Text/join) (#Doc-Example example) (let [baseline (find-baseline-column example) [cursor _] example [_ text] (doc-example->Text (with-baseline baseline cursor) baseline example)] - (Text/append text "\n\n")))) + (Text/compose text "\n\n")))) (macro: #export (doc tokens) {#;doc "## Creates code documentation, embedding text as comments and properly formatting the forms it's being given. @@ -5334,7 +5334,7 @@ ["Text" Text text$]) _ - (fail (Text/append "Cannot anti-quote type: " (Ident/encode name)))))) + (fail (Text/compose "Cannot anti-quote type: " (Ident/encode name)))))) (def: (anti-quote token) (-> Code (Lux Code)) @@ -5540,7 +5540,7 @@ (wrap (list (` (#Ex (~ (nat$ var-id)))))) #;None - (fail (Text/append "Indexed-type does not exist: " (Nat/encode idx))))) + (fail (Text/compose "Indexed-type does not exist: " (Nat/encode idx))))) _ (fail "Wrong syntax for $"))) @@ -5739,7 +5739,7 @@ (list (` (~ (replace-syntax rep-env input-template))))]) (~ g!_) - (#;Left (~ (text$ (Text/append "Wrong syntax for " name)))) + (#;Left (~ (text$ (Text/compose "Wrong syntax for " name)))) ))))) )) diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux index 0756f058a..ba0689e89 100644 --- a/stdlib/source/lux/cli.lux +++ b/stdlib/source/lux/cli.lux @@ -66,13 +66,13 @@ (let [[pre post] (list;split-with (. ;not (list;member? text;Eq<Text> names)) inputs)] (case post #;Nil - (#R;Error ($_ T/append "Missing option (" (text;join-with " " names) ")")) + (#R;Error ($_ T/compose "Missing option (" (text;join-with " " names) ")")) (^ (list& _ value post')) - (#R;Success [(L/append pre post') value]) + (#R;Success [(L/compose pre post') value]) _ - (#R;Error ($_ T/append "Option lacks value (" (text;join-with " " names) ")")) + (#R;Error ($_ T/compose "Option lacks value (" (text;join-with " " names) ")")) )))) (def: #export (flag names) @@ -85,7 +85,7 @@ (#R;Success [pre false]) (#;Cons _ post') - (#R;Success [(L/append pre post') true]))))) + (#R;Success [(L/compose pre post') true]))))) (def: #export end {#;doc "Ensures there are no more inputs."} @@ -93,7 +93,7 @@ (function [inputs] (case inputs #;Nil (#R;Success [inputs []]) - _ (#R;Error (T/append "Unknown parameters: " (text;join-with " " inputs)))))) + _ (#R;Error (T/compose "Unknown parameters: " (text;join-with " " inputs)))))) ## [Syntax] (type: Program-Args @@ -118,7 +118,7 @@ (wrap []))) (program: (name) - (io (log! (T/append "Hello, " name)))) + (io (log! (T/compose "Hello, " name)))) (program: ([config config^]) (do Monad<IO> diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux index c742b8d75..ac4db6606 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/concurrency/actor.lux @@ -315,7 +315,7 @@ g!message (code;local-symbol (get@ #name signature)) g!actor-vars (L/map code;local-symbol actor-vars) g!actor (` ((~ (code;symbol actor-name)) (~@ g!actor-vars))) - g!all-vars (|> (get@ #vars signature) (L/map code;local-symbol) (L/append g!actor-vars)) + g!all-vars (|> (get@ #vars signature) (L/map code;local-symbol) (L/compose g!actor-vars)) g!inputsC (|> (get@ #inputs signature) (L/map (|>. product;left code;local-symbol))) g!inputsT (|> (get@ #inputs signature) (L/map product;right)) g!state (|> signature (get@ #state) code;local-symbol) diff --git a/stdlib/source/lux/concurrency/frp.lux b/stdlib/source/lux/concurrency/frp.lux index ed0560b84..d59b96563 100644 --- a/stdlib/source/lux/concurrency/frp.lux +++ b/stdlib/source/lux/concurrency/frp.lux @@ -234,7 +234,7 @@ (All [a] (-> Nat (Channel a) (Channel (List a)))) (let [(^open) &;Monad<Promise>] (folds (function [input window] - (let [window' (L/append window (list input))] + (let [window' (L/compose window (list input))] (wrap (if (n.<= max (list;size window')) window' (tail window'))))) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index b36c97268..fda8103f2 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -17,9 +17,9 @@ (-> Text Text)) ## [Values] -(def: #hidden _text/append_ +(def: #hidden _text/compose_ (-> Text Text Text) - text/append) + text/compose) (def: #export (match? exception error) (-> Exception Text Bool) @@ -72,8 +72,8 @@ (exception: #export Some-Exception))} (do @ [current-module macro;current-module-name - #let [descriptor ($_ text/append "{" current-module ";" name "}" "\n") + #let [descriptor ($_ text/compose "{" current-module ";" name "}" "\n") g!message (code;symbol ["" "message"])]] (wrap (list (` (def: (~@ (csw;export _ex-lev)) ((~ (code;symbol ["" name])) (~ g!message)) Exception - (_text/append_ (~ (code;text descriptor)) (~ g!message)))))))) + (_text/compose_ (~ (code;text descriptor)) (~ g!message)))))))) diff --git a/stdlib/source/lux/control/monoid.lux b/stdlib/source/lux/control/monoid.lux index 356bc3c13..53f91474f 100644 --- a/stdlib/source/lux/control/monoid.lux +++ b/stdlib/source/lux/control/monoid.lux @@ -2,10 +2,10 @@ ## Signatures (sig: #export (Monoid a) - {#;doc "A way to combine (append) values. + {#;doc "A way to compose values. - Includes an identity (unit) value which does not alter any other value when combined with."} + Includes an identity value which does not alter any other value when combined with."} (: a - unit) + identity) (: (-> a a a) - append)) + compose)) diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux index 174040805..87d6820bd 100644 --- a/stdlib/source/lux/control/parser.lux +++ b/stdlib/source/lux/control/parser.lux @@ -149,7 +149,7 @@ (do Monad<Parser> [min (exactly n p) extra (some p)] - (wrap (L/append min extra)))) + (wrap (L/compose min extra)))) (def: #export (at-most n p) {#;doc "Parse at most N times."} diff --git a/stdlib/source/lux/control/writer.lux b/stdlib/source/lux/control/writer.lux index 10da747c9..d8785af46 100644 --- a/stdlib/source/lux/control/writer.lux +++ b/stdlib/source/lux/control/writer.lux @@ -21,12 +21,12 @@ (def: functor Functor<Writer>) (def: (wrap x) - [(:: mon unit) x]) + [(:: mon identity) x]) (def: (apply ff fa) (let [[log1 f] ff [log2 a] fa] - [(:: mon append log1 log2) (f a)]))) + [(:: mon compose log1 log2) (f a)]))) (struct: #export (Monad<Writer> mon) (All [l] (-> (Monoid l) (Monad (Writer l)))) @@ -34,7 +34,7 @@ (def: (join mma) (let [[log1 [log2 a]] mma] - [(:: mon append log1 log2) a]))) + [(:: mon compose log1 log2) a]))) (def: #export (log l) {#;doc "Set the log to a particular value."} @@ -49,11 +49,11 @@ [[l1 Mla] (: (($ +1) (Writer ($ +0) (($ +1) (Writer ($ +0) ($ +2))))) MlMla) [l2 a] Mla] - (wrap [(:: Monoid<l> append l1 l2) a])))) + (wrap [(:: Monoid<l> compose l1 l2) a])))) (def: #export (lift Monoid<l> Monad<M>) (All [l M a] (-> (Monoid l) (Monad M) (-> (M a) (M (Writer l a))))) (function [ma] (do Monad<M> [a ma] - (wrap [(:: Monoid<l> unit) a])))) + (wrap [(:: Monoid<l> identity) a])))) diff --git a/stdlib/source/lux/data/bool.lux b/stdlib/source/lux/data/bool.lux index e292c0ede..b07d3c8df 100644 --- a/stdlib/source/lux/data/bool.lux +++ b/stdlib/source/lux/data/bool.lux @@ -19,10 +19,10 @@ true +1 false +0))) -(do-template [<name> <unit> <op>] +(do-template [<name> <identity> <op>] [(struct: #export <name> (Monoid Bool) - (def: unit <unit>) - (def: (append x y) + (def: identity <identity>) + (def: (compose x y) (<op> x y)))] [ Or@Monoid<Bool> false or] diff --git a/stdlib/source/lux/data/coll/array.lux b/stdlib/source/lux/data/coll/array.lux index 507092de1..750e6b610 100644 --- a/stdlib/source/lux/data/coll/array.lux +++ b/stdlib/source/lux/data/coll/array.lux @@ -177,9 +177,9 @@ (struct: #export Monoid<Array> (All [a] (Monoid (Array a))) - (def: unit (new +0)) + (def: identity (new +0)) - (def: (append xs ys) + (def: (compose xs ys) (let [sxs (size xs) sxy (size ys)] (|> (new (n.+ sxy sxs)) diff --git a/stdlib/source/lux/data/coll/dict.lux b/stdlib/source/lux/data/coll/dict.lux index e6c46aa3f..531953a87 100644 --- a/stdlib/source/lux/data/coll/dict.lux +++ b/stdlib/source/lux/data/coll/dict.lux @@ -525,7 +525,7 @@ (All [K V] (-> (Node K V) (List [K V]))) (case node (#Hierarchy _size hierarchy) - (Array/fold (function [sub-node tail] (L/append (entries' sub-node) tail)) + (Array/fold (function [sub-node tail] (L/compose (entries' sub-node) tail)) #;Nil hierarchy) @@ -533,7 +533,7 @@ (Array/fold (function [branch tail] (case branch (#;Left sub-node) - (L/append (entries' sub-node) tail) + (L/compose (entries' sub-node) tail) (#;Right [key' val']) (#;Cons [key' val'] tail))) diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux index c2186fd8d..5db72e77e 100644 --- a/stdlib/source/lux/data/coll/list.lux +++ b/stdlib/source/lux/data/coll/list.lux @@ -252,11 +252,11 @@ (struct: #export Monoid<List> (All [a] (Monoid (List a))) - (def: unit #;Nil) - (def: (append xs ys) + (def: identity #;Nil) + (def: (compose xs ys) (case xs #;Nil ys - (#;Cons x xs') (#;Cons x (append xs' ys))))) + (#;Cons x xs') (#;Cons x (compose xs' ys))))) (open Monoid<List>) @@ -280,12 +280,12 @@ #;Nil (#;Cons f ff') - (append (map f fa) (apply ff' fa))))) + (compose (map f fa) (apply ff' fa))))) (struct: #export _ (Monad List) (def: applicative Applicative<List>) - (def: join (|>. reverse (fold append unit)))) + (def: join (|>. reverse (fold compose identity)))) ## [Functions] (def: #export (sort < xs) @@ -301,7 +301,7 @@ [pre (#;Cons x' post)])) [(list) (list)] xs')] - ($_ append (sort < pre) (list x) (sort < post))))) + ($_ compose (sort < pre) (list x) (sort < post))))) (do-template [<name> <type> <comp> <inc>] [(def: #export (<name> from to) diff --git a/stdlib/source/lux/data/coll/ordered/dict.lux b/stdlib/source/lux/data/coll/ordered/dict.lux index e51e23b70..677a24190 100644 --- a/stdlib/source/lux/data/coll/ordered/dict.lux +++ b/stdlib/source/lux/data/coll/ordered/dict.lux @@ -534,7 +534,7 @@ (list) (#;Some node') - ($_ L/append + ($_ L/compose (recur (get@ #left node')) (list <output>) (recur (get@ #right node'))))))] diff --git a/stdlib/source/lux/data/coll/queue.lux b/stdlib/source/lux/data/coll/queue.lux index db514cbaa..b6e5a7161 100644 --- a/stdlib/source/lux/data/coll/queue.lux +++ b/stdlib/source/lux/data/coll/queue.lux @@ -21,7 +21,7 @@ (def: #export (to-list queue) (All [a] (-> (Queue a) (List a))) (let [(^slots [#front #rear]) queue] - (L/append front (list;reverse rear)))) + (L/compose front (list;reverse rear)))) (def: #export peek (All [a] (-> (Queue a) (Maybe a))) diff --git a/stdlib/source/lux/data/coll/seq.lux b/stdlib/source/lux/data/coll/seq.lux index 0e861e15a..2b464adf8 100644 --- a/stdlib/source/lux/data/coll/seq.lux +++ b/stdlib/source/lux/data/coll/seq.lux @@ -50,7 +50,7 @@ (#;Some fingers) (#;Some (f;branch (new prefix) fingers)))) -(def: #export (append suffix subject) +(def: #export (compose suffix subject) (All [a] (-> a (Seq a) (Seq a))) (case subject #;None @@ -101,7 +101,7 @@ (list value) (#f;Branch tag left right) - (L/append (recur left) (recur right)))))) + (L/compose (recur left) (recur right)))))) (def: #export (from-list xs) (All [a] (-> (List a) (Seq a))) diff --git a/stdlib/source/lux/data/coll/tree/finger.lux b/stdlib/source/lux/data/coll/tree/finger.lux index ba66abcff..355c89b55 100644 --- a/stdlib/source/lux/data/coll/tree/finger.lux +++ b/stdlib/source/lux/data/coll/tree/finger.lux @@ -30,22 +30,22 @@ (All [m a] (-> (Fingers m a) (Fingers m a) (Fingers m a))) (let [Monoid<m> (get@ #monoid right)] {#monoid Monoid<m> - #tree (#Branch (:: Monoid<m> append (tag left) (tag right)) + #tree (#Branch (:: Monoid<m> compose (tag left) (tag right)) (get@ #tree left) (get@ #tree right))})) (def: #export (search pred fingers) (All [m a] (-> (-> m Bool) (Fingers m a) (Maybe a))) - (let [tag/append (get@ [#monoid #m;append] fingers)] + (let [tag/compose (get@ [#monoid #m;compose] fingers)] (if (pred (tag fingers)) - (loop [_tag (get@ [#monoid #m;unit] fingers) + (loop [_tag (get@ [#monoid #m;identity] fingers) _node (get@ #tree fingers)] (case _node (#Leaf _ value) (#;Some value) (#Branch _ left right) - (let [shifted-tag (tag/append _tag (tag (set@ #tree left fingers)))] + (let [shifted-tag (tag/compose _tag (tag (set@ #tree left fingers)))] (if (pred shifted-tag) (recur _tag left) (recur shifted-tag right))))) diff --git a/stdlib/source/lux/data/coll/tree/zipper.lux b/stdlib/source/lux/data/coll/tree/zipper.lux index 48c91ea34..c8f9a9059 100644 --- a/stdlib/source/lux/data/coll/tree/zipper.lux +++ b/stdlib/source/lux/data/coll/tree/zipper.lux @@ -84,9 +84,9 @@ (|> parent (update@ #node (: (-> (Tree ($ +0)) (Tree ($ +0))) (function [node] - (set@ #rose;children (L/append (list;reverse (get@ #lefts zipper)) - (#;Cons (get@ #node zipper) - (get@ #rights zipper))) + (set@ #rose;children (L/compose (list;reverse (get@ #lefts zipper)) + (#;Cons (get@ #node zipper) + (get@ #rights zipper))) node))))))) (def: #export (root zipper) @@ -153,9 +153,9 @@ (All [a] (-> a (Zipper a) (Zipper a))) (update@ [#node #rose;children] (function [children] - (L/append children - (list (: (Tree ($ +0)) - (rose;tree [value {}]))))) + (L/compose children + (list (: (Tree ($ +0)) + (rose;tree [value {}]))))) zipper)) (def: #export (remove zipper) diff --git a/stdlib/source/lux/data/coll/vector.lux b/stdlib/source/lux/data/coll/vector.lux index 826de5c42..ebdd6235c 100644 --- a/stdlib/source/lux/data/coll/vector.lux +++ b/stdlib/source/lux/data/coll/vector.lux @@ -173,7 +173,7 @@ (|> hierarchy array;to-list list;reverse - (List/fold (function [sub acc] (List/append (to-list' sub) acc)) + (List/fold (function [sub acc] (List/compose (to-list' sub) acc)) #;Nil)))) ## [Types] @@ -303,7 +303,7 @@ (loop [level init-level root (: (Hierarchy ($ +0)) (maybe;default (new-hierarchy []) - (pop-tail vec-size init-level (get@ #root vec))))] + (pop-tail vec-size init-level (get@ #root vec))))] (if (n.> branching-exponent level) (case [(array;get +1 root) (array;get +0 root)] [#;None (#;Some (#Hierarchy sub-node))] @@ -324,8 +324,8 @@ (def: #export (to-list vec) (All [a] (-> (Vector a) (List a))) - (List/append (to-list' (#Hierarchy (get@ #root vec))) - (to-list' (#Base (get@ #tail vec))))) + (List/compose (to-list' (#Hierarchy (get@ #root vec))) + (to-list' (#Base (get@ #tail vec))))) (def: #export (from-list list) (All [a] (-> (List a) (Vector a))) @@ -392,8 +392,8 @@ (struct: #export Monoid<Vector> (All [a] (Monoid (Vector a))) - (def: unit empty) - (def: (append xs ys) + (def: identity empty) + (def: (compose xs ys) (List/fold add xs (to-list ys)))) (struct: _ (F;Functor Node) @@ -426,7 +426,7 @@ (^open) Monoid<Vector> results (map (function [f] (map f fa)) ff)] - (fold append unit results))) + (fold compose identity results))) ) (struct: #export _ (Monad Vector) @@ -435,11 +435,11 @@ (def: join (let [(^open) Fold<Vector> (^open) Monoid<Vector>] - (fold (function [post pre] (append pre post)) unit))) + (fold (function [post pre] (compose pre post)) identity))) ) (def: #export (reverse xs) (All [a] (-> (Vector a) (Vector a))) (let [(^open) Fold<Vector> (^open) Monoid<Vector>] - (fold add unit xs))) + (fold add identity xs))) diff --git a/stdlib/source/lux/data/format/css.lux b/stdlib/source/lux/data/format/css.lux index e4ca7e3cd..1de9e0192 100644 --- a/stdlib/source/lux/data/format/css.lux +++ b/stdlib/source/lux/data/format/css.lux @@ -66,7 +66,7 @@ (do-template [<name> <type>] [(def: #export <name> (-> <type> <type> <type>) - L/append)] + L/compose)] [merge Style] [cascade Sheet] diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 95d689059..1cbf9e665 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -102,7 +102,7 @@ (#R;Success (d;keys obj)) _ - (#R;Error ($_ text/append "Cannot get the fields of a non-object.")))) + (#R;Error ($_ text/compose "Cannot get the fields of a non-object.")))) (def: #export (get key json) {#;doc "A JSON object field getter."} @@ -114,10 +114,10 @@ (#R;Success value) #;None - (#R;Error ($_ text/append "Missing field \"" key "\" on object."))) + (#R;Error ($_ text/compose "Missing field \"" key "\" on object."))) _ - (#R;Error ($_ text/append "Cannot get field \"" key "\" of a non-object.")))) + (#R;Error ($_ text/compose "Cannot get field \"" key "\" of a non-object.")))) (def: #export (set key value json) {#;doc "A JSON object field setter."} @@ -127,18 +127,18 @@ (#R;Success (#Object (d;put key value obj))) _ - (#R;Error ($_ text/append "Cannot set field \"" key "\" of a non-object.")))) + (#R;Error ($_ text/compose "Cannot set field \"" key "\" of a non-object.")))) (do-template [<name> <tag> <type> <desc>] [(def: #export (<name> key json) - {#;doc (#;TextA ($_ text/append "A JSON object field getter for " <desc> "."))} + {#;doc (#;TextA ($_ text/compose "A JSON object field getter for " <desc> "."))} (-> Text JSON (R;Result <type>)) (case (get key json) (#R;Success (<tag> value)) (#R;Success value) (#R;Success _) - (#R;Error ($_ text/append "Wrong value type at key: " key)) + (#R;Error ($_ text/compose "Wrong value type at key: " key)) (#R;Error error) (#R;Error error)))] @@ -226,7 +226,7 @@ (do-template [<name> <type> <tag> <desc>] [(def: #export <name> - {#;doc (#;TextA ($_ text/append "Reads a JSON value as " <desc> "."))} + {#;doc (#;TextA ($_ text/compose "Reads a JSON value as " <desc> "."))} (Reader <type>) (do p;Monad<Parser> [head any] @@ -235,7 +235,7 @@ (wrap value) _ - (fail ($_ text/append "JSON value is not " <desc> ".")))))] + (fail ($_ text/compose "JSON value is not " <desc> ".")))))] [null Unit #Null "null"] [boolean Bool #Boolean "boolean"] @@ -245,7 +245,7 @@ (do-template [<test> <check> <type> <eq> <encoder> <tag> <desc> <pre>] [(def: #export (<test> test) - {#;doc (#;TextA ($_ text/append "Asks whether a JSON value is a " <desc> "."))} + {#;doc (#;TextA ($_ text/compose "Asks whether a JSON value is a " <desc> "."))} (-> <type> (Reader Bool)) (do p;Monad<Parser> [head any] @@ -254,10 +254,10 @@ (wrap (:: <eq> = test (<pre> value))) _ - (fail ($_ text/append "JSON value is not " <desc> "."))))) + (fail ($_ text/compose "JSON value is not " <desc> "."))))) (def: #export (<check> test) - {#;doc (#;TextA ($_ text/append "Ensures a JSON value is a " <desc> "."))} + {#;doc (#;TextA ($_ text/compose "Ensures a JSON value is a " <desc> "."))} (-> <type> (Reader Unit)) (do p;Monad<Parser> [head any] @@ -266,10 +266,10 @@ (let [value (<pre> value)] (if (:: <eq> = test value) (wrap []) - (fail ($_ text/append "Value mismatch: " (<encoder> test) "=/=" (<encoder> value))))) + (fail ($_ text/compose "Value mismatch: " (<encoder> test) "=/=" (<encoder> value))))) _ - (fail ($_ text/append "JSON value is not a " <desc> ".")))))] + (fail ($_ text/compose "JSON value is not a " <desc> ".")))))] [boolean? boolean! Bool bool;Eq<Bool> (:: bool;Codec<Text,Bool> encode) #Boolean "boolean" id] [number? number! Frac number;Eq<Frac> (:: number;Codec<Text,Frac> encode) #Number "number" id] @@ -347,7 +347,7 @@ (fail error)) _ - (fail ($_ text/append "JSON object does not have field \"" field-name "\"."))) + (fail ($_ text/compose "JSON object does not have field \"" field-name "\"."))) _ (fail "JSON value is not an object.")))) @@ -366,16 +366,16 @@ (def: (show-array show-json elems) (-> (-> JSON Text) (-> Array Text)) - ($_ text/append "[" + ($_ text/compose "[" (|> elems (Vector/map show-json) vector;to-list (text;join-with ",")) "]")) (def: (show-object show-json object) (-> (-> JSON Text) (-> Object Text)) - ($_ text/append "{" + ($_ text/compose "{" (|> object d;entries - (L/map (function [[key value]] ($_ text/append (show-string key) ":" (show-json value)))) + (L/map (function [[key value]] ($_ text/compose (show-string key) ":" (show-json value)))) (text;join-with ",")) "}")) @@ -436,8 +436,8 @@ [mark (l;one-of "eE") signed?' (l;this? "-") offset (l;many l;decimal)] - (wrap ($_ text/append mark (if signed?' "-" "") offset))))] - (case (frac/decode ($_ text/append (if signed? "-" "") digits "." decimals exp)) + (wrap ($_ text/compose mark (if signed?' "-" "") offset))))] + (case (frac/decode ($_ text/compose (if signed? "-" "") digits "." decimals exp)) (#R;Error message) (p;fail message) @@ -466,7 +466,7 @@ (do @ [escaped escaped~ next-chars (recur [])] - (wrap ($_ text/append chars escaped next-chars))) + (wrap ($_ text/compose chars escaped next-chars))) (wrap chars)))) (def: (kv~ json~) diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index dc6074ef5..3763ca63b 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -65,7 +65,7 @@ l;alpha) tail (l;some (p;either (l;one-of "_.-") l;alpha-num))] - (wrap ($_ text/append head tail)))) + (wrap ($_ text/compose head tail)))) (def: namespaced-symbol^ (l;Lexer Ident) @@ -109,7 +109,7 @@ spaced^ (p;after (l;this "/")) (l;enclosed ["<" ">"]))] - (p;assert ($_ text/append "Close tag does not match open tag.\n" + (p;assert ($_ text/compose "Close tag does not match open tag.\n" "Expected: " (ident/encode expected) "\n" " Actual: " (ident/encode actual) "\n") (ident/= expected actual)))) @@ -186,14 +186,14 @@ (-> Tag Text) (case namespace "" name - _ ($_ text/append namespace ":" name))) + _ ($_ text/compose namespace ":" name))) (def: (write-attrs attrs) (-> Attrs Text) (|> attrs d;entries (L/map (function [[key value]] - ($_ text/append (write-tag key) "=" "\""(sanitize-value value) "\""))) + ($_ text/compose (write-tag key) "=" "\""(sanitize-value value) "\""))) (text;join-with " "))) (def: xml-header @@ -202,7 +202,7 @@ (def: #export (write input) (-> XML Text) - ($_ text/append xml-header + ($_ text/compose xml-header (loop [input input] (case input (#Text value) @@ -212,10 +212,10 @@ (let [tag (write-tag xml-tag) attrs (if (d;empty? xml-attrs) "" - ($_ text/append " " (write-attrs xml-attrs)))] + ($_ text/compose " " (write-attrs xml-attrs)))] (if (list;empty? xml-children) - ($_ text/append "<" tag attrs "/>") - ($_ text/append "<" tag attrs ">" + ($_ text/compose "<" tag attrs "/>") + ($_ text/compose "<" tag attrs ">" (|> xml-children (L/map recur) (text;join-with "")) diff --git a/stdlib/source/lux/data/ident.lux b/stdlib/source/lux/data/ident.lux index 174712b33..592f648ba 100644 --- a/stdlib/source/lux/data/ident.lux +++ b/stdlib/source/lux/data/ident.lux @@ -29,11 +29,11 @@ (def: (encode [module name]) (case module "" name - _ ($_ Text/append module ";" name))) + _ ($_ Text/compose module ";" name))) (def: (decode input) (if (Text/= "" input) - (#;Left (Text/append "Invalid format for Ident: " input)) + (#;Left (Text/compose "Invalid format for Ident: " input)) (case (text;split-all-with ";" input) (^ (list name)) (#;Right ["" name]) @@ -42,7 +42,7 @@ (#;Right [module name]) _ - (#;Left (Text/append "Invalid format for Ident: " input)))))) + (#;Left (Text/compose "Invalid format for Ident: " input)))))) (struct: #export _ (Hash Ident) (def: eq Eq<Ident>) diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux index 27d63f1fb..c45e756a3 100644 --- a/stdlib/source/lux/data/maybe.lux +++ b/stdlib/source/lux/data/maybe.lux @@ -13,8 +13,8 @@ ## [Structures] (struct: #export Monoid<Maybe> (All [a] (m;Monoid (Maybe a))) - (def: unit #;None) - (def: (append xs ys) + (def: identity #;None) + (def: (compose xs ys) (case xs #;None ys (#;Some x) (#;Some x)))) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index b48aa5f7d..769561b83 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -110,10 +110,10 @@ [ Deg Enum<Deg> (_lux_proc [ "deg" "max-value"] []) (_lux_proc [ "deg" "min-value"] [])] ) -(do-template [<name> <type> <unit> <append>] +(do-template [<name> <type> <identity> <compose>] [(struct: #export <name> (Monoid <type>) - (def: unit <unit>) - (def: append <append>))] + (def: identity <identity>) + (def: compose <compose>))] [ Add@Monoid<Nat> Nat +0 n.+] [ Mul@Monoid<Nat> Nat +1 n.*] diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index e1cb226a0..e8bcb2268 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/data/number/complex.lux @@ -313,14 +313,14 @@ (struct: #export _ (Codec Text Complex) (def: (encode (^slots [#real #imaginary])) - ($_ text/append "(" (f/encode real) ", " (f/encode imaginary) ")")) + ($_ text/compose "(" (f/encode real) ", " (f/encode imaginary) ")")) (def: (decode input) (case (do maybe;Monad<Maybe> [input' (text;clip +1 (n.- +1 (text;size input)) input)] (text;split-with "," input')) #;None - (#;Left (text/append "Wrong syntax for complex numbers: " input)) + (#;Left (text/compose "Wrong syntax for complex numbers: " input)) (#;Some [r' i']) (do R;Monad<Result> diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux index 83f987827..51e9464b1 100644 --- a/stdlib/source/lux/data/number/ratio.lux +++ b/stdlib/source/lux/data/number/ratio.lux @@ -136,7 +136,7 @@ (struct: #export _ (Codec Text Ratio) (def: (encode (^slots [#numerator #denominator])) - ($_ Text/append (part-encode numerator) separator (part-encode denominator))) + ($_ Text/compose (part-encode numerator) separator (part-encode denominator))) (def: (decode input) (case (text;split-with separator input) @@ -148,7 +148,7 @@ #denominator denominator}))) #;None - (#;Left (Text/append "Invalid syntax for ratio: " input))))) + (#;Left (Text/compose "Invalid syntax for ratio: " input))))) (syntax: #export (ratio numerator [?denominator (p;opt s;any)]) {#;doc (doc "Rational literals." diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index ec3d2f3c1..dd25a1359 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -129,11 +129,11 @@ ) (struct: #export _ (Monoid Text) - (def: unit "") - (def: (append left right) + (def: identity "") + (def: (compose left right) (_lux_proc ["text" "append"] [left right]))) -(open Monoid<Text>) +(open Monoid<Text> "text/") (def: #export (encode original) (-> Text Text) @@ -147,7 +147,7 @@ (replace-all "\f" "\\f") (replace-all "\"" "\\\"") )] - ($_ append "\"" escaped "\""))) + ($_ text/compose "\"" escaped "\""))) (struct: #export _ (Hash Text) (def: eq Eq<Text>) @@ -159,7 +159,7 @@ (-> (List Text) Text) (let [(^open) list;Fold<List> (^open) Monoid<Text>] - (|>. list;reverse (fold append unit)))) + (|>. list;reverse (fold text/compose identity)))) (def: #export (join-with sep texts) (-> Text (List Text) Text) @@ -174,16 +174,16 @@ (def: #export (replace-once pattern value template) (-> Text Text Text Text) (maybe;default template - (do maybe;Monad<Maybe> - [[pre post] (split-with pattern template) - #let [(^open) Monoid<Text>]] - (wrap ($_ append pre value post))))) + (do maybe;Monad<Maybe> + [[pre post] (split-with pattern template) + #let [(^open) Monoid<Text>]] + (wrap ($_ text/compose pre value post))))) (def: #export (enclose [left right] content) {#;doc "Surrounds the given content text with left and right side additions."} (-> [Text Text] Text Text) (let [(^open) Monoid<Text>] - ($_ append left content right))) + ($_ text/compose left content right))) (def: #export (enclose' boundary content) {#;doc "Surrounds the given content text with the same boundary text."} diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index d24dbbf59..c434d4637 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -18,14 +18,14 @@ ["s" syntax #+ syntax: Syntax]))) ## [Syntax] -(def: #hidden _append_ +(def: #hidden _compose_ (-> Text Text Text) - (:: text;Monoid<Text> append)) + (:: text;Monoid<Text> compose)) (syntax: #export (format [fragments (p;many s;any)]) {#;doc (doc "Text interpolation as a macro." (format "Static part " (%t static) " does not match URI: " uri))} - (wrap (list (` ($_ _append_ (~@ fragments)))))) + (wrap (list (` ($_ _compose_ (~@ fragments)))))) ## [Formatters] (type: #export (Formatter a) diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux index cb68fe93d..32ec67ad2 100644 --- a/stdlib/source/lux/data/text/lexer.lux +++ b/stdlib/source/lux/data/text/lexer.lux @@ -23,7 +23,7 @@ (def: (unconsumed-input-error offset tape) (-> Offset Text Text) - ($_ text/append "Unconsumed input: " (remaining offset tape))) + ($_ text/compose "Unconsumed input: " (remaining offset tape))) (def: #export (run input lexer) (All [a] (-> Text (Lexer a) (R;Result a))) @@ -69,7 +69,7 @@ (#R;Success [[(n.+ (text;size reference) offset) tape] []]) _ - (#R;Error ($_ text/append "Could not match: " (text;encode reference) " @ " tape))))) + (#R;Error ($_ text/compose "Could not match: " (text;encode reference) " @ " tape))))) (def: #export (this? reference) {#;doc "Lex a text if it matches the given sample."} @@ -120,14 +120,14 @@ (do p;Monad<Parser> [char any #let [char' (maybe;assume (text;nth +0 char))] - _ (p;assert ($_ text/append "Character is not within range: " (text;from-code bottom) "-" (text;from-code top)) + _ (p;assert ($_ text/compose "Character is not within range: " (text;from-code bottom) "-" (text;from-code top)) (and (n.>= bottom char') (n.<= top char')))] (wrap char))) (do-template [<name> <bottom> <top> <desc>] [(def: #export <name> - {#;doc (#;TextA ($_ text/append "Only lex " <desc> " characters."))} + {#;doc (#;TextA ($_ text/compose "Only lex " <desc> " characters."))} (Lexer Text) (range (char <bottom>) (char <top>)))] @@ -164,7 +164,7 @@ (let [output (text;from-code output)] (if (text;contains? output options) (#R;Success [[(n.inc offset) tape] output]) - (#R;Error ($_ text/append "Character (" output ") is not one of: " options)))) + (#R;Error ($_ text/compose "Character (" output ") is not one of: " options)))) _ (#R;Error cannot-lex-error)))) @@ -178,7 +178,7 @@ (let [output (text;from-code output)] (if (;not (text;contains? output options)) (#R;Success [[(n.inc offset) tape] output]) - (#R;Error ($_ text/append "Character (" output ") is one of: " options)))) + (#R;Error ($_ text/compose "Character (" output ") is one of: " options)))) _ (#R;Error cannot-lex-error)))) @@ -191,7 +191,7 @@ (#;Some output) (if (p output) (#R;Success [[(n.inc offset) tape] (text;from-code output)]) - (#R;Error ($_ text/append "Character does not satisfy predicate: " (text;from-code output)))) + (#R;Error ($_ text/compose "Character does not satisfy predicate: " (text;from-code output)))) _ (#R;Error cannot-lex-error)))) @@ -206,7 +206,7 @@ (do p;Monad<Parser> [=left left =right right] - (wrap ($_ text/append =left =right)))) + (wrap ($_ text/compose =left =right)))) (do-template [<name> <base> <doc>] [(def: #export (<name> p) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index 6d430b756..2625885b2 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -253,9 +253,9 @@ (re-quantified^ current-module) (re-simple^ current-module))) -(def: #hidden _Text/append_ +(def: #hidden _Text/compose_ (-> Text Text Text) - (:: text;Monoid<Text> append)) + (:: text;Monoid<Text> compose)) (type: Re-Group #Non-Capturing @@ -280,7 +280,7 @@ [idx names (list& (list g!temp complex - (' #let) (` [(~ g!total) (_Text/append_ (~ g!total) (~ g!temp))])) + (' #let) (` [(~ g!total) (_Text/compose_ (~ g!total) (~ g!temp))])) steps)] (#R;Success [(#Capturing [?name num-captures]) scoped]) @@ -296,7 +296,7 @@ [idx! (list& name! names) (list& (list name! scoped - (' #let) (` [(~ g!total) (_Text/append_ (~ g!total) (~ access))])) + (' #let) (` [(~ g!total) (_Text/compose_ (~ g!total) (~ access))])) steps)]) ))) [0 diff --git a/stdlib/source/lux/data/trace.lux b/stdlib/source/lux/data/trace.lux index 7f6a376a9..ffae2164f 100644 --- a/stdlib/source/lux/data/trace.lux +++ b/stdlib/source/lux/data/trace.lux @@ -18,7 +18,7 @@ (def: (unwrap wa) ((get@ #trace wa) - (get@ [#monoid #m;unit] wa))) + (get@ [#monoid #m;identity] wa))) (def: (split wa) (let [monoid (get@ #monoid wa)] @@ -27,7 +27,7 @@ {#monoid monoid #trace (function [t2] ((get@ #trace wa) - (:: monoid append t1 t2)))})}))) + (:: monoid compose t1 t2)))})}))) (def: #export (run context tracer) (All [t a] (-> t (Trace t a) a)) diff --git a/stdlib/source/lux/function.lux b/stdlib/source/lux/function.lux index d4f4abce0..1872b3085 100644 --- a/stdlib/source/lux/function.lux +++ b/stdlib/source/lux/function.lux @@ -16,5 +16,5 @@ ## [Structures] (struct: #export Monoid<Function> (Monoid (All [a] (-> a a))) - (def: unit id) - (def: append .)) + (def: identity id) + (def: compose .)) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index ece9583b9..28ea5a24e 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -831,7 +831,7 @@ [pm privacy-modifier^ strict-fp? (s;this? (' #strict)) method-vars (p;default (list) (type-params^ imports)) - #let [total-vars (L/append class-vars method-vars)] + #let [total-vars (L/compose class-vars method-vars)] [_ arg-decls] (s;form (p;seq (s;this (' new)) (arg-decls^ imports total-vars))) constructor-args (constructor-args^ imports total-vars) @@ -850,7 +850,7 @@ strict-fp? (s;this? (' #strict)) final? (s;this? (' #final)) method-vars (p;default (list) (type-params^ imports)) - #let [total-vars (L/append class-vars method-vars)] + #let [total-vars (L/compose class-vars method-vars)] [name arg-decls] (s;form (p;seq s;local-symbol (arg-decls^ imports total-vars))) return-type (generic-type^ imports total-vars) @@ -868,7 +868,7 @@ [strict-fp? (s;this? (' #strict)) owner-class (class-decl^ imports) method-vars (p;default (list) (type-params^ imports)) - #let [total-vars (L/append (product;right owner-class) method-vars)] + #let [total-vars (L/compose (product;right owner-class) method-vars)] [name arg-decls] (s;form (p;seq s;local-symbol (arg-decls^ imports total-vars))) return-type (generic-type^ imports total-vars) @@ -987,7 +987,7 @@ [tvars (p;default (list) (type-params^ imports)) _ (s;this (' new)) ?alias import-member-alias^ - #let [total-vars (L/append owner-vars tvars)] + #let [total-vars (L/compose owner-vars tvars)] ?prim-mode (p;opt primitive-mode^) args (import-member-args^ imports total-vars) [io? try? maybe?] import-member-return-flags^] @@ -1008,7 +1008,7 @@ tvars (p;default (list) (type-params^ imports)) name s;local-symbol ?alias import-member-alias^ - #let [total-vars (L/append owner-vars tvars)] + #let [total-vars (L/compose owner-vars tvars)] ?prim-mode (p;opt primitive-mode^) args (import-member-args^ imports total-vars) [io? try? maybe?] import-member-return-flags^ @@ -1312,7 +1312,7 @@ method-parsers (L/map (method->parser (product;right class-decl) fully-qualified-class-name) methods) replacer (parser->replacer (L/fold p;either (p;fail "") - (L/append field-parsers method-parsers))) + (L/compose field-parsers method-parsers))) def-code (format "class:" (spaced (list (class-decl$ class-decl) (super-class-decl$ super) @@ -1487,7 +1487,7 @@ (-> (List TypeParam) ImportMemberDecl (List TypeParam)) (case member (#ConstructorDecl [commons _]) - (L/append class-tvars (get@ #import-member-tvars commons)) + (L/compose class-tvars (get@ #import-member-tvars commons)) (#MethodDecl [commons _]) (case (get@ #import-member-kind commons) @@ -1495,7 +1495,7 @@ (get@ #import-member-tvars commons) _ - (L/append class-tvars (get@ #import-member-tvars commons))) + (L/compose class-tvars (get@ #import-member-tvars commons))) _ class-tvars)) @@ -1515,7 +1515,7 @@ arg-name)])))) import-member-args) #let [arg-classes (: (List Text) - (L/map (. (simple-class$ (L/append type-params import-member-tvars)) product;right) + (L/map (. (simple-class$ (L/compose type-params import-member-tvars)) product;right) import-member-args)) arg-types (L/map (: (-> [Bool GenericType] Code) (function [[maybe? arg]] @@ -2074,7 +2074,7 @@ (wrap fqcn) #;None - (macro;fail (Text/append "Unknown class: " class))))) + (macro;fail (Text/compose "Unknown class: " class))))) (syntax: #export (type [#let [imports (class-imports *compiler*)]] [type (generic-type^ imports (list))]) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 4a9b8e8f7..d2fe35244 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -117,7 +117,7 @@ (#R;Success [state module]) _ - (#R;Error ($_ T/append "Unknown module: " name))))) + (#R;Error ($_ T/compose "Unknown module: " name))))) (def: #export current-module-name (Lux Text) @@ -191,7 +191,7 @@ (do-template [<name> <tag> <desc>] [(def: #export <name> - {#;doc (#;TextA ($_ T/append "Checks whether a definition is " <desc> "."))} + {#;doc (#;TextA ($_ T/compose "Checks whether a definition is " <desc> "."))} (-> Anns Bool) (flag-set? (ident-for <tag>)))] @@ -220,13 +220,13 @@ (do-template [<name> <tag> <desc>] [(def: #export (<name> anns) - {#;doc (#;TextA ($_ T/append "Looks up the arguments of a " <desc> "."))} + {#;doc (#;TextA ($_ T/compose "Looks up the arguments of a " <desc> "."))} (-> Anns (List Text)) (maybe;default (list) - (do maybe;Monad<Maybe> - [_args (get-ann (ident-for <tag>) anns) - args (try-mlist _args)] - (M;map @ try-mtext args))))] + (do maybe;Monad<Maybe> + [_args (get-ann (ident-for <tag>) anns) + args (try-mlist _args)] + (M;map @ try-mtext args))))] [func-args #;func-args "function"] [type-args #;type-args "parameterized type"] @@ -338,7 +338,7 @@ (do Monad<Lux> [harg+ (expand-all harg) targs+ (M;map Monad<Lux> expand-all targs)] - (wrap (list (code;form (L/append harg+ (L/join (: (List (List Code)) targs+))))))) + (wrap (list (code;form (L/compose harg+ (L/join (: (List (List Code)) targs+))))))) [_ (#;Tuple members)] (do Monad<Lux> @@ -355,7 +355,7 @@ (-> Text (Lux Code)) (function [state] (#R;Success [(update@ #;seed n.inc state) - (code;symbol ["" ($_ T/append "__gensym__" prefix (:: number;Codec<Text,Nat> encode (get@ #;seed state)))])]))) + (code;symbol ["" ($_ T/compose "__gensym__" prefix (:: number;Codec<Text,Nat> encode (get@ #;seed state)))])]))) (def: (get-local-symbol ast) (-> Code (Lux Text)) @@ -364,7 +364,7 @@ (:: Monad<Lux> wrap name) _ - (fail (T/append "Code is not a local symbol: " (code;to-text ast))))) + (fail (T/compose "Code is not a local symbol: " (code;to-text ast))))) (macro: #export (with-gensyms tokens) {#;doc (doc "Creates new symbols and offers them to the body expression." @@ -442,7 +442,7 @@ (#R;Success [state var-type]) #;None - (#R;Error ($_ T/append "Unknown variable: " name)))))) + (#R;Error ($_ T/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)."} @@ -457,7 +457,7 @@ (#R;Success [state _anns]) _ - (#R;Error ($_ T/append "Unknown definition: " (Ident/encode name)))))) + (#R;Error ($_ T/compose "Unknown definition: " (Ident/encode name)))))) (def: #export (find-def-type name) {#;doc "Looks-up a definition's type in the available modules (including the current one)."} @@ -488,7 +488,7 @@ (-> Text (Lux (List [Text Def]))) (function [state] (case (get module-name (get@ #;modules state)) - #;None (#R;Error ($_ T/append "Unknown module: " module-name)) + #;None (#R;Error ($_ T/compose "Unknown module: " module-name)) (#;Some module) (#R;Success [state (get@ #;defs module)]) ))) @@ -560,10 +560,10 @@ (if (or exported? (T/= this-module-name module)) (wrap [idx tag-list type]) - (fail ($_ T/append "Cannot access tag: " (Ident/encode tag) " from module " this-module-name))) + (fail ($_ T/compose "Cannot access tag: " (Ident/encode tag) " from module " this-module-name))) _ - (fail ($_ T/append "Unknown tag: " (Ident/encode tag)))))) + (fail ($_ T/compose "Unknown tag: " (Ident/encode tag)))))) (def: #export (tag-lists module) {#;doc "All the tag-lists defined in a module, with their associated types."} @@ -643,7 +643,7 @@ (wrap output)) _ - (fail ($_ T/append "Wrong syntax for " <desc> "."))))] + (fail ($_ T/compose "Wrong syntax for " <desc> "."))))] [log-expand expand "log-expand"] [log-expand-all expand-all "log-expand-all"] diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux index a171d74d5..0f5465f2b 100644 --- a/stdlib/source/lux/macro/code.lux +++ b/stdlib/source/lux/macro/code.lux @@ -109,16 +109,16 @@ (text;encode value) [_ (#;Tag ident)] - (Text/append "#" (:: Codec<Text,Ident> encode ident)) + (Text/compose "#" (:: Codec<Text,Ident> encode ident)) (^template [<tag> <open> <close>] [_ (<tag> members)] - ($_ Text/append <open> (|> members (map to-text) (interpose " ") (text;join-with "")) <close>)) + ($_ Text/compose <open> (|> members (map to-text) (interpose " ") (text;join-with "")) <close>)) ([#;Form "(" ")"] [#;Tuple "[" "]"]) [_ (#;Record pairs)] - ($_ Text/append "{" (|> pairs (map (function [[left right]] ($_ Text/append (to-text left) " " (to-text right)))) (interpose " ") (text;join-with "")) "}") + ($_ Text/compose "{" (|> pairs (map (function [[left right]] ($_ Text/compose (to-text left) " " (to-text right)))) (interpose " ") (text;join-with "")) "}") )) (def: #export (replace original substitute ast) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 0cf927f00..b1e1a3d1b 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -45,7 +45,7 @@ (#R;Error (|> remaining (L/map type;to-text) (text;join-with ", ") - (text/append "Unconsumed types: ")))))) + (text/compose "Unconsumed types: ")))))) (def: #export (run type poly) (All [a] (-> Type (Poly a) (R;Result a))) @@ -98,7 +98,7 @@ (def: (label idx) (-> Nat Code) - (code;local-symbol (text/append "label\u0000" (nat/encode idx)))) + (code;local-symbol (text/compose "label\u0000" (nat/encode idx)))) (def: #export (with-extension type poly) (All [a] (-> Type (Poly a) (Poly [Code a]))) @@ -124,7 +124,7 @@ (wrap []) _ - (p;fail ($_ text/append "Not " <name> " type: " (type;to-text headT))))))] + (p;fail ($_ text/compose "Not " <name> " type: " (type;to-text headT))))))] [void "Void" #;Void] [unit "Unit" #;Unit] @@ -163,7 +163,7 @@ (let [members (<flattener> (type;un-name headT))] (if (n.> +1 (list;size members)) (local members poly) - (p;fail ($_ text/append "Not a " (Ident/encode (ident-for <tag>)) " type: " (type;to-text headT)))))))] + (p;fail ($_ text/compose "Not a " (Ident/encode (ident-for <tag>)) " type: " (type;to-text headT)))))))] [variant type;flatten-variant #;Sum] [tuple type;flatten-tuple #;Product] @@ -175,7 +175,7 @@ [headT any #let [[num-arg bodyT] (type;flatten-univ-q (type;un-name headT))]] (if (n.= +0 num-arg) - (p;fail ($_ text/append "Non-polymorphic type: " (type;to-text headT))) + (p;fail ($_ text/compose "Non-polymorphic type: " (type;to-text headT))) (wrap [num-arg bodyT])))) (def: #export (polymorphic poly) @@ -223,7 +223,7 @@ (if (n.> +0 (list;size inputsT)) (p;seq (local inputsT in-poly) (local (list outputT) out-poly)) - (p;fail ($_ text/append "Non-function type: " (type;to-text headT)))))) + (p;fail ($_ text/compose "Non-function type: " (type;to-text headT)))))) (def: #export (apply poly) (All [a] (-> (Poly a) (Poly a))) @@ -231,7 +231,7 @@ [headT any #let [[funcT paramsT] (type;flatten-application (type;un-name headT))]] (if (n.= +0 (list;size paramsT)) - (p;fail ($_ text/append "Non-application type: " (type;to-text headT))) + (p;fail ($_ text/compose "Non-application type: " (type;to-text headT))) (local (#;Cons funcT paramsT) poly)))) (def: #export (this expected) @@ -240,7 +240,7 @@ [actual any] (if (check;checks? expected actual) (wrap []) - (p;fail ($_ text/append + (p;fail ($_ text/compose "Types do not match." "\n" "Expected: " (type;to-text expected) "\n" " Actual: " (type;to-text actual)))))) @@ -264,10 +264,10 @@ (wrap poly-ast) #;None - (p;fail ($_ text/append "Unknown bound type: " (type;to-text headT)))) + (p;fail ($_ text/compose "Unknown bound type: " (type;to-text headT)))) _ - (p;fail ($_ text/append "Not a bound type: " (type;to-text headT)))))) + (p;fail ($_ text/compose "Not a bound type: " (type;to-text headT)))))) (def: #export (var id) (-> Nat (Poly Unit)) @@ -278,12 +278,12 @@ (#;Bound idx) (if (n.= id (adjusted-idx env idx)) (wrap []) - (p;fail ($_ text/append "Wrong bound type.\n" + (p;fail ($_ text/compose "Wrong bound type.\n" "Expected: " (nat/encode id) "\n" " Actual: " (nat/encode idx)))) _ - (p;fail ($_ text/append "Not a bound type: " (type;to-text headT)))))) + (p;fail ($_ text/compose "Not a bound type: " (type;to-text headT)))))) (def: #export (recursive poly) (All [a] (-> (Poly a) (Poly [Code a]))) @@ -299,7 +299,7 @@ (wrap [recT output])) _ - (p;fail ($_ text/append "Not a recursive type: " (type;to-text headT)))))) + (p;fail ($_ text/compose "Not a recursive type: " (type;to-text headT)))))) (def: #export recursive-self (Poly Code) @@ -313,7 +313,7 @@ (wrap self-call) _ - (p;fail ($_ text/append "Not a recursive type: " (type;to-text headT)))))) + (p;fail ($_ text/compose "Not a recursive type: " (type;to-text headT)))))) (def: #export recursive-call (Poly Code) @@ -331,7 +331,7 @@ (All [a] (Poly a)) (do p;Monad<Parser> [current any - #let [_ (log! ($_ text/append + #let [_ (log! ($_ text/compose "{" (Ident/encode (ident-for ;;log)) "} " (type;to-text current)))]] (p;fail "LOGGING"))) diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux index d5b331642..d8da515f4 100644 --- a/stdlib/source/lux/macro/poly/eq.lux +++ b/stdlib/source/lux/macro/poly/eq.lux @@ -117,8 +117,8 @@ (do @ [g!eqs (poly;tuple (p;many Eq<?>)) #let [indices (|> (list;size g!eqs) n.dec (list;n.range +0)) - g!lefts (L/map (|>. nat/encode (text/append "left") code;local-symbol) indices) - g!rights (L/map (|>. nat/encode (text/append "right") code;local-symbol) indices)]] + g!lefts (L/map (|>. nat/encode (text/compose "left") code;local-symbol) indices) + g!rights (L/map (|>. nat/encode (text/compose "right") code;local-symbol) indices)]] (wrap (` (: (~ (@Eq inputT)) (function [[(~@ g!lefts)] [(~@ g!rights)]] (and (~@ (|> (list;zip3 g!eqs g!lefts g!rights) diff --git a/stdlib/source/lux/macro/poly/functor.lux b/stdlib/source/lux/macro/poly/functor.lux index cc6007220..139cc5f7e 100644 --- a/stdlib/source/lux/macro/poly/functor.lux +++ b/stdlib/source/lux/macro/poly/functor.lux @@ -60,7 +60,7 @@ [_ (wrap []) memberC (Arg<?> slotC)] (recur (n.inc idx) - (L/append pairsCC (list [slotC memberC]))))) + (L/compose pairsCC (list [slotC memberC]))))) (wrap pairsCC)))))] (wrap (` (case (~ valueC) [(~@ (L/map product;left pairsCC))] diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index 321a80492..1e61d49f9 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -189,7 +189,7 @@ poly;bound poly;recursive-call ## If all else fails... - (p;fail (text/append "Cannot create JSON encoder for: " (type;to-text inputT))) + (p;fail (text/compose "Cannot create JSON encoder for: " (type;to-text inputT))) )))) (poly: #hidden Codec<JSON,?>//decode @@ -283,7 +283,7 @@ poly;bound poly;recursive-call ## If all else fails... - (p;fail (text/append "Cannot create JSON decoder for: " (type;to-text inputT))) + (p;fail (text/compose "Cannot create JSON decoder for: " (type;to-text inputT))) )))) (syntax: #export (Codec<JSON,?> inputT) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 96f1b658f..51333ddc3 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -29,7 +29,7 @@ ## [Utils] (def: (remaining-inputs asts) (-> (List Code) Text) - ($_ Text/append "\nRemaining input: " + ($_ Text/compose "\nRemaining input: " (|> asts (map code;to-text) (interpose " ") (text;join-with "")))) ## [Syntaxs] @@ -43,7 +43,7 @@ (do-template [<get-name> <type> <tag> <eq> <desc>] [(def: #export <get-name> - {#;doc (#;TextA ($_ Text/append "Parses the next " <desc> " input Code."))} + {#;doc (#;TextA ($_ Text/compose "Parses the next " <desc> " input Code."))} (Syntax <type>) (function [tokens] (case tokens @@ -51,7 +51,7 @@ (#R;Success [tokens' x]) _ - (#R;Error ($_ Text/append "Cannot parse " <desc> (remaining-inputs tokens))))))] + (#R;Error ($_ Text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))] [ bool Bool #;Bool bool;Eq<Bool> "bool"] [ nat Nat #;Nat number;Eq<Nat> "nat"] @@ -86,7 +86,7 @@ (#;Cons [token tokens']) (if (Code/= ast token) (#R;Success [tokens' []]) - (#R;Error ($_ Text/append "Expected a " (code;to-text ast) " but instead got " (code;to-text token) + (#R;Error ($_ Text/compose "Expected a " (code;to-text ast) " but instead got " (code;to-text token) (remaining-inputs tokens)))) _ @@ -106,7 +106,7 @@ (do-template [<name> <tag> <desc>] [(def: #export <name> - {#;doc (#;TextA ($_ Text/append "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))} + {#;doc (#;TextA ($_ Text/compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))} (Syntax Text) (function [tokens] (case tokens @@ -114,7 +114,7 @@ (#R;Success [tokens' x]) _ - (#R;Error ($_ Text/append "Cannot parse local " <desc> (remaining-inputs tokens))))))] + (#R;Error ($_ Text/compose "Cannot parse local " <desc> (remaining-inputs tokens))))))] [local-symbol #;Symbol "symbol"] [ local-tag #;Tag "tag"] @@ -122,7 +122,7 @@ (do-template [<name> <tag> <desc>] [(def: #export (<name> p) - {#;doc (#;TextA ($_ Text/append "Parse inside the contents of a " <desc> " as if they were the input Codes."))} + {#;doc (#;TextA ($_ Text/compose "Parse inside the contents of a " <desc> " as if they were the input Codes."))} (All [a] (-> (Syntax a) (Syntax a))) (function [tokens] @@ -130,17 +130,17 @@ (#;Cons [[_ (<tag> members)] tokens']) (case (p members) (#R;Success [#;Nil x]) (#R;Success [tokens' x]) - _ (#R;Error ($_ Text/append "Syntax was expected to fully consume " <desc> (remaining-inputs tokens)))) + _ (#R;Error ($_ Text/compose "Syntax was expected to fully consume " <desc> (remaining-inputs tokens)))) _ - (#R;Error ($_ Text/append "Cannot parse " <desc> (remaining-inputs tokens))))))] + (#R;Error ($_ Text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))] [ form #;Form "form"] [tuple #;Tuple "tuple"] ) (def: #export (record p) - {#;doc (#;TextA ($_ Text/append "Parse inside the contents of a record as if they were the input Codes."))} + {#;doc (#;TextA ($_ Text/compose "Parse inside the contents of a record as if they were the input Codes."))} (All [a] (-> (Syntax a) (Syntax a))) (function [tokens] @@ -148,10 +148,10 @@ (#;Cons [[_ (#;Record pairs)] tokens']) (case (p (join-pairs pairs)) (#R;Success [#;Nil x]) (#R;Success [tokens' x]) - _ (#R;Error ($_ Text/append "Syntax was expected to fully consume record" (remaining-inputs tokens)))) + _ (#R;Error ($_ Text/compose "Syntax was expected to fully consume record" (remaining-inputs tokens)))) _ - (#R;Error ($_ Text/append "Cannot parse record" (remaining-inputs tokens)))))) + (#R;Error ($_ Text/compose "Cannot parse record" (remaining-inputs tokens)))))) (def: #export end! {#;doc "Ensures there are no more inputs."} @@ -159,7 +159,7 @@ (function [tokens] (case tokens #;Nil (#R;Success [tokens []]) - _ (#R;Error ($_ Text/append "Expected list of tokens to be empty!" (remaining-inputs tokens)))))) + _ (#R;Error ($_ Text/compose "Expected list of tokens to be empty!" (remaining-inputs tokens)))))) (def: #export end? {#;doc "Checks whether there are no more inputs."} @@ -195,9 +195,9 @@ (#R;Success [real-inputs value]) _ - (#R;Error (Text/append "Unconsumed inputs: " - (|> (map code;to-text unconsumed-inputs) - (text;join-with ", ")))))))) + (#R;Error (Text/compose "Unconsumed inputs: " + (|> (map code;to-text unconsumed-inputs) + (text;join-with ", ")))))))) ## [Syntax] (def: #hidden text.join-with text;join-with) @@ -216,7 +216,7 @@ [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/append "anon-class:" + (let [def-code ($_ Text/compose "anon-class:" (spaced (list (super-class-decl$ (maybe;default object-super-class super)) (with-brackets (spaced (map super-class-decl$ interfaces))) (with-brackets (spaced (map constructor-arg$ constructor-args))) @@ -263,7 +263,7 @@ args) #let [g!state (code;symbol ["" "*compiler*"]) g!end (code;symbol ["" ""]) - error-msg (code;text (Text/append "Wrong syntax for " name)) + error-msg (code;text (Text/compose "Wrong syntax for " name)) export-ast (: (List Code) (case exported? (#;Some #R;Error) (list (' #hidden)) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index f054ec1e4..554dc8a5d 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -106,7 +106,7 @@ (do Monad<Random> [x char-gen xs (text' char-gen (n.dec size))] - (wrap (Text/append (text;from-code x) xs))))) + (wrap (Text/compose (text;from-code x) xs))))) (def: #export (text size) (-> Nat (Random Text)) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 09165c0b7..0a1bb1d30 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -265,7 +265,7 @@ (list;filter product;left) (L/map product;right))))) -(def: #hidden _appendT_ (-> Text Text Text) (:: text;Monoid<Text> append)) +(def: #hidden _composeT_ (-> Text Text Text) (:: text;Monoid<Text> compose)) (def: #hidden _%i_ (-> Int Text) %i) (syntax: #export (run) @@ -294,7 +294,7 @@ (' #let) (` [(~ g!total-successes) (n.+ (~ g!successes) (~ g!total-successes)) (~ g!total-failures) (n.+ (~ g!failures) (~ g!total-failures))]))) groups)))] - (exec (log! ($_ _appendT_ + (exec (log! ($_ _composeT_ "Test-suite finished." "\n" (_%i_ (nat-to-int (~ g!total-successes))) diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux index 4e74a3b73..dc63ca7ab 100644 --- a/stdlib/source/lux/time/date.lux +++ b/stdlib/source/lux/time/date.lux @@ -221,12 +221,12 @@ (def: (pad value) (-> Int Text) (if (i.< 10 value) - (text/append "0" (int/encode value)) + (text/compose "0" (int/encode value)) (int/encode value))) (def: (encode [year month day]) (-> Date Text) - ($_ text/append + ($_ text/compose (int/encode year) "-" (pad (|> month month-to-nat n.inc nat-to-int)) "-" (pad (|> day nat-to-int)))) diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux index 800a2536a..003a84a97 100644 --- a/stdlib/source/lux/time/duration.lux +++ b/stdlib/source/lux/time/duration.lux @@ -92,13 +92,13 @@ [minutes time-left] [(query minute time-left) (frame minute time-left)] [seconds time-left] [(query second time-left) (frame second time-left)] millis (to-millis time-left)] - ($_ text/append + ($_ text/compose (if signed? "-" "") - (if (i.= 0 days) "" (text/append (int/encode days) "D")) - (if (i.= 0 hours) "" (text/append (int/encode hours) "h")) - (if (i.= 0 minutes) "" (text/append (int/encode minutes) "m")) - (if (i.= 0 seconds) "" (text/append (int/encode seconds) "s")) - (if (i.= 0 millis) "" (text/append (int/encode millis) "ms")) + (if (i.= 0 days) "" (text/compose (int/encode days) "D")) + (if (i.= 0 hours) "" (text/compose (int/encode hours) "h")) + (if (i.= 0 minutes) "" (text/compose (int/encode minutes) "m")) + (if (i.= 0 seconds) "" (text/compose (int/encode seconds) "s")) + (if (i.= 0 millis) "" (text/compose (int/encode millis) "ms")) )))) (def: (lex-section suffix) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index c626e9ec4..f93cfbad4 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -133,7 +133,7 @@ (def: (pad value) (-> Int Text) (if (i.< 10 value) - (text/append "0" (int/encode value)) + (text/compose "0" (int/encode value)) (int/encode value))) (def: (adjust-negative space duration) @@ -145,10 +145,10 @@ (def: (encode-millis millis) (-> Int Text) (cond (i.= 0 millis) "" - (i.< 10 millis) ($_ text/append ".00" (int/encode millis)) - (i.< 100 millis) ($_ text/append ".0" (int/encode millis)) + (i.< 10 millis) ($_ text/compose ".00" (int/encode millis)) + (i.< 100 millis) ($_ text/compose ".0" (int/encode millis)) ## (i.< 1_000 millis) - ($_ text/append "." (int/encode millis)))) + ($_ text/compose "." (int/encode millis)))) (def: seconds-per-day Int (duration;query duration;second duration;day)) (def: days-up-to-epoch Int 719468) @@ -202,7 +202,7 @@ [minutes day-time] [(duration;query duration;minute day-time) (duration;frame duration;minute day-time)] [seconds millis] [(duration;query duration;second day-time) (duration;frame duration;second day-time)] ] - ($_ text/append (int/encode year) "-" (pad month) "-" (pad day) "T" + ($_ text/compose (int/encode year) "-" (pad month) "-" (pad day) "T" (pad hours) ":" (pad minutes) ":" (pad seconds) (|> millis (adjust-negative duration;second) diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index 8fe0465ba..acdbab38d 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -35,8 +35,8 @@ [#;ExQ]) (#;Bound idx) - (maybe;default (error! (Text/append "Unknown type var: " (Nat/encode idx))) - (list;nth idx env)) + (maybe;default (error! (Text/compose "Unknown type var: " (Nat/encode idx))) + (list;nth idx env)) _ type @@ -121,7 +121,7 @@ (case type (#;Apply arg func') (let [[func args] (flatten-application func')] - [func (List/append args (list arg))]) + [func (List/compose args (list arg))]) _ [type (list)])) @@ -209,10 +209,10 @@ (#;Host name params) (case params #;Nil - ($_ Text/append "(host " name ")") + ($_ Text/compose "(host " name ")") _ - ($_ Text/append "(host " name " " (|> params (List/map to-text) list;reverse (list;interpose " ") (List/fold Text/append "")) ")")) + ($_ Text/compose "(host " name " " (|> params (List/map to-text) list;reverse (list;interpose " ") (List/fold Text/compose "")) ")")) #;Void "Void" @@ -222,47 +222,47 @@ (^template [<tag> <open> <close> <flatten>] (<tag> _) - ($_ Text/append <open> + ($_ Text/compose <open> (|> (<flatten> type) (List/map to-text) list;reverse (list;interpose " ") - (List/fold Text/append "")) + (List/fold Text/compose "")) <close>)) ([#;Sum "(| " ")" flatten-variant] [#;Product "[" "]" flatten-tuple]) (#;Function input output) (let [[ins out] (flatten-function type)] - ($_ Text/append "(-> " + ($_ Text/compose "(-> " (|> ins (List/map to-text) list;reverse (list;interpose " ") - (List/fold Text/append "")) + (List/fold Text/compose "")) " " (to-text out) ")")) (#;Bound idx) (Nat/encode idx) (#;Var id) - ($_ Text/append "⌈v:" (Nat/encode id) "⌋") + ($_ Text/compose "⌈v:" (Nat/encode id) "⌋") (#;Ex id) - ($_ Text/append "⟨e:" (Nat/encode id) "⟩") + ($_ Text/compose "⟨e:" (Nat/encode id) "⟩") (#;Apply param fun) (let [[type-func type-args] (flatten-application type)] - ($_ Text/append "(" (to-text type-func) " " (|> type-args (List/map to-text) list;reverse (list;interpose " ") (List/fold Text/append "")) ")")) + ($_ Text/compose "(" (to-text type-func) " " (|> type-args (List/map to-text) list;reverse (list;interpose " ") (List/fold Text/compose "")) ")")) (^template [<tag> <desc>] (<tag> env body) - ($_ Text/append "(" <desc> " {" (|> env (List/map to-text) (text;join-with " ")) "} " (to-text body) ")")) + ($_ Text/compose "(" <desc> " {" (|> env (List/map to-text) (text;join-with " ")) "} " (to-text body) ")")) ([#;UnivQ "All"] [#;ExQ "Ex"]) (#;Named [module name] type) - ($_ Text/append module ";" name) + ($_ Text/compose module ";" name) )) (def: #export (un-alias type) @@ -337,9 +337,9 @@ (#;Apply A F) (maybe;default false - (do maybe;Monad<Maybe> - [applied (apply (list A) F)] - (wrap (quantified? applied)))) + (do maybe;Monad<Maybe> + [applied (apply (list A) F)] + (wrap (quantified? applied)))) (^or (#;UnivQ _) (#;ExQ _)) true diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux index 11b584859..b3ae0a04d 100644 --- a/stdlib/source/lux/type/check.lux +++ b/stdlib/source/lux/type/check.lux @@ -134,7 +134,7 @@ (function [context] (case (type;apply (list t-arg) t-func) #;None - (#R;Error ($_ text/append "Invalid type application: " (type;to-text t-func) " on " (type;to-text t-arg))) + (#R;Error ($_ text/compose "Invalid type application: " (type;to-text t-func) " on " (type;to-text t-arg))) (#;Some output) (#R;Success [context output])))) @@ -158,7 +158,7 @@ (#R;Success [context false]) #;None - (#R;Error ($_ text/append "Unknown type-var: " (nat/encode id)))))) + (#R;Error ($_ text/compose "Unknown type-var: " (nat/encode id)))))) (def: #export (read-var id) (-> Nat (Check Type)) @@ -168,24 +168,24 @@ (#R;Success [context type]) (#;Some #;None) - (#R;Error ($_ text/append "Unbound type-var: " (nat/encode id))) + (#R;Error ($_ text/compose "Unbound type-var: " (nat/encode id))) #;None - (#R;Error ($_ text/append "Unknown type-var: " (nat/encode id)))))) + (#R;Error ($_ text/compose "Unknown type-var: " (nat/encode id)))))) (def: #export (write-var id type) (-> Nat Type (Check Unit)) (function [context] (case (|> context (get@ #;var-bindings) (var::get id)) (#;Some (#;Some bound)) - (#R;Error ($_ text/append "Cannot rebind type-var: " (nat/encode id) " | Current type: " (type;to-text bound))) + (#R;Error ($_ text/compose "Cannot rebind type-var: " (nat/encode id) " | Current type: " (type;to-text bound))) (#;Some #;None) (#R;Success [(update@ #;var-bindings (var::put id (#;Some type)) context) []]) #;None - (#R;Error ($_ text/append "Unknown type-var: " (nat/encode id)))))) + (#R;Error ($_ text/compose "Unknown type-var: " (nat/encode id)))))) (def: (rewrite-var id type) (-> Nat Type (Check Unit)) @@ -196,7 +196,7 @@ []]) #;None - (#R;Error ($_ text/append "Unknown type-var: " (nat/encode id)))))) + (#R;Error ($_ text/compose "Unknown type-var: " (nat/encode id)))))) (def: #export (clear-var id) (-> Nat (Check Unit)) @@ -207,7 +207,7 @@ []]) #;None - (#R;Error ($_ text/append "Unknown type-var: " (nat/encode id)))))) + (#R;Error ($_ text/compose "Unknown type-var: " (nat/encode id)))))) (def: #export (clean t-id type) (-> Nat Type (Check Type)) @@ -329,7 +329,7 @@ (def: (fail-check expected actual) (All [a] (-> Type Type (Check a))) - (fail ($_ text/append + (fail ($_ text/compose "Expected: " (type;to-text expected) "\n\n" "Actual: " (type;to-text actual)))) @@ -488,11 +488,11 @@ (Check/wrap assumptions)) (fail-check expected actual)) - (^template [<unit> <append>] - [<unit> <unit>] + (^template [<identity> <compose>] + [<identity> <identity>] (Check/wrap assumptions) - [(<append> eL eR) (<append> aL aR)] + [(<compose> eL eR) (<compose> aL aR)] (do Monad<Check> [assumptions (check' eL aL assumptions)] (check' eR aR assumptions))) diff --git a/stdlib/source/lux/type/object.lux b/stdlib/source/lux/type/object.lux index 786e7806a..a7231d432 100644 --- a/stdlib/source/lux/type/object.lux +++ b/stdlib/source/lux/type/object.lux @@ -417,7 +417,7 @@ (updaterN export interface g!parameters g!ext g!child ancestors) (let [g!ancestors (ancestor-inputs ancestors) - g!states (L/append g!ancestors (list g!child)) + g!states (L/compose g!ancestors (list g!child)) g!self-object (` ((~ g!interface) (~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child))) de-alias (code;replace (code;symbol ["" alias]) g!self-object)] (L/map (|>. (update@ #inputs (L/map de-alias)) diff --git a/stdlib/source/lux/type/opaque.lux b/stdlib/source/lux/type/opaque.lux index 4dae66f11..b162ae79b 100644 --- a/stdlib/source/lux/type/opaque.lux +++ b/stdlib/source/lux/type/opaque.lux @@ -55,7 +55,7 @@ (def: representation-name (-> Text Text) - (|>. ($_ text/append "{" kind "@" module "}") + (|>. ($_ text/compose "{" kind "@" module "}") (let [[module kind] (ident-for #;;Representation)]))) (def: (install-casts' this-module-name name type-vars) @@ -77,7 +77,7 @@ (~ value))))) _ - (macro;fail ($_ text/append "Wrong syntax for " down-cast))))]))) + (macro;fail ($_ text/compose "Wrong syntax for " down-cast))))]))) (update@ #;defs (put up-cast (: Def [Macro macro-anns (function [tokens] @@ -89,7 +89,7 @@ (~ value))))) _ - (macro;fail ($_ text/append "Wrong syntax for " up-cast))))]))))]] + (macro;fail ($_ text/compose "Wrong syntax for " up-cast))))]))))]] (function [compiler] (#R;Success [(update@ #;modules (put this-module-name this-module) compiler) []])))) @@ -118,7 +118,7 @@ (wrap (list))) _ - (macro;fail ($_ text/append + (macro;fail ($_ text/compose "Cannot temporarily define casting functions (" down-cast " & " up-cast ") because definitions like that already exist."))))) @@ -135,7 +135,7 @@ (wrap (list))) _ - (macro;fail ($_ text/append + (macro;fail ($_ text/compose "Cannot un-define casting functions (" down-cast " & " up-cast ") because they do not exist."))))) @@ -160,5 +160,5 @@ (` (type: (~@ (csw;export export)) (~ representation-declaration) (~ representation-type))) (` (install-casts (~ (code;local-symbol name)) [(~@ type-varsC)])) - (L/append primitives - (list (` (un-install-casts)))))))) + (L/compose primitives + (list (` (un-install-casts)))))))) diff --git a/stdlib/test/test/lux/data/bool.lux b/stdlib/test/test/lux/data/bool.lux index f26c98a43..bbc867581 100644 --- a/stdlib/test/test/lux/data/bool.lux +++ b/stdlib/test/test/lux/data/bool.lux @@ -11,10 +11,10 @@ (test "" (and (not (and value (not value))) (or value (not value)) - (not (:: Or@Monoid<Bool> unit)) - (:: Or@Monoid<Bool> append value (not value)) - (:: And@Monoid<Bool> unit) - (not (:: And@Monoid<Bool> append value (not value))) + (not (:: Or@Monoid<Bool> identity)) + (:: Or@Monoid<Bool> compose value (not value)) + (:: And@Monoid<Bool> identity) + (not (:: And@Monoid<Bool> compose value (not value))) (:: Eq<Bool> = value (not (not value))) (not (:: Eq<Bool> = value (not value))) diff --git a/stdlib/test/test/lux/data/coll/array.lux b/stdlib/test/test/lux/data/coll/array.lux index 3f344a1be..81f8144d2 100644 --- a/stdlib/test/test/lux/data/coll/array.lux +++ b/stdlib/test/test/lux/data/coll/array.lux @@ -113,7 +113,7 @@ right (R;array sizeR R;nat) #let [(^open) &;Monoid<Array> (^open) (&;Eq<Array> number;Eq<Nat>) - fusion (append left right)]] + fusion (compose left right)]] ($_ seq (test "Appending two arrays should produce a new one twice as large." (n.= (n.+ sizeL sizeR) (&;size fusion))) diff --git a/stdlib/test/test/lux/data/coll/list.lux b/stdlib/test/test/lux/data/coll/list.lux index 087c9d831..a3d091625 100644 --- a/stdlib/test/test/lux/data/coll/list.lux +++ b/stdlib/test/test/lux/data/coll/list.lux @@ -82,7 +82,7 @@ inits (maybe;assume (&;inits sample)) last (maybe;assume (&;last sample))] (= sample - (append inits (list last))))) + (compose inits (list last))))) (test "Functor should go over every element of the list." (let [(^open) &;Functor<List> @@ -96,15 +96,15 @@ [left right] (&;split idx sample) [left' right'] (&;split-with n.even? sample)] (and (= sample - (append left right)) + (compose left right)) (= sample - (append left' right')) + (compose left' right')) (= sample - (append (&;take idx sample) - (&;drop idx sample))) + (compose (&;take idx sample) + (&;drop idx sample))) (= sample - (append (&;take-while n.even? sample) - (&;drop-while n.even? sample))) + (compose (&;take-while n.even? sample) + (&;drop-while n.even? sample))) ))) (test "Segmenting the list in pairs should yield as many elements as N/2." @@ -162,9 +162,9 @@ (test "List append is a monoid." (let [(^open) &;Monoid<List>] - (and (= sample (append unit sample)) - (= sample (append sample unit)) - (let [[left right] (&;split size (append sample other-sample))] + (and (= sample (compose identity sample)) + (= sample (compose sample identity)) + (let [[left right] (&;split size (compose sample other-sample))] (and (= sample left) (= other-sample right)))))) @@ -177,7 +177,7 @@ (test "List concatenation is a monad." (let [(^open) &;Monad<List> (^open) &;Monoid<List>] - (= (append sample other-sample) + (= (compose sample other-sample) (join (list sample other-sample))))) (test "You can find any value that satisfies some criterium, if such values exist in the list." diff --git a/stdlib/test/test/lux/data/coll/seq.lux b/stdlib/test/test/lux/data/coll/seq.lux index 15d6241de..c6d25a0d8 100644 --- a/stdlib/test/test/lux/data/coll/seq.lux +++ b/stdlib/test/test/lux/data/coll/seq.lux @@ -53,7 +53,7 @@ (&;prepend extra sample) extra) (&;member? number;Eq<Nat> - (&;append extra sample) + (&;compose extra sample) extra))) (test "Can do random access to seq elements." @@ -64,7 +64,7 @@ _ false)) - (|> (&;append extra sample) + (|> (&;compose extra sample) (&;nth size) (case> (#;Some reference) (n.= reference extra) diff --git a/stdlib/test/test/lux/data/coll/vector.lux b/stdlib/test/test/lux/data/coll/vector.lux index 2d7d00576..e605805a8 100644 --- a/stdlib/test/test/lux/data/coll/vector.lux +++ b/stdlib/test/test/lux/data/coll/vector.lux @@ -67,6 +67,6 @@ (&/= (&/map n.inc sample) (&/apply (&/wrap n.inc) sample)))) (test "Vector concatenation is a monad." - (&/= (&/append sample other-sample) + (&/= (&/compose sample other-sample) (&/join (&;vector sample other-sample)))) )) diff --git a/stdlib/test/test/lux/data/identity.lux b/stdlib/test/test/lux/data/identity.lux index e0e32ca04..494811947 100644 --- a/stdlib/test/test/lux/data/identity.lux +++ b/stdlib/test/test/lux/data/identity.lux @@ -12,15 +12,15 @@ (^open "&/") &;CoMonad<Identity>] ($_ seq (test "Functor does not affect values." - (Text/= "yololol" (&/map (Text/append "yolo") "lol"))) + (Text/= "yololol" (&/map (Text/compose "yolo") "lol"))) (test "Applicative does not affect values." (and (Text/= "yolo" (&/wrap "yolo")) - (Text/= "yololol" (&/apply (&/wrap (Text/append "yolo")) (&/wrap "lol"))))) + (Text/= "yololol" (&/apply (&/wrap (Text/compose "yolo")) (&/wrap "lol"))))) (test "Monad does not affect values." (Text/= "yololol" (do &;Monad<Identity> - [f (wrap Text/append) + [f (wrap Text/compose) a (wrap "yolo") b (wrap "lol")] (wrap (f a b))))) @@ -28,7 +28,7 @@ (test "CoMonad does not affect values." (and (Text/= "yololol" (&/unwrap "yololol")) (Text/= "yololol" (be &;CoMonad<Identity> - [f Text/append + [f Text/compose a "yolo" b "lol"] (f a b))))) diff --git a/stdlib/test/test/lux/data/maybe.lux b/stdlib/test/test/lux/data/maybe.lux index 35beef257..fed83c4b9 100644 --- a/stdlib/test/test/lux/data/maybe.lux +++ b/stdlib/test/test/lux/data/maybe.lux @@ -20,25 +20,25 @@ (not (Maybe/= (#;Some "yolo") #;None)))) (test "Monoid respects Maybe." - (and (Maybe/= #;None &/unit) - (Maybe/= (#;Some "yolo") (&/append (#;Some "yolo") (#;Some "lol"))) - (Maybe/= (#;Some "yolo") (&/append (#;Some "yolo") #;None)) - (Maybe/= (#;Some "lol") (&/append #;None (#;Some "lol"))) - (Maybe/= #;None (: (Maybe Text) (&/append #;None #;None))))) + (and (Maybe/= #;None &/identity) + (Maybe/= (#;Some "yolo") (&/compose (#;Some "yolo") (#;Some "lol"))) + (Maybe/= (#;Some "yolo") (&/compose (#;Some "yolo") #;None)) + (Maybe/= (#;Some "lol") (&/compose #;None (#;Some "lol"))) + (Maybe/= #;None (: (Maybe Text) (&/compose #;None #;None))))) (test "Functor respects Maybe." - (and (Maybe/= #;None (&/map (Text/append "yolo") #;None)) - (Maybe/= (#;Some "yololol") (&/map (Text/append "yolo") (#;Some "lol"))))) + (and (Maybe/= #;None (&/map (Text/compose "yolo") #;None)) + (Maybe/= (#;Some "yololol") (&/map (Text/compose "yolo") (#;Some "lol"))))) (test "Applicative respects Maybe." (and (Maybe/= (#;Some "yolo") (&/wrap "yolo")) (Maybe/= (#;Some "yololol") - (&/apply (&/wrap (Text/append "yolo")) (&/wrap "lol"))))) + (&/apply (&/wrap (Text/compose "yolo")) (&/wrap "lol"))))) (test "Monad respects Maybe." (Maybe/= (#;Some "yololol") (do &;Monad<Maybe> - [f (wrap Text/append) + [f (wrap Text/compose) a (wrap "yolo") b (wrap "lol")] (wrap (f a b))))) diff --git a/stdlib/test/test/lux/data/number.lux b/stdlib/test/test/lux/data/number.lux index b715119c6..c33d06856 100644 --- a/stdlib/test/test/lux/data/number.lux +++ b/stdlib/test/test/lux/data/number.lux @@ -86,10 +86,10 @@ #let [(^open) <Number> (^open) <Order> (^open) <Monoid>]] - (test "Appending to unit doesn't change the value." - (and (= x (append unit x)) - (= x (append x unit)) - (= unit (append unit unit)))))] + (test "Composing with identity doesn't change the value." + (and (= x (compose identity x)) + (= x (compose x identity)) + (= identity (compose identity identity)))))] ["Nat/Add" R;nat Number<Nat> Order<Nat> Add@Monoid<Nat> (n.% +1000) (function [_] true)] ["Nat/Mul" R;nat Number<Nat> Order<Nat> Mul@Monoid<Nat> (n.% +1000) (function [_] true)] |