From 7eb6d767daa24d08d609bad83d82985ffb32c762 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 19 Sep 2017 22:33:54 -0400 Subject: - Changed the terminology of monoids ("append" -> "compose", "unit" -> "identity"). --- stdlib/source/lux.lux | 220 +++++++++++++++++++++++++------------------------- 1 file changed, 110 insertions(+), 110 deletions(-) (limited to 'stdlib/source/lux.lux') 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 [] (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 [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 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 @@ -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 [enhanced-target (foldM Monad @@ -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 [] - (fold Text/append \"\" + (fold Text/compose \"\" (interpose \" \" (map Int/encode ))))"} (do Monad @@ -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 [] - (fold Text/append \"\" + (fold Text/compose \"\" (interpose \" \" (map Int/encode ))))"} (do Monad @@ -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 [ ] [(def: #export ( value) @@ -4955,7 +4955,7 @@ (def: Tag/encode (-> Ident Text) - (. (Text/append "#") Ident/encode)) + (. (Text/compose "#") Ident/encode)) (do-template [ ] [(def: #export ( 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 ( value)] (let [as-text ( 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 ( 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) ""] ( parts))] [(delim-update-cursor group-cursor') - ($_ Text/append (cursor-padding baseline prev-cursor group-cursor) + ($_ Text/compose (cursor-padding baseline prev-cursor group-cursor) parts-text )])) @@ -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)))) ))))) )) -- cgit v1.2.3