diff options
61 files changed, 1588 insertions, 978 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 959f6f910..639d9ab09 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -971,7 +971,7 @@ (fail "Wrong syntax for $'")} tokens)) -(def:'' (list@map f xs) +(def:'' (list\map f xs) #Nil (#UnivQ #Nil (#UnivQ #Nil @@ -982,7 +982,7 @@ #Nil (#Cons x xs') - (#Cons (f x) (list@map f xs'))} + (#Cons (f x) (list\map f xs'))} xs)) (def:'' RepEnv @@ -1000,7 +1000,7 @@ #Nil} [xs ys])) -(def:'' (text@= reference sample) +(def:'' (text\= reference sample) #Nil (#Function Text (#Function Text Bit)) ("lux text =" reference sample)) @@ -1017,7 +1017,7 @@ #0 (get-rep key env')} - (text@= k key))} + (text\= k key))} env)) (def:'' (replace-syntax reps syntax) @@ -1032,13 +1032,13 @@ (get-rep name reps)) [meta (#Form parts)] - [meta (#Form (list@map (replace-syntax reps) parts))] + [meta (#Form (list\map (replace-syntax reps) parts))] [meta (#Tuple members)] - [meta (#Tuple (list@map (replace-syntax reps) members))] + [meta (#Tuple (list\map (replace-syntax reps) members))] [meta (#Record slots)] - [meta (#Record (list@map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) + [meta (#Record (list\map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) (function'' [slot] ({[k v] [(replace-syntax reps k) (replace-syntax reps v)]} @@ -1061,10 +1061,10 @@ #Nil (#Function Code Code) ({[_ (#Tuple members)] - (tuple$ (list@map update-parameters members)) + (tuple$ (list\map update-parameters members)) [_ (#Record pairs)] - (record$ (list@map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) + (record$ (list\map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) (function'' [pair] (let'' [name val] pair [name (update-parameters val)]))) @@ -1074,7 +1074,7 @@ (form$ (#Cons (tag$ ["lux" "Parameter"]) (#Cons (nat$ ("lux i64 +" 2 idx)) #Nil))) [_ (#Form members)] - (form$ (list@map update-parameters members)) + (form$ (list\map update-parameters members)) _ code} @@ -1102,7 +1102,7 @@ (#Function Nat Code) (form$ (#Cons (tag$ ["lux" "Parameter"]) (#Cons (nat$ idx) #Nil)))) -(def:'' (list@fold f init xs) +(def:'' (list\fold f init xs) #Nil ## (All [a b] (-> (-> b a a) a (List b) a)) (#UnivQ #Nil (#UnivQ #Nil (#Function (#Function (#Parameter 1) @@ -1115,14 +1115,14 @@ init (#Cons x xs') - (list@fold f (f x init) xs')} + (list\fold f (f x init) xs')} xs)) -(def:'' (list@size list) +(def:'' (list\size list) #Nil (#UnivQ #Nil (#Function ($' List (#Parameter 1)) Nat)) - (list@fold (function'' [_ acc] ("lux i64 +" 1 acc)) 0 list)) + (list\fold (function'' [_ acc] ("lux i64 +" 1 acc)) 0 list)) (macro:' #export (All tokens) (#Cons [(tag$ ["lux" "doc"]) @@ -1143,7 +1143,7 @@ ({(#Cons [_ (#Tuple args)] (#Cons body #Nil)) (parse-quantified-args args (function'' [names] - (let'' body' (list@fold ("lux check" (#Function Text (#Function Code Code)) + (let'' body' (list\fold ("lux check" (#Function Text (#Function Code Code)) (function'' [name' body'] (form$ (#Cons (tag$ ["lux" "UnivQ"]) (#Cons (tag$ ["lux" "Nil"]) @@ -1158,10 +1158,10 @@ body' [#0 _] - (replace-syntax (#Cons [self-name (make-parameter (n/* 2 ("lux i64 -" 1 (list@size names))))] + (replace-syntax (#Cons [self-name (make-parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] #Nil) body')} - [(text@= "" self-name) names]) + [(text\= "" self-name) names]) #Nil))))) _ @@ -1187,7 +1187,7 @@ ({(#Cons [_ (#Tuple args)] (#Cons body #Nil)) (parse-quantified-args args (function'' [names] - (let'' body' (list@fold ("lux check" (#Function Text (#Function Code Code)) + (let'' body' (list\fold ("lux check" (#Function Text (#Function Code Code)) (function'' [name' body'] (form$ (#Cons (tag$ ["lux" "ExQ"]) (#Cons (tag$ ["lux" "Nil"]) @@ -1202,20 +1202,20 @@ body' [#0 _] - (replace-syntax (#Cons [self-name (make-parameter (n/* 2 ("lux i64 -" 1 (list@size names))))] + (replace-syntax (#Cons [self-name (make-parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] #Nil) body')} - [(text@= "" self-name) names]) + [(text\= "" self-name) names]) #Nil))))) _ (fail "Wrong syntax for Ex")} tokens))) -(def:'' (list@reverse list) +(def:'' (list\reverse list) #Nil (All [a] (#Function ($' List a) ($' List a))) - (list@fold ("lux check" (All [a] (#Function a (#Function ($' List a) ($' List a)))) + (list\fold ("lux check" (All [a] (#Function a (#Function ($' List a) ($' List a)))) (function'' [head tail] (#Cons head tail))) #Nil list)) @@ -1229,7 +1229,7 @@ "## This is the type of a function that takes 2 Ints and returns an Int.")))] #Nil) ({(#Cons output inputs) - (return (#Cons (list@fold ("lux check" (#Function Code (#Function Code Code)) + (return (#Cons (list\fold ("lux check" (#Function Code (#Function Code Code)) (function'' [i o] (form$ (#Cons (tag$ ["lux" "Function"]) (#Cons i (#Cons o #Nil)))))) output inputs) @@ -1237,7 +1237,7 @@ _ (fail "Wrong syntax for ->")} - (list@reverse tokens))) + (list\reverse tokens))) (macro:' #export (list xs) (#Cons [(tag$ ["lux" "doc"]) @@ -1245,12 +1245,12 @@ ("lux text concat" "## List-construction macro." __paragraph) "(list +1 +2 +3)"))] #Nil) - (return (#Cons (list@fold (function'' [head tail] + (return (#Cons (list\fold (function'' [head tail] (form$ (#Cons (tag$ ["lux" "Cons"]) (#Cons (tuple$ (#Cons [head (#Cons [tail #Nil])])) #Nil)))) (tag$ ["lux" "Nil"]) - (list@reverse xs)) + (list\reverse xs)) #Nil))) (macro:' #export (list& xs) @@ -1262,7 +1262,7 @@ "(list& +1 +2 +3 (list +4 +5 +6))")))] #Nil) ({(#Cons last init) - (return (list (list@fold (function'' [head tail] + (return (list (list\fold (function'' [head tail] (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list head tail))))) last @@ -1270,7 +1270,7 @@ _ (fail "Wrong syntax for list&")} - (list@reverse xs))) + (list\reverse xs))) (macro:' #export (& tokens) (#Cons [(tag$ ["lux" "doc"]) @@ -1286,10 +1286,10 @@ (return (list (identifier$ ["lux" "Any"]))) (#Cons last prevs) - (return (list (list@fold (function'' [left right] (form$ (list (tag$ ["lux" "Product"]) left right))) + (return (list (list\fold (function'' [left right] (form$ (list (tag$ ["lux" "Product"]) left right))) last prevs)))} - (list@reverse tokens))) + (list\reverse tokens))) (macro:' #export (| tokens) (#Cons [(tag$ ["lux" "doc"]) @@ -1305,10 +1305,10 @@ (return (list (identifier$ ["lux" "Nothing"]))) (#Cons last prevs) - (return (list (list@fold (function'' [left right] (form$ (list (tag$ ["lux" "Sum"]) left right))) + (return (list (list\fold (function'' [left right] (form$ (list (tag$ ["lux" "Sum"]) left right))) last prevs)))} - (list@reverse tokens))) + (list\reverse tokens))) (macro:' (function' tokens) (let'' [name tokens'] ({(#Cons [[_ (#Identifier ["" name])] tokens']) @@ -1324,12 +1324,12 @@ (#Cons [harg targs]) (return (list (form$ (list (tuple$ (list (local-identifier$ name) harg)) - (list@fold (function'' [arg body'] + (list\fold (function'' [arg body'] (form$ (list (tuple$ (list (local-identifier$ "") arg)) body'))) body - (list@reverse targs))))))} + (list\reverse targs))))))} args) _ @@ -1404,14 +1404,14 @@ (macro:' (let' tokens) ({(#Cons [[_ (#Tuple bindings)] (#Cons [body #Nil])]) - (return (list (list@fold ("lux check" (-> (& Code Code) Code + (return (list (list\fold ("lux check" (-> (& Code Code) Code Code) (function' [binding body] ({[label value] (form$ (list (record$ (list [label body])) value))} binding))) body - (list@reverse (as-pairs bindings))))) + (list\reverse (as-pairs bindings))))) _ (fail "Wrong syntax for let'")} @@ -1446,11 +1446,11 @@ (_ann (#Form (list (_ann (#Tag ["lux" "Cons"])) token (untemplate-list tokens'))))} tokens)) -(def:''' (list@compose xs ys) +(def:''' (list\compose xs ys) #Nil (All [a] (-> ($' List a) ($' List a) ($' List a))) ({(#Cons x xs') - (#Cons x (list@compose xs' ys)) + (#Cons x (list\compose xs' ys)) #Nil ys} @@ -1460,7 +1460,7 @@ #Nil (-> Code Code Code Code) ({[_ (#Form parts)] - (form$ (list@compose parts (list a1 a2))) + (form$ (list\compose parts (list a1 a2))) _ (form$ (list op a1 a2))} @@ -1478,14 +1478,14 @@ (text$ ("lux text concat" ("lux text concat" "## Left-association for the application of binary functions over variadic arguments." ..new-line) ("lux text concat" - ("lux text concat" "(_$ text@compose ''Hello, '' name ''. How are you?'')" ..new-line) + ("lux text concat" "(_$ text\compose ''Hello, '' name ''. How are you?'')" ..new-line) ("lux text concat" ("lux text concat" "## =>" ..new-line) - "(text@compose (text@compose ''Hello, '' name) ''. How are you?'')"))))] + "(text\compose (text\compose ''Hello, '' name) ''. How are you?'')"))))] #Nil) ({(#Cons op tokens') ({(#Cons first nexts) - (return (list (list@fold (function/flip (_$_joiner op)) first nexts))) + (return (list (list\fold (function/flip (_$_joiner op)) first nexts))) _ (fail "Wrong syntax for _$")} @@ -1500,18 +1500,18 @@ (text$ ("lux text concat" ("lux text concat" "## Right-association for the application of binary functions over variadic arguments." ..new-line) ("lux text concat" - ("lux text concat" "($_ text@compose ''Hello, '' name ''. How are you?'')" ..new-line) + ("lux text concat" "($_ text\compose ''Hello, '' name ''. How are you?'')" ..new-line) ("lux text concat" ("lux text concat" "## =>" ..new-line) - "(text@compose ''Hello, '' (text@compose name ''. How are you?''))"))))] + "(text\compose ''Hello, '' (text\compose name ''. How are you?''))"))))] #Nil) ({(#Cons op tokens') ({(#Cons last prevs) - (return (list (list@fold (_$_joiner op) last prevs))) + (return (list (list\fold (_$_joiner op) last prevs))) _ (fail "Wrong syntax for $_")} - (list@reverse tokens')) + (list\reverse tokens')) _ (fail "Wrong syntax for $_")} @@ -1567,7 +1567,7 @@ ({(#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil))) (let' [g!wrap (local-identifier$ "wrap") g!bind (local-identifier$ " bind ") - body' (list@fold ("lux check" (-> (& Code Code) Code Code) + body' (list\fold ("lux check" (-> (& Code Code) Code Code) (function' [binding body'] (let' [[var value] binding] ({[_ (#Tag "" "let")] @@ -1579,7 +1579,7 @@ value))} var)))) body - (list@reverse (as-pairs bindings)))] + (list\reverse (as-pairs bindings)))] (return (list (form$ (list (record$ (list [(record$ (list [(tag$ ["lux" "wrap"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind])) body'])) monad))))) @@ -1588,7 +1588,7 @@ (fail "Wrong syntax for do")} tokens)) -(def:''' (monad@map m f xs) +(def:''' (monad\map m f xs) #Nil ## (All [m a b] ## (-> (Monad m) (-> a (m b)) (List a) (m (List b)))) @@ -1604,11 +1604,11 @@ (#Cons x xs') (do m [y (f x) - ys (monad@map m f xs')] + ys (monad\map m f xs')] (wrap (#Cons y ys)))} xs))) -(def:''' (monad@fold m f y xs) +(def:''' (monad\fold m f y xs) #Nil ## (All [m a b] ## (-> (Monad m) (-> a b (m b)) b (List a) (m b))) @@ -1625,7 +1625,7 @@ (#Cons x xs') (do m [y' (f x y)] - (monad@fold m f y' xs'))} + (monad\fold m f y' xs'))} xs))) (macro:' #export (if tokens) @@ -1648,7 +1648,7 @@ (All [a] (-> Text ($' List (& Text a)) ($' Maybe a))) ({(#Cons [[k' v] plist']) - (if (text@= k k') + (if (text\= k k') (#Some v) (get k plist')) @@ -1664,7 +1664,7 @@ (list [k v]) (#Cons [[k' v'] dict']) - (if (text@= k k') + (if (text\= k k') (#Cons [[k' v] dict']) (#Cons [[k' v'] (put k v dict')]))} dict)) @@ -1677,17 +1677,17 @@ (-> Text Any) ("lux io log" message)) -(def:''' (text@compose x y) +(def:''' (text\compose x y) #Nil (-> Text Text Text) ("lux text concat" x y)) -(def:''' (name@encode full-name) +(def:''' (name\encode full-name) #Nil (-> Name Text) (let' [[module name] full-name] ({"" name - _ ($_ text@compose module "." name)} + _ ($_ text\compose module "." name)} module))) (def:''' (get-meta tag def-meta) @@ -1702,8 +1702,8 @@ _ (get-meta tag (record$ def-meta'))} - [(text@= prefix prefix') - (text@= name name')]) + [(text\= prefix prefix') + (text\= name name')]) _ (get-meta tag (record$ def-meta'))} @@ -1735,11 +1735,11 @@ constant) #None - (#Left ($_ text@compose "Unknown definition: " (name@encode full-name)))} + (#Left ($_ text\compose "Unknown definition: " (name\encode full-name)))} (get name definitions)) #None - (#Left ($_ text@compose "Unknown module: " module " @ " (name@encode full-name)))} + (#Left ($_ text\compose "Unknown module: " module " @ " (name\encode full-name)))} (get module modules)))) (def:''' (as-code-list expression) @@ -1768,12 +1768,12 @@ (wrap (as-code-list (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list lastO (tag$ ["lux" "Nil"]))))))))} lastI)] - (monad@fold meta-monad + (monad\fold meta-monad (function' [leftI rightO] ({[_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] (let' [g!in-module (form$ (list (text$ "lux in-module") (text$ "lux") - (identifier$ ["lux" "list@compose"])))] + (identifier$ ["lux" "list\compose"])))] (wrap (form$ (list g!in-module (as-code-list spliced) rightO)))) _ @@ -1783,10 +1783,10 @@ leftI)) lastO inits))} - (list@reverse elems)) + (list\reverse elems)) #0 (do meta-monad - [=elems (monad@map meta-monad untemplate elems)] + [=elems (monad\map meta-monad untemplate elems)] (wrap (untemplate-list =elems)))} replace?)) @@ -1831,7 +1831,7 @@ [#1 [_ (#Identifier [module name])]] (do meta-monad [real-name ({"" - (if (text@= "" subst) + (if (text\= "" subst) (wrap [module name]) (resolve-global-identifier [subst name])) @@ -1874,7 +1874,7 @@ [_ [_ (#Record fields)]] (do meta-monad - [=fields (monad@map meta-monad + [=fields (monad\map meta-monad ("lux check" (-> (& Code Code) ($' Meta Code)) (function' [kv] (let' [[k v] kv] @@ -1967,17 +1967,17 @@ (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" "## Piping macro." __paragraph - "(|> elems (list@map int@encode) (interpose '' '') (fold text@compose ''''))" __paragraph + "(|> elems (list\map int\encode) (interpose '' '') (fold text\compose ''''))" __paragraph "## =>" __paragraph - "(fold text@compose '''' (interpose '' '' (list@map int@encode elems)))"))]) + "(fold text\compose '''' (interpose '' '' (list\map int\encode elems)))"))]) ({(#Cons [init apps]) - (return (list (list@fold ("lux check" (-> Code Code Code) + (return (list (list\fold ("lux check" (-> Code Code Code) (function' [app acc] ({[_ (#Tuple parts)] - (tuple$ (list@compose parts (list acc))) + (tuple$ (list\compose parts (list acc))) [_ (#Form parts)] - (form$ (list@compose parts (list acc))) + (form$ (list\compose parts (list acc))) _ (` ((~ app) (~ acc)))} @@ -1993,17 +1993,17 @@ (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" "## Reverse piping macro." __paragraph - "(<| (fold text@compose '''') (interpose '' '') (list@map int@encode) elems)" __paragraph + "(<| (fold text\compose '''') (interpose '' '') (list\map int\encode) elems)" __paragraph "## =>" __paragraph - "(fold text@compose '''' (interpose '' '' (list@map int@encode elems)))"))]) + "(fold text\compose '''' (interpose '' '' (list\map int\encode elems)))"))]) ({(#Cons [init apps]) - (return (list (list@fold ("lux check" (-> Code Code Code) + (return (list (list\fold ("lux check" (-> Code Code Code) (function' [app acc] ({[_ (#Tuple parts)] - (tuple$ (list@compose parts (list acc))) + (tuple$ (list\compose parts (list acc))) [_ (#Form parts)] - (form$ (list@compose parts (list acc))) + (form$ (list\compose parts (list acc))) _ (` ((~ app) (~ acc)))} @@ -2013,7 +2013,7 @@ _ (fail "Wrong syntax for <|")} - (list@reverse tokens))) + (list\reverse tokens))) (def:''' (compose f g) (list [(tag$ ["lux" "doc"]) @@ -2074,13 +2074,13 @@ (get-rep sname env)) [meta (#Tuple elems)] - [meta (#Tuple (list@map (apply-template env) elems))] + [meta (#Tuple (list\map (apply-template env) elems))] [meta (#Form elems)] - [meta (#Form (list@map (apply-template env) elems))] + [meta (#Form (list\map (apply-template env) elems))] [meta (#Record members)] - [meta (#Record (list@map ("lux check" (-> (& Code Code) (& Code Code)) + [meta (#Record (list\map ("lux check" (-> (& Code Code) (& Code Code)) (function' [kv] (let' [[slot value] kv] [(apply-template env slot) (apply-template env value)]))) @@ -2094,7 +2094,7 @@ #Nil (All [a] (-> (-> a Bit) ($' List a) Bit)) - (list@fold (function' [_2 _1] (if _1 (p _2) #0)) #1 xs)) + (list\fold (function' [_2 _1] (if _1 (p _2) #0)) #1 xs)) (def:''' (high-bits value) (list) @@ -2131,11 +2131,11 @@ #1 ("lux i64 =" reference sample))) -(def:''' (list@join xs) +(def:''' (list\join xs) #Nil (All [a] (-> ($' List ($' List a)) ($' List a))) - (list@fold list@compose #Nil (list@reverse xs))) + (list\fold list\compose #Nil (list\reverse xs))) (macro:' #export (template tokens) (list [(tag$ ["lux" "doc"]) @@ -2148,20 +2148,20 @@ ({(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) ({[(#Some bindings') (#Some data')] (let' [apply ("lux check" (-> RepEnv ($' List Code)) - (function' [env] (list@map (apply-template env) templates))) - num-bindings (list@size bindings')] + (function' [env] (list\map (apply-template env) templates))) + num-bindings (list\size bindings')] (if (every? (function' [size] ("lux i64 =" num-bindings size)) - (list@map list@size data')) + (list\map list\size data')) (|> data' - (list@map (compose apply (make-env bindings'))) - list@join + (list\map (compose apply (make-env bindings'))) + list\join return) (fail "Irregular arguments tuples for template."))) _ (fail "Wrong syntax for template")} - [(monad@map maybe-monad get-short bindings) - (monad@map maybe-monad tuple->list data)]) + [(monad\map maybe-monad get-short bindings) + (monad\map maybe-monad tuple->list data)]) _ (fail "Wrong syntax for template")} @@ -2201,7 +2201,7 @@ left right)) -(def:''' (bit@encode x) +(def:''' (bit\encode x) #Nil (-> Bit Text) (if x "#1" "#0")) @@ -2216,7 +2216,7 @@ _ ("lux io error" "undefined")} digit)) -(def:''' (nat@encode value) +(def:''' (nat\encode value) #Nil (-> Nat Text) ({0 @@ -2228,19 +2228,19 @@ (if ("lux i64 =" 0 input) output (recur (n// 10 input) - (text@compose (|> input (n/% 10) digit::format) + (text\compose (|> input (n/% 10) digit::format) output)))))] (loop value ""))} value)) -(def:''' (int@abs value) +(def:''' (int\abs value) #Nil (-> Int Int) (if ("lux i64 <" +0 value) ("lux i64 *" -1 value) value)) -(def:''' (int@encode value) +(def:''' (int\encode value) #Nil (-> Int Text) (if ("lux i64 =" +0 value) @@ -2251,14 +2251,14 @@ (("lux check" (-> Int Text Text) (function' recur [input output] (if ("lux i64 =" +0 input) - (text@compose sign output) + (text\compose sign output) (recur ("lux i64 /" +10 input) - (text@compose (|> input ("lux i64 %" +10) ("lux coerce" Nat) digit::format) + (text\compose (|> input ("lux i64 %" +10) ("lux coerce" Nat) digit::format) output))))) - (|> value ("lux i64 /" +10) int@abs) - (|> value ("lux i64 %" +10) int@abs ("lux coerce" Nat) digit::format))))) + (|> value ("lux i64 /" +10) int\abs) + (|> value ("lux i64 %" +10) int\abs ("lux coerce" Nat) digit::format))))) -(def:''' (frac@encode x) +(def:''' (frac\encode x) #Nil (-> Frac Text) ("lux f64 encode" x)) @@ -2303,7 +2303,7 @@ (if (macro-type? def-type) (if exported? (#Some ("lux coerce" Macro def-value)) - (if (text@= module current-module) + (if (text\= module current-module) (#Some ("lux coerce" Macro def-value)) #None)) #None)} @@ -2388,8 +2388,8 @@ ({(#Some macro) (do meta-monad [expansion (("lux coerce" Macro' macro) args) - expansion' (monad@map meta-monad macro-expand expansion)] - (wrap (list@join expansion'))) + expansion' (monad\map meta-monad macro-expand expansion)] + (wrap (list\join expansion'))) #None (return (list token))} @@ -2409,28 +2409,28 @@ ({(#Some macro) (do meta-monad [expansion (("lux coerce" Macro' macro) args) - expansion' (monad@map meta-monad macro-expand-all expansion)] - (wrap (list@join expansion'))) + expansion' (monad\map meta-monad macro-expand-all expansion)] + (wrap (list\join expansion'))) #None (do meta-monad - [args' (monad@map meta-monad macro-expand-all args)] - (wrap (list (form$ (#Cons (identifier$ macro-name) (list@join args'))))))} + [args' (monad\map meta-monad macro-expand-all args)] + (wrap (list (form$ (#Cons (identifier$ macro-name) (list\join args'))))))} ?macro)) [_ (#Form members)] (do meta-monad - [members' (monad@map meta-monad macro-expand-all members)] - (wrap (list (form$ (list@join members'))))) + [members' (monad\map meta-monad macro-expand-all members)] + (wrap (list (form$ (list\join members'))))) [_ (#Tuple members)] (do meta-monad - [members' (monad@map meta-monad macro-expand-all members)] - (wrap (list (tuple$ (list@join members'))))) + [members' (monad\map meta-monad macro-expand-all members)] + (wrap (list (tuple$ (list\join members'))))) [_ (#Record pairs)] (do meta-monad - [pairs' (monad@map meta-monad + [pairs' (monad\map meta-monad (function' [kv] (let' [[key val] kv] (do meta-monad @@ -2452,10 +2452,10 @@ #Nil (-> Code Code) ({[_ (#Form (#Cons [_ (#Tag tag)] parts))] - (form$ (#Cons [(tag$ tag) (list@map walk-type parts)])) + (form$ (#Cons [(tag$ tag) (list\map walk-type parts)])) [_ (#Tuple members)] - (` (& (~+ (list@map walk-type members)))) + (` (& (~+ (list\map walk-type members)))) [_ (#Form (#Cons [_ (#Text "lux in-module")] (#Cons [_ (#Text module)] @@ -2467,10 +2467,10 @@ expression [_ (#Form (#Cons type-fn args))] - (list@fold ("lux check" (-> Code Code Code) + (list\fold ("lux check" (-> Code Code Code) (function' [arg type-fn] (` (#.Apply (~ arg) (~ type-fn))))) (walk-type type-fn) - (list@map walk-type args)) + (list\map walk-type args)) _ type} @@ -2540,7 +2540,7 @@ (-> ($' List Code) ($' Meta (& Code ($' Maybe ($' List Text))))) ({(#Cons [_ (#Record pairs)] #Nil) (do meta-monad - [members (monad@map meta-monad + [members (monad\map meta-monad (: (-> [Code Code] (Meta [Text Code])) (function' [pair] ({[[_ (#Tag "" member-name)] member-type] @@ -2550,8 +2550,8 @@ (fail "Wrong syntax for variant case.")} pair))) pairs)] - (return [(` (& (~+ (list@map second members)))) - (#Some (list@map first members))])) + (return [(` (& (~+ (list\map second members)))) + (#Some (list\map first members))])) (#Cons type #Nil) ({[_ (#Tag "" member-name)] @@ -2566,7 +2566,7 @@ (#Cons case cases) (do meta-monad - [members (monad@map meta-monad + [members (monad\map meta-monad (: (-> Code (Meta [Text Code])) (function' [case] ({[_ (#Tag "" member-name)] @@ -2582,8 +2582,8 @@ (fail "Wrong syntax for variant case.")} case))) (list& case cases))] - (return [(` (| (~+ (list@map second members)))) - (#Some (list@map first members))])) + (return [(` (| (~+ (list\map second members)))) + (#Some (list\map first members))])) _ (fail "Improper type-definition syntax")} @@ -2602,7 +2602,7 @@ #seed ("lux i64 +" 1 seed) #expected expected #location location #extensions extensions #scope-type-vars scope-type-vars} - (local-identifier$ ($_ text@compose "__gensym__" prefix (nat@encode seed))))} + (local-identifier$ ($_ text\compose "__gensym__" prefix (nat\encode seed))))} state)) (macro:' #export (Rec tokens) @@ -2631,7 +2631,7 @@ "''YOLO'')"))]) ({(#Cons value actions) (let' [dummy (local-identifier$ "")] - (return (list (list@fold ("lux check" (-> Code Code Code) + (return (list (list\fold ("lux check" (-> Code Code Code) (function' [pre post] (` ({(~ dummy) (~ post)} (~ pre))))) value @@ -2639,7 +2639,7 @@ _ (fail "Wrong syntax for exec")} - (list@reverse tokens))) + (list\reverse tokens))) (macro:' (def:' tokens) (let' [[export? tokens'] ({(#Cons [_ (#Tag ["" "export"])] tokens') @@ -2692,61 +2692,61 @@ (let' [[left right] pair] (list left right))) -(def:' (text@encode original) +(def:' (text\encode original) (-> Text Text) - ($_ text@compose ..double-quote original ..double-quote)) + ($_ text\compose ..double-quote original ..double-quote)) -(def:' (code@encode code) +(def:' (code\encode code) (-> Code Text) ({[_ (#Bit value)] - (bit@encode value) + (bit\encode value) [_ (#Nat value)] - (nat@encode value) + (nat\encode value) [_ (#Int value)] - (int@encode value) + (int\encode value) [_ (#Rev value)] ("lux io error" "Undefined behavior.") [_ (#Frac value)] - (frac@encode value) + (frac\encode value) [_ (#Text value)] - (text@encode value) + (text\encode value) [_ (#Identifier [prefix name])] - (if (text@= "" prefix) + (if (text\= "" prefix) name - ($_ text@compose prefix "." name)) + ($_ text\compose prefix "." name)) [_ (#Tag [prefix name])] - (if (text@= "" prefix) - ($_ text@compose "#" name) - ($_ text@compose "#" prefix "." name)) + (if (text\= "" prefix) + ($_ text\compose "#" name) + ($_ text\compose "#" prefix "." name)) [_ (#Form xs)] - ($_ text@compose "(" (|> xs - (list@map code@encode) + ($_ text\compose "(" (|> xs + (list\map code\encode) (interpose " ") - list@reverse - (list@fold text@compose "")) ")") + list\reverse + (list\fold text\compose "")) ")") [_ (#Tuple xs)] - ($_ text@compose "[" (|> xs - (list@map code@encode) + ($_ text\compose "[" (|> xs + (list\map code\encode) (interpose " ") - list@reverse - (list@fold text@compose "")) "]") + list\reverse + (list\fold text\compose "")) "]") [_ (#Record kvs)] - ($_ text@compose "{" (|> kvs - (list@map (function' [kv] ({[k v] ($_ text@compose (code@encode k) " " (code@encode v))} + ($_ text\compose "{" (|> kvs + (list\map (function' [kv] ({[k v] ($_ text\compose (code\encode k) " " (code\encode v))} kv))) (interpose " ") - list@reverse - (list@fold text@compose "")) "}")} + list\reverse + (list\fold text\compose "")) "}")} code)) (def:' (expander branches) @@ -2775,11 +2775,11 @@ (do meta-monad [] (wrap (list))) _ - (fail ($_ text@compose "'lux.case' expects an even number of tokens: " (|> branches - (list@map code@encode) + (fail ($_ text\compose "'lux.case' expects an even number of tokens: " (|> branches + (list\map code\encode) (interpose " ") - list@reverse - (list@fold text@compose ""))))} + list\reverse + (list\fold text\compose ""))))} branches)) (macro:' #export (case tokens) @@ -2849,9 +2849,9 @@ _ (let' [pairs (|> patterns - (list@map (function' [pattern] (list pattern body))) - (list@join))] - (return (list@compose pairs branches)))) + (list\map (function' [pattern] (list pattern body))) + (list\join))] + (return (list\compose pairs branches)))) _ (fail "Wrong syntax for ^or"))) @@ -2874,9 +2874,9 @@ " (op x y))"))]) (case tokens (^ (list [_ (#Tuple bindings)] body)) - (if (multiple? 2 (list@size bindings)) - (|> bindings as-pairs list@reverse - (list@fold (: (-> [Code Code] Code Code) + (if (multiple? 2 (list\size bindings)) + (|> bindings as-pairs list\reverse + (list\fold (: (-> [Code Code] Code Code) (function' [lr body'] (let' [[l r] lr] (if (identifier? l) @@ -2917,7 +2917,7 @@ (` ([(~ g!name) (~ g!blank)] (.case (~ g!blank) (~ arg) (~ body'))))))))] (return (list (nest (..local-identifier$ g!name) head - (list@fold (nest g!blank) body (list@reverse tail)))))) + (list\fold (nest g!blank) body (list\reverse tail)))))) #None (fail "Wrong syntax for function"))) @@ -2951,13 +2951,13 @@ [_ (#Tuple xs)] (|> xs - (list@map process-def-meta-value) + (list\map process-def-meta-value) untemplate-list (meta-code ["lux" "Tuple"])) [_ (#Record kvs)] (|> kvs - (list@map (: (-> [Code Code] Code) + (list\map (: (-> [Code Code] Code) (function (_ [k v]) (` [(~ (process-def-meta-value k)) (~ (process-def-meta-value v))])))) @@ -2967,7 +2967,7 @@ (def:' (process-def-meta kvs) (-> (List [Code Code]) Code) - (untemplate-list (list@map (: (-> [Code Code] Code) + (untemplate-list (list\map (: (-> [Code Code] Code) (function (_ [k v]) (` [(~ (process-def-meta-value k)) (~ (process-def-meta-value v))]))) @@ -2981,14 +2981,14 @@ _ (` (#.Cons [[(~ location-code) (#.Tag ["lux" "func-args"])] - [(~ location-code) (#.Tuple (.list (~+ (list@map (function (_ arg) - (` [(~ location-code) (#.Text (~ (text$ (code@encode arg))))])) + [(~ location-code) (#.Tuple (.list (~+ (list\map (function (_ arg) + (` [(~ location-code) (#.Text (~ (text$ (code\encode arg))))])) args))))]] (~ meta))))) (def:' (with-type-args args) (-> (List Code) Code) - (` {#.type-args [(~+ (list@map (function (_ arg) (text$ (code@encode arg))) + (` {#.type-args [(~+ (list\map (function (_ arg) (text$ (code\encode arg))) args))]})) (def:' (export^ tokens) @@ -3084,7 +3084,7 @@ (-> Code Code Code) (case addition [location (#Record pairs)] - (list@fold meta-code-add base pairs) + (list\fold meta-code-add base pairs) _ base)) @@ -3174,9 +3174,9 @@ (#Some name args meta sigs) (do meta-monad [name+ (normalize name) - sigs' (monad@map meta-monad macro-expand sigs) + sigs' (monad\map meta-monad macro-expand sigs) members (: (Meta (List [Text Code])) - (monad@map meta-monad + (monad\map meta-monad (: (-> Code (Meta [Text Code])) (function (_ token) (case token @@ -3185,10 +3185,10 @@ _ (fail "Signatures require typed members!")))) - (list@join sigs'))) + (list\join sigs'))) #let [[_module _name] name+ def-name (identifier$ name) - sig-type (record$ (list@map (: (-> [Text Code] [Code Code]) + sig-type (record$ (list\map (: (-> [Text Code] [Code Code]) (function (_ [m-name m-type]) [(local-tag$ m-name) m-type])) members)) @@ -3223,9 +3223,9 @@ (template [<name> <form> <message> <doc-msg>] [(macro: #export (<name> tokens) {#.doc <doc-msg>} - (case (list@reverse tokens) + (case (list\reverse tokens) (^ (list& last init)) - (return (list (list@fold (: (-> Code Code Code) + (return (list (list\fold (: (-> Code Code Code) (function (_ pre post) (` <form>))) last init))) @@ -3269,7 +3269,7 @@ _ (#Left "Wrong syntax for default"))) -(def: (text@split-all-with splitter input) +(def: (text\split-all-with splitter input) (-> Text Text (List Text)) (case (..index-of splitter input) #None @@ -3277,7 +3277,7 @@ (#Some idx) (list& ("lux text clip" 0 idx input) - (text@split-all-with splitter + (text\split-all-with splitter ("lux text clip" ("lux i64 +" 1 idx) ("lux text size" input) input))))) (def: (nth idx xs) @@ -3422,7 +3422,7 @@ (#Right state module) _ - (#Left ($_ text@compose "Unknown module: " name)))))) + (#Left ($_ text\compose "Unknown module: " name)))))) (def: get-current-module (Meta Module) @@ -3440,7 +3440,7 @@ (return output) _ - (fail (text@compose "Unknown tag: " (name@encode [module name])))))) + (fail (text\compose "Unknown tag: " (name\encode [module name])))))) (def: (resolve-type-tags type) (-> Type (Meta (Maybe [(List Name) (List Type)]))) @@ -3490,7 +3490,7 @@ (macro: #export (structure tokens) {#.doc "Not meant to be used directly. Prefer 'structure:'."} (do meta-monad - [tokens' (monad@map meta-monad macro-expand tokens) + [tokens' (monad\map meta-monad macro-expand tokens) struct-type get-expected-type tags+type (resolve-type-tags struct-type) tags (: (Meta (List Name)) @@ -3501,9 +3501,9 @@ _ (fail "No tags available for type."))) #let [tag-mappings (: (List [Text Code]) - (list@map (function (_ tag) [(second tag) (tag$ tag)]) + (list\map (function (_ tag) [(second tag) (tag$ tag)]) tags))] - members (monad@map meta-monad + members (monad\map meta-monad (: (-> Code (Meta [Code Code])) (function (_ token) (case token @@ -3513,22 +3513,22 @@ (wrap [tag value]) _ - (fail (text@compose "Unknown structure member: " tag-name))) + (fail (text\compose "Unknown structure member: " tag-name))) _ (fail "Invalid structure member.")))) - (list@join tokens'))] + (list\join tokens'))] (wrap (list (record$ members))))) -(def: (text@join-with separator parts) +(def: (text\join-with separator parts) (-> Text (List Text) Text) (case parts #Nil "" (#Cons head tail) - (list@fold (function (_ right left) - ($_ text@compose left separator right)) + (list\fold (function (_ right left) + ($_ text\compose left separator right)) head tail))) @@ -3581,7 +3581,7 @@ #None (fail "Wrong syntax for structure:")))) -(def: (function@identity x) (All [a] (-> a a)) x) +(def: (function\identity x) (All [a] (-> a a)) x) (macro: #export (type: tokens) {#.doc (text$ ($_ "lux text concat" @@ -3654,7 +3654,7 @@ (` ("lux def type tagged" (~ type-name) (~ typeC) (~ total-meta) - [(~+ (list@map text$ tags))] + [(~+ (list\map text$ tags))] (~ (bit$ exported?)))) _ @@ -3703,7 +3703,7 @@ (def: (extract-defs defs) (-> (List Code) (Meta (List Text))) - (monad@map meta-monad + (monad\map meta-monad (: (-> Code (Meta Text)) (function (_ def) (case def @@ -3748,7 +3748,7 @@ (^ (list& [_ (#Form (list& [_ (#Text prefix)] structs))] parts')) (do meta-monad - [structs' (monad@map meta-monad + [structs' (monad\map meta-monad (function (_ struct) (case struct [_ (#Identifier ["" struct-name])] @@ -3809,23 +3809,23 @@ (count-relatives ("lux i64 +" 1 relatives) input) relatives))) -(def: (list@take amount list) +(def: (list\take amount list) (All [a] (-> Nat (List a) (List a))) (case [amount list] (^or [0 _] [_ #Nil]) #Nil [_ (#Cons head tail)] - (#Cons head (list@take ("lux i64 -" 1 amount) tail)))) + (#Cons head (list\take ("lux i64 -" 1 amount) tail)))) -(def: (list@drop amount list) +(def: (list\drop amount list) (All [a] (-> Nat (List a) (List a))) (case [amount list] (^or [0 _] [_ #Nil]) list [_ (#Cons _ tail)] - (list@drop ("lux i64 -" 1 amount) tail))) + (list\drop ("lux i64 -" 1 amount) tail))) (def: (clean-module nested? relative-root module) (-> Bit Text Text (Meta Text)) @@ -3836,19 +3836,19 @@ module)) relatives - (let [parts (text@split-all-with ..module-separator relative-root) + (let [parts (text\split-all-with ..module-separator relative-root) jumps ("lux i64 -" 1 relatives)] - (if (n/< (list@size parts) jumps) + (if (n/< (list\size parts) jumps) (let [prefix (|> parts - list@reverse - (list@drop jumps) - list@reverse + list\reverse + (list\drop jumps) + list\reverse (interpose ..module-separator) - (text@join-with "")) + (text\join-with "")) clean ("lux text clip" relatives ("lux text size" module) module) output (case ("lux text size" clean) 0 prefix - _ ($_ text@compose prefix ..module-separator clean))] + _ ($_ text\compose prefix ..module-separator clean))] (return output)) (fail ($_ "lux text concat" "Cannot climb the module hierarchy..." ..new-line @@ -3858,22 +3858,22 @@ (def: (alter-domain alteration domain import) (-> Nat Text Importation Importation) (let [[import-name import-alias import-refer] import - original (text@split-all-with ..module-separator import-name) - truncated (list@drop (.nat alteration) original) + original (text\split-all-with ..module-separator import-name) + truncated (list\drop (.nat alteration) original) parallel (case domain "" truncated _ (list& domain truncated))] - {#import-name (text@join-with ..module-separator parallel) + {#import-name (text\join-with ..module-separator parallel) #import-alias import-alias #import-refer import-refer})) (def: (parse-imports nested? relative-root context-alias imports) (-> Bit Text Text (List Code) (Meta (List Importation))) (do meta-monad - [imports' (monad@map meta-monad + [imports' (monad\map meta-monad (: (-> Code (Meta (List Importation))) (function (_ token) (case token @@ -3926,29 +3926,29 @@ parallel-tree]))]) (do meta-monad [parallel-imports (parse-imports nested? relative-root context-alias (list parallel-tree))] - (wrap (list@map (alter-domain alteration domain) parallel-imports))) + (wrap (list\map (alter-domain alteration domain) parallel-imports))) (^ [_ (#Record (list [[_ (#Nat alteration)] parallel-tree]))]) (do meta-monad [parallel-imports (parse-imports nested? relative-root context-alias (list parallel-tree))] - (wrap (list@map (alter-domain alteration "") parallel-imports))) + (wrap (list\map (alter-domain alteration "") parallel-imports))) (^ [_ (#Record (list [[_ (#Tag ["" domain])] parallel-tree]))]) (do meta-monad [parallel-imports (parse-imports nested? relative-root context-alias (list parallel-tree)) - #let [alteration (list@size (text@split-all-with ..module-separator domain))]] - (wrap (list@map (alter-domain alteration domain) parallel-imports))) + #let [alteration (list\size (text\split-all-with ..module-separator domain))]] + (wrap (list\map (alter-domain alteration domain) parallel-imports))) _ (do meta-monad [current-module current-module-name] - (fail ($_ text@compose + (fail ($_ text\compose "Wrong syntax for import @ " current-module - ..new-line (code@encode token))))))) + ..new-line (code\encode token))))))) imports)] - (wrap (list@join imports')))) + (wrap (list\join imports')))) (def: (exported-definitions module state) (-> Text (Meta (List Text))) @@ -3960,7 +3960,7 @@ [current-module modules])] (case (get module modules) (#Some =module) - (let [to-alias (list@map (: (-> [Text Global] + (let [to-alias (list\map (: (-> [Text Global] (List Text)) (function (_ [name definition]) (case definition @@ -3973,22 +3973,22 @@ (list))))) (let [{#module-hash _ #module-aliases _ #definitions definitions #imports _ #tags tags #types types #module-annotations _ #module-state _} =module] definitions))] - (#Right state (list@join to-alias))) + (#Right state (list\join to-alias))) #None - (#Left ($_ text@compose - "Unknown module: " (text@encode module) ..new-line + (#Left ($_ text\compose + "Unknown module: " (text\encode module) ..new-line "Current module: " (case current-module (#Some current-module) - (text@encode current-module) + (text\encode current-module) #None "???") ..new-line "Known modules: " (|> modules - (list@map (function (_ [name module]) + (list\map (function (_ [name module]) (text$ name))) tuple$ - code@encode)))) + code\encode)))) )) (def: (filter p xs) @@ -4004,9 +4004,9 @@ (def: (is-member? cases name) (-> (List Text) Text Bit) - (let [output (list@fold (function (_ case prev) + (let [output (list\fold (function (_ case prev) (or prev - (text@= case name))) + (text\= case name))) #0 cases)] output)) @@ -4034,7 +4034,7 @@ #captured {#counter _ #mappings closure}} (try-both (find (: (-> [Text [Type Any]] (Maybe Type)) (function (_ [bname [type _]]) - (if (text@= name bname) + (if (text\= name bname) (#Some type) #None)))) (: (List [Text [Type Any]]) locals) @@ -4074,12 +4074,12 @@ #scope-type-vars scope-type-vars} state] (case (get v-prefix modules) #None - (#Left (text@compose "Unknown definition: " (name@encode name))) + (#Left (text\compose "Unknown definition: " (name\encode name))) (#Some {#definitions definitions #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-annotations _ #module-state _}) (case (get v-name definitions) #None - (#Left (text@compose "Unknown definition: " (name@encode name))) + (#Left (text\compose "Unknown definition: " (name\encode name))) (#Some definition) (case definition @@ -4106,7 +4106,7 @@ [#let [[module name] full-name] current-module current-module-name] (function (_ compiler) - (let [temp (if (text@= "" module) + (let [temp (if (text\= "" module) (case (find-in-env name compiler) (#Some struct-type) (#Right [compiler struct-type]) @@ -4117,13 +4117,13 @@ (#Right [compiler struct-type]) _ - (#Left ($_ text@compose "Unknown var: " (name@encode full-name))))) + (#Left ($_ text\compose "Unknown var: " (name\encode full-name))))) (case (find-def-type full-name compiler) (#Some struct-type) (#Right [compiler struct-type]) _ - (#Left ($_ text@compose "Unknown var: " (name@encode full-name)))))] + (#Left ($_ text\compose "Unknown var: " (name\encode full-name)))))] (case temp (#Right [compiler (#Var type-id)]) (let [{#info _ #source _ #current-module _ #modules _ @@ -4156,7 +4156,7 @@ _ (list))) -(def: (type@encode type) +(def: (type\encode type) (-> Type Text) (case type (#Primitive name params) @@ -4165,41 +4165,41 @@ name _ - ($_ text@compose "(" name " " (|> params (list@map type@encode) (interpose " ") list@reverse (list@fold text@compose "")) ")")) + ($_ text\compose "(" name " " (|> params (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")")) (#Sum _) - ($_ text@compose "(| " (|> (flatten-variant type) (list@map type@encode) (interpose " ") list@reverse (list@fold text@compose "")) ")") + ($_ text\compose "(| " (|> (flatten-variant type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")") (#Product _) - ($_ text@compose "[" (|> (flatten-tuple type) (list@map type@encode) (interpose " ") list@reverse (list@fold text@compose "")) "]") + ($_ text\compose "[" (|> (flatten-tuple type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) "]") (#Function _) - ($_ text@compose "(-> " (|> (flatten-lambda type) (list@map type@encode) (interpose " ") list@reverse (list@fold text@compose "")) ")") + ($_ text\compose "(-> " (|> (flatten-lambda type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")") (#Parameter id) - (nat@encode id) + (nat\encode id) (#Var id) - ($_ text@compose "⌈v:" (nat@encode id) "⌋") + ($_ text\compose "⌈v:" (nat\encode id) "⌋") (#Ex id) - ($_ text@compose "⟨e:" (nat@encode id) "⟩") + ($_ text\compose "⟨e:" (nat\encode id) "⟩") (#UnivQ env body) - ($_ text@compose "(All " (type@encode body) ")") + ($_ text\compose "(All " (type\encode body) ")") (#ExQ env body) - ($_ text@compose "(Ex " (type@encode body) ")") + ($_ text\compose "(Ex " (type\encode body) ")") (#Apply _) (let [[func args] (flatten-app type)] - ($_ text@compose - "(" (type@encode func) " " - (|> args (list@map type@encode) (interpose " ") list@reverse (list@fold text@compose "")) + ($_ text\compose + "(" (type\encode func) " " + (|> args (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")")) (#Named name _) - (name@encode name) + (name\encode name) )) (macro: #export (^open tokens) @@ -4221,18 +4221,18 @@ struct-evidence (resolve-type-tags init-type)] (case struct-evidence #None - (fail (text@compose "Can only 'open' structs: " (type@encode init-type))) + (fail (text\compose "Can only 'open' structs: " (type\encode init-type))) (#Some tags&members) (do meta-monad [full-body ((: (-> Name [(List Name) (List Type)] Code (Meta Code)) (function (recur source [tags members] target) - (let [locals (list@map (function (_ [t-module t-name]) + (let [locals (list\map (function (_ [t-module t-name]) ["" (de-alias "" t-name alias)]) tags) - pattern (tuple$ (list@map identifier$ locals))] + pattern (tuple$ (list\map identifier$ locals))] (do meta-monad - [enhanced-target (monad@fold meta-monad + [enhanced-target (monad\fold meta-monad (function (_ [m-local m-type] enhanced-target) (do meta-monad [m-structure (resolve-type-tags m-type)] @@ -4261,11 +4261,11 @@ __paragraph " ## else-branch" ..new-line " ''???'')"))} - (if ("lux i64 =" 0 (n/% 2 (list@size tokens))) + (if ("lux i64 =" 0 (n/% 2 (list\size tokens))) (fail "cond requires an uneven number of arguments.") - (case (list@reverse tokens) + (case (list\reverse tokens) (^ (list& else branches')) - (return (list (list@fold (: (-> [Code Code] Code Code) + (return (list (list\fold (: (-> [Code Code] Code Code) (function (_ branch else) (let [[right left] branch] (` (if (~ left) (~ right) (~ else)))))) @@ -4309,7 +4309,7 @@ g!output (gensym "")] (case (resolve-struct-type type) (#Some members) - (let [pattern (record$ (list@map (: (-> [Name [Nat Type]] [Code Code]) + (let [pattern (record$ (list\map (: (-> [Name [Nat Type]] [Code Code]) (function (_ [[r-prefix r-name] [r-idx r-type]]) [(tag$ [r-prefix r-name]) (if ("lux i64 =" idx r-idx) @@ -4322,7 +4322,7 @@ (fail "get@ can only use records."))) (^ (list [_ (#Tuple slots)] record)) - (return (list (list@fold (: (-> Code Code Code) + (return (list (list\fold (: (-> Code Code Code) (function (_ slot inner) (` (..get@ (~ slot) (~ inner))))) record @@ -4345,7 +4345,7 @@ #let [g!output (local-identifier$ short) pattern (|> tags enumeration - (list@map (function (_ [tag-idx tag]) + (list\map (function (_ [tag-idx tag]) (if ("lux i64 =" my-tag-index tag-idx) g!output g!_))) @@ -4354,12 +4354,12 @@ (case output (#Some [tags' members']) (do meta-monad - [decls' (monad@map meta-monad + [decls' (monad\map meta-monad (: (-> [Nat Name Type] (Meta (List Code))) (function (_ [sub-tag-index sname stype]) (open-field alias tags' sub-tag-index sname source+ stype))) (enumeration (zip/2 tags' members')))] - (return (list@join decls'))) + (return (list\join decls'))) _ (return (list (` ("lux def" (~ (local-identifier$ (de-alias "" short alias))) @@ -4390,14 +4390,14 @@ (case output (#Some [tags members]) (do meta-monad - [decls' (monad@map meta-monad (: (-> [Nat Name Type] (Meta (List Code))) + [decls' (monad\map meta-monad (: (-> [Nat Name Type] (Meta (List Code))) (function (_ [tag-index sname stype]) (open-field alias tags tag-index sname source stype))) (enumeration (zip/2 tags members)))] - (return (list@join decls'))) + (return (list\join decls'))) _ - (fail (text@compose "Can only 'open:' structs: " (type@encode struct-type))))) + (fail (text\compose "Can only 'open:' structs: " (type\encode struct-type))))) _ (do meta-monad @@ -4413,9 +4413,9 @@ (macro: #export (|>> tokens) {#.doc (text$ ($_ "lux text concat" "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..new-line - "(|>> (list@map int@encode) (interpose '' '') (fold text@compose ''''))" ..new-line + "(|>> (list\map int\encode) (interpose '' '') (fold text\compose ''''))" ..new-line "## =>" ..new-line - "(function (_ <arg>) (fold text@compose '''' (interpose '' '' (list@map int@encode <arg>))))"))} + "(function (_ <arg>) (fold text\compose '''' (interpose '' '' (list\map int\encode <arg>))))"))} (do meta-monad [g!_ (gensym "_") g!arg (gensym "arg")] @@ -4424,9 +4424,9 @@ (macro: #export (<<| tokens) {#.doc (text$ ($_ "lux text concat" "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..new-line - "(<<| (fold text@compose '''') (interpose '' '') (list@map int@encode))" ..new-line + "(<<| (fold text\compose '''') (interpose '' '') (list\map int\encode))" ..new-line "## =>" ..new-line - "(function (_ <arg>) (fold text@compose '''' (interpose '' '' (list@map int@encode <arg>))))"))} + "(function (_ <arg>) (fold text\compose '''' (interpose '' '' (list\map int\encode <arg>))))"))} (do meta-monad [g!_ (gensym "_") g!arg (gensym "arg")] @@ -4453,11 +4453,11 @@ #refer-open openings}) _ - (fail ($_ text@compose "Wrong syntax for refer @ " current-module + (fail ($_ text\compose "Wrong syntax for refer @ " current-module ..new-line (|> options - (list@map code@encode) + (list\map code\encode) (interpose " ") - (list@fold text@compose ""))))))) + (list\fold text\compose ""))))))) (def: (write-refer module-name [r-defs r-opens]) (-> Text Refer (Meta (List Code))) @@ -4465,12 +4465,12 @@ [current-module current-module-name #let [test-referrals (: (-> Text (List Text) (List Text) (Meta (List Any))) (function (_ module-name all-defs referred-defs) - (monad@map meta-monad + (monad\map meta-monad (: (-> Text (Meta Any)) (function (_ _def) (if (is-member? all-defs _def) (return []) - (fail ($_ text@compose _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 @@ -4493,18 +4493,18 @@ #Nothing (wrap (list))) - #let [defs (list@map (: (-> Text Code) + #let [defs (list\map (: (-> Text Code) (function (_ def) (` ("lux def alias" (~ (local-identifier$ def)) (~ (identifier$ [module-name def])))))) defs') openings (|> r-opens - (list@map (: (-> Openings (List Code)) + (list\map (: (-> Openings (List Code)) (function (_ [alias structs]) - (list@map (function (_ name) + (list\map (function (_ name) (` (open: (~ (text$ alias)) (~ (identifier$ [module-name name]))))) structs)))) - list@join)]] - (wrap (list@compose defs openings)) + list\join)]] + (wrap (list\compose defs openings)) )) (macro: #export (refer tokens) @@ -4526,19 +4526,19 @@ (list (' #*)) (#Only defs) - (list (form$ (list& (' #+) (list@map local-identifier$ defs)))) + (list (form$ (list& (' #+) (list\map local-identifier$ defs)))) (#Exclude defs) - (list (form$ (list& (' #-) (list@map local-identifier$ defs)))) + (list (form$ (list& (' #-) (list\map local-identifier$ defs)))) #Ignore (list) #Nothing (list))) - openings (list@map (function (_ [alias structs]) + openings (list\map (function (_ [alias structs]) (form$ (list& (text$ (..replace-all ..contextual-reference module-alias alias)) - (list@map local-identifier$ structs)))) + (list\map local-identifier$ structs)))) r-opens)] (` (..refer (~ (text$ module-name)) (~+ localizations) @@ -4573,11 +4573,11 @@ current-module current-module-name imports (parse-imports #0 current-module "" _imports) #let [=imports (|> imports - (list@map (: (-> Importation Code) + (list\map (: (-> Importation Code) (function (_ [m-name m-alias =refer]) (` [(~ (text$ m-name)) (~ (text$ (default "" m-alias)))])))) tuple$) - =refers (list@map (: (-> Importation Code) + =refers (list\map (: (-> Importation Code) (function (_ [m-name m-alias =refer]) (refer-to-code m-name m-alias =refer))) imports) @@ -4623,19 +4623,19 @@ (case (resolve-struct-type type) (#Some members) (do meta-monad - [pattern' (monad@map meta-monad + [pattern' (monad\map meta-monad (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) (function (_ [r-slot-name [r-idx r-type]]) (do meta-monad [g!slot (gensym "")] (return [r-slot-name r-idx g!slot])))) (zip/2 tags (enumeration members)))] - (let [pattern (record$ (list@map (: (-> [Name Nat Code] [Code Code]) + (let [pattern (record$ (list\map (: (-> [Name Nat Code] [Code Code]) (function (_ [r-slot-name r-idx r-var]) [(tag$ r-slot-name) r-var])) pattern')) - output (record$ (list@map (: (-> [Name Nat Code] [Code Code]) + output (record$ (list\map (: (-> [Name Nat Code] [Code Code]) (function (_ [r-slot-name r-idx r-var]) [(tag$ r-slot-name) (if ("lux i64 =" idx r-idx) @@ -4654,23 +4654,23 @@ _ (do meta-monad - [bindings (monad@map meta-monad + [bindings (monad\map meta-monad (: (-> Code (Meta Code)) (function (_ _) (gensym "temp"))) slots) #let [pairs (zip/2 slots bindings) - update-expr (list@fold (: (-> [Code Code] Code Code) + update-expr (list\fold (: (-> [Code Code] Code Code) (function (_ [s b] v) (` (..set@ (~ s) (~ v) (~ b))))) value - (list@reverse pairs)) - [_ accesses'] (list@fold (: (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))]) + (list\reverse pairs)) + [_ accesses'] (list\fold (: (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))]) (function (_ [new-slot new-binding] [old-record accesses']) [(` (get@ (~ new-slot) (~ new-binding))) (#Cons (list new-binding old-record) accesses')])) [record (: (List (List Code)) #Nil)] pairs) - accesses (list@join (list@reverse accesses'))]] + accesses (list\join (list\reverse accesses'))]] (wrap (list (` (let [(~+ accesses)] (~ update-expr))))))) @@ -4710,19 +4710,19 @@ (case (resolve-struct-type type) (#Some members) (do meta-monad - [pattern' (monad@map meta-monad + [pattern' (monad\map meta-monad (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) (function (_ [r-slot-name [r-idx r-type]]) (do meta-monad [g!slot (gensym "")] (return [r-slot-name r-idx g!slot])))) (zip/2 tags (enumeration members)))] - (let [pattern (record$ (list@map (: (-> [Name Nat Code] [Code Code]) + (let [pattern (record$ (list\map (: (-> [Name Nat Code] [Code Code]) (function (_ [r-slot-name r-idx r-var]) [(tag$ r-slot-name) r-var])) pattern')) - output (record$ (list@map (: (-> [Name Nat Code] [Code Code]) + output (record$ (list\map (: (-> [Name Nat Code] [Code Code]) (function (_ [r-slot-name r-idx r-var]) [(tag$ r-slot-name) (if ("lux i64 =" idx r-idx) @@ -4770,7 +4770,7 @@ " (-> (List Type) Type Type)" ..new-line " (case type" ..new-line " (#.Primitive name params)" ..new-line - " (#.Primitive name (list@map (beta-reduce env) params))" + " (#.Primitive name (list\map (beta-reduce env) params))" __paragraph " (^template [<tag>]" ..new-line " [(<tag> left right)" ..new-line @@ -4805,20 +4805,20 @@ branches)) (case (: (Maybe (List Code)) (do maybe-monad - [bindings' (monad@map maybe-monad get-short bindings) - data' (monad@map maybe-monad tuple->list data)] - (let [num-bindings (list@size bindings')] + [bindings' (monad\map maybe-monad get-short bindings) + data' (monad\map maybe-monad tuple->list data)] + (let [num-bindings (list\size bindings')] (if (every? (|>> ("lux i64 =" num-bindings)) - (list@map list@size data')) + (list\map list\size data')) (let [apply (: (-> RepEnv (List Code)) - (function (_ env) (list@map (apply-template env) templates)))] + (function (_ env) (list\map (apply-template env) templates)))] (|> data' - (list@map (compose apply (make-env bindings'))) - list@join + (list\map (compose apply (make-env bindings'))) + list\join wrap)) #None)))) (#Some output) - (return (list@compose output branches)) + (return (list\compose output branches)) #None (fail "Wrong syntax for ^template")) @@ -4843,14 +4843,14 @@ (^template [<tag>] [[[_ _ column] (<tag> parts)] - (list@fold n/min column (list@map find-baseline-column parts))]) + (list\fold n/min column (list\map find-baseline-column parts))]) ([#Form] [#Tuple]) [[_ _ column] (#Record pairs)] - (list@fold n/min column - (list@compose (list@map (|>> first find-baseline-column) pairs) - (list@map (|>> second find-baseline-column) pairs))) + (list\fold n/min column + (list\compose (list\map (|>> first find-baseline-column) pairs) + (list\map (|>> second find-baseline-column) pairs))) )) (type: Doc-Fragment @@ -4876,9 +4876,9 @@ [dec "lux i64 -" "Decrement function."] ) -(def: tag@encode +(def: tag\encode (-> Name Text) - (|>> name@encode (text@compose "#"))) + (|>> name\encode (text\compose "#"))) (def: (repeat n x) (All [a] (-> Int a (List a))) @@ -4889,18 +4889,18 @@ (def: (location-padding baseline [_ old-line old-column] [_ new-line new-column]) (-> Nat Location Location Text) (if ("lux i64 =" old-line new-line) - (text@join-with "" (repeat (.int ("lux i64 -" old-column new-column)) " ")) - (let [extra-lines (text@join-with "" (repeat (.int ("lux i64 -" old-line new-line)) ..new-line)) - space-padding (text@join-with "" (repeat (.int ("lux i64 -" baseline new-column)) " "))] - (text@compose extra-lines space-padding)))) + (text\join-with "" (repeat (.int ("lux i64 -" old-column new-column)) " ")) + (let [extra-lines (text\join-with "" (repeat (.int ("lux i64 -" old-line new-line)) ..new-line)) + space-padding (text\join-with "" (repeat (.int ("lux i64 -" baseline new-column)) " "))] + (text\compose extra-lines space-padding)))) -(def: (text@size x) +(def: (text\size x) (-> Text Nat) ("lux text size" x)) (def: (update-location [file line column] code-text) (-> Location Text Location) - [file line ("lux i64 +" column (text@size code-text))]) + [file line ("lux i64 +" column (text\size code-text))]) (def: (delim-update-location [file line column]) (-> Location Location) @@ -4908,7 +4908,7 @@ (def: rejoin-all-pairs (-> (List [Code Code]) (List Code)) - (|>> (list@map rejoin-pair) list@join)) + (|>> (list\map rejoin-pair) list\join)) (def: (doc-example->Text prev-location baseline example) (-> Location Nat Code [Location Text]) @@ -4917,30 +4917,30 @@ [[new-location (<tag> value)] (let [as-text (<encode> value)] [(update-location new-location as-text) - (text@compose (location-padding baseline prev-location new-location) + (text\compose (location-padding baseline prev-location new-location) as-text)])]) - ([#Bit bit@encode] - [#Nat nat@encode] - [#Int int@encode] - [#Frac frac@encode] - [#Text text@encode] - [#Identifier name@encode] - [#Tag tag@encode]) + ([#Bit bit\encode] + [#Nat nat\encode] + [#Int int\encode] + [#Frac frac\encode] + [#Text text\encode] + [#Identifier name\encode] + [#Tag tag\encode]) (^template [<tag> <open> <close> <prep>] [[group-location (<tag> parts)] - (let [[group-location' parts-text] (list@fold (function (_ part [last-location text-accum]) + (let [[group-location' parts-text] (list\fold (function (_ part [last-location text-accum]) (let [[part-location part-text] (doc-example->Text last-location baseline part)] - [part-location (text@compose text-accum part-text)])) + [part-location (text\compose text-accum part-text)])) [(delim-update-location group-location) ""] (<prep> parts))] [(delim-update-location group-location') - ($_ text@compose (location-padding baseline prev-location group-location) + ($_ text\compose (location-padding baseline prev-location group-location) <open> parts-text <close>)])]) - ([#Form "(" ")" ..function@identity] - [#Tuple "[" "]" ..function@identity] + ([#Form "(" ")" ..function\identity] + [#Tuple "[" "]" ..function\identity] [#Record "{" "}" rejoin-all-pairs]) [new-location (#Rev value)] @@ -4956,15 +4956,15 @@ (case fragment (#Doc-Comment comment) (|> comment - (text@split-all-with ..new-line) - (list@map (function (_ line) ($_ text@compose "## " line ..new-line))) - (text@join-with "")) + (text\split-all-with ..new-line) + (list\map (function (_ line) ($_ text\compose "## " line ..new-line))) + (text\join-with "")) (#Doc-Example example) (let [baseline (find-baseline-column example) [location _] example [_ text] (doc-example->Text (with-baseline baseline location) baseline example)] - (text@compose text __paragraph)))) + (text\compose text __paragraph)))) (macro: #export (doc tokens) {#.doc (text$ ($_ "lux text concat" @@ -4980,8 +4980,8 @@ " x)))"))} (return (list (` [(~ location-code) (#.Text (~ (|> tokens - (list@map (|>> identify-doc-fragment doc-fragment->Text)) - (text@join-with "") + (list\map (|>> identify-doc-fragment doc-fragment->Text)) + (text\join-with "") text$)))])))) (def: (interleave xs ys) @@ -5002,7 +5002,7 @@ (-> Type Code) (case type (#Primitive name params) - (` (#.Primitive (~ (text$ name)) (~ (untemplate-list (list@map type-to-code params))))) + (` (#.Primitive (~ (text$ name)) (~ (untemplate-list (list\map type-to-code params))))) (^template [<tag>] [(<tag> left right) @@ -5018,7 +5018,7 @@ (^template [<tag>] [(<tag> env type) - (let [env' (untemplate-list (list@map type-to-code env))] + (let [env' (untemplate-list (list\map type-to-code env))] (` (<tag> (~ env') (~ (type-to-code type)))))]) ([#.UnivQ] [#.ExQ]) @@ -5057,23 +5057,23 @@ (case ?params (#.Some [name bindings body]) (let [pairs (as-pairs bindings) - vars (list@map first pairs) - inits (list@map second pairs)] + vars (list\map first pairs) + inits (list\map second pairs)] (if (every? identifier? inits) (do meta-monad [inits' (: (Meta (List Name)) - (case (monad@map maybe-monad get-name inits) + (case (monad\map maybe-monad get-name inits) (#Some inits') (return inits') #None (fail "Wrong syntax for loop"))) - init-types (monad@map meta-monad find-type inits') + init-types (monad\map meta-monad find-type inits') expected get-expected-type] - (return (list (` (("lux check" (-> (~+ (list@map type-to-code init-types)) + (return (list (` (("lux check" (-> (~+ (list\map type-to-code init-types)) (~ (type-to-code expected))) (function ((~ name) (~+ vars)) (~ body))) (~+ inits)))))) (do meta-monad - [aliases (monad@map meta-monad + [aliases (monad\map meta-monad (: (-> Code (Meta Code)) (function (_ _) (gensym ""))) inits)] @@ -5097,7 +5097,7 @@ (case (: (Maybe [Name (List Name)]) (do maybe-monad [hslot (get-tag hslot') - tslots (monad@map maybe-monad get-tag tslots')] + tslots (monad\map maybe-monad get-tag tslots')] (wrap [hslot tslots]))) (#Some slots) (return slots) @@ -5106,15 +5106,15 @@ (fail "Wrong syntax for ^slots"))) #let [[hslot tslots] slots] hslot (normalize hslot) - tslots (monad@map meta-monad normalize tslots) + tslots (monad\map meta-monad normalize tslots) output (resolve-tag hslot) g!_ (gensym "_") #let [[idx tags exported? type] output - slot-pairings (list@map (: (-> Name [Text Code]) + slot-pairings (list\map (: (-> Name [Text Code]) (function (_ [module name]) [name (local-identifier$ name)])) (list& hslot tslots)) - pattern (record$ (list@map (: (-> Name [Code Code]) + pattern (record$ (list\map (: (-> Name [Code Code]) (function (_ [module name]) (let [tag (tag$ [module name])] (case (get name slot-pairings) @@ -5133,22 +5133,22 @@ (#Some (list target)) [_ (#Identifier [prefix name])] - (if (and (text@= "" prefix) - (text@= label name)) + (if (and (text\= "" prefix) + (text\= label name)) (#Some tokens) (#Some (list target))) (^template [<tag>] [[location (<tag> elems)] (do maybe-monad - [placements (monad@map maybe-monad (place-tokens label tokens) elems)] - (wrap (list [location (<tag> (list@join placements))])))]) + [placements (monad\map maybe-monad (place-tokens label tokens) elems)] + (wrap (list [location (<tag> (list\join placements))])))]) ([#Tuple] [#Form]) [location (#Record pairs)] (do maybe-monad - [=pairs (monad@map maybe-monad + [=pairs (monad\map maybe-monad (: (-> [Code Code] (Maybe [Code Code])) (function (_ [slot value]) (do maybe-monad @@ -5249,13 +5249,13 @@ ["Text" Text text$]) _ - (fail (text@compose "Cannot anti-quote type: " (name@encode name)))))) + (fail (text\compose "Cannot anti-quote type: " (name\encode name)))))) (def: (anti-quote token) (-> Code (Meta Code)) (case token [_ (#Identifier [def-prefix def-name])] - (if (text@= "" def-prefix) + (if (text\= "" def-prefix) (do meta-monad [current-module current-module-name] (anti-quote-def [current-module def-name])) @@ -5264,14 +5264,14 @@ (^template [<tag>] [[meta (<tag> parts)] (do meta-monad - [=parts (monad@map meta-monad anti-quote parts)] + [=parts (monad\map meta-monad anti-quote parts)] (wrap [meta (<tag> =parts)]))]) ([#Form] [#Tuple]) [meta (#Record pairs)] (do meta-monad - [=pairs (monad@map meta-monad + [=pairs (monad\map meta-monad (: (-> [Code Code] (Meta [Code Code])) (function (_ [slot value]) (do meta-monad @@ -5315,12 +5315,12 @@ (#Cons init extras) (do meta-monad - [extras' (monad@map meta-monad case-level^ extras)] + [extras' (monad\map meta-monad case-level^ extras)] (wrap [init extras'])))) (def: (multi-level-case$ g!_ [[init-pattern levels] body]) (-> Code [Multi-Level-Case Code] (List Code)) - (let [inner-pattern-body (list@fold (function (_ [calculation pattern] success) + (let [inner-pattern-body (list\fold (function (_ [calculation pattern] success) (let [bind? (case pattern [_ (#.Identifier _)] #1 @@ -5335,7 +5335,7 @@ (list) (list g!_ (` #.None)))))))) (` (#.Some (~ body))) - (: (List [Code Code]) (list@reverse levels)))] + (: (List [Code Code]) (list\reverse levels)))] (list init-pattern inner-pattern-body))) (macro: #export (^multi tokens) @@ -5343,7 +5343,7 @@ "Useful in situations where the result of a branch depends on further refinements on the values being matched." "For example:" (case (split (size static) uri) - (^multi (#.Some [chunk uri']) [(text@= static chunk) #1]) + (^multi (#.Some [chunk uri']) [(text\= static chunk) #1]) (match-uri endpoint? parts' uri') _ @@ -5352,7 +5352,7 @@ "Short-cuts can be taken when using bit tests." "The example above can be rewritten as..." (case (split (size static) uri) - (^multi (#.Some [chunk uri']) (text@= static chunk)) + (^multi (#.Some [chunk uri']) (text\= static chunk)) (match-uri endpoint? parts' uri') _ @@ -5393,8 +5393,8 @@ ## 'wrong-syntax-error' for easier maintenance of the error-messages. (def: wrong-syntax-error (-> Name Text) - (|>> name@encode - (text@compose "Wrong syntax for "))) + (|>> name\encode + (text\compose "Wrong syntax for "))) (macro: #export (name-of tokens) {#.doc (doc "Given an identifier or a tag, gives back a 2 tuple with the prefix and name parts, both as Text." @@ -5436,7 +5436,7 @@ "In the example below, 0 corresponds to the 'a' variable." (def: #export (from-list list) (All [a] (-> (List a) (Row a))) - (list@fold add + (list\fold add (: (Row ($ 0)) empty) list)))} @@ -5444,12 +5444,12 @@ (^ (list [_ (#Nat idx)])) (do meta-monad [stvs get-scope-type-vars] - (case (list-at idx (list@reverse stvs)) + (case (list-at idx (list\reverse stvs)) (#Some var-id) (wrap (list (` (#Ex (~ (nat$ var-id)))))) #None - (fail (text@compose "Indexed-type does not exist: " (nat@encode idx))))) + (fail (text\compose "Indexed-type does not exist: " (nat\encode idx))))) _ (fail (..wrong-syntax-error (name-of ..$))))) @@ -5468,7 +5468,7 @@ (macro: #export (^@ tokens) {#.doc (doc "Allows you to simultaneously bind and de-structure a value." (def: (hash (^@ set [Hash<a> _])) - (list@fold (function (_ elem acc) (+ (:: Hash<a> hash elem) acc)) + (list\fold (function (_ elem acc) (+ (:: Hash<a> hash elem) acc)) 0 (to-list set))))} (case tokens @@ -5555,7 +5555,7 @@ (case tokens (^ (list& [_ (#Form (list& [_ (#Identifier ["" name])] args'))] tokens')) (do meta-monad - [args (monad@map meta-monad + [args (monad\map meta-monad (function (_ arg') (case arg' [_ (#Identifier ["" arg-name])] @@ -5627,7 +5627,7 @@ g!tokens (gensym "tokens") g!compiler (gensym "compiler") g!_ (gensym "_") - #let [rep-env (list@map (function (_ arg) + #let [rep-env (list\map (function (_ arg) [arg (` ((~' ~) (~ (local-identifier$ arg))))]) args)] this-module current-module-name] @@ -5635,9 +5635,9 @@ ((~ (local-identifier$ name)) (~ g!tokens) (~ g!compiler)) (~ anns) (case (~ g!tokens) - (^ (list (~+ (list@map local-identifier$ args)))) + (^ (list (~+ (list\map local-identifier$ args)))) (#.Right [(~ g!compiler) - (list (~+ (list@map (function (_ template) + (list (~+ (list\map (function (_ template) (` (`' (~ (replace-syntax rep-env template))))) input-templates)))]) @@ -5671,7 +5671,7 @@ #Nil (case default #.None - (fail ($_ text@compose "No code for target platform: " target)) + (fail ($_ text\compose "No code for target platform: " target)) (#.Some default) (return (list default))) @@ -5680,7 +5680,7 @@ (with-expansions [<try-again> (target-pick target options' default)] (case key [_ (#Text platform)] - (if (text@= target platform) + (if (text\= target platform) (return (list pick)) <try-again>) @@ -5691,14 +5691,14 @@ #let [[type value] type+value]] (case (..flatten-alias type) (#Named ["lux" "Text"] (#Primitive "#Text" #Nil)) - (if (text@= target (:coerce ..Text value)) + (if (text\= target (:coerce ..Text value)) (wrap (list pick)) <try-again>) _ - (fail ($_ text@compose - "Invalid target platform (must be a value of type Text): " (name@encode identifier) - " : " (..code@encode (..type-to-code type)))))) + (fail ($_ text\compose + "Invalid target platform (must be a value of type Text): " (name\encode identifier) + " : " (..code\encode (..type-to-code type)))))) _ <try-again>)) @@ -5737,24 +5737,24 @@ (^template [<tag>] [[ann (<tag> parts)] (do meta-monad - [=parts (monad@map meta-monad label-code parts)] - (wrap [(list@fold list@compose (list) (list@map left =parts)) - [ann (<tag> (list@map right =parts))]]))]) + [=parts (monad\map meta-monad label-code parts)] + (wrap [(list\fold list\compose (list) (list\map left =parts)) + [ann (<tag> (list\map right =parts))]]))]) ([#Form] [#Tuple]) [ann (#Record kvs)] (do meta-monad - [=kvs (monad@map meta-monad + [=kvs (monad\map meta-monad (function (_ [key val]) (do meta-monad [=key (label-code key) =val (label-code val) #let [[key-labels key-labelled] =key [val-labels val-labelled] =val]] - (wrap [(list@compose key-labels val-labels) [key-labelled val-labelled]]))) + (wrap [(list\compose key-labels val-labels) [key-labelled val-labelled]]))) kvs)] - (wrap [(list@fold list@compose (list) (list@map left =kvs)) - [ann (#Record (list@map right =kvs))]])) + (wrap [(list\fold list\compose (list) (list\map left =kvs)) + [ann (#Record (list\map right =kvs))]])) _ (return [(list) code]))) @@ -5766,8 +5766,8 @@ [=raw (label-code raw) #let [[labels labelled] =raw]] (wrap (list (` (with-expansions [(~+ (|> labels - (list@map (function (_ [label expansion]) (list label expansion))) - list@join))] + (list\map (function (_ [label expansion]) (list label expansion))) + list\join))] (~ labelled)))))) _ @@ -5806,7 +5806,7 @@ [_ (#Record fields)] (do meta-monad - [=fields (monad@map meta-monad + [=fields (monad\map meta-monad (function (_ [key value]) (do meta-monad [=key (untemplate-pattern key) @@ -5824,17 +5824,17 @@ (^template [<tag>] [[_ (<tag> elems)] - (case (list@reverse elems) + (case (list\reverse elems) (#Cons [_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] inits) (do meta-monad - [=inits (monad@map meta-monad untemplate-pattern (list@reverse inits)) + [=inits (monad\map meta-monad untemplate-pattern (list\reverse inits)) g!meta (gensym "g!meta")] (wrap (` [(~ g!meta) (<tag> (~ (untemplate-list& spliced =inits)))]))) _ (do meta-monad - [=elems (monad@map meta-monad untemplate-pattern elems) + [=elems (monad\map meta-monad untemplate-pattern elems) g!meta (gensym "g!meta")] (wrap (` [(~ g!meta) (<tag> (~ (untemplate-list =elems)))]))))]) ([#Tuple] [#Form]) @@ -5867,12 +5867,12 @@ (macro: #export (:let tokens) (case tokens (^ (list [_ (#Tuple bindings)] bodyT)) - (if (multiple? 2 (list@size bindings)) + (if (multiple? 2 (list\size bindings)) (return (list (` (..with-expansions [(~+ (|> bindings ..as-pairs - (list@map (function (_ [localT valueT]) + (list\map (function (_ [localT valueT]) (list localT (` (..as-is (~ valueT)))))) - (list@fold list@compose (list))))] + (list\fold list\compose (list))))] (~ bodyT))))) (..fail ":let requires an even number of parts")) diff --git a/stdlib/source/lux/abstract/enum.lux b/stdlib/source/lux/abstract/enum.lux index ce9b66d92..0c099feb2 100644 --- a/stdlib/source/lux/abstract/enum.lux +++ b/stdlib/source/lux/abstract/enum.lux @@ -12,14 +12,14 @@ (def: #export (range enum from to) {#.doc "An inclusive [from, to] range of values."} (All [a] (-> (Enum a) a a (List a))) - (let [(^open "/@.") enum] + (let [(^open "/\.") enum] (loop [end to output #.Nil] - (cond (/@< end from) - (recur (/@pred end) (#.Cons end output)) + (cond (/\< end from) + (recur (/\pred end) (#.Cons end output)) - (/@< from end) - (recur (/@succ end) (#.Cons end output)) + (/\< from end) + (recur (/\succ end) (#.Cons end output)) - ## (/@= end from) + ## (/\= end from) (#.Cons end output))))) diff --git a/stdlib/source/lux/abstract/fold.lux b/stdlib/source/lux/abstract/fold.lux index a63dc8e20..fd309b5f0 100644 --- a/stdlib/source/lux/abstract/fold.lux +++ b/stdlib/source/lux/abstract/fold.lux @@ -12,5 +12,5 @@ (def: #export (with-monoid monoid fold value) (All [F a] (-> (Monoid a) (Fold F) (F a) a)) - (let [(^open "/@.") monoid] - (fold /@compose /@identity value))) + (let [(^open "/\.") monoid] + (fold /\compose /\identity value))) diff --git a/stdlib/source/lux/abstract/functor.lux b/stdlib/source/lux/abstract/functor.lux index 9ba47aaf8..03c10eaaf 100644 --- a/stdlib/source/lux/abstract/functor.lux +++ b/stdlib/source/lux/abstract/functor.lux @@ -12,33 +12,33 @@ (type: #export (Or f g) (All [a] (| (f a) (g a)))) -(def: #export (sum (^open "f@.") (^open "g@.")) +(def: #export (sum (^open "f\.") (^open "g\.")) (All [F G] (-> (Functor F) (Functor G) (Functor (..Or F G)))) (structure (def: (map f fa|ga) (case fa|ga (#.Left fa) - (#.Left (f@map f fa)) + (#.Left (f\map f fa)) (#.Right ga) - (#.Right (g@map f ga)))))) + (#.Right (g\map f ga)))))) (type: #export (And f g) (All [a] (& (f a) (g a)))) -(def: #export (product (^open "f@.") (^open "g@.")) +(def: #export (product (^open "f\.") (^open "g\.")) (All [F G] (-> (Functor F) (Functor G) (Functor (..And F G)))) (structure (def: (map f [fa ga]) - [(f@map f fa) - (g@map f ga)]))) + [(f\map f fa) + (g\map f ga)]))) (type: #export (Then f g) (All [a] (f (g a)))) -(def: #export (compose (^open "f@.") (^open "g@.")) +(def: #export (compose (^open "f\.") (^open "g\.")) {#.doc "Functor composition."} (All [F G] (-> (Functor F) (Functor G) (Functor (..Then F G)))) (structure (def: (map f fga) - (f@map (g@map f) fga)))) + (f\map (g\map f) fga)))) diff --git a/stdlib/source/lux/abstract/interval.lux b/stdlib/source/lux/abstract/interval.lux index 46fe020e1..c429fa5c8 100644 --- a/stdlib/source/lux/abstract/interval.lux +++ b/stdlib/source/lux/abstract/interval.lux @@ -34,28 +34,28 @@ (template [<name> <comp>] [(def: #export (<name> interval) (All [a] (-> (Interval a) Bit)) - (let [(^open ",@.") interval] - (<comp> ,@bottom ,@top)))] + (let [(^open ",\.") interval] + (<comp> ,\bottom ,\top)))] - [inner? (order.> ,@&order)] - [outer? ,@<] - [singleton? ,@=] + [inner? (order.> ,\&order)] + [outer? ,\<] + [singleton? ,\=] ) (def: #export (within? interval elem) (All [a] (-> (Interval a) a Bit)) - (let [(^open ",@.") interval] + (let [(^open ",\.") interval] (cond (inner? interval) - (and (order.>= ,@&order ,@bottom elem) - (order.<= ,@&order ,@top elem)) + (and (order.>= ,\&order ,\bottom elem) + (order.<= ,\&order ,\top elem)) (outer? interval) - (or (order.>= ,@&order ,@bottom elem) - (order.<= ,@&order ,@top elem)) + (or (order.>= ,\&order ,\bottom elem) + (order.<= ,\&order ,\top elem)) ## singleton - (and (,@= ,@bottom elem) - (,@= ,@top elem))))) + (and (,\= ,\bottom elem) + (,\= ,\top elem))))) (template [<name> <limit>] [(def: #export (<name> elem interval) @@ -105,20 +105,20 @@ (template [<name> <comp>] [(def: #export (<name> reference sample) (All [a] (-> a (Interval a) Bit)) - (let [(^open ",@.") sample] - (and (<comp> reference ,@bottom) - (<comp> reference ,@top))))] + (let [(^open ",\.") sample] + (and (<comp> reference ,\bottom) + (<comp> reference ,\top))))] - [before? ,@<] - [after? (order.> ,@&order)] + [before? ,\<] + [after? (order.> ,\&order)] ) (def: #export (meets? reference sample) (All [a] (-> (Interval a) (Interval a) Bit)) - (let [(^open ",@.") reference + (let [(^open ",\.") reference limit (:: reference bottom)] - (and (,@= limit (:: sample top)) - (order.<= ,@&order limit (:: sample bottom))))) + (and (,\= limit (:: sample top)) + (order.<= ,\&order limit (:: sample bottom))))) (def: #export (touches? reference sample) (All [a] (-> (Interval a) (Interval a) Bit)) @@ -128,47 +128,47 @@ (template [<name> <eq-side> <ineq> <ineq-side>] [(def: #export (<name> reference sample) (All [a] (-> (Interval a) (Interval a) Bit)) - (let [(^open ",@.") reference] - (and (,@= (:: reference <eq-side>) + (let [(^open ",\.") reference] + (and (,\= (:: reference <eq-side>) (:: sample <eq-side>)) - (<ineq> ,@&order + (<ineq> ,\&order (:: reference <ineq-side>) (:: sample <ineq-side>)))))] - [starts? ,@bottom order.<= ,@top] - [finishes? ,@top order.>= ,@bottom] + [starts? ,\bottom order.<= ,\top] + [finishes? ,\top order.>= ,\bottom] ) (structure: #export equivalence (All [a] (Equivalence (Interval a))) (def: (= reference sample) - (let [(^open ",@.") reference] - (and (,@= ,@bottom (:: sample bottom)) - (,@= ,@top (:: sample top)))))) + (let [(^open ",\.") reference] + (and (,\= ,\bottom (:: sample bottom)) + (,\= ,\top (:: sample top)))))) (def: #export (nested? reference sample) (All [a] (-> (Interval a) (Interval a) Bit)) (cond (or (singleton? sample) (and (inner? reference) (inner? sample)) (and (outer? reference) (outer? sample))) - (let [(^open ",@.") reference] - (and (order.>= ,@&order (:: reference bottom) (:: sample bottom)) - (order.<= ,@&order (:: reference top) (:: sample top)))) + (let [(^open ",\.") reference] + (and (order.>= ,\&order (:: reference bottom) (:: sample bottom)) + (order.<= ,\&order (:: reference top) (:: sample top)))) (or (singleton? reference) (and (inner? reference) (outer? sample))) #0 ## (and (outer? reference) (inner? sample)) - (let [(^open ",@.") reference] - (or (and (order.>= ,@&order (:: reference bottom) (:: sample bottom)) - (order.> ,@&order (:: reference bottom) (:: sample top))) - (and (,@< (:: reference top) (:: sample bottom)) - (order.<= ,@&order (:: reference top) (:: sample top))))) + (let [(^open ",\.") reference] + (or (and (order.>= ,\&order (:: reference bottom) (:: sample bottom)) + (order.> ,\&order (:: reference bottom) (:: sample top))) + (and (,\< (:: reference top) (:: sample bottom)) + (order.<= ,\&order (:: reference top) (:: sample top))))) )) (def: #export (overlaps? reference sample) (All [a] (-> (Interval a) (Interval a) Bit)) - (let [(^open ",@.") reference] + (let [(^open ",\.") reference] (and (not (:: ..equivalence = reference sample)) (cond (singleton? sample) #0 @@ -178,8 +178,8 @@ (or (and (inner? sample) (outer? reference)) (and (outer? sample) (inner? reference))) - (or (order.>= ,@&order (:: reference bottom) (:: sample top)) - (order.<= ,@&order (:: reference top) (:: sample bottom))) + (or (order.>= ,\&order (:: reference bottom) (:: sample top)) + (order.<= ,\&order (:: reference top) (:: sample bottom))) ## both inner (inner? sample) diff --git a/stdlib/source/lux/abstract/monad.lux b/stdlib/source/lux/abstract/monad.lux index 7cc5ae263..052191e66 100644 --- a/stdlib/source/lux/abstract/monad.lux +++ b/stdlib/source/lux/abstract/monad.lux @@ -5,7 +5,7 @@ [// [functor (#+ Functor)]]) -(def: (list@fold f init xs) +(def: (list\fold f init xs) (All [a b] (-> (-> b a a) a (List b) a)) (case xs @@ -13,9 +13,9 @@ init (#.Cons x xs') - (list@fold f (f x init) xs'))) + (list\fold f (f x init) xs'))) -(def: (list@size xs) +(def: (list\size xs) (All [a] (-> (List a) Nat)) (loop [counter 0 xs xs] @@ -29,7 +29,7 @@ (def: (reverse xs) (All [a] (-> (List a) (List a))) - (list@fold (function (_ head tail) (#.Cons head tail)) + (list\fold (function (_ head tail) (#.Cons head tail)) #.Nil xs)) @@ -69,14 +69,14 @@ _ #.None)) (#.Some [?name monad bindings body]) - (if (|> bindings list@size .int ("lux i64 %" +2) ("lux i64 =" +0)) + (if (|> bindings list\size .int ("lux i64 %" +2) ("lux i64 =" +0)) (let [[module short] (name-of ..do) gensym (: (-> Text Code) (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [location.dummy])) g!_ (gensym "_") g!map (gensym "map") g!join (gensym "join") - body' (list@fold (: (-> [Code Code] Code Code) + body' (list\fold (: (-> [Code Code] Code Code) (function (_ binding body') (let [[var value] binding] (case var @@ -118,55 +118,55 @@ (All [M a] (-> (Monad M) (List (M a)) (M (List a)))) - (let [(^open "!@.") monad] + (let [(^open "!\.") monad] (function (recur xs) (case xs #.Nil - (!@wrap #.Nil) + (!\wrap #.Nil) (#.Cons x xs') (|> x - (!@map (function (_ _x) - (!@map (|>> (#.Cons _x)) (recur xs')))) - !@join))))) + (!\map (function (_ _x) + (!\map (|>> (#.Cons _x)) (recur xs')))) + !\join))))) (def: #export (map monad f) {#.doc "Apply a monadic function to all values in a list."} (All [M a b] (-> (Monad M) (-> a (M b)) (List a) (M (List b)))) - (let [(^open "!@.") monad] + (let [(^open "!\.") monad] (function (recur xs) (case xs #.Nil - (!@wrap #.Nil) + (!\wrap #.Nil) (#.Cons x xs') (|> (f x) - (!@map (function (_ _x) - (!@map (|>> (#.Cons _x)) (recur xs')))) - !@join))))) + (!\map (function (_ _x) + (!\map (|>> (#.Cons _x)) (recur xs')))) + !\join))))) (def: #export (filter monad f) {#.doc "Filter the values in a list with a monadic function."} (All [! a b] (-> (Monad !) (-> a (! Bit)) (List a) (! (List a)))) - (let [(^open "!@.") monad] + (let [(^open "!\.") monad] (function (recur xs) (case xs #.Nil - (!@wrap #.Nil) + (!\wrap #.Nil) (#.Cons head xs') (|> (f head) - (!@map (function (_ verdict) - (!@map (function (_ tail) + (!\map (function (_ verdict) + (!\map (function (_ tail) (if verdict (#.Cons head tail) tail)) (recur xs')))) - !@join))))) + !\join))))) (def: #export (fold monad f init xs) {#.doc "Fold a list with a monadic function."} diff --git a/stdlib/source/lux/control/region.lux b/stdlib/source/lux/control/region.lux index f1bfd2c21..3bc17e7f9 100644 --- a/stdlib/source/lux/control/region.lux +++ b/stdlib/source/lux/control/region.lux @@ -14,12 +14,12 @@ [// ["." exception (#+ Exception exception:)]]) -(type: (Cleaner r m) - (-> r (m (Try Any)))) +(type: (Cleaner r !) + (-> r (! (Try Any)))) -(type: #export (Region r m a) - (-> [r (List (Cleaner r m))] - (m [(List (Cleaner r m)) +(type: #export (Region r ! a) + (-> [r (List (Cleaner r !))] + (! [(List (Cleaner r !)) (Try a)]))) (def: separator @@ -47,36 +47,36 @@ (#try.Success _) output - (#try.Failure error|clean-up) - (exception.throw ..clean-up-error [error|clean-up output]))) + (#try.Failure error) + (exception.throw ..clean-up-error [error output]))) -(def: #export (run Monad<m> computation) - (All [m a] - (-> (Monad m) (All [r] (Region r m a)) - (m (Try a)))) - (do {! Monad<m>} +(def: #export (run monad computation) + (All [! a] + (-> (Monad !) (All [r] (Region r ! a)) + (! (Try a)))) + (do {! monad} [[cleaners output] (computation [[] (list)]) results (monad.map ! (function (_ cleaner) (cleaner [])) cleaners)] (wrap (list\fold combine-outcomes output results)))) -(def: #export (acquire Monad<m> cleaner value) - (All [m a] (-> (Monad m) (-> a (m (Try Any))) a - (All [r] (Region r m a)))) +(def: #export (acquire monad cleaner value) + (All [! a] (-> (Monad !) (-> a (! (Try Any))) a + (All [r] (Region r ! a)))) (function (_ [region cleaners]) - (:: Monad<m> wrap [(#.Cons (function (_ region) (cleaner value)) - cleaners) - (#try.Success value)]))) + (:: monad wrap [(#.Cons (function (_ region) (cleaner value)) + cleaners) + (#try.Success value)]))) -(structure: #export (functor Functor<m>) - (All [m] - (-> (Functor m) - (All [r] (Functor (Region r m))))) +(structure: #export (functor super) + (All [!] + (-> (Functor !) + (All [r] (Functor (Region r !))))) (def: (map f) (function (_ fa) (function (_ region+cleaners) - (:: Functor<m> map + (:: super map (function (_ [cleaners' temp]) [cleaners' (case temp (#try.Success value) @@ -86,17 +86,17 @@ (#try.Failure error))]) (fa region+cleaners)))))) -(structure: #export (apply Monad<m>) - (All [m] - (-> (Monad m) - (All [r] (Apply (Region r m))))) +(structure: #export (apply super) + (All [!] + (-> (Monad !) + (All [r] (Apply (Region r !))))) (def: &functor - (..functor (get@ #monad.&functor Monad<m>))) + (..functor (get@ #monad.&functor super))) (def: (apply ff fa) (function (_ [region cleaners]) - (do Monad<m> + (do super [[cleaners ef] (ff [region cleaners]) [cleaners ea] (fa [region cleaners])] (case ef @@ -111,21 +111,21 @@ (#try.Failure error) (wrap [cleaners (#try.Failure error)])))))) -(structure: #export (monad Monad<m>) - (All [m] - (-> (Monad m) - (All [r] (Monad (Region r m))))) +(structure: #export (monad super) + (All [!] + (-> (Monad !) + (All [r] (Monad (Region r !))))) (def: &functor - (..functor (get@ #monad.&functor Monad<m>))) + (..functor (get@ #monad.&functor super))) (def: (wrap value) (function (_ [region cleaners]) - (:: Monad<m> wrap [cleaners (#try.Success value)]))) + (:: super wrap [cleaners (#try.Success value)]))) (def: (join ffa) (function (_ [region cleaners]) - (do Monad<m> + (do super [[cleaners efa] (ffa [region cleaners])] (case efa (#try.Success fa) @@ -134,24 +134,24 @@ (#try.Failure error) (wrap [cleaners (#try.Failure error)])))))) -(def: #export (fail Monad<m> error) - (All [m a] - (-> (Monad m) Text - (All [r] (Region r m a)))) +(def: #export (fail monad error) + (All [! a] + (-> (Monad !) Text + (All [r] (Region r ! a)))) (function (_ [region cleaners]) - (:: Monad<m> wrap [cleaners (#try.Failure error)]))) - -(def: #export (throw Monad<m> exception message) - (All [m e a] - (-> (Monad m) (Exception e) e - (All [r] (Region r m a)))) - (fail Monad<m> (exception.construct exception message))) - -(def: #export (lift Monad<m> operation) - (All [m a] - (-> (Monad m) (m a) - (All [r] (Region r m a)))) + (:: monad wrap [cleaners (#try.Failure error)]))) + +(def: #export (throw monad exception message) + (All [! e a] + (-> (Monad !) (Exception e) e + (All [r] (Region r ! a)))) + (fail monad (exception.construct exception message))) + +(def: #export (lift monad operation) + (All [! a] + (-> (Monad !) (! a) + (All [r] (Region r ! a)))) (function (_ [region cleaners]) - (do Monad<m> + (do monad [output operation] (wrap [cleaners (#try.Success output)])))) diff --git a/stdlib/source/lux/control/try.lux b/stdlib/source/lux/control/try.lux index 8f710b0f0..1a2f5cbe0 100644 --- a/stdlib/source/lux/control/try.lux +++ b/stdlib/source/lux/control/try.lux @@ -80,13 +80,13 @@ (All [M a] (-> (Monad M) (-> (M a) (M (Try a))))) (:: monad map (:: ..monad wrap))) -(structure: #export (equivalence (^open "_@.")) +(structure: #export (equivalence (^open "_\.")) (All [a] (-> (Equivalence a) (Equivalence (Try a)))) (def: (= reference sample) (case [reference sample] [(#Success reference) (#Success sample)] - (_@= reference sample) + (_\= reference sample) [(#Failure reference) (#Failure sample)] ("lux text =" reference sample) @@ -128,8 +128,7 @@ (#Success value) #.None - (let [[module short] (name-of ..from-maybe)] - (#Failure ($_ "lux text concat" short " @ " module))))) + (#Failure (("lux in-module" "lux" .name\encode) (name-of ..from-maybe))))) (macro: #export (default tokens compiler) {#.doc (doc "Allows you to provide a default value that will be used" diff --git a/stdlib/source/lux/data/format/css.lux b/stdlib/source/lux/data/format/css.lux index aef22816a..31daa7462 100644 --- a/stdlib/source/lux/data/format/css.lux +++ b/stdlib/source/lux/data/format/css.lux @@ -8,7 +8,7 @@ ["%" format (#+ format)] ["." encoding (#+ Encoding)]] [collection - ["." list ("#;." functor)]]] + ["." list ("#\." functor)]]] [type abstract] [world @@ -57,7 +57,7 @@ ["font-style" (|> font (get@ #/font.style) (maybe.default /value.normal-style) /value.value)] ["font-weight" (|> font (get@ #/font.weight) (maybe.default /value.normal-weight) /value.value)] with-unicode) - (list;map (function (_ [property value]) + (list\map (function (_ [property value]) (format property ": " value ";"))) (text.join-with /style.separator) (text.enclose ["{" "}"]) @@ -85,7 +85,7 @@ (-> (Value Animation) (List Frame) (CSS Special)) (:abstraction (format "@keyframes " (/value.value animation) " {" (|> frames - (list;map (function (_ frame) + (list\map (function (_ frame) (format (/value.percentage (get@ #when frame)) " {" (/style.inline (get@ #what frame)) "}"))) @@ -105,7 +105,7 @@ (|> css :representation (text.split-all-with ..css-separator) - (list;map (|>> (format (/selector.selector (|> selector (combinator (/selector.tag ""))))))) + (list\map (|>> (format (/selector.selector (|> selector (combinator (/selector.tag ""))))))) (text.join-with ..css-separator) :abstraction)) diff --git a/stdlib/source/lux/data/format/css/value.lux b/stdlib/source/lux/data/format/css/value.lux index d6aee7813..4bce35214 100644 --- a/stdlib/source/lux/data/format/css/value.lux +++ b/stdlib/source/lux/data/format/css/value.lux @@ -15,7 +15,7 @@ ["." text ["%" format (#+ Format format)]] [collection - ["." list ("#;." functor)]]] + ["." list ("#\." functor)]]] [type abstract] [macro @@ -799,7 +799,7 @@ (def: #export (cubic-bezier p0 p1 p2 p3) (-> Frac Frac Frac Frac (Value Timing)) (|> (list p0 p1 p2 p3) - (list;map %number) + (list\map %number) (..apply "cubic-bezier"))) (template [<name> <brand>] @@ -959,7 +959,7 @@ (let [[now after] next] (..apply <function> (list& (:representation Angle angle) (with-hint now) - (list;map with-hint after)))))] + (list\map with-hint after)))))] [linear-gradient "linear-gradient"] [repeating-linear-gradient "repeating-linear-gradient"] @@ -1084,7 +1084,7 @@ [now after] next] (..apply <function> (list& (..shape shape) (with-hint now) - (list;map with-hint after)))))] + (list\map with-hint after)))))] [radial-gradient "radial-gradient"] [repeating-radial-gradient "repeating-radial-gradient"] @@ -1156,7 +1156,7 @@ (case options (#.Cons _) (|> options - (list;map ..font-name) + (list\map ..font-name) (text.join-with ",") (:abstraction Value)) @@ -1195,7 +1195,7 @@ (-> (List (List (Maybe (Value Grid)))) (Value Grid-Template)) (let [empty (: (Value Grid) (:abstraction "."))] - (|>> (list;map (|>> (list;map (|>> (maybe.default empty) + (|>> (list\map (|>> (list\map (|>> (maybe.default empty) :representation)) (text.join-with ..grid-column-separator) (text.enclose ["'" "'"]))) @@ -1232,7 +1232,7 @@ (def: #export (quotes [left0 right0] [left1 right1]) (-> [Quote Quote] [Quote Quote] (Value Quotes)) (|> (list left0 right0 left1 right1) - (list;map (|>> ..quote-text %.text)) + (list\map (|>> ..quote-text %.text)) (text.join-with ..quote-separator) :abstraction)) @@ -1242,7 +1242,7 @@ [Frac Frac] (Value Transform)) (|> (list a b c d tx ty) - (list;map %number) + (list\map %number) (..apply "matrix"))) (def: #export (matrix-3d [a0 b0 c0 d0] [a1 b1 c1 d1] [a2 b2 c2 d2] [a3 b3 c3 d3]) @@ -1252,14 +1252,14 @@ [Frac Frac Frac Frac] (Value Transform)) (|> (list a0 b0 c0 d0 a1 b1 c1 d1 a2 b2 c2 d2 a3 b3 c3 d3) - (list;map %number) + (list\map %number) (..apply "matrix3d"))) (template [<name> <function> <input-types> <input-values>] [(`` (def: #export (<name> [(~~ (template.splice <input-values>))]) (-> [(~~ (template.splice <input-types>))] (Value Transform)) (|> (list (~~ (template.splice <input-values>))) - (list;map %number) + (list\map %number) (..apply <function>))))] [translate-2d "translate" [Frac Frac] [x y]] @@ -1281,7 +1281,7 @@ [(`` (def: #export (<name> [(~~ (template.splice <input-values>))]) (-> [(~~ (template.splice <input-types>))] (Value Transform)) (|> (list (~~ (template.splice <input-values>))) - (list;map ..angle) + (list\map ..angle) (..apply <function>))))] [rotate-2d "rotate" [Angle] [angle]] diff --git a/stdlib/source/lux/data/format/markdown.lux b/stdlib/source/lux/data/format/markdown.lux index a63cd7e72..5cdc68865 100644 --- a/stdlib/source/lux/data/format/markdown.lux +++ b/stdlib/source/lux/data/format/markdown.lux @@ -4,7 +4,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#;." functor)]]] + ["." list ("#\." functor)]]] [type abstract] [world @@ -85,7 +85,7 @@ (def: (prefix with) (-> Text (-> Text Text)) (|>> (text.split-all-with text.new-line) - (list;map (function (_ line) + (list\map (function (_ line) (if (text.empty? line) line (format with line)))) @@ -105,7 +105,7 @@ (-> (List [(Markdown Span) (Maybe (Markdown Block))]) (Markdown Block)) (|>> list.enumeration - (list;map (function (_ [idx [summary detail]]) + (list\map (function (_ [idx [summary detail]]) (format (%.nat (inc idx)) ". " (:representation summary) text.new-line (case detail (#.Some detail) @@ -119,7 +119,7 @@ (def: #export bullet-list (-> (List [(Markdown Span) (Maybe (Markdown Block))]) (Markdown Block)) - (|>> (list;map (function (_ [summary detail]) + (|>> (list\map (function (_ [summary detail]) (format "*. " (:representation summary) text.new-line (case detail (#.Some detail) diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux index db0293413..87be68d66 100644 --- a/stdlib/source/lux/data/lazy.lux +++ b/stdlib/source/lux/data/lazy.lux @@ -41,11 +41,11 @@ (with-gensyms [g!_] (wrap (list (` ((~! freeze') (function ((~ g!_) (~ g!_)) (~ expr)))))))) -(structure: #export (equivalence (^open "_@.")) +(structure: #export (equivalence (^open "_\.")) (All [a] (-> (Equivalence a) (Equivalence (Lazy a)))) (def: (= left right) - (_@= (..thaw left) (..thaw right)))) + (_\= (..thaw left) (..thaw right)))) (structure: #export functor (Functor Lazy) diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index 114398a9a..306815880 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/data/number/complex.lux @@ -6,26 +6,25 @@ [codec (#+ Codec)] ["M" monad (#+ Monad do)]] [control - ["p" parser - ["s" code (#+ Parser)]]] + ["<>" parser + ["<.>" code (#+ Parser)]]] [data ["." maybe] [number ["n" nat] - ["." int] - ["f" frac]] - ["." text ("#;." monoid)] + ["f" frac] + ["." int]] [collection - ["." list ("#;." functor)]]] + ["." list ("#\." functor)]]] [macro - ["." code] - [syntax (#+ syntax:)]]]) + [syntax (#+ syntax:)] + ["." code]]]) (type: #export Complex {#real Frac #imaginary Frac}) -(syntax: #export (complex real {?imaginary (p.maybe s.any)}) +(syntax: #export (complex real {?imaginary (<>.maybe <code>.any)}) {#.doc (doc "Complex literals." (complex real imaginary) "The imaginary part can be omitted if it's 0." @@ -34,11 +33,17 @@ #..imaginary (~ (maybe.default (' +0.0) ?imaginary))})))) -(def: #export i Complex (complex +0.0 +1.0)) +(def: #export i + (..complex +0.0 +1.0)) -(def: #export one Complex (complex +1.0 +0.0)) +(def: #export +one + (..complex +1.0 +0.0)) -(def: #export zero Complex (complex +0.0 +0.0)) +(def: #export -one + (..complex -1.0 +0.0)) + +(def: #export zero + (..complex +0.0 +0.0)) (def: #export (not-a-number? complex) (or (f.not-a-number? (get@ #real complex)) @@ -63,7 +68,9 @@ [- f.-] ) -(structure: #export equivalence (Equivalence Complex) +(structure: #export equivalence + (Equivalence Complex) + (def: = ..=)) (template [<name> <transform>] @@ -178,21 +185,20 @@ #imaginary (f./ d (math.sin i2))})) (def: #export (abs subject) - (-> Complex Complex) + (-> Complex Frac) (let [(^slots [#real #imaginary]) subject] - (complex (if (f.< (f.abs imaginary) - (f.abs real)) - (if (f.= +0.0 imaginary) - (f.abs real) - (let [q (f./ imaginary real)] - (f.* (math.pow +0.5 (f.+ +1.0 (f.* q q))) - (f.abs imaginary)))) - (if (f.= +0.0 real) - (f.abs imaginary) - (let [q (f./ real imaginary)] - (f.* (math.pow +0.5 (f.+ +1.0 (f.* q q))) - (f.abs real)))) - )))) + (if (f.< (f.abs imaginary) + (f.abs real)) + (if (f.= +0.0 imaginary) + (f.abs real) + (let [q (f./ imaginary real)] + (f.* (math.pow +0.5 (f.+ +1.0 (f.* q q))) + (f.abs imaginary)))) + (if (f.= +0.0 real) + (f.abs imaginary) + (let [q (f./ real imaginary)] + (f.* (math.pow +0.5 (f.+ +1.0 (f.* q q))) + (f.abs real))))))) (def: #export (exp subject) (-> Complex Complex) @@ -204,7 +210,7 @@ (def: #export (log subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (|> subject ..abs (get@ #real) math.log) + {#real (|> subject ..abs math.log) #imaginary (math.atan2 real imaginary)})) (template [<name> <type> <op>] @@ -220,20 +226,20 @@ (-> Frac Frac Frac) (f.* (f.signum sign) magnitude)) -(def: #export (root2 (^@ input (^slots [#real #imaginary]))) +(def: #export (root/2 (^@ input (^slots [#real #imaginary]))) (-> Complex Complex) - (let [t (|> input ..abs (get@ #real) (f.+ (f.abs real)) (f./ +2.0) (math.pow +0.5))] + (let [t (|> input ..abs (f.+ (f.abs real)) (f./ +2.0) (math.pow +0.5))] (if (f.>= +0.0 real) {#real t #imaginary (f./ (f.* +2.0 t) imaginary)} {#real (f./ (f.* +2.0 t) (f.abs imaginary)) - #imaginary (f.* t (copy-sign imaginary +1.0))}))) + #imaginary (f.* t (..copy-sign imaginary +1.0))}))) -(def: #export (root2-1z input) +(def: (root/2-1z input) (-> Complex Complex) - (|> (complex +1.0) (- (* input input)) root2)) + (|> (complex +1.0) (- (* input input)) ..root/2)) (def: #export (reciprocal (^slots [#real #imaginary])) (-> Complex Complex) @@ -253,14 +259,14 @@ (def: #export (acos input) (-> Complex Complex) (|> input - (+ (|> input root2-1z (* i))) + (+ (|> input ..root/2-1z (* i))) log (* (negate i)))) (def: #export (asin input) (-> Complex Complex) (|> input - root2-1z + ..root/2-1z (+ (* i input)) log (* (negate i)))) @@ -282,11 +288,11 @@ (if (n.= 0 nth) (list) (let [r-nth (|> nth .int int.frac) - nth-root-of-abs (|> input abs (get@ #real) (math.pow (f./ r-nth +1.0))) - nth-phi (|> input argument (f./ r-nth)) + nth-root-of-abs (|> input ..abs (math.pow (f./ r-nth +1.0))) + nth-phi (|> input ..argument (f./ r-nth)) slice (|> math.pi (f.* +2.0) (f./ r-nth))] (|> (list.indices nth) - (list;map (function (_ nth') + (list\map (function (_ nth') (let [inner (|> nth' .int int.frac (f.* slice) (f.+ nth-phi)) @@ -296,3 +302,12 @@ (math.sin inner))] {#real real #imaginary imaginary}))))))) + +(def: #export (within? margin-of-error standard value) + (-> Frac Complex Complex Bit) + (and (f.within? margin-of-error + (get@ #..real standard) + (get@ #..real value)) + (f.within? margin-of-error + (get@ #..imaginary standard) + (get@ #..imaginary value)))) diff --git a/stdlib/source/lux/data/number/frac.lux b/stdlib/source/lux/data/number/frac.lux index ac6ac4ea8..13f085310 100644 --- a/stdlib/source/lux/data/number/frac.lux +++ b/stdlib/source/lux/data/number/frac.lux @@ -410,3 +410,10 @@ (def: &equivalence ..equivalence) (def: hash ..to-bits)) + +(def: #export (within? margin-of-error standard value) + (-> Frac Frac Frac Bit) + (|> value + (..- standard) + ..abs + (..< margin-of-error))) diff --git a/stdlib/source/lux/data/sum.lux b/stdlib/source/lux/data/sum.lux index 6a048153c..4d76b6039 100644 --- a/stdlib/source/lux/data/sum.lux +++ b/stdlib/source/lux/data/sum.lux @@ -60,34 +60,34 @@ (0 #0 x') [(#.Cons x' lefts) rights] (0 #1 x') [lefts (#.Cons x' rights)])))) -(structure: #export (equivalence l@= r@=) +(structure: #export (equivalence l\= r\=) (All [l r] (-> (Equivalence l) (Equivalence r) (Equivalence (| l r)))) (def: (= reference sample) (case [reference sample] [(#.Left reference) (#.Left sample)] - (l@= reference sample) + (l\= reference sample) [(#.Right reference) (#.Right sample)] - (r@= reference sample) + (r\= reference sample) _ false))) -(structure: #export (hash (^open "l@.") (^open "r@.")) +(structure: #export (hash (^open "l\.") (^open "r\.")) (All [l r] (-> (Hash l) (Hash r) (Hash (| l r)))) - (def: &equivalence (..equivalence l@= r@=)) + (def: &equivalence (..equivalence l\= r\=)) (def: (hash value) (case value (#.Left value) - (l@hash value) + (l\hash value) (#.Right value) (.nat ("lux i64 *" (.int 2) - (.int (r@hash value))))))) + (.int (r\hash value))))))) diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index ac6a442f8..51b9300e9 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -64,6 +64,9 @@ [ceil "ceil"] [floor "floor"] + + [root/2 "sqrt"] + [root/3 "cbrt"] ) (def: #export (pow param subject) (-> Frac Frac Frac) @@ -90,6 +93,9 @@ [ceil "Math.ceil"] [floor "Math.floor"] + + [root/2 "Math.sqrt"] + [root/3 "Math.cbrt"] ) (def: #export (pow param subject) (-> Frac Frac Frac) diff --git a/stdlib/source/lux/math/infix.lux b/stdlib/source/lux/math/infix.lux index 20d1e061a..55b82d715 100644 --- a/stdlib/source/lux/math/infix.lux +++ b/stdlib/source/lux/math/infix.lux @@ -3,7 +3,7 @@ [abstract monad] [control - ["p" parser ("#;." functor) + ["p" parser ("#\." functor) ["s" code (#+ Parser)]]] [data ["." product] @@ -11,7 +11,7 @@ ["n" nat] ["i" int]] [collection - ["." list ("#;." fold)]]] + ["." list ("#\." fold)]]] [macro [syntax (#+ syntax:)] ["." code]]]) @@ -27,14 +27,14 @@ (<| p.rec (function (_ infix^)) ($_ p.or ($_ p.either - (p;map code.bit s.bit) - (p;map code.nat s.nat) - (p;map code.int s.int) - (p;map code.rev s.rev) - (p;map code.frac s.frac) - (p;map code.text s.text) - (p;map code.identifier s.identifier) - (p;map code.tag s.tag)) + (p\map code.bit s.bit) + (p\map code.nat s.nat) + (p\map code.int s.int) + (p\map code.rev s.rev) + (p\map code.frac s.frac) + (p\map code.text s.text) + (p\map code.identifier s.identifier) + (p\map code.tag s.tag)) (s.form (p.many s.any)) (s.tuple (p.and s.any infix^)) (s.tuple ($_ p.either @@ -44,7 +44,7 @@ init-op s.any init-param infix^ steps (p.some (p.and s.any infix^))] - (wrap (product.right (list;fold (function (_ [op param] [subject [_subject _op _param]]) + (wrap (product.right (list\fold (function (_ [op param] [subject [_subject _op _param]]) [param [(#Binary _subject _op _param) (` and) (#Binary subject op param)]]) @@ -55,7 +55,7 @@ init-op s.any init-param infix^ steps (p.some (p.and s.any infix^))] - (wrap (list;fold (function (_ [op param] [_subject _op _param]) + (wrap (list\fold (function (_ [op param] [_subject _op _param]) [(#Binary _subject _op _param) op param]) [init-subject init-op init-param] steps))) diff --git a/stdlib/source/lux/meta/location.lux b/stdlib/source/lux/meta/location.lux index 351ace90c..75acdf755 100644 --- a/stdlib/source/lux/meta/location.lux +++ b/stdlib/source/lux/meta/location.lux @@ -25,6 +25,6 @@ [file line column] value] ($_ "lux text concat" "@" - (("lux in-module" "lux" .text@encode) file) separator - (("lux in-module" "lux" .nat@encode) line) separator - (("lux in-module" "lux" .nat@encode) column)))) + (("lux in-module" "lux" .text\encode) file) separator + (("lux in-module" "lux" .nat\encode) line) separator + (("lux in-module" "lux" .nat\encode) column)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/bundle.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/bundle.lux index 4816993f3..1004c55f8 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/bundle.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/bundle.lux @@ -6,7 +6,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#;." functor)] + ["." list ("#\." functor)] ["." dictionary (#+ Dictionary)]]]] [// (#+ Handler Bundle)]) @@ -24,5 +24,5 @@ (All [s i o] (-> Text (-> (Bundle s i o) (Bundle s i o)))) (|>> dictionary.entries - (list;map (function (_ [key val]) [(format prefix " " key) val])) + (list\map (function (_ [key val]) [(format prefix " " key) val])) (dictionary.from-list text.hash))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux index 1d99c2736..e74488d08 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux @@ -19,7 +19,7 @@ [// ["." generation] [/// - ["#" phase ("operation@." monad)] + ["#" phase ("operation\." monad)] [reference ["." variable (#+ Register Variable)]] [meta @@ -53,7 +53,7 @@ (-> Archive Variable (Operation (Bytecode Any))) (case variable (#variable.Local variable) - (operation@wrap (_.aload variable)) + (operation\wrap (_.aload variable)) (#variable.Foreign variable) (..foreign archive variable))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux index 950b3b74b..d6d33999b 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux @@ -6,7 +6,7 @@ [runtime (#+ Phase)] ["." primitive] ["." structure] - ["." reference ("#;." system)] + ["." reference ("#\." system)] ["." function] ["." case] ["." loop] @@ -34,7 +34,7 @@ (structure.tuple generate members) (#synthesis.Reference value) - (reference;reference value) + (reference\reference value) (^ (synthesis.branch/case case)) (case.case generate case) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux index 782838b92..f7f55e260 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux @@ -12,7 +12,7 @@ [number (#+ hex) ["f" frac]] [collection - ["." list ("#;." functor)] + ["." list ("#\." functor)] ["dict" dictionary (#+ Dictionary)]]] ["." macro (#+ with-gensyms) ["." code] @@ -48,7 +48,7 @@ (^ (list (~+ g!input+))) (do /////.monad [(~+ (|> g!input+ - (list;map (function (_ g!input) + (list\map (function (_ g!input) (list g!input (` ((~ g!phase) (~ g!input)))))) list.concat))] ((~' wrap) ((~ g!extension) [(~+ g!input+)]))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux index 2bf25cec9..7206c23d5 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux @@ -9,7 +9,7 @@ [text ["%" format (#+ format)]] [collection - ["." list ("#;." functor)]]] + ["." list ("#\." functor)]]] [target ["_" scheme (#+ Expression Computation Var)]]] ["." // #_ @@ -18,7 +18,7 @@ ["#." case] ["#/" // ["#." reference] - ["#/" // ("#;." monad) + ["#/" // ("#\." monad) ["#/" // #_ [reference (#+ Register Variable)] [arity (#+ Arity)] @@ -37,7 +37,7 @@ (def: (with-closure function-name inits function-definition) (-> Text (List Expression) Computation (Operation Computation)) - (////;wrap + (////\wrap (case inits #.Nil function-definition @@ -46,7 +46,7 @@ (let [@closure (_.var (format function-name "___CLOSURE"))] (_.letrec (list [@closure (_.lambda [(|> (list.enumeration inits) - (list;map (|>> product.left ..capture))) + (list\map (|>> product.left ..capture))) #.None] function-definition)]) (_.apply/* @closure inits)))))) @@ -78,7 +78,7 @@ (<| (_.if (|> @num-args (_.=/2 arityO)) (<| (_.let (list [(//case.register 0) @function])) (_.let-values (list [[(|> (list.indices arity) - (list;map ..input)) + (list\map ..input)) #.None] (_.apply/2 (_.global "apply") (_.global "values") @curried)])) bodyO)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux index b4a9943ec..053a32c15 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux @@ -8,7 +8,7 @@ [number ["n" nat]] [collection - ["." list ("#;." functor)]]] + ["." list ("#\." functor)]]] [target ["_" scheme (#+ Computation Var)]]] ["." // #_ @@ -29,7 +29,7 @@ (generate bodyS))] (wrap (_.letrec (list [@scope (_.lambda [(|> initsS+ list.enumeration - (list;map (|>> product.left (n.+ start) //case.register))) + (list\map (|>> product.left (n.+ start) //case.register))) #.None] bodyO)]) (_.apply/* @scope initsO+))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux index 7c3c3975b..45dcd3eb2 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux @@ -4,14 +4,14 @@ [monad (#+ do)]] [control ["." function] - ["p" parser ("#;." monad) + ["p" parser ("#\." monad) ["s" code (#+ Parser)]]] [data [number (#+ hex)] [text ["%" format (#+ format)]] [collection - ["." list ("#;." monad)]]] + ["." list ("#\." monad)]]] [macro ["." code] [syntax (#+ syntax:)]] @@ -72,7 +72,7 @@ (def: declaration (Parser [Text (List Text)]) - (p.either (p.and s.local-identifier (p;wrap (list))) + (p.either (p.and s.local-identifier (p\wrap (list))) (s.form (p.and s.local-identifier (p.some s.local-identifier))))) (syntax: (runtime: {[name args] declaration} @@ -80,8 +80,8 @@ (let [implementation (code.local-identifier (format "@@" name)) runtime (format prefix "__" (/////name.normalize name)) @runtime (` (_.var (~ (code.text runtime)))) - argsC+ (list;map code.local-identifier args) - argsLC+ (list;map (|>> /////name.normalize (format "LRV__") code.text (~) (_.var) (`)) + argsC+ (list\map code.local-identifier args) + argsLC+ (list\map (|>> /////name.normalize (format "LRV__") code.text (~) (_.var) (`)) args) declaration (` ((~ (code.local-identifier name)) (~+ argsC+))) @@ -103,9 +103,9 @@ _ (` (let [(~+ (|> (list.zip/2 argsC+ argsLC+) - (list;map (function (_ [left right]) + (list\map (function (_ [left right]) (list left right))) - list;join))] + list\join))] (_.define-function (~ @runtime) [(list (~+ argsLC+)) #.None] (~ definition)))))))))))) @@ -126,10 +126,10 @@ (syntax: #export (with-vars {vars (s.tuple (p.many s.local-identifier))} body) (wrap (list (` (let [(~+ (|> vars - (list;map (function (_ var) + (list\map (function (_ var) (list (code.local-identifier var) (` (_.var (~ (code.text (format "LRV__" (/////name.normalize var))))))))) - list;join))] + list\join))] (~ body)))))) (runtime: (lux//try op) diff --git a/stdlib/source/lux/tool/interpreter.lux b/stdlib/source/lux/tool/interpreter.lux index efff99be8..a8c2fe0b6 100644 --- a/stdlib/source/lux/tool/interpreter.lux +++ b/stdlib/source/lux/tool/interpreter.lux @@ -5,7 +5,7 @@ ["." try (#+ Try)] ["ex" exception (#+ exception:)]] [data - ["." text ("#;." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]]] [type (#+ :share) ["." check]] @@ -205,7 +205,7 @@ (:: Console<!> write "> ")) line (:: Console<!> read-line)] (if (and (not multi-line?) - (text;= ..exit-command line)) + (text\= ..exit-command line)) (:: Console<!> write ..farewell-message) (case (read-eval-print (update@ #source (add-line line) context)) (#try.Success [context' representation]) diff --git a/stdlib/source/lux/world/db/jdbc.lux b/stdlib/source/lux/world/db/jdbc.lux index ab0c0f03f..a442fda28 100644 --- a/stdlib/source/lux/world/db/jdbc.lux +++ b/stdlib/source/lux/world/db/jdbc.lux @@ -7,15 +7,13 @@ ["." try (#+ Try)] ["ex" exception] [concurrency - ["." promise (#+ Promise) ("#;." monad)]] + ["." promise (#+ Promise) ("#\." monad)]] [security ["!" capability (#+ capability:)]]] [data ["." product] [text - ["%" format (#+ format)]] - [collection - ["." list ("#;." fold)]]] + ["%" format (#+ format)]]] ["." io (#+ IO)] [world [net (#+ URL)]] @@ -173,5 +171,5 @@ (do (try.with promise.monad) [db (promise.future (..connect creds)) result (action (..async db)) - _ (promise;wrap (io.run (!.use (:: db close) [])))] + _ (promise\wrap (io.run (!.use (:: db close) [])))] (wrap result))) diff --git a/stdlib/source/lux/world/db/jdbc/input.lux b/stdlib/source/lux/world/db/jdbc/input.lux index 065327f06..625af00ba 100644 --- a/stdlib/source/lux/world/db/jdbc/input.lux +++ b/stdlib/source/lux/world/db/jdbc/input.lux @@ -4,9 +4,6 @@ [functor (#+ Contravariant)] [monad (#+ Monad do)] ["." try (#+ Try)]] - [data - [collection - ["." list ("#;." fold)]]] [time ["." instant (#+ Instant)]] ["." io (#+ IO)] diff --git a/stdlib/source/lux/world/db/sql.lux b/stdlib/source/lux/world/db/sql.lux index 2d2c55c6a..4c9bce9b2 100644 --- a/stdlib/source/lux/world/db/sql.lux +++ b/stdlib/source/lux/world/db/sql.lux @@ -5,10 +5,10 @@ [data [number ["i" int]] - ["." text ("#;." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection - ["." list ("#;." functor)]]] + ["." list ("#\." functor)]]] [type abstract]]) @@ -107,7 +107,7 @@ (def: enumerate (-> (List (SQL Any)) Text) - (|>> (list;map (|>> :representation)) + (|>> (list\map (|>> :representation)) (text.join-with ", "))) ## Value @@ -214,8 +214,8 @@ _ (|> columns - (list;map (.function (_ [column alias]) - (if (text;= ..no-alias alias) + (list\map (.function (_ [column alias]) + (if (text\= ..no-alias alias) (:representation column) (format (:representation column) " AS " alias)))) (text.join-with ", "))) @@ -295,7 +295,7 @@ (format (:representation query) " ORDER BY " (|> pairs - (list;map (.function (_ [value order]) + (list\map (.function (_ [value order]) (format (:representation value) " " (:representation order)))) (text.join-with ", ")))))) @@ -322,7 +322,7 @@ (..parenthesize (..enumerate columns)) " VALUES " (|> rows - (list;map (|>> ..enumerate ..parenthesize)) + (list\map (|>> ..enumerate ..parenthesize)) (text.join-with ", ")) ))) @@ -335,7 +335,7 @@ _ (format " SET " (|> pairs - (list;map (.function (_ [column value]) + (list\map (.function (_ [column value]) (format (:representation column) "=" (:representation value)))) (text.join-with ", "))))))) diff --git a/stdlib/source/lux/world/file/watch.lux b/stdlib/source/lux/world/file/watch.lux new file mode 100644 index 000000000..b33cdaa6e --- /dev/null +++ b/stdlib/source/lux/world/file/watch.lux @@ -0,0 +1,457 @@ +(.module: + [lux #* + ["@" target] + ["." host (#+ import:)] + [abstract + [predicate (#+ Predicate)] + ["." monad (#+ do)]] + [control + ["." io (#+ IO)] + ["." try (#+ Try)] + ["." exception (#+ exception:)] + [concurrency + ["." promise (#+ Promise)] + ["." stm (#+ STM Var)]] + [security + ["!" capability]]] + [data + ["." product] + ["." maybe] + ["." text + ["%" format (#+ format)]] + [number + ["n" nat]] + [collection + ["." dictionary (#+ Dictionary)] + ["." list ("#\." functor monoid fold)] + ["." set] + ["." array]]] + [time + ["." instant (#+ Instant) ("#\." equivalence)]] + [type + [abstract (#+ abstract: :representation :abstraction)]]] + ["." //]) + +(abstract: #export Concern + {#create Bit + #modify Bit + #delete Bit} + + (def: none + Concern + (:abstraction + {#create false + #modify false + #delete false})) + + (template [<concern> <predicate> <event> <create> <modify> <delete>] + [(def: #export <concern> + Concern + (:abstraction + {#create <create> + #modify <modify> + #delete <delete>})) + + (def: #export <predicate> + (Predicate Concern) + (|>> :representation (get@ <event>)))] + + [creation creation? #create + true false false] + [modification modification? #modify + false true false] + [deletion deletion? #delete + false false true] + ) + + (def: #export (also left right) + (-> Concern Concern Concern) + (:abstraction + {#create (or (..creation? left) (..creation? right)) + #modify (or (..modification? left) (..modification? right)) + #delete (or (..deletion? left) (..deletion? right))})) + + (def: #export all + Concern + ($_ ..also + ..creation + ..modification + ..deletion + )) + ) + +(signature: #export (Watcher !) + (: (-> Concern //.Path (! (Try Any))) + start) + (: (-> //.Path (! (Try Concern))) + concern) + (: (-> //.Path (! (Try Concern))) + stop) + (: (-> [] (! (Try (List [//.Path Concern])))) + poll)) + +(exception: #export (not-being-watched {path //.Path}) + (exception.report + ["Path" (%.text path)])) + +(type: File-Tracker + (Dictionary //.Path [(//.File Promise) Instant])) + +(type: Directory-Tracker + (Dictionary //.Path [Concern (//.Directory Promise) File-Tracker])) + +(def: (update-watch! new-concern path tracker) + (-> Concern //.Path (Var Directory-Tracker) (STM Bit)) + (do {! stm.monad} + [@tracker (stm.read tracker)] + (case (dictionary.get path @tracker) + (#.Some [old-concern file last-modified]) + (do ! + [_ (stm.update (dictionary.put path [new-concern file last-modified]) tracker)] + (wrap true)) + + #.None + (wrap false)))) + +(def: (file-tracker fs directory) + (-> (//.System Promise) (//.Directory Promise) (Promise (Try File-Tracker))) + (do {! (try.with promise.monad)} + [files (!.use (:: directory files) [])] + (monad.fold ! + (function (_ file tracker) + (do ! + [last-modified (!.use (:: file last-modified) [])] + (wrap (dictionary.put (!.use (:: file path) []) + [file last-modified] + tracker)))) + (: File-Tracker + (dictionary.new text.hash)) + files))) + +(def: (poll-files directory file-tracker) + (-> (//.Directory Promise) File-Tracker (Promise (Try (List [//.Path (//.File Promise) Instant])))) + (do {! (try.with promise.monad)} + [files (!.use (:: directory files) [])] + (monad.map ! (function (_ file) + (do ! + [last-modified (!.use (:: file last-modified) [])] + (wrap [(!.use (:: file path) []) file last-modified]))) + files))) + +(def: (poll-directory-changes [path [concern directory file-tracker]]) + (-> [//.Path [Concern (//.Directory Promise) File-Tracker]] + (Promise (Try [[//.Path [Concern (//.Directory Promise) File-Tracker]] + [(List [//.Path (//.File Promise) Instant]) + (List [//.Path Instant Instant]) + (List [//.Path])]]))) + (do {! (try.with promise.monad)} + [current-files (..poll-files directory file-tracker) + #let [creations (if (..creation? concern) + (list.filter (function (_ [path file last-modified]) + (not (dictionary.contains? path file-tracker))) + current-files) + (list)) + available (|> current-files + (list\map product.left) + (set.from-list text.hash)) + deletions (if (..deletion? concern) + (|> (dictionary.entries file-tracker) + (list\map product.left) + (list.filter (|>> (set.member? available) not))) + (list)) + modifications (list.all (function (_ [path file current-modification]) + (do maybe.monad + [[_ previous-modification] (dictionary.get path file-tracker)] + (wrap [path previous-modification current-modification]))) + current-files)]] + (wrap [[path + [concern + directory + (let [with-deletions (list\fold dictionary.remove file-tracker deletions) + with-creations (list\fold (function (_ [path file last-modified] tracker) + (dictionary.put path [file last-modified] tracker)) + with-deletions + creations) + with-modifications (list\fold (function (_ [path previous-modification current-modification] tracker) + (dictionary.update path + (function (_ [file _]) + [file current-modification]) + tracker)) + with-creations + modifications)] + with-modifications)]] + [creations + modifications + deletions]]))) + +(def: #export (polling fs) + (-> (//.System Promise) (Watcher Promise)) + (let [tracker (: (Var Directory-Tracker) + (stm.var (dictionary.new text.hash)))] + (structure + (def: (start new-concern path) + (do {! promise.monad} + [updated? (stm.commit (..update-watch! new-concern path tracker))] + (if updated? + (wrap (#try.Success [])) + (do (try.with !) + [directory (!.use (:: fs directory) path) + file-tracker (..file-tracker fs directory)] + (do ! + [_ (stm.commit (stm.update (dictionary.put path [new-concern directory file-tracker]) tracker))] + (wrap (#try.Success []))))))) + (def: (concern path) + (stm.commit + (do stm.monad + [@tracker (stm.read tracker)] + (wrap (case (dictionary.get path @tracker) + (#.Some [concern directory file-tracker]) + (#try.Success concern) + + #.None + (exception.throw ..not-being-watched [path])))))) + (def: (stop path) + (stm.commit + (do {! stm.monad} + [@tracker (stm.read tracker)] + (case (dictionary.get path @tracker) + (#.Some [concern directory file-tracker]) + (do ! + [_ (stm.update (dictionary.remove path) tracker)] + (wrap (#try.Success concern))) + + #.None + (wrap (exception.throw ..not-being-watched [path])))))) + (def: (poll _) + (do promise.monad + [@tracker (stm.commit (stm.read tracker))] + (do {! (try.with promise.monad)} + [changes (|> @tracker + dictionary.entries + (monad.map ! ..poll-directory-changes)) + _ (do promise.monad + [_ (stm.commit (stm.write (|> changes + (list\map product.left) + (dictionary.from-list text.hash)) + tracker))] + (wrap (#try.Success []))) + #let [[creations modifications deletions] + (list\fold (function (_ [_ [creations modifications deletions]] + [all-creations all-modifications all-deletions]) + [(list\compose creations all-creations) + (list\compose modifications all-modifications) + (list\compose deletions all-deletions)]) + [(list) (list) (list)] + changes)]] + (wrap ($_ list\compose + (list\map (function (_ [path file last-modification]) [path ..creation]) creations) + (|> modifications + (list.filter (function (_ [path previous-modification current-modification]) + (not (instant\= previous-modification current-modification)))) + (list\map (function (_ [path previous-modification current-modification]) + [path ..modification]))) + (list\map (function (_ path) [path ..deletion]) deletions) + ))))) + ))) + +(def: #export (mock separator) + (-> Text [(//.System Promise) (Watcher Promise)]) + (let [fs (//.mock separator)] + [fs + (..polling fs)])) + +(with-expansions [<jvm> (as-is (import: java/lang/Object) + + (import: java/lang/String) + + (import: (java/util/List a) + ["#::." + (size [] int) + (get [int] a)]) + + (def: (default\\list list) + (All [a] (-> (java/util/List a) (List a))) + (let [size (.nat (java/util/List::size list))] + (loop [idx 0 + output #.Nil] + (if (n.< size idx) + (recur (inc idx) + (#.Cons (java/util/List::get (.int idx) list) + output)) + output)))) + + (import: (java/nio/file/WatchEvent$Kind a)) + + (import: (java/nio/file/WatchEvent a) + ["#::." + (kind [] (java/nio/file/WatchEvent$Kind a))]) + + (import: java/nio/file/Watchable) + + (import: java/nio/file/Path + ["#::." + (register [java/nio/file/WatchService [(java/nio/file/WatchEvent$Kind ?)]] #io #try java/nio/file/WatchKey) + (toString [] java/lang/String)]) + + (import: java/nio/file/StandardWatchEventKinds + ["#::." + (#static ENTRY_CREATE (java/nio/file/WatchEvent$Kind java/nio/file/Path)) + (#static ENTRY_MODIFY (java/nio/file/WatchEvent$Kind java/nio/file/Path)) + (#static ENTRY_DELETE (java/nio/file/WatchEvent$Kind java/nio/file/Path))]) + + (def: (default\\event-concern event) + (All [a] + (-> (java/nio/file/WatchEvent a) Concern)) + (let [kind (:coerce (java/nio/file/WatchEvent$Kind java/nio/file/Path) + (java/nio/file/WatchEvent::kind event))] + (cond (is? (java/nio/file/StandardWatchEventKinds::ENTRY_CREATE) + kind) + ..creation + + (is? (java/nio/file/StandardWatchEventKinds::ENTRY_MODIFY) + kind) + ..modification + + (is? (java/nio/file/StandardWatchEventKinds::ENTRY_DELETE) + kind) + ..deletion + + ## else + ..none + ))) + + (import: java/nio/file/WatchKey + ["#::." + (reset [] #io boolean) + (cancel [] #io void) + (watchable [] java/nio/file/Watchable) + (pollEvents [] #io (java/util/List (java/nio/file/WatchEvent ?)))]) + + (def: default\\key-concern + (-> java/nio/file/WatchKey (IO Concern)) + (|>> java/nio/file/WatchKey::pollEvents + (:: io.monad map (|>> ..default\\list + (list\map default\\event-concern) + (list\fold ..also ..none))))) + + (import: java/nio/file/WatchService + ["#::." + (poll [] #io #try #? java/nio/file/WatchKey)]) + + (import: java/nio/file/FileSystem + ["#::." + (newWatchService [] #io #try java/nio/file/WatchService)]) + + (import: java/nio/file/FileSystems + ["#::." + (#static getDefault [] java/nio/file/FileSystem)]) + + (import: java/io/File + ["#::." + (new [java/lang/String]) + (exists [] #io #try boolean) + (isDirectory [] #io #try boolean) + (listFiles [] #io #try [java/io/File]) + (getAbsolutePath [] #io #try java/lang/String) + (toPath [] java/nio/file/Path)]) + + (type: Watch-Event + (java/nio/file/WatchEvent$Kind java/lang/Object)) + + (def: (default\\start watch-events watcher path) + (-> (List Watch-Event) java/nio/file/WatchService //.Path (Promise (Try java/nio/file/WatchKey))) + (promise.future + (java/nio/file/Path::register watcher + (array.from-list watch-events) + (|> path java/io/File::new java/io/File::toPath)))) + + (def: (default\\poll watcher) + (-> java/nio/file/WatchService (IO (Try (List [//.Path Concern])))) + (loop [output (: (List [//.Path Concern]) + (list))] + (do (try.with io.monad) + [?key (java/nio/file/WatchService::poll watcher)] + (case ?key + (#.Some key) + (do {! io.monad} + [valid? (java/nio/file/WatchKey::reset key)] + (if valid? + (do ! + [#let [path (|> key + java/nio/file/WatchKey::watchable + (:coerce java/nio/file/Path) + java/nio/file/Path::toString + (:coerce //.Path))] + concern (..default\\key-concern key)] + (recur (#.Cons [path concern] + output))) + (recur output))) + + #.None + (wrap output))))) + + (def: (watch-events concern) + (-> Concern (List Watch-Event)) + ($_ list\compose + (if (..creation? concern) + (list (:coerce Watch-Event (java/nio/file/StandardWatchEventKinds::ENTRY_CREATE))) + (list)) + (if (..modification? concern) + (list (:coerce Watch-Event (java/nio/file/StandardWatchEventKinds::ENTRY_MODIFY))) + (list)) + (if (..deletion? concern) + (list (:coerce Watch-Event (java/nio/file/StandardWatchEventKinds::ENTRY_DELETE))) + (list)) + )) + + (def: #export default + (IO (Try (Watcher Promise))) + (do (try.with io.monad) + [watcher (java/nio/file/FileSystem::newWatchService + (java/nio/file/FileSystems::getDefault)) + #let [tracker (stm.var (: (Dictionary //.Path [Concern java/nio/file/WatchKey]) + (dictionary.new text.hash))) + + stop (: (-> //.Path (Promise (Try Concern))) + (function (_ path) + (do {! promise.monad} + [@tracker (stm.commit (stm.read tracker))] + (case (dictionary.get path @tracker) + (#.Some [concern key]) + (do ! + [_ (promise.future + (java/nio/file/WatchKey::cancel key)) + _ (stm.commit (stm.update (dictionary.remove path) tracker))] + (wrap (#try.Success concern))) + + #.None + (wrap (exception.throw ..not-being-watched [path]))))))]] + (wrap (: (Watcher Promise) + (structure + (def: (start concern path) + (do promise.monad + [?concern (stop path)] + (do (try.with promise.monad) + [key (..default\\start (..watch-events (..also (try.default ..none ?concern) + concern)) + watcher + path)] + (do promise.monad + [_ (stm.commit (stm.update (dictionary.put path [concern key]) tracker))] + (wrap (#try.Success [])))))) + (def: (concern path) + (do promise.monad + [@tracker (stm.commit (stm.read tracker))] + (case (dictionary.get path @tracker) + (#.Some [concern key]) + (wrap (#try.Success concern)) + + #.None + (wrap (exception.throw ..not-being-watched [path]))))) + (def: stop stop) + (def: (poll _) + (promise.future (..default\\poll watcher))) + ))))) + )] + (for {@.old (as-is <jvm>) + @.jvm (as-is <jvm>)})) diff --git a/stdlib/source/lux/world/net/http/cookie.lux b/stdlib/source/lux/world/net/http/cookie.lux index 29e7fb6ce..969f951ec 100644 --- a/stdlib/source/lux/world/net/http/cookie.lux +++ b/stdlib/source/lux/world/net/http/cookie.lux @@ -3,7 +3,7 @@ [control [monad (#+ do)] ["." try (#+ Try)] - ["p" parser ("#;." monad) + ["p" parser ("#\." monad) ["l" text (#+ Parser)]]] [data [number @@ -80,7 +80,7 @@ [context' (..cookie context) _ (l.this "; ")] (cookies context')) - (p;wrap context))) + (p\wrap context))) (def: #export (get header) (-> Text (Try Context)) diff --git a/stdlib/source/lux/world/net/http/request.lux b/stdlib/source/lux/world/net/http/request.lux index 9ddc6ee94..21f2ee071 100644 --- a/stdlib/source/lux/world/net/http/request.lux +++ b/stdlib/source/lux/world/net/http/request.lux @@ -19,7 +19,7 @@ ["." json (#+ JSON)] ["." context (#+ Context Property)]] [collection - ["." list ("#;." functor fold)] + ["." list ("#\." functor fold)] ["." dictionary]]] [world ["." binary (#+ Binary)]]] @@ -37,8 +37,8 @@ (:: try.functor map (|>> [(n.+ amount offset)]) (binary.copy amount 0 input offset output)))) [0 (|> inputs - (list;map binary.size) - (list;fold n.+ 0) + (list\map binary.size) + (list\fold n.+ 0) binary.create)] inputs))] output)) diff --git a/stdlib/source/lux/world/net/http/route.lux b/stdlib/source/lux/world/net/http/route.lux index 9210dc67c..32bdf1213 100644 --- a/stdlib/source/lux/world/net/http/route.lux +++ b/stdlib/source/lux/world/net/http/route.lux @@ -6,7 +6,7 @@ ["." promise]]] [data ["." maybe] - ["." text ("#;." equivalence)] + ["." text] [number ["n" nat]]]] ["." // (#+ URI Server) diff --git a/stdlib/source/poly/lux/abstract/functor.lux b/stdlib/source/poly/lux/abstract/functor.lux index da14b2b6c..d640d4205 100644 --- a/stdlib/source/poly/lux/abstract/functor.lux +++ b/stdlib/source/poly/lux/abstract/functor.lux @@ -13,7 +13,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#;." monad monoid)]]] + ["." list ("#\." monad monoid)]]] [macro ["." code] [syntax (#+ syntax:) @@ -37,7 +37,7 @@ (function (_ unwrappedT) (if (n.= 1 num-vars) (` ((~! /.Functor) (~ (poly.to-code *env* unwrappedT)))) - (let [paramsC (|> num-vars dec list.indices (list;map (|>> %.nat code.local-identifier)))] + (let [paramsC (|> num-vars dec list.indices (list\map (|>> %.nat code.local-identifier)))] (` (All [(~+ paramsC)] ((~! /.Functor) ((~ (poly.to-code *env* unwrappedT)) (~+ paramsC))))))))) Arg<?> (: (-> Code (<type>.Parser Code)) @@ -54,7 +54,7 @@ membersC (<type>.variant (p.many (Arg<?> valueC))) #let [last (dec (list.size membersC))]] (wrap (` (case (~ valueC) - (~+ (list;join (list;map (function (_ [tag memberC]) + (~+ (list\join (list\map (function (_ [tag memberC]) (if (n.= last tag) (list (` ((~ (code.nat (dec tag))) #1 (~ valueC))) (` ((~ (code.nat (dec tag))) #1 (~ memberC)))) @@ -72,11 +72,11 @@ [_ (wrap []) memberC (Arg<?> slotC)] (recur (inc idx) - (list;compose pairsCC (list [slotC memberC]))))) + (list\compose pairsCC (list [slotC memberC]))))) (wrap pairsCC)))))] (wrap (` (case (~ valueC) - [(~+ (list;map product.left pairsCC))] - [(~+ (list;map product.right pairsCC))])))) + [(~+ (list\map product.left pairsCC))] + [(~+ (list\map product.right pairsCC))])))) ## Functions (do ! [_ (wrap []) @@ -86,7 +86,7 @@ (Arg<?> outL)) #let [inC+ (|> (list.size inT+) list.indices - (list;map (|>> %.nat (format "____________inC") code.local-identifier)))]] + (list\map (|>> %.nat (format "____________inC") code.local-identifier)))]] (wrap (` (function ((~ g!) (~+ inC+)) (let [(~ outL) ((~ valueC) (~+ inC+))] (~ outC)))))) diff --git a/stdlib/source/program/aedifex/cache.lux b/stdlib/source/program/aedifex/cache.lux index dca14b496..1aee65405 100644 --- a/stdlib/source/program/aedifex/cache.lux +++ b/stdlib/source/program/aedifex/cache.lux @@ -86,11 +86,11 @@ (def: (decode codec data) (All [a] (-> (Codec Text a) Binary (Try a))) - (let [(^open "_@.") try.monad] + (let [(^open "_\.") try.monad] (|> data encoding.from-utf8 - (_@map (:: codec decode)) - _@join))) + (_\map (:: codec decode)) + _\join))) (def: #export (read-one system [artifact type]) (-> (file.System Promise) Dependency (Promise (Try Package))) diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index 94d6760b6..30206095e 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -32,7 +32,6 @@ ["#." local] ["#." cache] ["#." repository] - ["#." shell] ["#." runtime] ["#." dependency (#+ Dependency) ["#/." resolution (#+ Resolution)]] diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux index 2996a6741..f4da76ac4 100644 --- a/stdlib/source/program/aedifex/command/test.lux +++ b/stdlib/source/program/aedifex/command/test.lux @@ -21,7 +21,6 @@ ["/#" // #_ ["#." action] ["#." command (#+ Command)] - ["#." shell] ["#." runtime] [dependency [resolution (#+ Resolution)]]]]) diff --git a/stdlib/source/program/aedifex/shell.lux b/stdlib/source/program/aedifex/shell.lux deleted file mode 100644 index e70571667..000000000 --- a/stdlib/source/program/aedifex/shell.lux +++ /dev/null @@ -1,108 +0,0 @@ -(.module: - [lux #* - ["." host (#+ import:)] - [abstract - [monad (#+ do)]] - [control - ["." io (#+ IO)] - ["." try (#+ Try)] - ["." exception (#+ exception:)] - [concurrency - ["." promise]]] - [data - [text - ["%" format (#+ format)]] - [number - ["." int]]] - [world - [file (#+ Path)]]] - ["." // #_ - ["#." action (#+ Action)]]) - -(import: java/lang/String) - -(import: java/io/InputStream) - -(import: java/io/Reader) - -(import: java/io/InputStreamReader - ["#::." - (new [java/io/InputStream])]) - -(import: java/io/BufferedReader - ["#::." - (new [java/io/Reader]) - (readLine [] #io #try java/lang/String)]) - -(import: java/lang/Process - ["#::." - (getInputStream [] java/io/InputStream) - (getErrorStream [] java/io/InputStream) - (waitFor [] #io #try int)]) - -(import: java/io/File - ["#::." - (new [java/lang/String])]) - -(import: java/lang/Runtime - ["#::." - (#static getRuntime [] #io java/lang/Runtime) - (exec [java/lang/String #? [java/lang/String] java/io/File] #io #try java/lang/Process)]) - -(template [<exception>] - [(exception: #export (<exception> {working-directory Text} {command Text} {error Text}) - (exception.report - ["Working directory" (%.text working-directory)] - ["Command" (%.text command)] - ["Error" (%.text error)]))] - - [failure-to-execute-command] - [failure-during-command-execution] - ) - -(exception: #export (abnormal-exit {working-directory Text} {command Text} {code Int}) - (exception.report - ["Working Directory" (%.text working-directory)] - ["Command" (%.text command)] - ["Code" (%.int code)])) - -(def: (consume-stream working-directory command stream) - (-> Text Path java/io/InputStream (IO (Try Any))) - (let [reader (|> stream java/io/InputStreamReader::new java/io/BufferedReader::new)] - (loop [_ []] - (do io.monad - [?line (java/io/BufferedReader::readLine reader)] - (case ?line - (#try.Success line) - (exec (log! line) - (recur [])) - - (#try.Failure error) - (wrap (exception.throw ..failure-during-command-execution [working-directory command error]))))))) - -(def: normal-exit - +0) - -(def: #export (execute command working-directory) - (-> Text Path (Action Any)) - (promise.future - (do {! io.monad} - [runtime (java/lang/Runtime::getRuntime) - ?process (java/lang/Runtime::exec command #.None (java/io/File::new working-directory) runtime)] - (case ?process - (#try.Success process) - (do ! - [_ (..consume-stream working-directory command (java/lang/Process::getInputStream process)) - _ (..consume-stream working-directory command (java/lang/Process::getErrorStream process)) - ?exit-code (java/lang/Process::waitFor process)] - (case ?exit-code - (#try.Success exit-code) - (if (int.= ..normal-exit exit-code) - (wrap (#try.Success [])) - (wrap (exception.throw ..abnormal-exit [working-directory command exit-code]))) - - (#try.Failure error) - (wrap (exception.throw ..failure-to-execute-command [working-directory command error])))) - - (#try.Failure error) - (wrap (exception.throw ..failure-to-execute-command [working-directory command error])))))) diff --git a/stdlib/source/program/licentia.lux b/stdlib/source/program/licentia.lux index 244e28223..e9b4f0074 100644 --- a/stdlib/source/program/licentia.lux +++ b/stdlib/source/program/licentia.lux @@ -29,7 +29,7 @@ [format ["." json]]] ["." cli (#+ program:)] - ["." io (#+ IO) ("#;." monad)] + ["." io (#+ IO) ("#\." monad)] [world ["." file (#+ Path File)]] [host (#+ import:)]] @@ -59,7 +59,7 @@ (do (try.with io.monad) [file (!.use (:: file.default file) input) blob (!.use (:: file content) []) - document (io;wrap (do try.monad + document (io\wrap (do try.monad [raw-json (encoding.from-utf8 blob) json (|> raw-json (:coerce java/lang/String) diff --git a/stdlib/source/program/licentia/document.lux b/stdlib/source/program/licentia/document.lux index b3787f2f2..b1bc20cce 100644 --- a/stdlib/source/program/licentia/document.lux +++ b/stdlib/source/program/licentia/document.lux @@ -4,7 +4,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#;." functor)]]]]) + ["." list ("#\." functor)]]]]) (def: #export (quote text) (-> Text Text) @@ -24,7 +24,7 @@ (def: #export paragraph (-> (List Text) Text) - (|>> (list;map ..sentence) + (|>> (list\map ..sentence) (text.join-with text.new-line))) (template [<name> <word>] diff --git a/stdlib/source/program/licentia/license/black-list.lux b/stdlib/source/program/licentia/license/black-list.lux index a71ceda9c..14dcdfe91 100644 --- a/stdlib/source/program/licentia/license/black-list.lux +++ b/stdlib/source/program/licentia/license/black-list.lux @@ -1,11 +1,11 @@ (.module: [lux #* [data - ["." maybe ("#;." functor)] + ["." maybe ("#\." functor)] ["." text ["%" format (#+ format)]] [collection - ["." list ("#;." functor)]]]] + ["." list ("#\." functor)]]]] ["." // (#+ Entity Black-List) ["_" term] [// @@ -21,11 +21,11 @@ effect "shall not be granted to the following entities, or any subsidiary thereof" justification (|> black-list (get@ #//.justification) - (maybe;map (|>> (format ", due to "))) + (maybe\map (|>> (format ", due to "))) (maybe.default "")) entities (|> black-list (get@ #//.entities) - (list;map ..entity) + (list\map ..entity) (text.join-with text.new-line))] (format scope " " effect justification ":" text.new-line entities))) diff --git a/stdlib/source/program/licentia/license/commercial.lux b/stdlib/source/program/licentia/license/commercial.lux index f05bcf470..05b8c3966 100644 --- a/stdlib/source/program/licentia/license/commercial.lux +++ b/stdlib/source/program/licentia/license/commercial.lux @@ -2,9 +2,7 @@ [lux #* [data ["." text - ["%" format (#+ format)]] - [collection - ["." list ("#;." monoid)]]]] + ["%" format (#+ format)]]]] ["." // (#+ Commercial) ["_" term] [// diff --git a/stdlib/source/program/licentia/license/distribution.lux b/stdlib/source/program/licentia/license/distribution.lux index 58eaab22d..f911623a0 100644 --- a/stdlib/source/program/licentia/license/distribution.lux +++ b/stdlib/source/program/licentia/license/distribution.lux @@ -4,7 +4,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#;." monoid)]]]] + ["." list ("#\." monoid)]]]] ["." // (#+ Distribution) ["_" term] [// @@ -103,7 +103,7 @@ (def: #export (extension distribution) (-> Distribution Text) - ($.paragraph ($_ list;compose + ($.paragraph ($_ list\compose (if (get@ #//.can-re-license? distribution) (list allow-re-licensing) (list)) diff --git a/stdlib/source/program/licentia/license/extension.lux b/stdlib/source/program/licentia/license/extension.lux index 68b5f6669..f808a8913 100644 --- a/stdlib/source/program/licentia/license/extension.lux +++ b/stdlib/source/program/licentia/license/extension.lux @@ -2,9 +2,7 @@ [lux #* [data ["." text - ["%" format (#+ format)]] - [collection - ["." list ("#;." monoid)]]]] + ["%" format (#+ format)]]]] ["." // (#+ Extension) ["_" term] ["." grant] diff --git a/stdlib/source/program/licentia/license/notice.lux b/stdlib/source/program/licentia/license/notice.lux index d4df7d166..219af97f4 100644 --- a/stdlib/source/program/licentia/license/notice.lux +++ b/stdlib/source/program/licentia/license/notice.lux @@ -6,7 +6,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#;." functor)]]]] + ["." list ("#\." functor)]]]] ["." // #_ ["#." time] ["#." copyright] @@ -28,5 +28,5 @@ (def: #export copyright (-> (List //copyright.Holder) Text) - (|>> (list;map ..copyright-holder) + (|>> (list\map ..copyright-holder) (text.join-with text.new-line))) diff --git a/stdlib/source/program/licentia/output.lux b/stdlib/source/program/licentia/output.lux index 05d68ff76..5d3899170 100644 --- a/stdlib/source/program/licentia/output.lux +++ b/stdlib/source/program/licentia/output.lux @@ -1,11 +1,11 @@ (.module: [lux (#- Definition) [data - ["." maybe ("#;." functor)] + ["." maybe ("#\." functor)] ["." text ["%" format (#+ format)]] [collection - ["." list ("#;." functor monoid)]]]] + ["." list ("#\." functor monoid)]]]] [// ["." license (#+ Identification Termination @@ -175,7 +175,7 @@ "")] [(get@ #license.same-license? value) "License Retention" - ($.paragraph (list;compose extension.sharing-requirement + ($.paragraph (list\compose extension.sharing-requirement extension.license-conflict-resolution))] [(get@ #license.must-be-distinguishable? value) (format _.extension " Distinctness") @@ -251,7 +251,7 @@ (-> License Text) (let [identification (|> value (get@ #license.identification) - (maybe;map ..identification) + (maybe\map ..identification) (maybe.default "")) identified? (case (get@ #license.identification value) (#.Some _) @@ -269,12 +269,12 @@ black-lists ($.block ($.section {#$.title (format "Denial of " _.license) #$.content (|> black-lists - (list;map black-list.black-list) + (list\map black-list.black-list) (text.join-with ..black-list-spacing))}))) ($.section {#$.title "Definitions" #$.content (|> definition.all - (list;map (|>> ..definition $.block)) + (list\map (|>> ..definition $.block)) (text.join-with ""))}) ($.block ($.section {#$.title (format "Acceptance of " _.license) @@ -294,7 +294,7 @@ (|> value (get@ #license.attribution) - (maybe;map (|>> ..attribution + (maybe\map (|>> ..attribution ["Attribution Information"] $.section $.block)) diff --git a/stdlib/source/test/lux/control/continuation.lux b/stdlib/source/test/lux/control/continuation.lux index 99b56cfdc..0c09dcb23 100644 --- a/stdlib/source/test/lux/control/continuation.lux +++ b/stdlib/source/test/lux/control/continuation.lux @@ -32,8 +32,8 @@ (<| (_.covering /._) (do random.monad [sample random.nat - #let [(^open "_@.") /.apply - (^open "_@.") /.monad] + #let [(^open "_\.") /.apply + (^open "_\.") /.monad] elems (random.list 3 random.nat)]) (_.with-cover [/.Cont]) ($_ _.and @@ -45,7 +45,7 @@ ($monad.spec ..injection ..comparison /.monad)) (_.cover [/.run] - (n.= sample (/.run (_@wrap sample)))) + (n.= sample (/.run (_\wrap sample)))) (_.cover [/.call/cc] (n.= (n.* 2 sample) (/.run (do {! /.monad} @@ -66,14 +66,14 @@ (restart [(n.+ 10 output) (inc idx)]) (wrap output)))))) (_.cover [/.shift /.reset] - (let [(^open "_@.") /.monad - (^open "list@.") (list.equivalence n.equivalence) + (let [(^open "_\.") /.monad + (^open "list\.") (list.equivalence n.equivalence) visit (: (-> (List Nat) (/.Cont (List Nat) (List Nat))) (function (visit xs) (case xs #.Nil - (_@wrap #.Nil) + (_\wrap #.Nil) (#.Cons x xs') (do {! /.monad} @@ -82,7 +82,7 @@ [tail (k xs')] (wrap (#.Cons x tail)))))] (visit output)))))] - (list@= elems + (list\= elems (/.run (/.reset (visit elems)))))) (_.cover [/.continue] (/.continue (is? sample) diff --git a/stdlib/source/test/lux/control/reader.lux b/stdlib/source/test/lux/control/reader.lux index 7b6a8a8c3..f211948e4 100644 --- a/stdlib/source/test/lux/control/reader.lux +++ b/stdlib/source/test/lux/control/reader.lux @@ -49,11 +49,11 @@ (_.cover [/.local] (n.= (n.* factor sample) (/.run sample (/.local (n.* factor) /.ask)))) - (let [(^open "io@.") io.monad] + (let [(^open "io\.") io.monad] (_.cover [/.with /.lift] (|> (: (/.Reader Any (IO Nat)) (do (/.with io.monad) - [a (/.lift (io@wrap sample)) + [a (/.lift (io\wrap sample)) b (wrap factor)] (wrap (n.* b a)))) (/.run []) diff --git a/stdlib/source/test/lux/control/region.lux b/stdlib/source/test/lux/control/region.lux index 691bcbbce..d9f28e5db 100644 --- a/stdlib/source/test/lux/control/region.lux +++ b/stdlib/source/test/lux/control/region.lux @@ -26,23 +26,27 @@ ["." / (#+ Region) [// ["." thread (#+ Thread)] - ["." exception (#+ exception:)]]]}) + ["." exception (#+ Exception exception:)]]]}) (exception: oops) -(template [<name> <success> <error>] - [(def: (<name> result) - (All [a] (-> (Try a) Bit)) - (case result - (#try.Success _) - <success> - - (#try.Failure _) - <error>))] +(def: (success? result) + (All [a] (-> (Try a) Bit)) + (case result + (#try.Success _) + true + + (#try.Failure _) + false)) - [success? #1 #0] - [failure? #0 #1] - ) +(def: (throws? exception result) + (All [e a] (-> (Exception e) (Try a) Bit)) + (case result + (#try.Success _) + false + + (#try.Failure error) + (exception.match? exception error))) (def: (injection value) (Injection (All [a] (All [! r] (Region r (Thread !) a)))) @@ -105,7 +109,7 @@ (enum.range n.enum 1 expected-clean-ups))] (wrap []))) actual-clean-ups (thread.read clean-up-counter)] - (wrap (and (success? outcome) + (wrap (and (..success? outcome) (n.= expected-clean-ups actual-clean-ups)))))) (_.cover [/.fail] @@ -124,7 +128,7 @@ _ (/.fail //@ (exception.construct ..oops []))] (wrap []))) actual-clean-ups (thread.read clean-up-counter)] - (wrap (and (failure? outcome) + (wrap (and (..throws? ..oops outcome) (n.= expected-clean-ups actual-clean-ups)))))) (_.cover [/.throw] @@ -143,10 +147,10 @@ _ (/.throw //@ ..oops [])] (wrap []))) actual-clean-ups (thread.read clean-up-counter)] - (wrap (and (failure? outcome) + (wrap (and (..throws? ..oops outcome) (n.= expected-clean-ups actual-clean-ups)))))) - (_.cover [/.acquire] + (_.cover [/.acquire /.clean-up-error] (thread.run (do {! thread.monad} [clean-up-counter (thread.box 0) @@ -163,7 +167,7 @@ (wrap []))) actual-clean-ups (thread.read clean-up-counter)] (wrap (and (or (n.= 0 expected-clean-ups) - (failure? outcome)) + (..throws? /.clean-up-error outcome)) (n.= expected-clean-ups actual-clean-ups)))))) (_.cover [/.lift] @@ -176,7 +180,7 @@ [_ (/.lift //@ (thread.write expected-clean-ups clean-up-counter))] (wrap []))) actual-clean-ups (thread.read clean-up-counter)] - (wrap (and (success? outcome) + (wrap (and (..success? outcome) (n.= expected-clean-ups actual-clean-ups)))))) )))) diff --git a/stdlib/source/test/lux/control/state.lux b/stdlib/source/test/lux/control/state.lux index ffac9570f..3e30afab0 100644 --- a/stdlib/source/test/lux/control/state.lux +++ b/stdlib/source/test/lux/control/state.lux @@ -109,11 +109,11 @@ [state random.nat left random.nat right random.nat] - (let [(^open "io@.") io.monad] + (let [(^open "io\.") io.monad] (_.cover [/.State' /.with /.lift /.run'] (|> (: (/.State' io.IO Nat Nat) (do (/.with io.monad) - [a (/.lift io.monad (io@wrap left)) + [a (/.lift io.monad (io\wrap left)) b (wrap right)] (wrap (n.+ a b)))) (/.run' state) diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index d81ff7220..77b3652a1 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -187,9 +187,9 @@ (..encoding expected) (_.cover [/.complement] (let [~expected (/.complement expected) - (^open "/@.") /.equivalence] - (and (not (/@= expected ~expected)) - (/@= expected (/.complement ~expected))))) + (^open "/\.") /.equivalence] + (and (not (/\= expected ~expected)) + (/\= expected (/.complement ~expected))))) (_.cover [/.black /.white] (and (:: /.equivalence = /.white (/.complement /.black)) (:: /.equivalence = /.black (/.complement /.white)))) diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/data/number/complex.lux index 13497bfa5..6b623388c 100644 --- a/stdlib/source/test/lux/data/number/complex.lux +++ b/stdlib/source/test/lux/data/number/complex.lux @@ -17,190 +17,270 @@ [collection ["." list ("#\." functor)]]] ["." math - ["r" random (#+ Random)]]] + ["." random (#+ Random)]]] {1 - ["." / (#+ Complex)]}) + ["." /]}) -(def: margin-of-error Frac +0.000000001) - -(def: (within? margin standard value) - (-> Frac Complex Complex Bit) - (let [real-dist (f.abs (f.- (get@ #/.real standard) - (get@ #/.real value))) - imgn-dist (f.abs (f.- (get@ #/.imaginary standard) - (get@ #/.imaginary value)))] - (and (f.< margin real-dist) - (f.< margin imgn-dist)))) +(def: margin-of-error + +0.000000001) (def: dimension (Random Frac) - (do {! r.monad} - [factor (|> r.nat (:: ! map (|>> (n.% 1000) (n.max 1)))) - measure (|> r.safe-frac (r.filter (f.> +0.0)))] + (do {! random.monad} + [factor (|> random.nat (:: ! map (|>> (n.% 1000) (n.max 1)))) + measure (|> random.safe-frac (random.filter (f.> +0.0)))] (wrap (f.* (|> factor .int int.frac) measure)))) -(def: #export complex - (Random Complex) - (do r.monad +(def: #export random + (Random /.Complex) + (do random.monad [real ..dimension imaginary ..dimension] (wrap (/.complex real imaginary)))) +(def: angle + (Random /.Complex) + (:: random.monad map + (|>> (update@ #/.real (f.% +1.0)) + (update@ #/.imaginary (f.% +1.0))) + ..random)) + (def: construction Test - (do r.monad + (do random.monad [real ..dimension imaginary ..dimension] ($_ _.and - (_.test "Can build and tear apart complex numbers" - (let [r+i (/.complex real imaginary)] - (and (f.= real (get@ #/.real r+i)) - (f.= imaginary (get@ #/.imaginary r+i))))) - (_.test "If either the real part or the imaginary part is NaN, the composite is NaN." - (and (/.not-a-number? (/.complex f.not-a-number imaginary)) - (/.not-a-number? (/.complex real f.not-a-number)))) + (_.cover [/.complex] + (and (let [r+i (/.complex real imaginary)] + (and (f.= real (get@ #/.real r+i)) + (f.= imaginary (get@ #/.imaginary r+i)))) + (let [r+i (/.complex real)] + (and (f.= real (get@ #/.real r+i)) + (f.= +0.0 (get@ #/.imaginary r+i)))))) + (_.cover [/.within?] + (/.within? ..margin-of-error + (/.complex real imaginary) + (/.complex real imaginary))) + (_.cover [/.not-a-number?] + (and (/.not-a-number? (/.complex f.not-a-number imaginary)) + (/.not-a-number? (/.complex real f.not-a-number)))) + ))) + +(def: constant + Test + (do random.monad + [sample ..random + dimension ..dimension] + ($_ _.and + (_.cover [/.zero] + (/.= /.zero (/.* /.zero sample))) + (_.cover [/.+one] + (/.= sample (/.* /.+one sample))) + (_.cover [/.-one] + (and (/.= /.zero + (/.+ sample + (/.* /.-one sample))) + (/.= sample (/.* /.-one (/.* /.-one sample))))) + (_.cover [/.i] + (and (/.= (/.complex +0.0 dimension) + (/.* /.i (/.complex dimension))) + (/.= (/.* /.-one sample) + (/.* /.i (/.* /.i sample))))) ))) -(def: absolute-value +(def: absolute-value&argument Test - (do r.monad + (do random.monad [real ..dimension imaginary ..dimension] ($_ _.and - (_.test "Absolute value of complex >= absolute value of any of the parts." - (let [r+i (/.complex real imaginary) - abs (get@ #/.real (/.abs r+i))] - (and (f.>= (f.abs real) abs) - (f.>= (f.abs imaginary) abs)))) - (_.test "The absolute value of a complex number involving a NaN on either dimension, results in a NaN value." - (and (f.not-a-number? (get@ #/.real (/.abs (/.complex f.not-a-number imaginary)))) - (f.not-a-number? (get@ #/.real (/.abs (/.complex real f.not-a-number)))))) - (_.test "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value." - (and (f.= f.positive-infinity (get@ #/.real (/.abs (/.complex f.positive-infinity imaginary)))) - (f.= f.positive-infinity (get@ #/.real (/.abs (/.complex real f.positive-infinity)))) - (f.= f.positive-infinity (get@ #/.real (/.abs (/.complex f.negative-infinity imaginary)))) - (f.= f.positive-infinity (get@ #/.real (/.abs (/.complex real f.negative-infinity)))))) + (_.cover [/.abs] + (let [normal! + (let [r+i (/.complex real imaginary)] + (and (f.>= (f.abs real) (/.abs r+i)) + (f.>= (f.abs imaginary) (/.abs r+i)))) + + not-a-number! + (and (f.not-a-number? (/.abs (/.complex f.not-a-number imaginary))) + (f.not-a-number? (/.abs (/.complex real f.not-a-number)))) + + infinity! + (and (f.= f.positive-infinity (/.abs (/.complex f.positive-infinity imaginary))) + (f.= f.positive-infinity (/.abs (/.complex real f.positive-infinity))) + (f.= f.positive-infinity (/.abs (/.complex f.negative-infinity imaginary))) + (f.= f.positive-infinity (/.abs (/.complex real f.negative-infinity))))] + (and normal! + not-a-number! + infinity!))) + ## https://en.wikipedia.org/wiki/Argument_(complex_analysis)#Identities + (_.cover [/.argument] + (let [sample (/.complex real imaginary)] + (or (/.= /.zero sample) + (/.within? ..margin-of-error + sample + (/.*' (/.abs sample) + (/.exp (/.* /.i (/.complex (/.argument sample))))))))) ))) (def: number Test - (do r.monad - [x ..complex - y ..complex + (do random.monad + [x ..random + y ..random factor ..dimension] ($_ _.and - (_.test "Adding 2 complex numbers is the same as adding their parts." - (let [z (/.+ y x)] - (and (/.= z - (/.complex (f.+ (get@ #/.real y) - (get@ #/.real x)) - (f.+ (get@ #/.imaginary y) - (get@ #/.imaginary x))))))) - (_.test "Subtracting 2 complex numbers is the same as adding their parts." - (let [z (/.- y x)] - (and (/.= z - (/.complex (f.- (get@ #/.real y) - (get@ #/.real x)) - (f.- (get@ #/.imaginary y) - (get@ #/.imaginary x))))))) - (_.test "Subtraction is the inverse of addition." - (and (|> x (/.+ y) (/.- y) (within? margin-of-error x)) - (|> x (/.- y) (/.+ y) (within? margin-of-error x)))) - (_.test "Division is the inverse of multiplication." - (|> x (/.* y) (/./ y) (within? margin-of-error x))) - (_.test "Scalar division is the inverse of scalar multiplication." - (|> x (/.*' factor) (/./' factor) (within? margin-of-error x))) - (_.test "If you subtract the remainder, all divisions must be exact." - (let [rem (/.% y x) - quotient (|> x (/.- rem) (/./ y)) - floored (|> quotient - (update@ #/.real math.floor) - (update@ #/.imaginary math.floor))] - (within? +0.000000000001 - x - (|> quotient (/.* y) (/.+ rem))))) + (_.cover [/.+] + (let [z (/.+ y x)] + (and (/.= z + (/.complex (f.+ (get@ #/.real y) + (get@ #/.real x)) + (f.+ (get@ #/.imaginary y) + (get@ #/.imaginary x))))))) + (_.cover [/.-] + (let [normal! + (let [z (/.- y x)] + (and (/.= z + (/.complex (f.- (get@ #/.real y) + (get@ #/.real x)) + (f.- (get@ #/.imaginary y) + (get@ #/.imaginary x)))))) + + inverse! + (and (|> x (/.+ y) (/.- y) (/.within? ..margin-of-error x)) + (|> x (/.- y) (/.+ y) (/.within? ..margin-of-error x)))] + (and normal! + inverse!))) + (_.cover [/.* /./] + (|> x (/.* y) (/./ y) (/.within? ..margin-of-error x))) + (_.cover [/.*' /./'] + (|> x (/.*' factor) (/./' factor) (/.within? ..margin-of-error x))) + (_.cover [/.%] + (let [rem (/.% y x) + quotient (|> x (/.- rem) (/./ y)) + floored (|> quotient + (update@ #/.real math.floor) + (update@ #/.imaginary math.floor))] + (/.within? +0.000000000001 + x + (|> quotient (/.* y) (/.+ rem))))) ))) (def: conjugate&reciprocal&signum&negation Test - (do r.monad - [x ..complex] + (do random.monad + [x ..random] ($_ _.and - (_.test "Conjugate has same real part as original, and opposite of imaginary part." - (let [cx (/.conjugate x)] - (and (f.= (get@ #/.real x) - (get@ #/.real cx)) - (f.= (f.negate (get@ #/.imaginary x)) - (get@ #/.imaginary cx))))) - (_.test "The reciprocal functions is its own inverse." - (|> x /.reciprocal /.reciprocal (within? margin-of-error x))) - (_.test "x*(x^-1) = 1" - (|> x (/.* (/.reciprocal x)) (within? margin-of-error /.one))) - (_.test "Absolute value of signum is always root2(2), 1 or 0." - (let [signum-abs (|> x /.signum /.abs (get@ #/.real))] - (or (f.= +0.0 signum-abs) - (f.= +1.0 signum-abs) - (f.= (math.pow +0.5 +2.0) signum-abs)))) - (_.test "Negation is its own inverse." - (let [there (/.negate x) - back-again (/.negate there)] - (and (not (/.= there x)) - (/.= back-again x)))) - (_.test "Negation doesn't change the absolute value." - (f.= (get@ #/.real (/.abs x)) - (get@ #/.real (/.abs (/.negate x))))) + (_.cover [/.conjugate] + (let [cx (/.conjugate x)] + (and (f.= (get@ #/.real x) + (get@ #/.real cx)) + (f.= (f.negate (get@ #/.imaginary x)) + (get@ #/.imaginary cx))))) + (_.cover [/.reciprocal] + (let [reciprocal! + (|> x (/.* (/.reciprocal x)) (/.within? ..margin-of-error /.+one)) + + own-inverse! + (|> x /.reciprocal /.reciprocal (/.within? ..margin-of-error x))] + (and reciprocal! + own-inverse!))) + (_.cover [/.signum] + ## Absolute value of signum is always root/2(2), 1 or 0. + (let [signum-abs (|> x /.signum /.abs)] + (or (f.= +0.0 signum-abs) + (f.= +1.0 signum-abs) + (f.= (math.pow +0.5 +2.0) signum-abs)))) + (_.cover [/.negate] + (let [own-inverse! + (let [there (/.negate x) + back-again (/.negate there)] + (and (not (/.= there x)) + (/.= back-again x))) + + absolute! + (f.= (/.abs x) + (/.abs (/.negate x)))] + (and own-inverse! + absolute!))) ))) (def: (trigonometric-symmetry forward backward angle) - (-> (-> Complex Complex) (-> Complex Complex) Complex Bit) + (-> (-> /.Complex /.Complex) (-> /.Complex /.Complex) /.Complex Bit) (let [normal (|> angle forward backward)] - (|> normal forward backward (within? margin-of-error normal)))) + (|> normal forward backward (/.within? ..margin-of-error normal)))) (def: trigonometry Test - (do {! r.monad} - [angle (|> ..complex (:: ! map (|>> (update@ #/.real (f.% +1.0)) - (update@ #/.imaginary (f.% +1.0)))))] + (do {! random.monad} + [angle ..angle] ($_ _.and - (_.test "Arc-sine is the inverse of sine." - (trigonometric-symmetry /.sin /.asin angle)) - (_.test "Arc-cosine is the inverse of cosine." - (trigonometric-symmetry /.cos /.acos angle)) - (_.test "Arc-tangent is the inverse of tangent." - (trigonometric-symmetry /.tan /.atan angle))))) + (_.cover [/.sin /.asin] + (trigonometric-symmetry /.sin /.asin angle)) + (_.cover [/.cos /.acos] + (trigonometric-symmetry /.cos /.acos angle)) + (_.cover [/.tan /.atan] + (trigonometric-symmetry /.tan /.atan angle))))) + +(def: hyperbolic + Test + (do {! random.monad} + [angle ..angle] + ($_ _.and + (_.cover [/.sinh] + (/.within? ..margin-of-error + (|> angle (/.* /.i) /.sin (/.* /.i) (/.* /.-one)) + (/.sinh angle))) + (_.cover [/.cosh] + (/.within? ..margin-of-error + (|> angle (/.* /.i) /.cos) + (/.cosh angle))) + (_.cover [/.tanh] + (/.within? ..margin-of-error + (|> angle (/.* /.i) /.tan (/.* /.i) (/.* /.-one)) + (/.tanh angle))) + ))) (def: exponentiation&logarithm Test - (do r.monad - [x ..complex] + (do random.monad + [x ..random] ($_ _.and - (_.test "Root 2 is inverse of power 2." - (|> x (/.pow' +2.0) (/.pow' +0.5) (within? margin-of-error x))) - (_.test "Logarithm is inverse of exponentiation." - (|> x /.log /.exp (within? margin-of-error x))) + (_.cover [/.pow /.root/2] + (|> x (/.pow (/.complex +2.0)) /.root/2 (/.within? ..margin-of-error x))) + (_.cover [/.pow'] + (|> x (/.pow' +2.0) (/.pow' +0.5) (/.within? ..margin-of-error x))) + (_.cover [/.log /.exp] + (|> x /.log /.exp (/.within? ..margin-of-error x))) ))) (def: root Test - (do {! r.monad} - [sample ..complex - degree (|> r.nat (:: ! map (|>> (n.max 1) (n.% 5))))] - (_.test "Can calculate the N roots for any complex number." - (|> sample - (/.roots degree) - (list\map (/.pow' (|> degree .int int.frac))) - (list.every? (within? margin-of-error sample)))))) + (do {! random.monad} + [sample ..random + degree (|> random.nat (:: ! map (|>> (n.max 1) (n.% 5))))] + (_.cover [/.roots] + (|> sample + (/.roots degree) + (list\map (/.pow' (|> degree .int int.frac))) + (list.every? (/.within? ..margin-of-error sample)))))) (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.covering /._) + (_.with-cover [/.Complex]) ($_ _.and + (_.with-cover [/.= /.equivalence] + ($equivalence.spec /.equivalence ..random)) + ..construction - ..absolute-value + ..constant + ..absolute-value&argument ..number ..conjugate&reciprocal&signum&negation ..trigonometry + ..hyperbolic ..exponentiation&logarithm ..root ))) diff --git a/stdlib/source/test/lux/data/number/ratio.lux b/stdlib/source/test/lux/data/number/ratio.lux index 788638fcf..a774b5e81 100644 --- a/stdlib/source/test/lux/data/number/ratio.lux +++ b/stdlib/source/test/lux/data/number/ratio.lux @@ -47,7 +47,7 @@ [denom0 ..part denom1 ..part] (_.test "All zeroes are the same." - (let [(^open "/@.") /.equivalence] - (/@= (/.ratio 0 denom0) + (let [(^open "/\.") /.equivalence] + (/\= (/.ratio 0 denom0) (/.ratio 0 denom1))))) )))) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 5a6b2e4bb..7849ee04a 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -249,14 +249,14 @@ sampleR (random.unicode sizeR) middle (random.unicode 1) #let [sample (/.concat (list sampleL sampleR)) - (^open "/@.") /.equivalence]] + (^open "/\.") /.equivalence]] ($_ _.and (_.cover [/.split] (|> (/.split sizeL sample) (case> (#.Right [_l _r]) - (and (/@= sampleL _l) - (/@= sampleR _r) - (/@= sample (/.concat (list _l _r)))) + (and (/\= sampleL _l) + (/\= sampleR _r) + (/\= sample (/.concat (list _l _r)))) _ #0))) @@ -266,10 +266,10 @@ (/.clip' sizeL sample) (/.clip' 0 sample)] (case> [(#.Right _l) (#.Right _r) (#.Right _r') (#.Right _f)] - (and (/@= sampleL _l) - (/@= sampleR _r) - (/@= _r _r') - (/@= sample _f)) + (and (/\= sampleL _l) + (/\= sampleR _r) + (/\= _r _r') + (/\= sample _f)) _ #0))) @@ -288,8 +288,8 @@ parts (random.list sizeL part-gen) #let [sample1 (/.concat (list.interpose sep1 parts)) sample2 (/.concat (list.interpose sep2 parts)) - (^open "/@.") /.equivalence]] + (^open "/\.") /.equivalence]] (_.cover [/.replace-all] - (/@= sample2 + (/\= sample2 (/.replace-all sep1 sep2 sample1)))) ))) diff --git a/stdlib/source/test/lux/host.jvm.lux b/stdlib/source/test/lux/host.jvm.lux index 355be630f..bda13403b 100644 --- a/stdlib/source/test/lux/host.jvm.lux +++ b/stdlib/source/test/lux/host.jvm.lux @@ -4,7 +4,7 @@ [control pipe] [data - ["." text ("#;." equivalence)] + ["." text ("#\." equivalence)] [number ["n" nat] ["i" int]]] @@ -107,7 +107,7 @@ (/.synchronized sample #1)) (_.test "Can access Class instances." - (text;= "java.lang.Class" (java/lang/Class::getName (/.class-for java/lang/Class)))) + (text\= "java.lang.Class" (java/lang/Class::getName (/.class-for java/lang/Class)))) (_.test "Can check if a value is null." (and (/.null? (/.null)) diff --git a/stdlib/source/test/lux/host.old.lux b/stdlib/source/test/lux/host.old.lux index fdb5d0c30..fa0ad409e 100644 --- a/stdlib/source/test/lux/host.old.lux +++ b/stdlib/source/test/lux/host.old.lux @@ -4,7 +4,7 @@ [control pipe] [data - ["." text ("#;." equivalence)] + ["." text ("#\." equivalence)] [number ["n" nat] ["i" int]]] @@ -103,7 +103,7 @@ (/.synchronized sample #1)) (_.test "Can access Class instances." - (text;= "java.lang.Class" (java/lang/Class::getName (/.class-for java/lang/Class)))) + (text\= "java.lang.Class" (java/lang/Class::getName (/.class-for java/lang/Class)))) (_.test "Can check if a value is null." (and (/.null? (/.null)) diff --git a/stdlib/source/test/lux/macro/poly/equivalence.lux b/stdlib/source/test/lux/macro/poly/equivalence.lux index 1790c0111..fcc12c61b 100644 --- a/stdlib/source/test/lux/macro/poly/equivalence.lux +++ b/stdlib/source/test/lux/macro/poly/equivalence.lux @@ -78,6 +78,6 @@ (<| (_.context (%.name (name-of /._))) (do random.monad [sample gen-record - #let [(^open "/@.") ..equivalence]] + #let [(^open "/\.") ..equivalence]] (_.test "Every instance equals itself." - (/@= sample sample))))) + (/\= sample sample))))) diff --git a/stdlib/source/test/lux/meta/annotation.lux b/stdlib/source/test/lux/meta/annotation.lux index 8acce1930..8ed76090c 100644 --- a/stdlib/source/test/lux/meta/annotation.lux +++ b/stdlib/source/test/lux/meta/annotation.lux @@ -10,7 +10,7 @@ [data ["." product] ["." bit] - ["." name] + ["." name ("#\." equivalence)] ["." text ["%" format (#+ format)]] [number @@ -90,7 +90,8 @@ [key ..random-key] (`` ($_ _.and (do ! - [dummy ..random-key + [dummy (random.filter (|>> (name\= key) not) + ..random-key) expected random.bit] (_.cover [/.flagged?] (and (|> expected code.bit diff --git a/stdlib/source/test/lux/time/duration.lux b/stdlib/source/test/lux/time/duration.lux index 7d40750a5..52454eae6 100644 --- a/stdlib/source/test/lux/time/duration.lux +++ b/stdlib/source/test/lux/time/duration.lux @@ -40,12 +40,12 @@ [sample (|> duration (:: ! map (/.frame /.day))) frame duration factor (|> random.nat (:: ! map (|>> (n.% 10) (n.max 1)))) - #let [(^open "/@.") /.order]] + #let [(^open "/\.") /.order]] ($_ _.and (_.test "Can scale a duration." (|> sample (/.scale-up factor) (/.query sample) (i.= (.int factor)))) (_.test "Scaling a duration by one does not change it." - (|> sample (/.scale-up 1) (/@= sample))) + (|> sample (/.scale-up 1) (/\= sample))) (_.test "Merging a duration with it's opposite yields an empty duration." - (|> sample (/.merge (/.inverse sample)) (/@= /.empty))))) + (|> sample (/.merge (/.inverse sample)) (/\= /.empty))))) ))) diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index fa1edcfe8..5c633a048 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -22,6 +22,8 @@ [time ["." instant] ["." duration]]] + ["." / #_ + ["#." watch]] {1 ["." / (#+ Path File)]} [/// @@ -78,8 +80,9 @@ duration.from-millis instant.absolute)))] ($_ _.and - (creation-and-deletion 0) - (read-and-write 1 dataL) + (..creation-and-deletion 0) + (..read-and-write 1 dataL) + (wrap (do promise.monad [#let [path "temp_file_2"] result (promise.future @@ -197,4 +200,6 @@ confirmed?))))] (_.assert "Can move a file from one path to another." (try.default #0 result)))) + + /watch.test )))) diff --git a/stdlib/source/test/lux/world/file/watch.lux b/stdlib/source/test/lux/world/file/watch.lux new file mode 100644 index 000000000..8d27ab307 --- /dev/null +++ b/stdlib/source/test/lux/world/file/watch.lux @@ -0,0 +1,155 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [predicate (#+ Predicate)] + [monad (#+ do)]] + [control + ["." try] + ["." exception] + [concurrency + ["." promise]] + [security + ["!" capability]]] + [data + ["." binary ("#\." equivalence)] + ["." text ("#\." equivalence) + ["%" format (#+ format)]] + [collection + ["." list]]] + [math + ["." random (#+ Random) ("#\." monad)]]] + {1 + ["." /]} + [//// + [data + ["_." binary]]]) + +(def: concern + (Random [/.Concern (Predicate /.Concern)]) + ($_ random.either + (random\wrap [/.creation /.creation?]) + (random\wrap [/.modification /.modification?]) + (random\wrap [/.deletion /.deletion?]) + )) + +(def: concern\\test + Test + (<| (_.with-cover [/.Concern]) + ($_ _.and + (_.cover [/.creation /.creation?] + (and (/.creation? /.creation) + (not (/.creation? /.modification)) + (not (/.creation? /.deletion)))) + (_.cover [/.modification /.modification?] + (and (not (/.modification? /.creation)) + (/.modification? /.modification) + (not (/.modification? /.deletion)))) + (_.cover [/.deletion /.deletion?] + (and (not (/.deletion? /.creation)) + (not (/.deletion? /.modification)) + (/.deletion? /.deletion))) + (do random.monad + [left ..concern + right (random.filter (|>> (is? left) not) + ..concern) + #let [[left left?] left + [right right?] right]] + (_.cover [/.also] + (let [composition (/.also left right)] + (and (left? composition) + (right? composition))))) + (_.cover [/.all] + (and (/.creation? /.all) + (/.modification? /.all) + (/.deletion? /.all))) + ))) + +(def: exception + Test + (do {! random.monad} + [directory (random.ascii/alpha 5) + #let [[fs watcher] (/.mock "/")]] + ($_ _.and + (wrap (do promise.monad + [?concern (:: watcher concern directory) + ?stop (:: watcher stop directory)] + (_.cover' [/.not-being-watched] + (and (case ?concern + (#try.Failure error) + (exception.match? /.not-being-watched error) + + (#try.Success _) + false) + (case ?stop + (#try.Failure error) + (exception.match? /.not-being-watched error) + + (#try.Success _) + false))))) + ))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Watcher]) + ($_ _.and + ..concern\\test + ..exception + + (do {! random.monad} + [directory (random.ascii/alpha 5) + #let [/ "/" + [fs watcher] (/.mock /)] + expected-path (:: ! map (|>> (format directory /)) + (random.ascii/alpha 5)) + data (_binary.random 10)] + (wrap (do {! promise.monad} + [verdict (do (try.with !) + [_ (!.use (:: fs create-directory) [directory]) + _ (:: watcher start /.all directory) + poll/0 (:: watcher poll []) + #let [no-events-prior-to-creation! + (list.empty? poll/0)] + file (!.use (:: fs create-file) [expected-path]) + poll/1 (:: watcher poll []) + #let [after-creation! + (case poll/1 + (^ (list [actual-path concern])) + (and (text\= expected-path actual-path) + (and (/.creation? concern) + (not (/.modification? concern)) + (not (/.deletion? concern)))) + + _ + false)] + _ (!.use (:: file over-write) data) + poll/2 (:: watcher poll []) + #let [after-modification! + (case poll/2 + (^ (list [actual-path concern])) + (and (text\= expected-path actual-path) + (and (not (/.creation? concern)) + (/.modification? concern) + (not (/.deletion? concern)))) + + _ + false)] + _ (!.use (:: file delete) []) + poll/3 (:: watcher poll []) + #let [after-deletion! + (case poll/3 + (^ (list [actual-path concern])) + (and (not (/.creation? concern)) + (not (/.modification? concern)) + (/.deletion? concern)) + + _ + false)]] + (wrap (and no-events-prior-to-creation! + after-creation! + after-modification! + after-deletion!)))] + (_.cover' [/.mock /.polling] + (try.default false verdict))))) + ))) |