diff options
Diffstat (limited to 'stdlib/source/library/lux/control')
22 files changed, 291 insertions, 145 deletions
diff --git a/stdlib/source/library/lux/control/concatenative.lux b/stdlib/source/library/lux/control/concatenative.lux index f8426ebb7..88ac4f0b9 100644 --- a/stdlib/source/library/lux/control/concatenative.lux +++ b/stdlib/source/library/lux/control/concatenative.lux @@ -12,6 +12,7 @@ ["." list ("#\." fold functor)]]] ["." macro (#+ with_gensyms) ["." code] + ["." template] [syntax (#+ syntax:) ["|.|" export] ["|.|" annotations]]] @@ -61,7 +62,7 @@ (monad.do meta.monad [expansion expander] (case expansion - (#.Cons singleton #.Nil) + (#.Item singleton #.End) (in singleton) _ @@ -71,6 +72,15 @@ (syntax: #export (=> {aliases aliases^} {inputs stack^} {outputs stack^}) + {#.doc (doc "Concatenative function types." + (=> [Nat] [Nat]) + (All [a] (-> a (=> [] [a]))) + (All [t] (=> [t] [])) + (All [a b c] (=> [a b c] [b c a])) + (All [___a ___z] + (=> {then (=> ___a ___z) + else (=> ___a ___z)} + ___a [Bit then else] ___z)))} (let [de_alias (function (_ aliased) (list\fold (function (_ [from to] pre) (code.replace (code.local_identifier from) to pre)) @@ -102,6 +112,13 @@ top)) (syntax: #export (||> {commands (<>.some <c>.any)}) + {#.doc (doc "A self-contained sequence of concatenative instructions." + (is? value + (||> (..push sample))) + + (||> (push 123) + dup + n/=))} (in (list (` (|> (~! ..begin!) (~+ commands) ((~! ..end!))))))) (syntax: #export (word: @@ -110,12 +127,21 @@ {annotations (<>.default |annotations|.empty |annotations|.parser)} type {commands (<>.some <c>.any)}) + {#.doc (doc "A named concatenative function." + (word: square + (=> [Nat] [Nat]) + + dup + (apply/2 n.*)))} (in (list (` (def: (~+ (|export|.format export)) (~ (code.local_identifier name)) (~ (|annotations|.format annotations)) (~ type) (|>> (~+ commands))))))) (syntax: #export (apply {arity (|> <c>.nat (<>.only (n.> 0)))}) + {#.doc (doc "A generator for functions that turn arity N functions into arity N concatenative functions." + (: (=> [Nat] [Nat]) + ((apply 1) inc)))} (with_gensyms [g! g!func g!stack g!output] (monad.do {! meta.monad} [g!inputs (|> (macro.gensym "input") (list.repeat arity) (monad.seq !))] @@ -126,70 +152,84 @@ (function ((~ g!) (~ (stack_fold g!inputs g!stack))) [(~ g!stack) ((~ g!func) (~+ g!inputs))]))))))))) -(def: #export apply/1 (apply 1)) -(def: #export apply/2 (apply 2)) -(def: #export apply/3 (apply 3)) -(def: #export apply/4 (apply 4)) -(def: #export apply/5 (apply 5)) -(def: #export apply/6 (apply 6)) -(def: #export apply/7 (apply 7)) -(def: #export apply/8 (apply 8)) +(template [<arity>] + [(with_expansions [<name> (template.identifier ["apply/" <arity>]) + <doc> (template.text ["Lift a function of arity " <arity> + " into a concatenative function of arity " <arity> "."])] + (def: #export <name> + {#.doc (doc <doc>)} + (apply <arity>)))] + + [1] [2] [3] [4] + [5] [6] [7] [8] + ) (def: #export (push x) + {#.doc (doc "Push a value onto the stack.")} (All [a] (-> a (=> [] [a]))) (function (_ stack) [stack x])) (def: #export drop + {#.doc (doc "Drop/pop a value from the top of the stack.")} (All [t] (=> [t] [])) (function (_ [stack top]) stack)) (def: #export nip + {#.doc (doc "Drop the second-to-last value from the top of the stack.")} (All [_ a] (=> [_ a] [a])) (function (_ [[stack _] top]) [stack top])) (def: #export dup + {#.doc (doc "Duplicate the top of the stack.")} (All [a] (=> [a] [a a])) (function (_ [stack top]) [[stack top] top])) (def: #export swap + {#.doc (doc "Swaps the 2 topmost stack values.")} (All [a b] (=> [a b] [b a])) (function (_ [[stack l] r]) [[stack r] l])) (def: #export rotL + {#.doc (doc "Rotes the 3 topmost stack values to the left.")} (All [a b c] (=> [a b c] [b c a])) (function (_ [[[stack a] b] c]) [[[stack b] c] a])) (def: #export rotR + {#.doc (doc "Rotes the 3 topmost stack values to the right.")} (All [a b c] (=> [a b c] [c a b])) (function (_ [[[stack a] b] c]) [[[stack c] a] b])) (def: #export && + {#.doc (doc "Groups the 2 topmost stack values as a 2-tuple.")} (All [a b] (=> [a b] [(& a b)])) (function (_ [[stack l] r]) [stack [l r]])) (def: #export ||L + {#.doc (doc "Left-injects the top into sum.")} (All [a b] (=> [a] [(| a b)])) (function (_ [stack l]) [stack (0 #0 l)])) (def: #export ||R + {#.doc (doc "Right-injects the top into sum.")} (All [a b] (=> [b] [(| a b)])) (function (_ [stack r]) [stack (0 #1 r)])) (template [<input> <output> <word> <func>] - [(def: #export <word> - (=> [<input> <input>] [<output>]) - (function (_ [[stack subject] param]) - [stack (<func> param subject)]))] + [(`` (def: #export <word> + {#.doc (doc (~~ (template.text [<func> " for " <input> " arithmetic."])))} + (=> [<input> <input>] [<output>]) + (function (_ [[stack subject] param]) + [stack (<func> param subject)])))] [Nat Nat n/+ n.+] [Nat Nat n/- n.-] @@ -237,6 +277,12 @@ ) (def: #export if + {#.doc (doc "If expression." + (is? "then" + (||> (push true) + (push "then") + (push "else") + if)))} (All [___a ___z] (=> {then (=> ___a ___z) else (=> ___a ___z)} @@ -247,6 +293,7 @@ (else stack)))) (def: #export call + {#.doc (doc "Executes an anonymous block on the stack.")} (All [___a ___z] (=> {quote (=> ___a ___z)} ___a [quote] ___z)) @@ -254,6 +301,7 @@ (quote stack))) (def: #export loop + {#.doc (doc "Executes a block as a loop until it yields #0 to stop.")} (All [___] (=> {test (=> ___ ___ [Bit])} ___ [test] ___)) @@ -264,6 +312,7 @@ stack')))) (def: #export dip + {#.doc (doc "Executes a block on the stack, save for the topmost value.")} (All [___ a] (=> ___ [a (=> ___ ___)] ___ [a])) @@ -271,6 +320,7 @@ [(quote stack) a])) (def: #export dip/2 + {#.doc (doc "Executes a block on the stack, save for the 2 topmost values.")} (All [___ a b] (=> ___ [a b (=> ___ ___)] ___ [a b])) @@ -278,6 +328,12 @@ [[(quote stack) a] b])) (def: #export do + {#.doc (doc "Do-while loop expression." + (n.= (inc sample) + (||> (push sample) + (push (push false)) + (push (|>> (push 1) n/+)) + do while)))} (All [___a ___z] (=> {body (=> ___a ___z) pred (=> ___z ___a [Bit])} @@ -287,6 +343,14 @@ [[(body stack) pred] body])) (def: #export while + {#.doc (doc "While loop expression." + (n.= (n.+ distance start) + (||> (push start) + (push (|>> dup + (push start) n/- + (push distance) n/<)) + (push (|>> (push 1) n/+)) + while)))} (All [___a ___z] (=> {body (=> ___z ___a) pred (=> ___a ___z [Bit])} @@ -299,13 +363,27 @@ stack')))) (def: #export compose + {#.doc (doc "Function composition." + (n.= (n.+ 2 sample) + (||> (push sample) + (push (|>> (push 1) n/+)) + (push (|>> (push 1) n/+)) + compose + call)))} (All [___a ___ ___z] (=> [(=> ___a ___) (=> ___ ___z)] [(=> ___a ___z)])) (function (_ [[stack f] g]) [stack (|>> f g)])) -(def: #export curry +(def: #export partial + {#.doc (doc "Partial application." + (n.= (n.+ sample sample) + (||> (push sample) + (push sample) + (push n/+) + partial + call)))} (All [___a ___z a] (=> ___a [a (=> ___a [a] ___z)] ___a [(=> ___a ___z)])) @@ -313,19 +391,21 @@ [stack (|>> (push arg) quote)])) (word: #export when + {#.doc (doc "Only execute the block when #1.")} (All [___] (=> {body (=> ___ ___)} ___ [Bit body] ___)) swap - (push (|>> call)) - (push (|>> drop)) + (push ..call) + (push ..drop) if) (word: #export ? + {#.doc (doc "Choose the top value when #0 and the second-to-top when #1.")} (All [a] (=> [Bit a a] [a])) rotL - (push (|>> drop)) - (push (|>> nip)) + (push ..drop) + (push ..nip) if) diff --git a/stdlib/source/library/lux/control/concurrency/actor.lux b/stdlib/source/library/lux/control/concurrency/actor.lux index 5b954efcd..72d28a0b7 100644 --- a/stdlib/source/library/lux/control/concurrency/actor.lux +++ b/stdlib/source/library/lux/control/concurrency/actor.lux @@ -58,11 +58,11 @@ [current (async.poll read)] (case current (#.Some [head tail]) - (\ ! map (|>> (#.Cons head)) + (\ ! map (|>> (#.Item head)) (pending tail)) #.None - (in #.Nil)))) + (in #.End)))) (abstract: #export (Actor s) {#obituary [(Async <Obituary>) @@ -106,7 +106,7 @@ (exec (io.run (do io.monad [pending (..pending tail)] - (resolve [error state (#.Cons head pending)]))) + (resolve [error state (#.Item head pending)]))) (in []))) (#try.Success state') @@ -270,7 +270,7 @@ (message: #export (push {value a} state self) (List a) - (let [state' (#.Cons value state)] + (let [state' (#.Item value state)] (async.resolved (#try.Success [state' state']))))) (actor: #export Counter diff --git a/stdlib/source/library/lux/control/concurrency/async.lux b/stdlib/source/library/lux/control/concurrency/async.lux index 68a586914..4f96b2122 100644 --- a/stdlib/source/library/lux/control/concurrency/async.lux +++ b/stdlib/source/library/lux/control/concurrency/async.lux @@ -78,7 +78,7 @@ (f value) #.None - (let [new [_value (#.Cons f _observers)]] + (let [new [_value (#.Item f _observers)]] (do ! [swapped? (atom.compare_and_swap old new async)] (if swapped? diff --git a/stdlib/source/library/lux/control/concurrency/frp.lux b/stdlib/source/library/lux/control/concurrency/frp.lux index 9bda3c334..beecb2511 100644 --- a/stdlib/source/library/lux/control/concurrency/frp.lux +++ b/stdlib/source/library/lux/control/concurrency/frp.lux @@ -102,9 +102,9 @@ (def: (apply ff fa) (do async.monad - [cons_f ff - cons_a fa] - (case [cons_f cons_a] + [item_f ff + item_a fa] + (case [item_f item_a] [(#.Some [head_f tail_f]) (#.Some [head_a tail_a])] (in (#.Some [(head_f head_a) (apply tail_f tail_a)])) @@ -157,8 +157,8 @@ (io (exec (: (Async Any) (loop [channel channel] (do async.monad - [cons channel] - (case cons + [item channel] + (case item (#.Some [head tail]) (case (io.run (subscriber head)) (#.Some _) @@ -176,8 +176,8 @@ "that pass the test.")} (All [a] (-> (-> a Bit) (Channel a) (Channel a))) (do async.monad - [cons channel] - (case cons + [item channel] + (case item (#.Some [head tail]) (let [tail' (only pass? tail)] (if (pass? head) @@ -200,8 +200,8 @@ (-> (-> b a (Async a)) a (Channel b) (Async a))) (do {! async.monad} - [cons channel] - (case cons + [item channel] + (case item #.None (in init) @@ -215,8 +215,8 @@ (-> (-> b a (Async a)) a (Channel b) (Channel a))) (do {! async.monad} - [cons channel] - (case cons + [item channel] + (case item #.None (in (#.Some [init (in #.None)])) @@ -254,8 +254,8 @@ (def: (distinct' equivalence previous channel) (All [a] (-> (Equivalence a) a (Channel a) (Channel a))) (do async.monad - [cons channel] - (case cons + [item channel] + (case item (#.Some [head tail]) (if (\ equivalence = previous head) (distinct' equivalence previous tail) @@ -267,8 +267,8 @@ (def: #export (distinct equivalence channel) (All [a] (-> (Equivalence a) (Channel a) (Channel a))) (do async.monad - [cons channel] - (case cons + [item channel] + (case item (#.Some [head tail]) (in (#.Some [head (distinct' equivalence head tail)])) @@ -278,23 +278,23 @@ (def: #export (consume channel) (All [a] (-> (Channel a) (Async (List a)))) (do {! async.monad} - [cons channel] - (case cons + [item channel] + (case item (#.Some [head tail]) - (\ ! map (|>> (#.Cons head)) + (\ ! map (|>> (#.Item head)) (consume tail)) #.None - (in #.Nil)))) + (in #.End)))) (def: #export (sequential milli_seconds values) {#.doc (doc "Transforms the given list into a channel with the same elements.")} (All [a] (-> Nat (List a) (Channel a))) (case values - #.Nil + #.End ..empty - (#.Cons head tail) + (#.Item head tail) (async.resolved (#.Some [head (do async.monad [_ (async.wait milli_seconds)] (sequential milli_seconds tail))])))) diff --git a/stdlib/source/library/lux/control/concurrency/stm.lux b/stdlib/source/library/lux/control/concurrency/stm.lux index da01d2db8..183558265 100644 --- a/stdlib/source/library/lux/control/concurrency/stm.lux +++ b/stdlib/source/library/lux/control/concurrency/stm.lux @@ -72,7 +72,7 @@ (do io.monad [#let [[channel sink] (frp.channel [])] _ (atom.update (function (_ [value observers]) - [value (#.Cons sink observers)]) + [value (#.Item sink observers)]) (:representation target))] (in [channel sink]))) ) @@ -109,23 +109,23 @@ #.None (let [value (..read! var)] - [(#.Cons [var value value] tx) + [(#.Item [var value value] tx) value])))) (def: (update_tx_value var value tx) (All [a] (-> (Var a) a Tx Tx)) (case tx - #.Nil - #.Nil + #.End + #.End - (#.Cons [_var _original _current] tx') + (#.Item [_var _original _current] tx') (if (is? (:as (Var Any) var) (:as (Var Any) _var)) - (#.Cons {#var (:as (Var Any) _var) + (#.Item {#var (:as (Var Any) _var) #original (:as Any _original) #current (:as Any value)} tx') - (#.Cons {#var _var + (#.Item {#var _var #original _original #current _current} (update_tx_value var value tx'))))) @@ -139,7 +139,7 @@ []] #.None - [(#.Cons [var (..read! var) value] tx) + [(#.Item [var (..read! var) value] tx) []]))) (implementation: #export functor diff --git a/stdlib/source/library/lux/control/concurrency/thread.lux b/stdlib/source/library/lux/control/concurrency/thread.lux index 36f65d0ea..9a6f3a7b1 100644 --- a/stdlib/source/library/lux/control/concurrency/thread.lux +++ b/stdlib/source/library/lux/control/concurrency/thread.lux @@ -130,7 +130,7 @@ ## Default (do {! io.monad} [now (\ ! map (|>> instant.to_millis .nat) instant.now) - _ (atom.update (|>> (#.Cons {#creation now + _ (atom.update (|>> (#.Item {#creation now #delay milli_seconds #action action})) ..runner)] @@ -153,7 +153,7 @@ [threads (atom.read ..runner)] (case threads ## And... we're done! - #.Nil + #.End (in []) _ diff --git a/stdlib/source/library/lux/control/exception.lux b/stdlib/source/library/lux/control/exception.lux index 22b882f85..c57c9877b 100644 --- a/stdlib/source/library/lux/control/exception.lux +++ b/stdlib/source/library/lux/control/exception.lux @@ -34,6 +34,7 @@ #constructor (-> a Text)}) (def: #export (match? exception error) + {#.doc (doc "Is this exception the cause of the error message?")} (All [e] (-> (Exception e) Text Bit)) (text.starts_with? (get@ #label exception) error)) @@ -100,7 +101,7 @@ (exception: #export some_exception) "" "Complex case:" - (exception: #export [optional type variables] (some_exception {optional Text} {arguments Int}) + (exception: #export [arbitrary type variables] (some_exception {optional Text} {arguments Int}) optional_body))} (macro.with_gensyms [g!descriptor] (do meta.monad @@ -140,29 +141,37 @@ (text.replace_all text.new_line on_new_line) ($_ text\compose padding header header_separator)))))] (case entries - #.Nil + #.End "" - (#.Cons head tail) + (#.Item head tail) (list\fold (function (_ post pre) ($_ text\compose pre text.new_line (on_entry post))) (on_entry head) tail)))) (syntax: #export (report {entries (p.many (s.tuple (p.and s.any s.any)))}) + {#.doc (doc "An error report." + (: Text + (report ["Row 0" value/0] + ["Row 1" value/1] + ,,, + ["Row N" value/N])))} (in (list (` ((~! report') (list (~+ (|> entries (list\map (function (_ [header message]) (` [(~ header) (~ message)]))))))))))) (def: #export (enumerate format entries) + {#.doc (doc "A numbered report of the entries on a list." + "NOTE: 0-based numbering.")} (All [a] (-> (-> a Text) (List a) Text)) (|> entries (list\fold (function (_ entry [index next]) [(inc index) - (#.Cons [(n\encode index) (format entry)] + (#.Item [(n\encode index) (format entry)] next)]) - [0 #.Nil]) + [0 #.End]) product.right list.reverse ..report')) @@ -183,6 +192,7 @@ error)) (def: #export (with exception message computation) + {#.doc (doc "If a computation fails, prepends the exception to the error.")} (All [e a] (-> (Exception e) e (Try a) (Try a))) (case computation (#//.Failure error) diff --git a/stdlib/source/library/lux/control/function.lux b/stdlib/source/library/lux/control/function.lux index 2f880a872..32d3633ef 100644 --- a/stdlib/source/library/lux/control/function.lux +++ b/stdlib/source/library/lux/control/function.lux @@ -36,6 +36,7 @@ (function (_ x y) (f y x))) (def: #export (apply input function) + {#.doc (doc "Simple 1-argument function application.")} (All [i o] (-> i (-> i o) o)) (function input)) diff --git a/stdlib/source/library/lux/control/function/mutual.lux b/stdlib/source/library/lux/control/function/mutual.lux index 73407a7f1..d53249897 100644 --- a/stdlib/source/library/lux/control/function/mutual.lux +++ b/stdlib/source/library/lux/control/function/mutual.lux @@ -70,10 +70,10 @@ (and (even? 4) (odd? 5))))} (case functions - #.Nil + #.End (in (list body)) - (#.Cons mutual #.Nil) + (#.Item mutual #.End) (.let [g!name (|> mutual (get@ [#declaration #declaration.name]) code.local_identifier)] (in (list (` (.let [(~ g!name) (: (~ (get@ #type mutual)) (function (~ (declaration.format (get@ #declaration mutual))) @@ -134,10 +134,10 @@ 0 false _ (even? (dec number)))]))} (case functions - #.Nil + #.End (in (list)) - (#.Cons definition #.Nil) + (#.Item definition #.End) (.let [(^slots [#exported? #mutual]) definition (^slots [#declaration #type #body]) mutual] (in (list (` (.def: diff --git a/stdlib/source/library/lux/control/parser.lux b/stdlib/source/library/lux/control/parser.lux index f473208a9..d38044ec1 100644 --- a/stdlib/source/library/lux/control/parser.lux +++ b/stdlib/source/library/lux/control/parser.lux @@ -90,6 +90,9 @@ (#try.Success [input' (#.Some x)])))) (def: #export (run parser input) + {#.doc (doc "Executes the parser on the input." + "Does not verify that all of the input has been consumed by the parser." + "Returns both the parser's output, and a value that represents the remaining input.")} (All [s a] (-> (Parser s a) s (Try [s a]))) (parser input)) @@ -151,7 +154,7 @@ (-> (Parser s a) (Parser s (List a)))) (|> (..some parser) (..and parser) - (\ ..monad map (|>> #.Cons)))) + (\ ..monad map (|>> #.Item)))) (def: #export (exactly amount parser) {#.doc "Parse exactly N times."} @@ -162,7 +165,7 @@ [x parser] (|> parser (exactly (dec amount)) - (\ ! map (|>> (#.Cons x))))))) + (\ ! map (|>> (#.Item x))))))) (def: #export (at_least amount parser) {#.doc "Parse at least N times."} @@ -182,7 +185,7 @@ (#try.Success [input (list)]) (#try.Success [input' x]) - (..run (\ ..monad map (|>> (#.Cons x)) + (..run (\ ..monad map (|>> (#.Item x)) (at_most (dec amount) parser)) input'))))) @@ -197,21 +200,22 @@ (in minimum)))) (def: #export (separated_by separator parser) - {#.doc "Parsers instances of 'parser' that are separated by instances of 'separator'."} + {#.doc "Parses instances of 'parser' that are separated by instances of 'separator'."} (All [s a b] (-> (Parser s b) (Parser s a) (Parser s (List a)))) (do {! ..monad} [?x (..maybe parser)] (case ?x #.None - (in #.Nil) + (in #.End) (#.Some x) (|> parser (..and separator) ..some - (\ ! map (|>> (list\map product.right) (#.Cons x))))))) + (\ ! map (|>> (list\map product.right) (#.Item x))))))) (def: #export (not parser) + {#.doc (doc "Only succeeds when the underlying parser fails.")} (All [s a] (-> (Parser s a) (Parser s Any))) (function (_ input) (case (parser input) @@ -222,11 +226,13 @@ (#try.Failure "Expected to fail; yet succeeded.")))) (def: #export (failure message) + {#.doc (doc "Always fail with this 'message'.")} (All [s a] (-> Text (Parser s a))) (function (_ input) (#try.Failure message))) (def: #export (lift operation) + {#.doc (doc "Lift a potentially failed computation into a parser.")} (All [s a] (-> (Try a) (Parser s a))) (function (_ input) (case operation @@ -248,23 +254,26 @@ (#try.Success [input' output])))) (def: #export remaining + {#.doc (doc "Yield the remaining input (without consuming it).")} (All [s] (Parser s s)) (function (_ inputs) (#try.Success [inputs inputs]))) (def: #export (rec parser) - {#.doc "Combinator for recursive parser."} + {#.doc "Combinator for recursive parsers."} (All [s a] (-> (-> (Parser s a) (Parser s a)) (Parser s a))) (function (_ inputs) (..run (parser (rec parser)) inputs))) (def: #export (after param subject) + {#.doc (doc "Run the parser after another one (whose output is ignored).")} (All [s _ a] (-> (Parser s _) (Parser s a) (Parser s a))) (do ..monad [_ param] subject)) (def: #export (before param subject) + {#.doc (doc "Run the parser before another one (whose output is ignored).")} (All [s _ a] (-> (Parser s _) (Parser s a) (Parser s a))) (do ..monad [output subject @@ -272,6 +281,7 @@ (in output))) (def: #export (only test parser) + {#.doc (doc "Only succeed when the parser's output passes a test.")} (All [s a] (-> (-> a Bit) (Parser s a) (Parser s a))) (do ..monad [output parser @@ -279,6 +289,7 @@ (in output))) (def: #export (parses? parser) + {#.doc (doc "Ignore a parser's output and just verify that it succeeds.")} (All [s a] (-> (Parser s a) (Parser s Bit))) (function (_ input) (case (parser input) @@ -289,6 +300,7 @@ (#try.Success [input' true])))) (def: #export (parses parser) + {#.doc (doc "Ignore a parser's output and just execute it.")} (All [s a] (-> (Parser s a) (Parser s Any))) (function (_ input) (case (parser input) @@ -299,6 +311,8 @@ (#try.Success [input' []])))) (def: #export (speculative parser) + {#.doc (doc "Executes a parser, without actually consuming the input." + "That way, the same input can be consumed again by another parser.")} (All [s a] (-> (Parser s a) (Parser s a))) (function (_ input) (case (parser input) @@ -309,6 +323,7 @@ output))) (def: #export (codec codec parser) + {#.doc (doc "Decode the output of a parser using a codec.")} (All [s a z] (-> (Codec a z) (Parser s a) (Parser s z))) (function (_ input) (case (parser input) diff --git a/stdlib/source/library/lux/control/parser/analysis.lux b/stdlib/source/library/lux/control/parser/analysis.lux index 2b585c31e..b94490a95 100644 --- a/stdlib/source/library/lux/control/parser/analysis.lux +++ b/stdlib/source/library/lux/control/parser/analysis.lux @@ -59,7 +59,7 @@ (#try.Failure error) (#try.Failure error) - (#try.Success [#.Nil value]) + (#try.Success [#.End value]) (#try.Success value) (#try.Success [unconsumed _]) @@ -70,10 +70,10 @@ (Parser Analysis) (function (_ input) (case input - #.Nil + #.End (exception.except ..cannot_parse input) - (#.Cons [head tail]) + (#.Item [head tail]) (#try.Success [tail head])))) (def: #export end! @@ -81,7 +81,7 @@ (Parser Any) (function (_ tokens) (case tokens - #.Nil (#try.Success [tokens []]) + #.End (#try.Success [tokens []]) _ (#try.Failure (format "Expected list of tokens to be empty!" (remaining_inputs tokens)))))) @@ -90,7 +90,7 @@ (Parser Bit) (function (_ tokens) (#try.Success [tokens (case tokens - #.Nil true + #.End true _ false)]))) (template [<query> <assertion> <tag> <type> <eq>] diff --git a/stdlib/source/library/lux/control/parser/cli.lux b/stdlib/source/library/lux/control/parser/cli.lux index e8796ff1b..df59dbd44 100644 --- a/stdlib/source/library/lux/control/parser/cli.lux +++ b/stdlib/source/library/lux/control/parser/cli.lux @@ -20,7 +20,7 @@ (case (//.run parser inputs) (#try.Success [remaining output]) (case remaining - #.Nil + #.End (#try.Success output) _ @@ -34,7 +34,7 @@ (Parser Text) (function (_ inputs) (case inputs - (#.Cons arg inputs') + (#.Item arg inputs') (#try.Success [inputs' arg]) _ @@ -70,13 +70,13 @@ (#try.Failure try) (case immediate - #.Nil + #.End (#try.Failure try) - (#.Cons to_omit immediate') + (#.Item to_omit immediate') (do try.monad [[remaining output] (recur immediate')] - (in [(#.Cons to_omit remaining) + (in [(#.Item to_omit remaining) output]))))))) (def: #export end @@ -84,7 +84,7 @@ (Parser Any) (function (_ inputs) (case inputs - #.Nil (#try.Success [inputs []]) + #.End (#try.Success [inputs []]) _ (#try.Failure (format "Unknown parameters: " (text.join_with " " inputs)))))) (def: #export (named name value) diff --git a/stdlib/source/library/lux/control/parser/code.lux b/stdlib/source/library/lux/control/parser/code.lux index 6f52b23d9..7dd43ffa4 100644 --- a/stdlib/source/library/lux/control/parser/code.lux +++ b/stdlib/source/library/lux/control/parser/code.lux @@ -24,8 +24,8 @@ (def: (join_pairs pairs) (All [a] (-> (List [a a]) (List a))) (case pairs - #.Nil #.Nil - (#.Cons [[x y] pairs']) (list& x y (join_pairs pairs')))) + #.End #.End + (#.Item [[x y] pairs']) (list& x y (join_pairs pairs')))) (type: #export Parser {#.doc "A Lux code parser."} @@ -41,10 +41,10 @@ (Parser Code) (function (_ tokens) (case tokens - #.Nil + #.End (#try.Failure "There are no tokens to parse!") - (#.Cons [t tokens']) + (#.Item [t tokens']) (#try.Success [tokens' t])))) (template [<query> <check> <type> <tag> <eq> <desc>] @@ -54,7 +54,7 @@ (Parser <type>) (function (_ tokens) (case tokens - (#.Cons [[_ (<tag> x)] tokens']) + (#.Item [[_ (<tag> x)] tokens']) (#try.Success [tokens' x]) _ @@ -65,7 +65,7 @@ (-> <type> (Parser Any)) (function (_ tokens) (case tokens - (#.Cons [[_ (<tag> actual)] tokens']) + (#.Item [[_ (<tag> actual)] tokens']) (if (\ <eq> = expected actual) (#try.Success [tokens' []]) <failure>) @@ -88,7 +88,7 @@ (-> Code (Parser Any)) (function (_ tokens) (case tokens - (#.Cons [token tokens']) + (#.Item [token tokens']) (if (code\= code token) (#try.Success [tokens' []]) (#try.Failure ($_ text\compose "Expected a " (code.format code) " but instead got " (code.format token) @@ -104,7 +104,7 @@ (Parser Text) (function (_ tokens) (case tokens - (#.Cons [[_ (<tag> ["" x])] tokens']) + (#.Item [[_ (<tag> ["" x])] tokens']) (#try.Success [tokens' x]) _ @@ -115,7 +115,7 @@ (-> Text (Parser Any)) (function (_ tokens) (case tokens - (#.Cons [[_ (<tag> ["" actual])] tokens']) + (#.Item [[_ (<tag> ["" actual])] tokens']) (if (\ <eq> = expected actual) (#try.Success [tokens' []]) <failure>) @@ -134,9 +134,9 @@ (-> (Parser a) (Parser a))) (function (_ tokens) (case tokens - (#.Cons [[_ (<tag> members)] tokens']) + (#.Item [[_ (<tag> members)] tokens']) (case (p members) - (#try.Success [#.Nil x]) (#try.Success [tokens' x]) + (#try.Success [#.End x]) (#try.Success [tokens' x]) _ (#try.Failure ($_ text\compose "Parser was expected to fully consume " <desc> (remaining_inputs tokens)))) _ @@ -152,9 +152,9 @@ (-> (Parser a) (Parser a))) (function (_ tokens) (case tokens - (#.Cons [[_ (#.Record pairs)] tokens']) + (#.Item [[_ (#.Record pairs)] tokens']) (case (p (join_pairs pairs)) - (#try.Success [#.Nil x]) (#try.Success [tokens' x]) + (#try.Success [#.End x]) (#try.Success [tokens' x]) _ (#try.Failure ($_ text\compose "Parser was expected to fully consume record" (remaining_inputs tokens)))) _ @@ -165,7 +165,7 @@ (Parser Any) (function (_ tokens) (case tokens - #.Nil (#try.Success [tokens []]) + #.End (#try.Success [tokens []]) _ (#try.Failure ($_ text\compose "Expected list of tokens to be empty!" (remaining_inputs tokens)))))) (def: #export end? @@ -173,7 +173,7 @@ (Parser Bit) (function (_ tokens) (#try.Success [tokens (case tokens - #.Nil true + #.End true _ false)]))) (def: #export (run parser inputs) @@ -185,7 +185,7 @@ (#try.Success [unconsumed value]) (case unconsumed - #.Nil + #.End (#try.Success value) _ diff --git a/stdlib/source/library/lux/control/parser/json.lux b/stdlib/source/library/lux/control/parser/json.lux index cc20f6512..f186a315a 100644 --- a/stdlib/source/library/lux/control/parser/json.lux +++ b/stdlib/source/library/lux/control/parser/json.lux @@ -39,7 +39,7 @@ (case (//.run parser (list json)) (#try.Success [remainder output]) (case remainder - #.Nil + #.End (#try.Success output) _ @@ -53,10 +53,10 @@ (Parser JSON) (<| (function (_ inputs)) (case inputs - #.Nil + #.End (exception.except ..empty_input []) - (#.Cons head tail) + (#.Item head tail) (#try.Success [tail head])))) (exception: #export (unexpected_value {value JSON}) @@ -138,7 +138,7 @@ (#try.Success [remainder output]) (case remainder - #.Nil + #.End (in output) _ @@ -166,7 +166,7 @@ (#try.Success [remainder output]) (case remainder - #.Nil + #.End (in output) _ @@ -184,7 +184,7 @@ (^ (list& (#/.String key) value inputs')) (if (text\= key field_name) (case (//.run parser (list value)) - (#try.Success [#.Nil output]) + (#try.Success [#.End output]) (#try.Success [inputs' output]) (#try.Success [inputs'' _]) @@ -197,7 +197,7 @@ (in [(list& (#/.String key) value inputs'') output]))) - #.Nil + #.End (exception.except ..empty_input []) _ diff --git a/stdlib/source/library/lux/control/parser/synthesis.lux b/stdlib/source/library/lux/control/parser/synthesis.lux index 3496fde42..b902d4b81 100644 --- a/stdlib/source/library/lux/control/parser/synthesis.lux +++ b/stdlib/source/library/lux/control/parser/synthesis.lux @@ -60,7 +60,7 @@ (#try.Failure error) (#try.Failure error) - (#try.Success [#.Nil value]) + (#try.Success [#.End value]) (#try.Success value) (#try.Success [unconsumed _]) @@ -71,10 +71,10 @@ (Parser Synthesis) (.function (_ input) (case input - #.Nil + #.End (exception.except ..empty_input []) - (#.Cons [head tail]) + (#.Item [head tail]) (#try.Success [tail head])))) (def: #export end! @@ -82,7 +82,7 @@ (Parser Any) (.function (_ tokens) (case tokens - #.Nil (#try.Success [tokens []]) + #.End (#try.Success [tokens []]) _ (exception.except ..expected_empty_input [tokens])))) (def: #export end? @@ -90,7 +90,7 @@ (Parser Bit) (.function (_ tokens) (#try.Success [tokens (case tokens - #.Nil true + #.End true _ false)]))) (template [<query> <assertion> <tag> <type> <eq>] diff --git a/stdlib/source/library/lux/control/parser/type.lux b/stdlib/source/library/lux/control/parser/type.lux index d8177a553..c4438fbf8 100644 --- a/stdlib/source/library/lux/control/parser/type.lux +++ b/stdlib/source/library/lux/control/parser/type.lux @@ -81,7 +81,7 @@ (#try.Success [[env' remaining] output]) (case remaining - #.Nil + #.End (#try.Success output) _ @@ -114,10 +114,10 @@ (Parser Type) (.function (_ [env inputs]) (case inputs - #.Nil + #.End (exception.except ..empty_input []) - (#.Cons headT tail) + (#.Item headT tail) (#try.Success [[env inputs] headT])))) (def: #export any @@ -125,10 +125,10 @@ (Parser Type) (.function (_ [env inputs]) (case inputs - #.Nil + #.End (exception.except ..empty_input []) - (#.Cons headT tail) + (#.Item headT tail) (#try.Success [[env tail] headT])))) (def: #export (local types poly) @@ -202,7 +202,7 @@ (|> env' (dictionary.put funcI [headT funcL]) (dictionary.put (inc funcI) [(#.Parameter (inc funcI)) varL])) - (#.Cons varL all_varsL))) + (#.Item varL all_varsL))) (let [partialI (|> current_arg (n.* 2) (n.+ funcI)) partial_varI (inc partialI) partial_varL (label partial_varI) @@ -213,7 +213,7 @@ (|> env' (dictionary.put partialI [.Nothing partialC]) (dictionary.put partial_varI [(#.Parameter partial_varI) partial_varL])) - (#.Cons partial_varL all_varsL)))) + (#.Item partial_varL all_varsL)))) [all_varsL env']))]] (<| (with_env env') (local (list non_poly)) @@ -240,7 +240,7 @@ #let [[funcT paramsT] (type.flat_application (type.anonymous headT))]] (if (n.= 0 (list.size paramsT)) (//.failure (exception.construct ..not_application headT)) - (..local (#.Cons funcT paramsT) poly)))) + (..local (#.Item funcT paramsT) poly)))) (template [<name> <test> <doc>] [(def: #export (<name> expected) @@ -324,7 +324,7 @@ (`` (template: (|nothing|) (#.Named [(~~ (static .prelude_module)) "Nothing"] - (#.UnivQ #.Nil + (#.UnivQ #.End (#.Parameter 1))))) (def: #export (recursive poly) diff --git a/stdlib/source/library/lux/control/parser/xml.lux b/stdlib/source/library/lux/control/parser/xml.lux index eb11fb3fd..4af88b9b3 100644 --- a/stdlib/source/library/lux/control/parser/xml.lux +++ b/stdlib/source/library/lux/control/parser/xml.lux @@ -60,10 +60,10 @@ (Parser Text) (function (_ [attrs documents]) (case documents - #.Nil + #.End (exception.except ..empty_input []) - (#.Cons head tail) + (#.Item head tail) (case head (#/.Text value) (#try.Success [[attrs tail] value]) @@ -76,10 +76,10 @@ (Parser Tag) (function (_ [attrs documents]) (case documents - #.Nil + #.End (exception.except ..empty_input []) - (#.Cons head _) + (#.Item head _) (case head (#/.Text _) (exception.except ..unexpected_input []) @@ -103,10 +103,10 @@ (All [a] (-> Tag (Parser a) (Parser a))) (function (_ [attrs documents]) (case documents - #.Nil + #.End (exception.except ..empty_input []) - (#.Cons head tail) + (#.Item head tail) (case head (#/.Text _) (exception.except ..unexpected_input []) @@ -123,10 +123,10 @@ (Parser Any) (function (_ [attrs documents]) (case documents - #.Nil + #.End (exception.except ..empty_input []) - (#.Cons head tail) + (#.Item head tail) (#try.Success [[attrs tail] []])))) (exception: #export nowhere) @@ -141,11 +141,11 @@ (#try.Failure error) (case input - #.Nil + #.End (exception.except ..nowhere []) - (#.Cons head tail) + (#.Item head tail) (do try.monad [[[attrs tail'] output] (recur [attrs tail])] - (in [[attrs (#.Cons head tail')] + (in [[attrs (#.Item head tail')] output])))))) diff --git a/stdlib/source/library/lux/control/pipe.lux b/stdlib/source/library/lux/control/pipe.lux index 1945eec59..128c8f036 100644 --- a/stdlib/source/library/lux/control/pipe.lux +++ b/stdlib/source/library/lux/control/pipe.lux @@ -68,11 +68,26 @@ (|> (~ g!temp) (~+ else))))))))) (syntax: #export (if> {test body^} {then body^} {else body^} prev) + {#.doc (doc "If-branching." + (is? (if (n.even? sample) + "even" + "odd") + (|> sample + (if> [n.even?] + [(new> "even" [])] + [(new> "odd" [])]))))} (in (list (` (cond> [(~+ test)] [(~+ then)] [(~+ else)] (~ prev)))))) (syntax: #export (when> {test body^} {then body^} prev) + {#.doc (doc "Only execute the body when the test passes." + (is? (if (n.even? sample) + (n.* 2 sample) + sample) + (|> sample + (when> [n.even?] + [(n.* 2)]))))} (in (list (` (cond> [(~+ test)] [(~+ then)] [] (~ prev)))))) diff --git a/stdlib/source/library/lux/control/reader.lux b/stdlib/source/library/lux/control/reader.lux index cf565cd22..8c46ef9a8 100644 --- a/stdlib/source/library/lux/control/reader.lux +++ b/stdlib/source/library/lux/control/reader.lux @@ -2,8 +2,8 @@ [library [lux #* [abstract - ["." functor (#+ Functor)] [apply (#+ Apply)] + ["." functor (#+ Functor)] ["." monad (#+ Monad do)]]]]) (type: #export (Reader r a) @@ -21,6 +21,7 @@ (|>> change proc)) (def: #export (run env proc) + {#.doc (doc "Executes the reader against the given environment.")} (All [r a] (-> r (Reader r a) a)) (proc env)) diff --git a/stdlib/source/library/lux/control/region.lux b/stdlib/source/library/lux/control/region.lux index 98250983a..281c8d19e 100644 --- a/stdlib/source/library/lux/control/region.lux +++ b/stdlib/source/library/lux/control/region.lux @@ -19,6 +19,8 @@ (-> r (! (Try Any)))) (type: #export (Region r ! a) + {#.doc (doc "A region where resources may be be claimed and where a side-effecting computation may be performed." + "Every resource is paired with a function that knows how to clean/reclaim it, to make sure there are no leaks.")} (-> [r (List (Cleaner r !))] (! [(List (Cleaner r !)) (Try a)]))) @@ -52,6 +54,7 @@ (exception.except ..clean_up_error [error output]))) (def: #export (run monad computation) + {#.doc (doc "Executes a region-based computation, with a side-effect determined by the monad.")} (All [! a] (-> (Monad !) (All [r] (Region r ! a)) (! (Try a)))) @@ -62,10 +65,11 @@ (in (list\fold combine_outcomes output results)))) (def: #export (acquire monad cleaner value) + {#.doc (doc "Acquire a resource while pairing it a function that knows how to reclaim it.")} (All [! a] (-> (Monad !) (-> a (! (Try Any))) a (All [r] (Region r ! a)))) (function (_ [region cleaners]) - (\ monad in [(#.Cons (function (_ region) (cleaner value)) + (\ monad in [(#.Item (function (_ region) (cleaner value)) cleaners) (#try.Success value)]))) @@ -136,6 +140,7 @@ (in [cleaners (#try.Failure error)])))))) (def: #export (failure monad error) + {#.doc (doc "Immediately fail with this 'message'.")} (All [! a] (-> (Monad !) Text (All [r] (Region r ! a)))) @@ -143,16 +148,18 @@ (\ monad in [cleaners (#try.Failure error)]))) (def: #export (except monad exception message) + {#.doc (doc "Fail by throwing/raising an exception.")} (All [! e a] (-> (Monad !) (Exception e) e (All [r] (Region r ! a)))) (failure monad (exception.construct exception message))) (def: #export (lift monad operation) + {#.doc (doc "Lift an effectful computation into a region-based computation.")} (All [! a] (-> (Monad !) (! a) (All [r] (Region r ! a)))) (function (_ [region cleaners]) - (do monad - [output operation] - (in [cleaners (#try.Success output)])))) + (\ monad map + (|>> #try.Success [cleaners]) + operation))) diff --git a/stdlib/source/library/lux/control/remember.lux b/stdlib/source/library/lux/control/remember.lux index d8a6dc8a7..659c1cc39 100644 --- a/stdlib/source/library/lux/control/remember.lux +++ b/stdlib/source/library/lux/control/remember.lux @@ -18,6 +18,7 @@ ["." meta] [macro ["." code] + ["." template] [syntax (#+ syntax:)]]]]) (exception: #export (must_remember {deadline Date} {today Date} {message Text} {focus (Maybe Code)}) @@ -47,6 +48,13 @@ (<>.failure message))))) (syntax: #export (remember {deadline ..deadline} {message <c>.text} {focus (<>.maybe <c>.any)}) + {#.doc (doc "A message with an expiration date." + "Can have an optional piece of code to focus on." + (remember "2022-04-01" + "Do this, that and the other.") + (remember "2022-04-01" + "Improve the performace." + (some (complicated (computation 123)))))} (let [now (io.run instant.now) today (instant.date now)] (if (date\< deadline today) @@ -59,15 +67,22 @@ (meta.failure (exception.construct ..must_remember [deadline today message focus]))))) (template [<name> <message>] - [(syntax: #export (<name> {deadline ..deadline} {message <c>.text} {focus (<>.maybe <c>.any)}) - (in (list (` (..remember (~ (code.text (%.date deadline))) - (~ (code.text (format <message> " " message))) - (~+ (case focus - (#.Some focus) - (list focus) + [(`` (syntax: #export (<name> {deadline ..deadline} {message <c>.text} {focus (<>.maybe <c>.any)}) + {#.doc (doc (~~ (template.text ["A " <message> " message with an expiration date."])) + "Can have an optional piece of code to focus on." + (<name> "2022-04-01" + "Do this, that and the other.") + (<name> "2022-04-01" + "Improve the performace." + (some (complicated (computation 123)))))} + (in (list (` (..remember (~ (code.text (%.date deadline))) + (~ (code.text (format <message> " " message))) + (~+ (case focus + (#.Some focus) + (list focus) - #.None - (list))))))))] + #.None + (list)))))))))] [to_do "TODO"] [fix_me "FIXME"] diff --git a/stdlib/source/library/lux/control/state.lux b/stdlib/source/library/lux/control/state.lux index 661c081d8..447b6428e 100644 --- a/stdlib/source/library/lux/control/state.lux +++ b/stdlib/source/library/lux/control/state.lux @@ -29,13 +29,13 @@ [(change state) []])) (def: #export (use user) - {#.doc "Run function on current state."} + {#.doc "Run a function on the current state."} (All [s a] (-> (-> s a) (State s a))) (function (_ state) [state (user state)])) (def: #export (local change action) - {#.doc "Run computation with a locally-modified state."} + {#.doc "Run the computation with a locally-modified state."} (All [s a] (-> (-> s s) (State s a) (State s a))) (function (_ state) (let [[state' output] (action (change state))] @@ -80,6 +80,7 @@ (ma state'))))) (def: #export (while condition body) + {#.doc (doc "A stateful while loop.")} (All [s] (-> (State s Bit) (State s Any) (State s Any))) (do {! ..monad} [execute? condition] @@ -90,6 +91,7 @@ (in [])))) (def: #export (do_while condition body) + {#.doc (doc "A stateful do-while loop.")} (All [s] (-> (State s Bit) (State s Any) (State s Any))) (do ..monad [_ body] @@ -120,7 +122,7 @@ (-> s (M [s a]))) (def: #export (run' state action) - {#.doc "Run a stateful computation decorated by a monad."} + {#.doc "Execute a stateful computation decorated by a monad."} (All [M s a] (-> s (State' M s a) (M [s a]))) (action state)) |