aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--stdlib/source/lux/codata/io.lux2
-rw-r--r--stdlib/source/lux/concurrency/actor.lux138
-rw-r--r--stdlib/source/lux/concurrency/atom.lux16
-rw-r--r--stdlib/source/lux/concurrency/frp.lux43
-rw-r--r--stdlib/source/lux/concurrency/promise.lux11
-rw-r--r--stdlib/source/lux/concurrency/stm.lux28
-rw-r--r--stdlib/source/lux/control/applicative.lux28
-rw-r--r--stdlib/source/lux/control/bounded.lux1
-rw-r--r--stdlib/source/lux/control/codec.lux17
-rw-r--r--stdlib/source/lux/control/comonad.lux3
-rw-r--r--stdlib/source/lux/control/effect.lux56
-rw-r--r--stdlib/source/lux/control/enum.lux2
-rw-r--r--stdlib/source/lux/control/eq.lux1
-rw-r--r--stdlib/source/lux/control/fold.lux1
-rw-r--r--stdlib/source/lux/control/functor.lux7
-rw-r--r--stdlib/source/lux/control/hash.lux3
-rw-r--r--stdlib/source/lux/control/monad.lux18
-rw-r--r--stdlib/source/lux/control/monoid.lux3
-rw-r--r--stdlib/source/lux/control/number.lux2
-rw-r--r--stdlib/source/lux/control/ord.lux2
-rw-r--r--stdlib/source/lux/data/error/exception.lux12
-rw-r--r--stdlib/source/lux/data/log.lux2
-rw-r--r--stdlib/source/lux/data/number.lux17
-rw-r--r--stdlib/source/lux/data/product.lux3
-rw-r--r--stdlib/source/lux/data/struct/array.lux5
-rw-r--r--stdlib/source/lux/data/struct/dict.lux50
-rw-r--r--stdlib/source/lux/data/struct/list.lux31
-rw-r--r--stdlib/source/lux/data/struct/queue.lux9
-rw-r--r--stdlib/source/lux/data/struct/tree.lux8
-rw-r--r--stdlib/source/lux/data/struct/vector.lux2
-rw-r--r--stdlib/source/lux/data/struct/zipper.lux1
-rw-r--r--stdlib/source/lux/data/sum.lux3
-rw-r--r--stdlib/source/lux/data/text.lux2
-rw-r--r--stdlib/source/lux/data/text/format.lux3
-rw-r--r--stdlib/source/lux/host.lux11
-rw-r--r--stdlib/source/lux/lexer.lux50
-rw-r--r--stdlib/source/lux/macro.lux6
-rw-r--r--stdlib/source/lux/macro/ast.lux46
-rw-r--r--stdlib/source/lux/macro/syntax.lux55
-rw-r--r--stdlib/source/lux/macro/syntax/common.lux42
-rw-r--r--stdlib/source/lux/macro/template.lux46
-rw-r--r--stdlib/source/lux/math.lux18
-rw-r--r--stdlib/source/lux/math/complex.lux8
-rw-r--r--stdlib/source/lux/math/random.lux28
-rw-r--r--stdlib/source/lux/math/ratio.lux11
-rw-r--r--stdlib/source/lux/math/simple.lux30
-rw-r--r--stdlib/source/lux/pipe.lux11
-rw-r--r--stdlib/source/lux/regex.lux58
-rw-r--r--stdlib/source/lux/test.lux84
-rw-r--r--stdlib/source/lux/type.lux12
-rw-r--r--stdlib/source/lux/type/auto.lux26
-rw-r--r--stdlib/source/lux/type/check.lux61
-rw-r--r--stdlib/test/test/lux/concurrency/actor.lux2
-rw-r--r--stdlib/test/test/lux/data/struct/queue.lux18
54 files changed, 796 insertions, 357 deletions
diff --git a/stdlib/source/lux/codata/io.lux b/stdlib/source/lux/codata/io.lux
index e612c24c9..60ea73834 100644
--- a/stdlib/source/lux/codata/io.lux
+++ b/stdlib/source/lux/codata/io.lux
@@ -3,7 +3,7 @@
## If a copy of the MPL was not distributed with this file,
## You can obtain one at http://mozilla.org/MPL/2.0/.
-(;module:
+(;module: {#;doc "A method for abstracting I/O and effectful computations to make it safe while writing pure functional code."}
lux
(lux (control functor
applicative
diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux
index cea170b2c..650065a0e 100644
--- a/stdlib/source/lux/concurrency/actor.lux
+++ b/stdlib/source/lux/concurrency/actor.lux
@@ -3,7 +3,7 @@
## If a copy of the MPL was not distributed with this file,
## You can obtain one at http://mozilla.org/MPL/2.0/.
-(;module:
+(;module: {#;doc "The actor model of concurrency."}
lux
(lux (control monad)
(codata [io #- run]
@@ -18,32 +18,35 @@
["s" syntax #+ syntax: Syntax]
(syntax [common]))
[type])
- (.. [promise #+ Monad<Promise>]
+ (.. ["P" promise #+ Monad<Promise>]
[stm #+ Monad<STM>]
[frp]))
## [Types]
(type: #export (Actor s m)
+ {#;doc "An actor, defined as all the necessities it requires."}
{#mailbox (stm;Var m)
- #kill-signal (promise;Promise Unit)
- #obituary (promise;Promise [(Maybe Text) s (List m)])})
+ #kill-signal (P;Promise Unit)
+ #obituary (P;Promise [(Maybe Text) s (List m)])})
-(type: #export (Proc s m)
- {#step (-> (Actor s m) (-> m s (promise;Promise (Error s))))
- #end (-> (Maybe Text) s (promise;Promise Unit))})
+(type: #export (Behavior s m)
+ {#;doc "An actor's behavior when messages are received."}
+ {#step (-> (Actor s m) (-> m s (P;Promise (Error s))))
+ #end (-> (Maybe Text) s (P;Promise Unit))})
## [Values]
-(def: #export (spawn init [proc on-death])
- {#;doc "Given a procedure and initial state, launches an actor and returns it."}
- (All [s m] (-> s (Proc s m) (IO (Actor s m))))
- (io (let [mailbox (stm;var (:! ($ +1) []))
- kill-signal (promise;promise Unit)
- obituary (promise;promise [(Maybe Text) ($ +0) (List ($ +1))])
+(def: #export (spawn init behavior)
+ {#;doc "Given a behavior and initial state, spawns an actor and returns it."}
+ (All [s m] (-> s (Behavior s m) (IO (Actor s m))))
+ (io (let [[step on-death] behavior
+ mailbox (stm;var (:! ($ +1) []))
+ kill-signal (P;promise Unit)
+ obituary (P;promise [(Maybe Text) ($ +0) (List ($ +1))])
self {#mailbox mailbox
#kill-signal kill-signal
#obituary obituary}
mailbox-chan (io;run (stm;follow "\tmailbox\t" mailbox))
- proc (proc self)
+ step (step self)
|mailbox| (stm;var mailbox-chan)
_ (:: Monad<Promise> map
(lambda [_]
@@ -60,11 +63,11 @@
(#;Some [message messages'])
(do Monad<Promise>
[#let [_ (io;run (stm;write! messages' |mailbox|))]
- ?state' (proc message state)]
+ ?state' (step message state)]
(case ?state'
(#;Left error)
(do @
- [#let [_ (io;run (promise;resolve [] kill-signal))
+ [#let [_ (io;run (P;resolve [] kill-signal))
_ (io;run (frp;close messages'))
death-message (#;Some error)]
_ (on-death death-message state)
@@ -86,12 +89,12 @@
(def: #export poison
{#;doc "Immediately kills the given actor (if it's not already dead)."}
(All [s m] (-> (Actor s m) (io;IO Bool)))
- (|>. (get@ #kill-signal) (promise;resolve [])))
+ (|>. (get@ #kill-signal) (P;resolve [])))
(def: #export (alive? actor)
(All [s m] (-> (Actor s m) Bool))
- (case [(promise;poll (get@ #kill-signal actor))
- (promise;poll (get@ #obituary actor))]
+ (case [(P;poll (get@ #kill-signal actor))
+ (P;poll (get@ #obituary actor))]
[#;None #;None]
true
@@ -99,18 +102,20 @@
false))
(def: #export (send message actor)
- (All [s m] (-> m (Actor s m) (promise;Promise Bool)))
+ {#;doc "Communicate with an actor through message passing."}
+ (All [s m] (-> m (Actor s m) (P;Promise Bool)))
(if (alive? actor)
(exec (io;run (stm;write! message (get@ #mailbox actor)))
(:: Monad<Promise> wrap true))
(:: Monad<Promise> wrap false)))
-(def: #export (keep-alive init proc)
- {#;doc "Given initial-state and a procedure, launches and actor that will reboot if it dies of errors.
- However, it can still be killed."}
- (All [s m] (-> s (Proc s m) (IO (Actor s m))))
+(def: #export (keep-alive init behavior)
+ {#;doc "Given initial-state and a behavior, spawns an actor that will reboot if it dies of errors.
+
+ However, if it is killed, it won't re-spawn."}
+ (All [s m] (-> s (Behavior s m) (IO (Actor s m))))
(io (let [ka-actor (: (Actor (Actor ($ +0) ($ +1)) ($ +1))
- (io;run (spawn (io;run (spawn init proc))
+ (io;run (spawn (io;run (spawn init behavior))
{#step (lambda [*self* message server]
(do Monad<Promise>
[was-sent? (send message server)]
@@ -118,17 +123,19 @@
(wrap (#;Right server))
(do @
[[?cause state unprocessed-messages] (get@ #obituary server)]
- (exec (log! (format "ACTOR DIED:\n" (default "" ?cause) "\n RESTARTING"))
+ (exec (log! (format "ACTOR DIED:" "\n"
+ (default "" ?cause) "\n"
+ "RESTARTING" "\n"))
(do @
- [#let [new-server (io;run (spawn state proc))
+ [#let [new-server (io;run (spawn state behavior))
mailbox (get@ #mailbox new-server)]
- _ (promise;future (mapM io;Monad<IO> ((flip stm;write!) mailbox) (#;Cons message unprocessed-messages)))]
+ _ (P;future (mapM io;Monad<IO> ((flip stm;write!) mailbox) (#;Cons message unprocessed-messages)))]
(wrap (#;Right new-server))))
))))
#end (lambda [_ server] (exec (io;run (poison server))
(:: Monad<Promise> wrap [])))})))]
- (update@ #obituary (: (-> (promise;Promise [(Maybe Text) (Actor ($ +0) ($ +1)) (List ($ +1))])
- (promise;Promise [(Maybe Text) ($ +0) (List ($ +1))]))
+ (update@ #obituary (: (-> (P;Promise [(Maybe Text) (Actor ($ +0) ($ +1)) (List ($ +1))])
+ (P;Promise [(Maybe Text) ($ +0) (List ($ +1))]))
(lambda [process]
(do Monad<Promise>
[[_ server unprocessed-messages-0] process
@@ -193,23 +200,22 @@
state-type
[methods (s;many method^)]
[?stop (s;opt stop^)])
- {#;doc (doc "Allows defining an actor, with a set of methods that can be called on it."
- "The methods can return promisehronous outputs."
- "The methods can access the actor's state through the *state* variable."
- "The methods can also access the actor itself through the *self* variable."
+ {#;doc (doc "Allows defining an actor, with a pice of state and a set of methods that can be called on it."
+ "A method can access the actor's state through the *state* variable."
+ "A method can also access the actor itself through the *self* variable."
+ "A method may succeed or fail (in case of failure, the actor dies). This is handled through the Either type."
+ "A method's output must be a promise containing a 2-tuple with the updated state and a return value."
+ "All methods are run implicitly within the Promise monad."
(actor: #export Adder
Int
- (method: (count! {to-add Int})
+ (method: (count! [to-add Int])
[Int Int]
- (if (>= 0 to-add)
- (do Monad<Promise>
- [#let [new-state (i.+ to-add *state*)]]
+ (if (i.>= 0 to-add)
+ (let [new-state (i.+ to-add *state*)]
(wrap (#;Right [new-state [*state* new-state]])))
- (do Monad<Promise>
- []
- (wrap (#;Left "Can't add negative numbers!")))))
+ (wrap (#;Left "Can't add negative numbers!"))))
))}
(with-gensyms [g!message g!error g!return g!error g!output]
(let [g!state-name (ast;symbol ["" (format _name "//STATE")])
@@ -217,62 +223,62 @@
g!self (ast;symbol ["" "*self*"])
g!state (ast;symbol ["" "*state*"])
g!cause (ast;symbol ["" "*cause*"])
- g!stop-body (default (` (:: promise;Monad<Promise> (~' wrap) [])) ?stop)
+ g!stop-body (default (` (:: P;Monad<Promise> (~' wrap) [])) ?stop)
protocol (List/map (lambda [(^slots [#name #vars #args #return #body])]
- (` ((~ (ast;tag ["" name])) [(~@ (List/map product;right args))] (promise;Promise (~ return)))))
+ (` ((~ (ast;tag ["" name])) [(~@ (List/map product;right args))] (P;Promise (~ return)))))
methods)
protocol-pm (List/map (: (-> Method [AST AST])
(lambda [(^slots [#name #vars #args #return #body])]
(let [arg-names (|> (list;size args) (list;n.range +1) (List/map (|>. Nat/encode [""] ast;symbol)))
- body-func (` (: (-> (~ g!state-name) (~@ (List/map product;right args)) (promise;Promise (Error [(~ g!state-name) (~ return)])))
+ body-func (` (: (-> (~ g!state-name) (~@ (List/map product;right args)) (P;Promise (Error [(~ g!state-name) (~ return)])))
(lambda (~ (ast;symbol ["" _name])) [(~ g!state) (~@ (List/map (|>. product;left [""] ast;symbol) args))]
- (do promise;Monad<Promise>
+ (do P;Monad<Promise>
[]
(~ body)))))]
[(` [[(~@ arg-names)] (~ g!return)])
- (` (do promise;Monad<Promise>
+ (` (do P;Monad<Promise>
[(~ g!output) ((~ body-func) (~ g!state) (~@ arg-names))]
(case (~ g!output)
(#;Right [(~ g!state) (~ g!output)])
- (exec (io;run (promise;resolve (~ g!output) (~ g!return)))
+ (exec (io;run (P;resolve (~ g!output) (~ g!return)))
((~' wrap) (#;Right (~ g!state))))
(#;Left (~ g!error))
((~' wrap) (#;Left (~ g!error))))
))])))
methods)
- g!proc (` {#step (lambda [(~ g!self) (~ g!message) (~ g!state)]
- (case (~ g!message)
- (~@ (if (n.= +1 (list;size protocol-pm))
- (List/join (List/map (lambda [[pattern clause]]
- (list pattern clause))
- protocol-pm))
- (List/join (List/map (lambda [[method [pattern clause]]]
- (list (` ((~ (ast;tag ["" (get@ #name method)])) (~ pattern)))
- clause))
- (list;zip2 methods protocol-pm)))))
- ))
- #end (lambda [(~ g!cause) (~ g!state)]
- (do promise;Monad<Promise>
- []
- (~ g!stop-body)))})
+ g!behavior (` {#step (lambda [(~ g!self) (~ g!message) (~ g!state)]
+ (case (~ g!message)
+ (~@ (if (n.= +1 (list;size protocol-pm))
+ (List/join (List/map (lambda [[pattern clause]]
+ (list pattern clause))
+ protocol-pm))
+ (List/join (List/map (lambda [[method [pattern clause]]]
+ (list (` ((~ (ast;tag ["" (get@ #name method)])) (~ pattern)))
+ clause))
+ (list;zip2 methods protocol-pm)))))
+ ))
+ #end (lambda [(~ g!cause) (~ g!state)]
+ (do P;Monad<Promise>
+ []
+ (~ g!stop-body)))})
g!actor-name (ast;symbol ["" _name])
g!methods (List/map (: (-> Method AST)
(lambda [(^slots [#name #vars #args #return #body])]
(let [arg-names (|> (list;size args) (list;n.range +1) (List/map (|>. Nat/encode [""] ast;symbol)))
type (` (-> (~@ (List/map product;right args))
(~ g!actor-name)
- (promise;Promise (~ return))))]
+ (P;Promise (~ return))))]
(` (def: (~@ (common;gen-export-level _ex-lev)) ((~ (ast;symbol ["" name])) (~@ arg-names) (~ g!self))
(~ type)
- (let [(~ g!output) (promise;promise (~ return))]
+ (let [(~ g!output) (P;promise (~ return))]
(exec (send ((~ (ast;tag ["" name])) [[(~@ arg-names)] (~ g!output)]) (~ g!self))
(~ g!output))))))))
methods)]
(wrap (list& (` (type: (~@ (common;gen-export-level _ex-lev)) (~ g!state-name) (~ state-type)))
(` (type: (~@ (common;gen-export-level _ex-lev)) (~ g!protocol-name) (~@ protocol)))
(` (type: (~@ (common;gen-export-level _ex-lev)) (~ g!actor-name) (Actor (~ g!state-name) (~ g!protocol-name))))
- (` (def: (~@ (common;gen-export-level _ex-lev)) (~@ (actor-def-decl decl (` (Proc (~ g!state-name) (~ g!protocol-name)))))
- (~ g!proc)))
+ (` (def: (~@ (common;gen-export-level _ex-lev)) (~@ (actor-def-decl decl (` (Behavior (~ g!state-name) (~ g!protocol-name)))))
+ (~ g!behavior)))
g!methods))
)))
diff --git a/stdlib/source/lux/concurrency/atom.lux b/stdlib/source/lux/concurrency/atom.lux
index 3905ee7ca..3b4687931 100644
--- a/stdlib/source/lux/concurrency/atom.lux
+++ b/stdlib/source/lux/concurrency/atom.lux
@@ -6,8 +6,7 @@
(;module:
lux
(lux (codata [io #- run])
- host)
- )
+ host))
(jvm-import (java.util.concurrent.atomic.AtomicReference V)
(new [V])
@@ -15,6 +14,7 @@
(get [] V))
(type: #export (Atom a)
+ {#;doc "Atomic references that are safe to mutate concurrently."}
(AtomicReference a))
(def: #export (atom value)
@@ -25,11 +25,19 @@
(All [a] (-> (Atom a) (IO a)))
(io (AtomicReference.get [] atom)))
-(def: #export (compare-and-swap old new atom)
+(def: #export (compare-and-swap current new atom)
+ {#;doc "Only mutates an atom if you can present it's current value.
+
+ That guarantees that actor wasn't updated since you last read from it."}
(All [a] (-> a a (Atom a) (IO Bool)))
- (io (AtomicReference.compareAndSet [old new] atom)))
+ (io (AtomicReference.compareAndSet [current new] atom)))
(def: #export (update f atom)
+ {#;doc "Updates an atom by applying a function to its current value.
+
+ If it fails to update it (because some other process wrote to it first), it will retry until it succeeds.
+
+ The retries will be done with the new values of the atom, as they show up."}
(All [a] (-> (-> a a) (Atom a) (IO Unit)))
(io (let [old (AtomicReference.get [] atom)]
(if (AtomicReference.compareAndSet [old (f old)] atom)
diff --git a/stdlib/source/lux/concurrency/frp.lux b/stdlib/source/lux/concurrency/frp.lux
index 3a8e62fbb..1620618d5 100644
--- a/stdlib/source/lux/concurrency/frp.lux
+++ b/stdlib/source/lux/concurrency/frp.lux
@@ -19,12 +19,18 @@
## [Types]
(type: #export (Chan a)
+ {#;doc "An asynchronous channel of values which may be closed.
+
+ Reading from a channel does not remove the read piece of data, as it can still be accessed if you have an earlier node of the channel."}
(&;Promise (Maybe [a (Chan a)])))
## [Syntax]
(syntax: #export (chan [?type (s;opt s;any)])
{#;doc (doc "Makes an uninitialized Chan (in this case, of Unit)."
- (chan Unit))}
+ (chan Unit)
+
+ "The type is optional."
+ (chan))}
(case ?type
(#;Some type)
(wrap (list (` (: (Chan (~ type))
@@ -45,16 +51,17 @@
(filter p xs')))))
(def: #export (write value chan)
+ {#;doc "Write to a channel, so long as it's still open."}
(All [a] (-> a (Chan a) (IO (Maybe (Chan a)))))
(case (&;poll chan)
(^template [<case> <chan-to-write>]
- <case>
- (do Monad<IO>
- [#let [new-tail (&;promise)]
- done? (&;resolve (#;Some [value new-tail]) <chan-to-write>)]
- (if done?
- (wrap (#;Some new-tail))
- (write value <chan-to-write>))))
+ <case>
+ (do Monad<IO>
+ [#let [new-tail (&;promise)]
+ done? (&;resolve (#;Some [value new-tail]) <chan-to-write>)]
+ (if done?
+ (wrap (#;Some new-tail))
+ (write value <chan-to-write>))))
([#;None chan]
[(#;Some (#;Some [_ chan'])) chan'])
@@ -66,12 +73,12 @@
(All [a] (-> (Chan a) (IO Bool)))
(case (&;poll chan)
(^template [<case> <chan-to-write>]
- <case>
- (do Monad<IO>
- [done? (&;resolve #;None <chan-to-write>)]
- (if done?
- (wrap true)
- (close <chan-to-write>))))
+ <case>
+ (do Monad<IO>
+ [done? (&;resolve #;None <chan-to-write>)]
+ (if done?
+ (wrap true)
+ (close <chan-to-write>))))
([#;None chan]
[(#;Some (#;Some [_ chan'])) chan'])
@@ -93,6 +100,7 @@
(pipe' input' output')))))
(def: #export (pipe input output)
+ {#;doc "Copy/pipe the contents of a channel on to another."}
(All [a] (-> (Chan a) (Chan a) (&;Promise Unit)))
(do &;Monad<Promise>
[_ (pipe' input output)]
@@ -100,6 +108,7 @@
(wrap []))))
(def: #export (merge xss)
+ {#;doc "Fuse all the elements in a list of channels by piping them onto a new output channel."}
(All [a] (-> (List (Chan a)) (Chan a)))
(let [output (chan ($ +0))]
(exec (do &;Monad<Promise>
@@ -109,6 +118,7 @@
output)))
(def: #export (fold f init xs)
+ {#;doc "Asynchronous fold over channels."}
(All [a b] (-> (-> b a (&;Promise a)) a (Chan b) (&;Promise a)))
(do &;Monad<Promise>
[?x+xs xs]
@@ -140,6 +150,7 @@
(#;Some [x xs']) (wrap (#;Some [x (no-dups' eq x xs')]))))))
(def: #export (consume xs)
+ {#;doc "Reads the entirety of a channel's contents and returns them as a list."}
(All [a] (-> (Chan a) (&;Promise (List a))))
(do &;Monad<Promise>
[?x+xs' xs]
@@ -152,10 +163,10 @@
[=xs (consume xs')]
(wrap (#;Cons x =xs))))))
-(def: #export (as-chan !x)
+(def: #export (as-chan p)
(All [a] (-> (&;Promise a) (Chan a)))
(do &;Monad<Promise>
- [x !x]
+ [x p]
(wrap (#;Some [x (wrap #;None)]))))
## [Structures]
diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux
index 5eb95d0bb..1d33ee4ee 100644
--- a/stdlib/source/lux/concurrency/promise.lux
+++ b/stdlib/source/lux/concurrency/promise.lux
@@ -64,7 +64,7 @@
#observers (List (-> a (IO Unit)))})
(type: #export (Promise a)
- {#;doc "Represents values produced by promisehronous computations (unlike IO, which is synchronous)."}
+ {#;doc "Represents values produced by asynchronous computations (unlike IO, which is synchronous)."}
(Atom (Promise-State a)))
(def: #hidden (promise' ?value)
@@ -74,7 +74,10 @@
(syntax: #export (promise [?type (s;opt s;any)])
{#;doc (doc "Makes an uninitialized Promise (in this example, of Unit)."
- (promise Unit))}
+ (promise Unit)
+
+ "The type is optional."
+ (promise))}
(case ?type
(#;Some type)
(wrap (list (` (: (Promise (~ type))
@@ -207,7 +210,7 @@
left||right))))
(def: #export (future computation)
- {#;doc "Runs computation on it's own process and returns an Promise that will eventually host it's result."}
+ {#;doc "Runs an I/O computation on its own process and returns an Promise that will eventually host its result."}
(All [a] (-> (IO a) (Promise a)))
(let [!out (promise ($ +0))]
(exec (Thread.start [] (Thread.new [(runnable (io;run (resolve (io;run computation)
@@ -215,6 +218,7 @@
!out)))
(def: #export (wait time)
+ {#;doc "Returns a Promise that will be resolved after the specified amount of milliseconds."}
(-> Nat (Promise Unit))
(let [!out (promise Unit)]
(exec (ScheduledThreadPoolExecutor.schedule [(runnable (io;run (resolve [] !out)))
@@ -224,6 +228,7 @@
!out)))
(def: #export (time-out time promise)
+ {#;doc "Wait for a Promise to be resolved within the specified amount of milliseconds."}
(All [a] (-> Nat (Promise a) (Promise (Maybe a))))
(alt (wait time) promise))
diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux
index b9f337024..06912a25a 100644
--- a/stdlib/source/lux/concurrency/stm.lux
+++ b/stdlib/source/lux/concurrency/stm.lux
@@ -30,6 +30,7 @@
#observers (Dict Text (-> a (IO Unit)))})
(type: #export (Var a)
+ {#;doc "A mutable cell containing a value, and observers that will be alerted of any change to it."}
(Atom (Var-State a)))
(type: (Tx-Frame a)
@@ -41,9 +42,11 @@
(List (Ex [a] (Tx-Frame a))))
(type: #export (STM a)
+ {#;doc "A computation which updates a transaction and produces a value."}
(-> Tx [Tx a]))
(def: #export (var value)
+ {#;doc "Creates a new STM var, with a default value."}
(All [a] (-> a (Var a)))
(atom;atom {#value value
#observers (dict;new text;Hash<Text>)}))
@@ -128,6 +131,9 @@
(write! new-value var))))
(def: #export (unfollow label target)
+ {#;doc "Stop tracking the changes to a Var.
+
+ Caveat emptor: It won't close any Chan that used to track the changes."}
(All [a] (-> Text (Var a) (IO Unit)))
(do Monad<IO>
[[value observers] (atom;get target)]
@@ -135,7 +141,7 @@
target)))
(def: #export (follow label target)
- {#;doc "Creates a channel (identified by a given text) that will receive all changes to the value of the given var."}
+ {#;doc "Creates a channel (identified by a label) that will receive all changes to the value of the given var."}
(All [a] (-> Text (Var a) (IO (frp;Chan a))))
(let [head (frp;chan ($ +0))
chan-var (var head)
@@ -181,17 +187,19 @@
(ma tx')))))
(def: #export (update! f var)
- (All [a] (-> (-> a a) (Var a) (Promise [a a])))
- (P;future (io (loop [_ []]
- (let [(^@ state [value observers]) (io;run (atom;get var))
- value' (f value)]
- (if (io;run (atom;compare-and-swap state
- [value' observers]
- var))
- [value value']
- (recur [])))))))
+ {#;doc "Will update a Var's value, and return a tuple with the old and the new values."}
+ (All [a] (-> (-> a a) (Var a) (IO [a a])))
+ (io (loop [_ []]
+ (let [(^@ state [value observers]) (io;run (atom;get var))
+ value' (f value)]
+ (if (io;run (atom;compare-and-swap state
+ [value' observers]
+ var))
+ [value value']
+ (recur []))))))
(def: #export (update f var)
+ {#;doc "Will update a Var's value, and return a tuple with the old and the new values."}
(All [a] (-> (-> a a) (Var a) (STM [a a])))
(do Monad<STM>
[a (read var)
diff --git a/stdlib/source/lux/control/applicative.lux b/stdlib/source/lux/control/applicative.lux
index 5d4cad0c0..63ed1bc00 100644
--- a/stdlib/source/lux/control/applicative.lux
+++ b/stdlib/source/lux/control/applicative.lux
@@ -8,6 +8,7 @@
(.. ["F" functor]))
(sig: #export (Applicative f)
+ {#;doc "Applicative functors."}
(: (F;Functor f)
functor)
(: (All [a]
@@ -17,17 +18,18 @@
(-> (f (-> a b)) (f a) (f b)))
apply))
-(def: #export (compA Applicative<F> Applicative<G>)
+(struct: #export (compA Applicative<F> Applicative<G>)
+ {#;doc "Applicative functor composition."}
(All [F G] (-> (Applicative F) (Applicative G) (Applicative (All [a] (F (G a))))))
- (struct (def: functor (F;compF (get@ #functor Applicative<F>)
- (get@ #functor Applicative<G>)))
- (def: wrap
- (|>. (:: Applicative<G> wrap) (:: Applicative<F> wrap)))
- (def: (apply fgf fgx)
- (let [applyF (:: Applicative<F> apply)
- applyG (:: Applicative<G> apply)]
- ($_ applyF
- (:: Applicative<F> wrap applyG)
- fgf
- fgx)))
- ))
+ (def: functor (F;compF (get@ #functor Applicative<F>)
+ (get@ #functor Applicative<G>)))
+ (def: wrap
+ (|>. (:: Applicative<G> wrap) (:: Applicative<F> wrap)))
+ (def: (apply fgf fgx)
+ (let [applyF (:: Applicative<F> apply)
+ applyG (:: Applicative<G> apply)]
+ ($_ applyF
+ (:: Applicative<F> wrap applyG)
+ fgf
+ fgx)))
+ )
diff --git a/stdlib/source/lux/control/bounded.lux b/stdlib/source/lux/control/bounded.lux
index 291c4d8b6..a81135261 100644
--- a/stdlib/source/lux/control/bounded.lux
+++ b/stdlib/source/lux/control/bounded.lux
@@ -7,6 +7,7 @@
## Signatures
(sig: #export (Bounded a)
+ {#;doc "A representation of top and bottom boundaries for an ordered type."}
(: a
top)
diff --git a/stdlib/source/lux/control/codec.lux b/stdlib/source/lux/control/codec.lux
index e9833ccc9..97fa8c4de 100644
--- a/stdlib/source/lux/control/codec.lux
+++ b/stdlib/source/lux/control/codec.lux
@@ -10,19 +10,20 @@
## [Signatures]
(sig: #export (Codec m a)
+ {#;doc "A way to move back-and-forth between a type and an alternative representation for it."}
(: (-> a m)
encode)
(: (-> m (Error a))
decode))
## [Values]
-(def: #export (<.> (^open "bc:") (^open "ab:"))
+(struct: #export (compC Codec<c,b> Codec<b,a>)
+ {#;doc "Codec composition."}
(All [a b c] (-> (Codec c b) (Codec b a) (Codec c a)))
- (struct
- (def: encode (|>. ab:encode bc:encode))
+ (def: encode (|>. (:: Codec<b,a> encode) (:: Codec<c,b> encode)))
- (def: (decode cy)
- (do Monad<Error>
- [by (bc:decode cy)]
- (ab:decode by)))
- ))
+ (def: (decode cy)
+ (do Monad<Error>
+ [by (:: Codec<c,b> decode cy)]
+ (:: Codec<b,a> decode by)))
+ )
diff --git a/stdlib/source/lux/control/comonad.lux b/stdlib/source/lux/control/comonad.lux
index 420771d23..046511190 100644
--- a/stdlib/source/lux/control/comonad.lux
+++ b/stdlib/source/lux/control/comonad.lux
@@ -10,6 +10,9 @@
## [Signatures]
(sig: #export (CoMonad w)
+ {#;doc "CoMonads are the opposite/complement to monads.
+
+ CoMonadic structures are often infinite in size and built upon lazily-evaluated functions."}
(: (F;Functor w)
functor)
(: (All [a]
diff --git a/stdlib/source/lux/control/effect.lux b/stdlib/source/lux/control/effect.lux
index 6643acd26..ede2f9d8f 100644
--- a/stdlib/source/lux/control/effect.lux
+++ b/stdlib/source/lux/control/effect.lux
@@ -3,7 +3,8 @@
## If a copy of the MPL was not distributed with this file,
## You can obtain one at http://mozilla.org/MPL/2.0/.
-(;module: lux
+(;module: {#;doc "Algebraic effects."}
+ lux
(lux (control ["F" functor]
applicative
monad)
@@ -12,7 +13,8 @@
[number "Nat/" Codec<Text,Nat>]
text/format
error
- [ident "Ident/" Eq<Ident>])
+ [ident "Ident/" Eq<Ident>]
+ [text])
[compiler]
[macro]
(macro [ast]
@@ -22,10 +24,12 @@
## [Type]
(type: #export (Eff F a)
+ {#;doc "A Free Monad implementation for algebraic effects."}
(#Pure a)
(#Effect (F (Eff F a))))
(sig: #export (Handler E M)
+ {#;doc "A way to interpret effects into arbitrary monads."}
(: (Monad M)
monad)
(: (All [a] (-> (E a) (M a)))
@@ -85,10 +89,10 @@
fefa))
)))
-(type: #export (|@ L R)
+(type: #hidden (|@ L R)
(All [a] (| (L a) (R a))))
-(def: #export (combine-functors left right)
+(def: #hidden (combine-functors left right)
(All [L R]
(-> (F;Functor L) (F;Functor R)
(F;Functor (|@ L R))))
@@ -99,7 +103,7 @@
(+1 r) (+1 (:: right map f r)))
)))
-(def: #export (combine-handlers Monad<M> left right)
+(def: #hidden (combine-handlers Monad<M> left right)
(All [L R M]
(-> (Monad M)
(Handler L M) (Handler R M)
@@ -115,12 +119,23 @@
## [Syntax]
(syntax: #export (|E [effects (s;many s;any)])
+ {#;doc (doc "A way to combine smaller effect into a larger effect."
+ (type: EffABC (|E EffA EffB EffC)))}
(wrap (list (` ($_ ;;|@ (~@ effects))))))
(syntax: #export (|F [functors (s;many s;any)])
+ {#;doc (doc "A way to combine smaller effect functors into a larger functor."
+ (def: Functor<EffABC>
+ (Functor EffABC)
+ (|F Functor<EffA> Functor<EffB> Functor<EffC>)))}
(wrap (list (` ($_ ;;combine-functors (~@ functors))))))
(syntax: #export (|H monad [handlers (s;many s;any)])
+ {#;doc (doc "A way to combine smaller effect handlers into a larger handler."
+ (def: Handler<EffABC,IO>
+ (Handler EffABC io;IO)
+ (|H io;Monad<IO>
+ Handler<EffA,IO> Handler<EffB,IO> Handler<EffC,IO>)))}
(do @
[g!combiner (compiler;gensym "")]
(wrap (list (` (let [(~ g!combiner) (;;combine-handlers (~ monad))]
@@ -145,6 +160,13 @@
(syntax: #export (effect: [exp-lvl common;export-level]
[name s;local-symbol]
[ops (s;many op^)])
+ {#;doc (doc "Define effects by specifying which operations and constants a handler must provide."
+ (effect: #export EffA
+ (opA [Nat Text] Bool)
+ (fieldA Nat))
+
+ "In this case, 'opA' will be a function (-> Nat Text Bool)."
+ "'fieldA' will be a value provided by a handler.")}
(do @
[g!output (compiler;gensym "g!output")
#let [op-types (List/map (lambda [op]
@@ -204,6 +226,15 @@
[name s;local-symbol]
[[effect target-type target-monad] translation^]
[defs (s;many (common;def *compiler*))])
+ {#;doc (doc "Define effect handlers by implementing the operations and values of an effect."
+ (handler: _
+ (=> EffA [io;IO io;Monad<IO>])
+ (def: (opA size sample)
+ (:: io;Monad<IO> wrap (n.< size (text;size sample))))
+
+ (def: fieldA (:: io;Monad<IO> wrap +10)))
+
+ "Since a name for the handler was not specified, 'handler:' will generate the name as Handler<EffA,IO>.")}
(do @
[(^@ effect [e-module _]) (compiler;un-alias effect)
g!input (compiler;gensym "g!input")
@@ -244,6 +275,7 @@
)))))))
(def: #export (with-handler handler body)
+ {#;doc "Handles an effectful computation with the given handler to produce a monadic value."}
(All [E M a] (-> (Handler E M) (Eff E a) (M a)))
(case body
(#Pure value)
@@ -276,6 +308,13 @@
(def: g!functor AST (ast;symbol ["" "\t@E\t"]))
(syntax: #export (doE functor [bindings (s;tuple (s;some s;any))] body)
+ {#;doc (doc "An alternative to the 'do' macro for monads."
+ (io;run (with-handler Handler<EffABC,IO>
+ (doE Functor<EffABC>
+ [a (lift fieldA)
+ b (lift fieldB)
+ c (lift fieldC)]
+ (wrap ($_ n.+ a b c))))))}
(do @
[g!output (compiler;gensym "")]
(wrap (list (` (let [(~ g!functor) (~ functor)]
@@ -330,6 +369,13 @@
(syntax: #export (lift [value (s;alt s;symbol
s;any)])
+ {#;doc (doc "A way to (automatically) lift effectful fields and operations from simple effects into the larger space of composite effects."
+ (io;run (with-handler Handler<EffABC,IO>
+ (doE Functor<EffABC>
+ [a (lift fieldA)
+ b (lift fieldB)
+ c (lift fieldC)]
+ (wrap ($_ n.+ a b c))))))}
(case value
(#;Left var)
(do @
diff --git a/stdlib/source/lux/control/enum.lux b/stdlib/source/lux/control/enum.lux
index 63c041f95..a6c377fab 100644
--- a/stdlib/source/lux/control/enum.lux
+++ b/stdlib/source/lux/control/enum.lux
@@ -8,6 +8,7 @@
## [Signatures]
(sig: #export (Enum e)
+ {#;doc "Enumerable types, with a notion of moving forward and backwards through a type's instances."}
(: (ord;Ord e) ord)
(: (-> e e) succ)
(: (-> e e) pred))
@@ -20,5 +21,6 @@
#;Nil))
(def: #export (range (^open) from to)
+ {#;doc "An inclusive [from, to] range of values."}
(All [a] (-> (Enum a) a a (List a)))
(range' <= succ from to))
diff --git a/stdlib/source/lux/control/eq.lux b/stdlib/source/lux/control/eq.lux
index 357780fcd..40f29a446 100644
--- a/stdlib/source/lux/control/eq.lux
+++ b/stdlib/source/lux/control/eq.lux
@@ -6,6 +6,7 @@
(;module: lux)
(sig: #export (Eq a)
+ {#;doc "Equality for a type's instances."}
(: (-> a a Bool)
=))
diff --git a/stdlib/source/lux/control/fold.lux b/stdlib/source/lux/control/fold.lux
index 6e56dacee..66f083ac6 100644
--- a/stdlib/source/lux/control/fold.lux
+++ b/stdlib/source/lux/control/fold.lux
@@ -7,6 +7,7 @@
## [Signatures]
(sig: #export (Fold F)
+ {#;doc "Iterate over a structure's values to build a summary value."}
(: (All [a b]
(-> (-> b a a) a (F b) a))
fold))
diff --git a/stdlib/source/lux/control/functor.lux b/stdlib/source/lux/control/functor.lux
index 711c5ae16..5c76ba76a 100644
--- a/stdlib/source/lux/control/functor.lux
+++ b/stdlib/source/lux/control/functor.lux
@@ -10,7 +10,8 @@
(-> (-> a b) (f a) (f b)))
map))
-(def: #export (compF Functor<F> Functor<G>)
+(struct: #export (compF Functor<F> Functor<G>)
+ {#;doc "Functor composition."}
(All [F G] (-> (Functor F) (Functor G) (Functor (All [a] (F (G a))))))
- (struct (def: (map f fga)
- (:: Functor<F> map (:: Functor<G> map f) fga))))
+ (def: (map f fga)
+ (:: Functor<F> map (:: Functor<G> map f) fga)))
diff --git a/stdlib/source/lux/control/hash.lux b/stdlib/source/lux/control/hash.lux
index d8ae926ad..6e222e5d7 100644
--- a/stdlib/source/lux/control/hash.lux
+++ b/stdlib/source/lux/control/hash.lux
@@ -9,6 +9,9 @@
## [Signatures]
(sig: #export (Hash a)
+ {#;doc "A way to produce hash-codes for a type's instances.
+
+ A necessity when working with some data-structures, such as dictionaries or sets."}
(: (Eq a)
eq)
(: (-> a Nat)
diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux
index 71a873704..b6c509064 100644
--- a/stdlib/source/lux/control/monad.lux
+++ b/stdlib/source/lux/control/monad.lux
@@ -79,13 +79,13 @@
body
(reverse (as-pairs bindings)))]
(#;Right [state (#;Cons (` (;_lux_case (~ monad)
- (~ g!@)
- (;_lux_case (~ g!@)
- {#applicative {#A;functor {#F;map (~ g!map)}
- #A;wrap (~' wrap)
- #A;apply (~ g!apply)}
- #join (~ g!join)}
- (~ body'))))
+ (~ g!@)
+ (;_lux_case (~ g!@)
+ {#applicative {#A;functor {#F;map (~ g!map)}
+ #A;wrap (~' wrap)
+ #A;apply (~ g!apply)}
+ #join (~ g!join)}
+ (~ body'))))
#;Nil)]))
_
@@ -93,6 +93,7 @@
## [Functions]
(def: #export (seqM monad xs)
+ {#;doc "Run all the monadic values in the list and produce a list of the base values."}
(All [M a]
(-> (Monad M) (List (M a)) (M (List a))))
(case xs
@@ -107,6 +108,7 @@
))
(def: #export (mapM monad f xs)
+ {#;doc "Apply a monad-producing function to all values in a list."}
(All [M a b]
(-> (Monad M) (-> a (M b)) (List a) (M (List b))))
(case xs
@@ -121,6 +123,7 @@
))
(def: #export (foldM monad f init xs)
+ {#;doc "Fold a list with a monad-producing function."}
(All [M a b]
(-> (Monad M) (-> b a (M a)) a (List b)
(M a)))
@@ -134,6 +137,7 @@
(foldM monad f init' xs'))))
(def: #export (liftM Monad<M> f)
+ {#;doc "Lift a normal function into the space of monads."}
(All [M a b]
(-> (Monad M) (-> a b) (-> (M a) (M b))))
(lambda [ma]
diff --git a/stdlib/source/lux/control/monoid.lux b/stdlib/source/lux/control/monoid.lux
index 67f6d868c..77ef5e1cc 100644
--- a/stdlib/source/lux/control/monoid.lux
+++ b/stdlib/source/lux/control/monoid.lux
@@ -7,6 +7,9 @@
## Signatures
(sig: #export (Monoid a)
+ {#;doc "A way to combine (append) values.
+
+ Includes an identity (unit) value which doesn't alter any other value when combined with."}
(: a
unit)
(: (-> a a a)
diff --git a/stdlib/source/lux/control/number.lux b/stdlib/source/lux/control/number.lux
index d6e9a42b6..d017e72d4 100644
--- a/stdlib/source/lux/control/number.lux
+++ b/stdlib/source/lux/control/number.lux
@@ -9,6 +9,8 @@
## [Signatures]
(sig: #export (Number n)
+ {#;doc "Everything that should be expected of a number type."}
+
(: (ord;Ord n)
ord)
diff --git a/stdlib/source/lux/control/ord.lux b/stdlib/source/lux/control/ord.lux
index 7acc97172..0200d738a 100644
--- a/stdlib/source/lux/control/ord.lux
+++ b/stdlib/source/lux/control/ord.lux
@@ -10,6 +10,8 @@
## [Signatures]
(sig: #export (Ord a)
+ {#;doc "A signature for types that possess some sense of ordering among their elements."}
+
(: (Eq a)
eq)
diff --git a/stdlib/source/lux/data/error/exception.lux b/stdlib/source/lux/data/error/exception.lux
index 7c6fb5ab6..457a3a092 100644
--- a/stdlib/source/lux/data/error/exception.lux
+++ b/stdlib/source/lux/data/error/exception.lux
@@ -3,7 +3,7 @@
## If a copy of the MPL was not distributed with this file,
## You can obtain one at http://mozilla.org/MPL/2.0/.
-(;module:
+(;module: {#;doc "Exception-handling functionality built on top of the Error type."}
lux
(lux (control monad)
(data [error #- fail]
@@ -15,6 +15,7 @@
## [Types]
(type: #export Exception
+ {#;doc "An exception provides a way to decorate error messages."}
(-> Text Text))
## [Values]
@@ -23,6 +24,9 @@
(:: text;Monoid<Text> append))
(def: #export (catch exception then try)
+ {#;doc "If a particular exception is detected on a possibly-erroneous value, handle it.
+
+ If no exception was detected, or a different one from the one being checked, then pass along the original value."}
(All [a]
(-> Exception (-> Text a) (Error a)
(Error a)))
@@ -36,6 +40,7 @@
(#;Left error))))
(def: #export (otherwise to-do try)
+ {#;doc "If no handler could be found to catch the exception, then run a function as a last-resort measure."}
(All [a]
(-> (-> Text a) (Error a) a))
(case try
@@ -46,14 +51,19 @@
(to-do error)))
(def: #export (return value)
+ {#;doc "A way to lift normal values into the error-handling context."}
(All [a] (-> a (Error a)))
(#;Right value))
(def: #export (throw exception message)
+ {#;doc "Decorate an error message with an Exception and lift it into the error-handling context."}
(All [a] (-> Exception Text (Error a)))
(#;Left (exception message)))
(syntax: #export (exception: [_ex-lev common;export-level] [name s;local-symbol])
+ {#;doc (doc "Define a new exception type."
+ "It moslty just serves as a way to tag error messages for later catching."
+ (exception: #export Some-Exception))}
(do @
[current-module compiler;current-module-name
#let [g!message (ast;symbol ["" "message"])]]
diff --git a/stdlib/source/lux/data/log.lux b/stdlib/source/lux/data/log.lux
index 687f23478..e8e15d0ad 100644
--- a/stdlib/source/lux/data/log.lux
+++ b/stdlib/source/lux/data/log.lux
@@ -11,6 +11,7 @@
["M" monad #*]))
(type: #export (Log l a)
+ {#;doc "Represents a value with an associated 'log' value to record arbitrary information."}
[l a])
(struct: #export Functor<Log> (All [l]
@@ -40,6 +41,7 @@
[(:: mon append log1 log2) a])))
(def: #export (log l)
+ {#;doc "Set the log to a particular value."}
(All [l] (-> l (Log l Unit)))
[l []])
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index 1a104071f..b2ad1df52 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -3,7 +3,7 @@
## If a copy of the MPL was not distributed with this file,
## You can obtain one at http://mozilla.org/MPL/2.0/.
-(;module:
+(;module: {#;doc "Implementations of common structures for Lux's primitive number types."}
lux
(lux (control number
monoid
@@ -223,21 +223,24 @@
(bin "11001001"))]
[Octal@Codec<Text,Nat> "invokestatic:java.lang.Long:toOctalString:long" 8 oct "Invalid octal syntax."
(doc "Given syntax for an octal number, generates a Nat."
- (oct "0615243"))]
+ (oct "615243"))]
[Hex@Codec<Text,Nat> "invokestatic:java.lang.Long:toHexString:long" 16 hex "Invalid hexadecimal syntax."
(doc "Given syntax for a hexadecimal number, generates a Nat."
(hex "deadBEEF"))]
)
-(do-template [<name> <field>]
- [(def: #export <name> Real
+(do-template [<name> <field> <doc>]
+ [(def: #export <name>
+ {#;doc <doc>}
+ Real
(_lux_proc ["jvm" <field>] []))]
- [nan "getstatic:java.lang.Double:NaN"]
- [+inf "getstatic:java.lang.Double:POSITIVE_INFINITY"]
- [-inf "getstatic:java.lang.Double:NEGATIVE_INFINITY"]
+ [nan "getstatic:java.lang.Double:NaN" "not-a-number"]
+ [+inf "getstatic:java.lang.Double:POSITIVE_INFINITY" "positive infinity"]
+ [-inf "getstatic:java.lang.Double:NEGATIVE_INFINITY" "negative infinity"]
)
(def: #export (nan? number)
+ {#;doc "Tests whether a real is actually not-a-number."}
(-> Real Bool)
(not (r.= number number)))
diff --git a/stdlib/source/lux/data/product.lux b/stdlib/source/lux/data/product.lux
index f542d7a38..9e5e72538 100644
--- a/stdlib/source/lux/data/product.lux
+++ b/stdlib/source/lux/data/product.lux
@@ -3,7 +3,8 @@
## If a copy of the MPL was not distributed with this file,
## You can obtain one at http://mozilla.org/MPL/2.0/.
-(;module: lux)
+(;module: {#;doc "Functionality for working with tuples (particularly 2-tuples)."}
+ lux)
## [Functions]
(do-template [<name> <type> <output>]
diff --git a/stdlib/source/lux/data/struct/array.lux b/stdlib/source/lux/data/struct/array.lux
index 3a3c6bfaa..fa52df9f1 100644
--- a/stdlib/source/lux/data/struct/array.lux
+++ b/stdlib/source/lux/data/struct/array.lux
@@ -18,6 +18,7 @@
## [Types]
(type: #export (Array a)
+ {#;doc "Mutable arrays."}
(#;HostT "#Array" (#;Cons a #;Nil)))
## [Functions]
@@ -161,7 +162,7 @@
))))
## [Structures]
-(struct: #export (Eq<Array> (^open "a:"))
+(struct: #export (Eq<Array> Eq<a>)
(All [a] (-> (Eq a) (Eq (Array a))))
(def: (= xs ys)
(let [sxs (size xs)
@@ -174,7 +175,7 @@
true
[(#;Some x) (#;Some y)]
- (a:= x y)
+ (:: Eq<a> = x y)
_
false)))
diff --git a/stdlib/source/lux/data/struct/dict.lux b/stdlib/source/lux/data/struct/dict.lux
index 56ab6ca64..3b153d229 100644
--- a/stdlib/source/lux/data/struct/dict.lux
+++ b/stdlib/source/lux/data/struct/dict.lux
@@ -560,17 +560,20 @@
{#hash Hash<K>
#root empty})
-(def: #export (put key val [Hash<K> node])
+(def: #export (put key val dict)
(All [K V] (-> K V (Dict K V) (Dict K V)))
- [Hash<K> (put' root-level (:: Hash<K> hash key) key val Hash<K> node)])
+ (let [[Hash<K> node] dict]
+ [Hash<K> (put' root-level (:: Hash<K> hash key) key val Hash<K> node)]))
-(def: #export (remove key [Hash<K> node])
+(def: #export (remove key dict)
(All [K V] (-> K (Dict K V) (Dict K V)))
- [Hash<K> (remove' root-level (:: Hash<K> hash key) key Hash<K> node)])
+ (let [[Hash<K> node] dict]
+ [Hash<K> (remove' root-level (:: Hash<K> hash key) key Hash<K> node)]))
-(def: #export (get key [Hash<K> node])
+(def: #export (get key dict)
(All [K V] (-> K (Dict K V) (Maybe V)))
- (get' root-level (:: Hash<K> hash key) key Hash<K> node))
+ (let [[Hash<K> node] dict]
+ (get' root-level (:: Hash<K> hash key) key Hash<K> node)))
(def: #export (contains? key table)
(All [K V] (-> K (Dict K V) Bool))
@@ -615,29 +618,35 @@
kvs))
(do-template [<name> <elem-type> <side>]
- [(def: #export <name>
+ [(def: #export (<name> dict)
(All [K V] (-> (Dict K V) (List <elem-type>)))
- (|>. entries (List/map <side>)))]
+ (|> dict entries (List/map <side>)))]
[keys K product;left]
[values V product;right]
)
(def: #export (merge dict2 dict1)
+ {#;doc "Merges 2 dictionaries.
+
+ If any collisions with keys occur, the values of dict2 will overwrite those of dict1."}
(All [K V] (-> (Dict K V) (Dict K V) (Dict K V)))
(List/fold (lambda [[key val] dict] (put key val dict))
dict1
(entries dict2)))
-(def: #export (merge-with f dict1 dict2)
+(def: #export (merge-with f dict2 dict1)
+ {#;doc "Merges 2 dictionaries.
+
+ If any collisions with keys occur, a new value will be computed by applying 'f' to the values of dict2 and dict1."}
(All [K V] (-> (-> V V V) (Dict K V) (Dict K V) (Dict K V)))
- (List/fold (lambda [[key val] dict]
+ (List/fold (lambda [[key val2] dict]
(case (get key dict)
#;None
- (put key val dict)
+ (put key val2 dict)
- (#;Some val')
- (put key (f val' val) dict)))
+ (#;Some val1)
+ (put key (f val2 val1) dict)))
dict1
(entries dict2)))
@@ -652,15 +661,16 @@
(remove from-key)
(put to-key val))))
-(def: #export (select keys (^@ old-dict [Hash<K> _]))
+(def: #export (select keys dict)
{#;doc "Creates a sub-set of the given dict, with only the specified keys."}
(All [K V] (-> (List K) (Dict K V) (Dict K V)))
- (List/fold (lambda [key new-dict]
- (case (get key old-dict)
- #;None new-dict
- (#;Some val) (put key val new-dict)))
- (new Hash<K>)
- keys))
+ (let [[Hash<K> _] dict]
+ (List/fold (lambda [key new-dict]
+ (case (get key dict)
+ #;None new-dict
+ (#;Some val) (put key val new-dict)))
+ (new Hash<K>)
+ keys)))
## [Structures]
(struct: #export (Eq<Dict> Eq<v>) (All [k v] (-> (Eq v) (Eq (Dict k v))))
diff --git a/stdlib/source/lux/data/struct/list.lux b/stdlib/source/lux/data/struct/list.lux
index cd7323669..3228e1d78 100644
--- a/stdlib/source/lux/data/struct/list.lux
+++ b/stdlib/source/lux/data/struct/list.lux
@@ -53,10 +53,14 @@
(filter p xs'))))
(def: #export (partition p xs)
+ {#;doc "Divide the list into all elements that satisfy a predicate, and all elements that don't."}
(All [a] (-> (-> a Bool) (List a) [(List a) (List a)]))
[(filter p xs) (filter (complement p) xs)])
(def: #export (as-pairs xs)
+ {#;doc "Cut the list into pairs of 2.
+
+ Caveat emptor: If the list has an uneven number of elements, the last one will be skipped."}
(All [a] (-> (List a) (List [a a])))
(case xs
(^ (#;Cons [x1 (#;Cons [x2 xs'])]))
@@ -125,12 +129,14 @@
[ys xs])))
(def: #export (split-with p xs)
+ {#;doc "Segment the list by using a predicate to tell when to cut."}
(All [a]
(-> (-> a Bool) (List a) [(List a) (List a)]))
(let [[ys' xs'] (split-with' p #;Nil xs)]
[(reverse ys') xs']))
(def: #export (split-all n xs)
+ {#;doc "Segment the list in chunks of size n."}
(All [a] (-> Nat (List a) (List (List a))))
(case xs
#;Nil
@@ -141,6 +147,7 @@
(#;Cons pre (split-all n post)))))
(def: #export (repeat n x)
+ {#;doc "A list of the value x, repeated n times."}
(All [a]
(-> Nat a (List a)))
(if (n.> +0 n)
@@ -158,6 +165,7 @@
(list)))
(def: #export (iterate f x)
+ {#;doc "Generates a list element by element until the function returns #;None."}
(All [a]
(-> (-> a (Maybe a)) a (List a)))
(case (f x)
@@ -168,6 +176,7 @@
(list x)))
(def: #export (find p xs)
+ {#;doc "Returns the first value in the list for which the predicate is true."}
(All [a]
(-> (-> a Bool) (List a) (Maybe a)))
(case xs
@@ -180,6 +189,7 @@
(find p xs'))))
(def: #export (interpose sep xs)
+ {#;doc "Puts a value between every two elements in the list."}
(All [a]
(-> a (List a) (List a)))
(case xs
@@ -206,6 +216,7 @@
[any? false or])
(def: #export (at i xs)
+ {#;doc "Fetches the element at the specified index."}
(All [a]
(-> Nat (List a) (Maybe a)))
(case xs
@@ -218,7 +229,7 @@
(at (n.dec i) xs'))))
## [Structures]
-(struct: #export (Eq<List> (^open "a:"))
+(struct: #export (Eq<List> Eq<a>)
(All [a] (-> (Eq a) (Eq (List a))))
(def: (= xs ys)
(case [xs ys]
@@ -226,7 +237,7 @@
true
[(#;Cons x xs') (#;Cons y ys')]
- (and (a:= x y)
+ (and (:: Eq<a> = x y)
(= xs' ys'))
[_ _]
@@ -288,12 +299,13 @@
(do-template [<name> <type> <comp> <inc>]
[(def: #export (<name> from to)
+ {#;doc "Generates an inclusive interval of values [from, to]."}
(-> <type> <type> (List <type>))
(if (<comp> to from)
(list& from (<name> (<inc> from) to))
(list)))]
- [i.range Int i.<= i.inc]
+ [i.range Int i.<= i.inc]
[n.range Nat n.<= n.inc]
)
@@ -310,8 +322,9 @@
(#;Cons x' xs') (or (:: eq = x x')
(member? eq xs' x))))
-(do-template [<name> <output> <side>]
+(do-template [<name> <output> <side> <doc>]
[(def: #export (<name> xs)
+ {#;doc <doc>}
(All [a] (-> (List a) (Maybe <output>)))
(case xs
#;Nil
@@ -320,8 +333,8 @@
(#;Cons x xs')
(#;Some <side>)))]
- [head a x]
- [tail (List a) xs']
+ [head a x "Returns the first element of a list."]
+ [tail (List a) xs' "For a list of size N, returns the N-1 elements after the first one."]
)
## [Syntax]
@@ -373,7 +386,7 @@
(def: #export zip3 (zip 3))
(macro: #export (zip-with tokens state)
- {#;doc (doc "Create list zip-with`s with the specified number of input lists."
+ {#;doc (doc "Create list zippers with the specified number of input lists."
(def: #export zip2-with (zip-with 2))
(def: #export zip3-with (zip-with 3))
((zip-with 2) i.+ xs ys))}
@@ -431,6 +444,9 @@
(last xs')))
(def: #export (inits xs)
+ {#;doc "For a list of size N, returns the first N-1 elements.
+
+ Empty lists will result in a #;None value being returned instead."}
(All [a] (-> (List a) (Maybe (List a))))
(case xs
#;Nil
@@ -476,6 +492,7 @@
(#;Cons [idx x] (enumerate' (n.inc idx) xs'))))
(def: #export (enumerate xs)
+ {#;doc "Pairs every element in the list with it's index, starting at 0."}
(All [a] (-> (List a) (List [Nat a])))
(enumerate' +0 xs))
diff --git a/stdlib/source/lux/data/struct/queue.lux b/stdlib/source/lux/data/struct/queue.lux
index e22f0bb81..1c7fcdc3e 100644
--- a/stdlib/source/lux/data/struct/queue.lux
+++ b/stdlib/source/lux/data/struct/queue.lux
@@ -43,13 +43,13 @@
(All [a] (-> (Queue a) Bool))
(|>. (get@ [#front]) list;empty?))
-(def: #export (enqueued? a/Eq queue member)
+(def: #export (member? a/Eq queue member)
(All [a] (-> (Eq a) (Queue a) a Bool))
(let [(^slots [#front #rear]) queue]
(or (list;member? a/Eq front member)
(list;member? a/Eq rear member))))
-(def: #export (dequeue queue)
+(def: #export (pop queue)
(All [a] (-> (Queue a) (Queue a)))
(case (get@ #front queue)
(^ (list)) ## Empty...
@@ -64,7 +64,7 @@
(|> queue
(set@ #front front'))))
-(def: #export (enqueue val queue)
+(def: #export (push val queue)
(All [a] (-> a (Queue a) (Queue a)))
(case (get@ #front queue)
#;Nil
@@ -74,6 +74,7 @@
(update@ #rear (|>. (#;Cons val)) queue)))
## [Structures]
-(struct: #export (Eq<Queue> Eq<a>) (All [a] (-> (Eq a) (Eq (Queue a))))
+(struct: #export (Eq<Queue> Eq<a>)
+ (All [a] (-> (Eq a) (Eq (Queue a))))
(def: (= qx qy)
(:: (list;Eq<List> Eq<a>) = (to-list qx) (to-list qy))))
diff --git a/stdlib/source/lux/data/struct/tree.lux b/stdlib/source/lux/data/struct/tree.lux
index 8603f5677..8620e46a7 100644
--- a/stdlib/source/lux/data/struct/tree.lux
+++ b/stdlib/source/lux/data/struct/tree.lux
@@ -39,9 +39,15 @@
(def: (tree^ _)
(-> Unit (Syntax Tree-AST))
- (s;record (s;seq s;any (s;tuple (s;some (lambda [state] ((tree^ []) state)))))))
+ (s;either (s;record (s;seq s;any (s;tuple (s;some (lambda [state] ((tree^ []) state))))))
+ (s;seq s;any (:: s;Monad<Syntax> wrap (list)))))
(syntax: #export (tree type [root (tree^ [])])
+ {#;doc (doc "Tree literals."
+ (tree Int 10)
+ (tree Int {10 [20
+ {30 []}
+ 40]}))}
(wrap (list (` (: (Tree (~ type))
(~ (loop [[value children] root]
(` {#value (~ value)
diff --git a/stdlib/source/lux/data/struct/vector.lux b/stdlib/source/lux/data/struct/vector.lux
index fbe3dbd97..e1640a0f0 100644
--- a/stdlib/source/lux/data/struct/vector.lux
+++ b/stdlib/source/lux/data/struct/vector.lux
@@ -349,6 +349,8 @@
## [Syntax]
(syntax: #export (vector [elems (s;some s;any)])
+ {#;doc (doc "Vector literals."
+ (vector 10 20 30 40))}
(wrap (list (` (from-list (list (~@ elems)))))))
## [Structures]
diff --git a/stdlib/source/lux/data/struct/zipper.lux b/stdlib/source/lux/data/struct/zipper.lux
index ddd8ae703..2a447a65b 100644
--- a/stdlib/source/lux/data/struct/zipper.lux
+++ b/stdlib/source/lux/data/struct/zipper.lux
@@ -16,6 +16,7 @@
## [Types]
(type: #export (Zipper a)
+ {#;doc "Tree zippers, for easy navigation and editing over trees."}
{#parent (Maybe (Zipper a))
#lefts (Stack (Tree a))
#rights (Stack (Tree a))
diff --git a/stdlib/source/lux/data/sum.lux b/stdlib/source/lux/data/sum.lux
index f01d88727..5cc9606b2 100644
--- a/stdlib/source/lux/data/sum.lux
+++ b/stdlib/source/lux/data/sum.lux
@@ -3,7 +3,8 @@
## If a copy of the MPL was not distributed with this file,
## You can obtain one at http://mozilla.org/MPL/2.0/.
-(;module: lux)
+(;module: {#;doc "Functionality for working with variants (particularly 2-variants)."}
+ lux)
## [Values]
(do-template [<name> <type> <index>]
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index b1e751861..85d5d9dd5 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -214,10 +214,12 @@
(wrap ($_ append pre value post))))))
(def: #export (enclose [left right] content)
+ {#;doc "Surrounds the given content text with left and right side additions."}
(-> [Text Text] Text Text)
(let [(^open) Monoid<Text>]
($_ append left content right)))
(def: #export (enclose' boundary content)
+ {#;doc "Surrounds the given content text with the same boundary text."}
(-> Text Text Text)
(enclose [boundary boundary] content))
diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux
index fee9c576c..ebcb3fc48 100644
--- a/stdlib/source/lux/data/text/format.lux
+++ b/stdlib/source/lux/data/text/format.lux
@@ -28,7 +28,8 @@
(wrap (list (` ($_ _append_ (~@ fragments))))))
## [Formatters]
-(type: (Formatter a)
+(type: #export (Formatter a)
+ {#;doc "A way to produce readable text from values."}
(-> a Text))
(do-template [<name> <type> <formatter>]
diff --git a/stdlib/source/lux/host.lux b/stdlib/source/lux/host.lux
index 69148bbd2..75ad3a1c5 100644
--- a/stdlib/source/lux/host.lux
+++ b/stdlib/source/lux/host.lux
@@ -1414,6 +1414,9 @@
(s;tuple (s;some (super-class-decl^ imports class-vars))))]
[annotations (annotations^ imports)]
[members (s;some (method-decl^ imports class-vars))])
+ {#;doc (doc "Allows defining JVM interfaces."
+ (interface: TestInterface
+ ([] foo [boolean String] void #throws [Exception])))}
(let [def-code (format "interface:"
(spaced (list (class-decl$ class-decl)
(with-brackets (spaced (map super-class-decl$ supers)))
@@ -1536,14 +1539,14 @@
(HttpServerRequest.setExpectMultipart [true])
(ReadStream.handler [(object [(Handler Buffer)]
[]
- ((Handler A) (handle {buffer A}) void
+ ((Handler A) (handle [buffer A]) void
(io;run (do Monad<IO>
[_ (write (Buffer.getBytes [] buffer) body)]
(wrap []))))
)])
(ReadStream.endHandler [[(object [(Handler Void)]
[]
- ((Handler A) (handle {_ A}) void
+ ((Handler A) (handle [_ A]) void
(exec (do Monad<Promise>
[#let [_ (io;run (close body))]
response (handler (request$ vreq body))]
@@ -2157,6 +2160,10 @@
(get-import name imports)))
(def: #export (resolve-class class)
+ {#;doc (doc "Given a potentially unqualified class name, qualifies it if necessary."
+ (resolve-class "String")
+ =>
+ "java.lang.String")}
(-> Text (Lux Text))
(do Monad<Lux>
[*compiler* get-compiler]
diff --git a/stdlib/source/lux/lexer.lux b/stdlib/source/lux/lexer.lux
index e27e1925a..04e9dfef1 100644
--- a/stdlib/source/lux/lexer.lux
+++ b/stdlib/source/lux/lexer.lux
@@ -85,6 +85,7 @@
(#;Left message)))
(def: #export any
+ {#;doc "Just returns the next character without applying any logic."}
(Lexer Char)
(lambda [input]
(case [(text;at +0 input) (text;split +1 input)]
@@ -96,6 +97,7 @@
))
(def: #export (seq left right)
+ {#;doc "Sequencing combinator."}
(All [a b] (-> (Lexer a) (Lexer b) (Lexer [a b])))
(do Monad<Lexer>
[=left left
@@ -103,6 +105,7 @@
(wrap [=left =right])))
(def: #export (alt left right)
+ {#;doc "Heterogeneous alternative combinator."}
(All [a b] (-> (Lexer a) (Lexer b) (Lexer (| a b))))
(lambda [input]
(case (left input)
@@ -118,6 +121,7 @@
(#;Right [input' (+0 output)]))))
(def: #export (not! p)
+ {#;doc "Ensure a lexer fails."}
(All [a] (-> (Lexer a) (Lexer Unit)))
(lambda [input]
(case (p input)
@@ -128,6 +132,7 @@
(#;Left "Expected to fail; yet succeeded."))))
(def: #export (not p)
+ {#;doc "Produce a character if the lexer fails."}
(All [a] (-> (Lexer a) (Lexer Char)))
(lambda [input]
(case (p input)
@@ -138,6 +143,7 @@
(#;Left "Expected to fail; yet succeeded."))))
(def: #export (either left right)
+ {#;doc "Homogeneous alternative combinator."}
(All [a] (-> (Lexer a) (Lexer a) (Lexer a)))
(lambda [input]
(case (left input)
@@ -148,6 +154,7 @@
output)))
(def: #export (assert message test)
+ {#;doc "Fails with the given message if the test is false."}
(-> Text Bool (Lexer Unit))
(lambda [input]
(if test
@@ -155,6 +162,7 @@
(#;Left message))))
(def: #export (some p)
+ {#;doc "0-or-more combinator."}
(All [a] (-> (Lexer a) (Lexer (List a))))
(lambda [input]
(case (p input)
@@ -169,6 +177,7 @@
))
(def: #export (many p)
+ {#;doc "1-or-more combinator."}
(All [a] (-> (Lexer a) (Lexer (List a))))
(do Monad<Lexer>
[x p
@@ -176,6 +185,7 @@
(wrap (#;Cons x xs))))
(def: #export (exactly n p)
+ {#;doc "Lex exactly N times."}
(All [a] (-> Nat (Lexer a) (Lexer (List a))))
(if (n.> +0 n)
(do Monad<Lexer>
@@ -185,6 +195,7 @@
(:: Monad<Lexer> wrap (list))))
(def: #export (at-most n p)
+ {#;doc "Lex at most N times."}
(All [a] (-> Nat (Lexer a) (Lexer (List a))))
(if (n.> +0 n)
(lambda [input]
@@ -201,6 +212,7 @@
(:: Monad<Lexer> wrap (list))))
(def: #export (at-least n p)
+ {#;doc "Lex at least N times."}
(All [a] (-> Nat (Lexer a) (Lexer (List a))))
(do Monad<Lexer>
[min-xs (exactly n p)
@@ -208,6 +220,7 @@
(wrap (list;concat (list min-xs extras)))))
(def: #export (between from to p)
+ {#;doc "Lex between N and M times."}
(All [a] (-> Nat Nat (Lexer a) (Lexer (List a))))
(do Monad<Lexer>
[min-xs (exactly from p)
@@ -215,6 +228,7 @@
(wrap (list;concat (list min-xs max-xs)))))
(def: #export (opt p)
+ {#;doc "Optionality combinator."}
(All [a] (-> (Lexer a) (Lexer (Maybe a))))
(lambda [input]
(case (p input)
@@ -226,6 +240,7 @@
)))
(def: #export (text test)
+ {#;doc "Lex a text if it matches the given sample."}
(-> Text (Lexer Text))
(lambda [input]
(if (text;starts-with? test input)
@@ -235,21 +250,23 @@
(#;Left (format "Invalid match: " test " @ " (:: text;Codec<Text,Text> encode input))))
))
-(def: #export (sep-by sep p)
+(def: #export (sep-by sep lexer)
+ {#;doc "Apply a lexer multiple times, checking that a separator lexer succeeds between each time."}
(All [a b] (-> (Lexer b) (Lexer a) (Lexer (List a))))
(do Monad<Lexer>
- [?x (opt p)]
+ [?x (opt lexer)]
(case ?x
#;None
(wrap #;Nil)
(#;Some x)
(do @
- [xs' (some (seq sep p))]
+ [xs' (some (seq sep lexer))]
(wrap (#;Cons x (map product;right xs'))))
)))
(def: #export end
+ {#;doc "Ensure the lexer's input is empty."}
(Lexer Unit)
(lambda [input]
(case input
@@ -258,6 +275,7 @@
)))
(def: #export peek
+ {#;doc "Lex the next character (without consuming it from the input)."}
(Lexer Char)
(lambda [input]
(case (text;at +0 input)
@@ -269,6 +287,7 @@
))
(def: #export (char test)
+ {#;doc "Lex a character if it matches the given sample."}
(-> Char (Lexer Char))
(lambda [input]
(case [(text;at +0 input) (text;split +1 input)]
@@ -283,11 +302,13 @@
))
(def: #export get-input
+ {#;doc "Get all of the remaining input (without consuming it)."}
(Lexer Text)
(lambda [input]
(#;Right [input input])))
(def: #export (char-range bottom top)
+ {#;doc "Only lex characters within a range."}
(-> Char Char (Lexer Char))
(do Monad<Lexer>
[input get-input
@@ -297,26 +318,30 @@
(Char/<= top char)))]
(wrap char)))
-(do-template [<name> <bottom> <top>]
+(do-template [<name> <bottom> <top> <desc>]
[(def: #export <name>
+ {#;doc (#;TextM (format "Only lex " <desc> " characters."))}
(Lexer Char)
(char-range <bottom> <top>))]
- [upper #"A" #"Z"]
- [lower #"a" #"z"]
- [digit #"0" #"9"]
- [oct-digit #"0" #"7"]
+ [upper #"A" #"Z" "uppercase"]
+ [lower #"a" #"z" "lowercase"]
+ [digit #"0" #"9" "decimal"]
+ [oct-digit #"0" #"7" "octal"]
)
(def: #export alpha
+ {#;doc "Only lex alphabetic characters."}
(Lexer Char)
(either lower upper))
(def: #export alpha-num
+ {#;doc "Only lex alphanumeric characters."}
(Lexer Char)
(either alpha digit))
(def: #export hex-digit
+ {#;doc "Only lex hexadecimal digits."}
(Lexer Char)
($_ either
digit
@@ -324,6 +349,7 @@
(char-range #"A" #"F")))
(def: #export (one-of options)
+ {#;doc "Only lex characters that are part of a piece of text."}
(-> Text (Lexer Char))
(lambda [input]
(case (text;split +1 input)
@@ -341,6 +367,7 @@
(#;Left "Can't parse character from empty text."))))
(def: #export (none-of options)
+ {#;doc "Only lex characters that aren't part of a piece of text."}
(-> Text (Lexer Char))
(lambda [input]
(case (text;split +1 input)
@@ -358,6 +385,7 @@
(#;Left "Can't parse character from empty text."))))
(def: #export (satisfies p)
+ {#;doc "Only lex characters that satisfy a predicate."}
(-> (-> Char Bool) (Lexer Char))
(lambda [input]
(case (: (Maybe [Text Char])
@@ -374,22 +402,26 @@
(#;Left "Can't parse character from empty text."))))
(def: #export space
+ {#;doc "Only lex white-space."}
(Lexer Char)
(satisfies char;space?))
(def: #export (some' p)
+ {#;doc "Lex some characters as a single continuous text."}
(-> (Lexer Char) (Lexer Text))
(do Monad<Lexer>
[cs (some p)]
(wrap (text;concat (map char;as-text cs)))))
(def: #export (many' p)
+ {#;doc "Lex many characters as a single continuous text."}
(-> (Lexer Char) (Lexer Text))
(do Monad<Lexer>
[cs (many p)]
(wrap (text;concat (map char;as-text cs)))))
(def: #export end?
+ {#;doc "Ask if the lexer's input is empty."}
(Lexer Bool)
(lambda [input]
(#;Right [input (text;empty? input)])))
@@ -408,6 +440,7 @@
(wrap output)))
(def: #export (default value lexer)
+ {#;doc "If the given lexer fails, this lexer will succeed with the provided value."}
(All [a] (-> a (Lexer a) (Lexer a)))
(lambda [input]
(case (lexer input)
@@ -418,6 +451,7 @@
(#;Right input'+value))))
(def: #export (codec codec lexer)
+ {#;doc "Lex a token by means of a codec."}
(All [a] (-> (Codec Text a) (Lexer Text) (Lexer a)))
(lambda [input]
(case (lexer input)
diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux
index b7d93bd86..f9cfce416 100644
--- a/stdlib/source/lux/macro.lux
+++ b/stdlib/source/lux/macro.lux
@@ -17,6 +17,12 @@
(do-template [<macro> <func>]
[(syntax: #export (<macro> [? omit^] token)
+ {#;doc (doc "Performs a macro-expansion and logs the resulting ASTs."
+ "You can either use the resulting ASTs, or omit them."
+ "By omitting them, this macro produces nothing (just like the lux;comment macro)."
+ (<macro> (def: (foo bar baz)
+ (-> Int Int Int)
+ (i.+ bar baz))))}
(do @
[output (<func> token)
#let [_ (List/map (. log! %ast)
diff --git a/stdlib/source/lux/macro/ast.lux b/stdlib/source/lux/macro/ast.lux
index 06ba2aaed..8976ca64d 100644
--- a/stdlib/source/lux/macro/ast.lux
+++ b/stdlib/source/lux/macro/ast.lux
@@ -54,21 +54,22 @@
[record (List [AST AST]) #;RecordS]
)
-(do-template [<name> <tag>]
+(do-template [<name> <tag> <doc>]
[(def: #export (<name> name)
+ {#;doc <doc>}
(-> Text AST)
[_cursor (<tag> ["" name])])]
- [local-symbol #;SymbolS]
- [local-tag #;TagS])
+ [local-symbol #;SymbolS "Produces a local symbol (a symbol with no module prefix)."]
+ [local-tag #;TagS "Produces a local tag (a tag with no module prefix)."])
## [Structures]
(struct: #export _ (Eq AST)
(def: (= x y)
(case [x y]
(^template [<tag> <eq>]
- [[_ (<tag> x')] [_ (<tag> y')]]
- (:: <eq> = x' y'))
+ [[_ (<tag> x')] [_ (<tag> y')]]
+ (:: <eq> = x' y'))
([#;BoolS Eq<Bool>]
[#;NatS Eq<Nat>]
[#;IntS Eq<Int>]
@@ -80,12 +81,12 @@
[#;TagS Eq<Ident>])
(^template [<tag>]
- [[_ (<tag> xs')] [_ (<tag> ys')]]
- (and (:: Eq<Nat> = (size xs') (size ys'))
- (fold (lambda [[x' y'] old]
- (and old (= x' y')))
- true
- (zip2 xs' ys'))))
+ [[_ (<tag> xs')] [_ (<tag> ys')]]
+ (and (:: Eq<Nat> = (size xs') (size ys'))
+ (fold (lambda [[x' y'] old]
+ (and old (= x' y')))
+ true
+ (zip2 xs' ys'))))
([#;FormS]
[#;TupleS])
@@ -104,8 +105,8 @@
(-> AST Text)
(case ast
(^template [<tag> <struct>]
- [_ (<tag> value)]
- (:: <struct> encode value))
+ [_ (<tag> value)]
+ (:: <struct> encode value))
([#;BoolS Codec<Text,Bool>]
[#;NatS Codec<Text,Nat>]
[#;IntS Codec<Text,Int>]
@@ -119,8 +120,8 @@
(Text/append "#" (:: Codec<Text,Ident> encode ident))
(^template [<tag> <open> <close>]
- [_ (<tag> members)]
- ($_ Text/append <open> (|> members (map to-text) (interpose " ") (text;join-with "")) <close>))
+ [_ (<tag> members)]
+ ($_ Text/append <open> (|> members (map to-text) (interpose " ") (text;join-with "")) <close>))
([#;FormS "(" ")"]
[#;TupleS "[" "]"])
@@ -128,21 +129,22 @@
($_ Text/append "{" (|> pairs (map (lambda [[left right]] ($_ Text/append (to-text left) " " (to-text right)))) (interpose " ") (text;join-with "")) "}")
))
-(def: #export (replace source target ast)
+(def: #export (replace original substitute ast)
+ {#;doc "Replaces all ASTs that look like 'original' with the 'substitute' in the given AST."}
(-> AST AST AST AST)
- (if (:: Eq<AST> = source ast)
- target
+ (if (:: Eq<AST> = original ast)
+ substitute
(case ast
(^template [<tag>]
- [cursor (<tag> parts)]
- [cursor (<tag> (map (replace source target) parts))])
+ [cursor (<tag> parts)]
+ [cursor (<tag> (map (replace original substitute) parts))])
([#;FormS]
[#;TupleS])
[cursor (#;RecordS parts)]
[cursor (#;RecordS (map (lambda [[left right]]
- [(replace source target left)
- (replace source target right)])
+ [(replace original substitute left)
+ (replace original substitute right)])
parts))]
_
diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux
index ce36cef19..d043a0b29 100644
--- a/stdlib/source/lux/macro/syntax.lux
+++ b/stdlib/source/lux/macro/syntax.lux
@@ -29,6 +29,7 @@
## [Types]
(type: #export (Syntax a)
+ {#;doc "A Lux AST syntax parser."}
(-> (List AST) (Error [(List AST) a])))
## [Structures]
@@ -91,6 +92,7 @@
(do-template [<get-name> <ask-name> <demand-name> <type> <tag> <eq> <desc>]
[(def: #export <get-name>
+ {#;doc (#;TextM ($_ Text/append "Parses the next " <desc> " input AST."))}
(Syntax <type>)
(lambda [tokens]
(case tokens
@@ -101,6 +103,7 @@
(#;Left ($_ Text/append "Can't parse " <desc> (remaining-inputs tokens))))))
(def: #export (<ask-name> v)
+ {#;doc (#;TextM ($_ Text/append "Asks if the given " <desc> " is the next input AST."))}
(-> <type> (Syntax Bool))
(lambda [tokens]
(case tokens
@@ -115,6 +118,7 @@
(#;Right [tokens false]))))
(def: #export (<demand-name> v)
+ {#;doc (#;TextM ($_ Text/append "Ensures the given " <desc> " is the next input AST."))}
(-> <type> (Syntax Unit))
(lambda [tokens]
(case tokens
@@ -137,10 +141,11 @@
[ tag tag? tag! Ident #;TagS ident;Eq<Ident> "tag"]
)
-(def: #export (assert message v)
+(def: #export (assert message test)
+ {#;doc "Fails with the given message if the test is false."}
(-> Text Bool (Syntax Unit))
(lambda [tokens]
- (if v
+ (if test
(#;Right [tokens []])
(#;Left ($_ Text/append message (remaining-inputs tokens))))))
@@ -158,6 +163,7 @@
(do-template [<name> <tag> <desc>]
[(def: #export <name>
+ {#;doc (#;TextM ($_ Text/append "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))}
(Syntax Text)
(lambda [tokens]
(case tokens
@@ -165,14 +171,15 @@
(#;Right [tokens' x])
_
- (#;Left ($_ Text/append "Can't parse " <desc> (remaining-inputs tokens))))))]
+ (#;Left ($_ Text/append "Can't parse local " <desc> (remaining-inputs tokens))))))]
- [local-symbol #;SymbolS "local symbol"]
- [ local-tag #;TagS "local tag"]
+ [local-symbol #;SymbolS "symbol"]
+ [ local-tag #;TagS "tag"]
)
(do-template [<name> <tag> <desc>]
[(def: #export (<name> p)
+ {#;doc (#;TextM ($_ Text/append "Parse inside the contents of a " <desc> " as if they were the input ASTs."))}
(All [a]
(-> (Syntax a) (Syntax a)))
(lambda [tokens]
@@ -190,6 +197,7 @@
)
(def: #export (record p)
+ {#;doc (#;TextM ($_ Text/append "Parse inside the contents of a record as if they were the input ASTs."))}
(All [a]
(-> (Syntax a) (Syntax a)))
(lambda [tokens]
@@ -287,6 +295,7 @@
_ (#;Right [tokens false]))))
(def: #export (exactly n p)
+ {#;doc "Parse exactly N times."}
(All [a] (-> Nat (Syntax a) (Syntax (List a))))
(if (n.> +0 n)
(do Monad<Syntax>
@@ -296,6 +305,7 @@
(:: Monad<Syntax> wrap (list))))
(def: #export (at-least n p)
+ {#;doc "Parse at least N times."}
(All [a] (-> Nat (Syntax a) (Syntax (List a))))
(do Monad<Syntax>
[min (exactly n p)
@@ -303,6 +313,7 @@
(wrap (List/append min extra))))
(def: #export (at-most n p)
+ {#;doc "Parse at most N times."}
(All [a] (-> Nat (Syntax a) (Syntax (List a))))
(if (n.> +0 n)
(lambda [input]
@@ -319,6 +330,7 @@
(:: Monad<Syntax> wrap (list))))
(def: #export (between from to p)
+ {#;doc "Parse between N and M times."}
(All [a] (-> Nat Nat (Syntax a) (Syntax (List a))))
(do Monad<Syntax>
[min-xs (exactly from p)
@@ -366,31 +378,35 @@
(#;Right [input' output])
(#;Right [input' output]))))
-(def: #export (on compiler meta)
+(def: #export (on compiler action)
+ {#;doc "Run a Lux operation as if it was a Syntax parser."}
(All [a] (-> Compiler (Lux a) (Syntax a)))
(lambda [input]
- (case (meta compiler)
+ (case (compiler;run compiler action)
(#;Left error)
(#;Left error)
- (#;Right [_ value])
+ (#;Right value)
(#;Right [input value])
)))
(def: #export (local local-inputs syntax)
+ {#;doc "Run a syntax parser with the given list of inputs, instead of the real ones."}
(All [a] (-> (List AST) (Syntax a) (Syntax a)))
(lambda [real-inputs]
(case (syntax local-inputs)
(#;Left error)
(#;Left error)
- (#;Right [unconsume-inputs value])
- (case unconsume-inputs
+ (#;Right [unconsumed-inputs value])
+ (case unconsumed-inputs
#;Nil
(#;Right [real-inputs value])
_
- (#;Left "Unconsumed inputs.")))))
+ (#;Left (Text/append "Unconsumed inputs: "
+ (|> (map ast;to-text unconsumed-inputs)
+ (text;join-with ", "))))))))
## [Syntax]
(def: #hidden text.join-with text;join-with)
@@ -413,11 +429,14 @@
(with-brackets (spaced (map (method-def$ id) methods))))))]
(wrap (list (` (;_lux_proc ["jvm" (~ (ast;text def-code))] [])))))))}
(let [[exported? tokens] (case tokens
+ (^ (list& [_ (#;TagS ["" "hidden"])] tokens'))
+ [(#;Some #;Left) tokens']
+
(^ (list& [_ (#;TagS ["" "export"])] tokens'))
- [true tokens']
+ [(#;Some #;Right) tokens']
_
- [false tokens])
+ [#;None tokens])
?parts (: (Maybe [Text (List AST) AST AST])
(case tokens
(^ (list [_ (#;FormS (list& [_ (#;SymbolS ["" name])] args))]
@@ -451,7 +470,15 @@
#let [g!state (ast;symbol ["" "*compiler*"])
g!end (ast;symbol ["" ""])
error-msg (ast;text (Text/append "Wrong syntax for " name))
- export-ast (: (List AST) (if exported? (list (' #export)) (list)))]]
+ export-ast (: (List AST) (case exported?
+ (#;Some #;Left)
+ (list (' #hidden))
+
+ (#;Some #;Right)
+ (list (' #export))
+
+ _
+ (list)))]]
(wrap (list (` (macro: (~@ export-ast) ((~ (ast;symbol ["" name])) (~ g!tokens))
(~ meta)
(lambda [(~ g!state)]
diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux
index 9d1887b87..69564fc7d 100644
--- a/stdlib/source/lux/macro/syntax/common.lux
+++ b/stdlib/source/lux/macro/syntax/common.lux
@@ -3,7 +3,9 @@
## If a copy of the MPL was not distributed with this file,
## You can obtain one at http://mozilla.org/MPL/2.0/.
-(;module:
+(;module: {#;doc "Commons syntax parsers and generators.
+
+ The goal is to be able to reuse common syntax in macro definitions across libraries."}
lux
(lux (control monad)
(data (struct [list])
@@ -20,6 +22,10 @@
#Hidden)
(def: #export export-level
+ {#;doc (doc "A parser for export levels."
+ "Such as:"
+ #export
+ #hidden)}
(Syntax (Maybe Export-Level))
(s;opt (s;alt (s;tag! ["" "export"])
(s;tag! ["" "hidden"]))))
@@ -42,6 +48,11 @@
#decl-args (List Text)})
(def: #export decl
+ {#;doc (doc "A parser for declaration syntax."
+ "Such as:"
+ quux
+ (foo bar baz))}
+ (Syntax Decl)
(s;either (s;seq s;local-symbol
(:: s;Monad<Syntax> wrap (list)))
(s;form (s;seq s;local-symbol
@@ -52,7 +63,7 @@
{#def-name Text
#def-type (Maybe AST)
#def-value AST
- #def-meta (List [Ident AST])
+ #def-anns (List [Ident AST])
#def-args (List Text)
})
@@ -66,17 +77,17 @@
(s;seq (:: s;Monad<Syntax> wrap #;None)
s;any)))
-(def: _def-meta-tag^
+(def: _def-anns-tag^
(Syntax Ident)
(s;tuple (s;seq s;text s;text)))
-(def: (_def-meta^ _)
+(def: (_def-anns^ _)
(-> Top (Syntax (List [Ident AST])))
(s;alt (s;tag! ["lux" "Nil"])
(s;form (do s;Monad<Syntax>
[_ (s;tag! ["lux" "Cons"])
- [head tail] (s;seq (s;tuple (s;seq _def-meta-tag^ s;any))
- (_def-meta^ []))]
+ [head tail] (s;seq (s;tuple (s;seq _def-anns-tag^ s;any))
+ (_def-anns^ []))]
(wrap [head tail])))
))
@@ -119,6 +130,7 @@
))
(def: #export (def compiler)
+ {#;doc "A parser that first macro-expands and then analyses the input AST, to ensure it's a definition."}
(-> Compiler (Syntax Def-Syntax))
(do s;Monad<Syntax>
[def-raw s;any
@@ -129,17 +141,18 @@
[_ (s;symbol! ["lux" "_lux_def"])
def-name s;local-symbol
[?def-type def-value] check^
- def-meta s;any
- def-meta (s;local (list def-meta)
- (_def-meta^ []))
- #let [def-args (find-def-args def-meta)]]
+ def-anns s;any
+ def-anns (s;local (list def-anns)
+ (_def-anns^ []))
+ #let [def-args (find-def-args def-anns)]]
(wrap {#def-name def-name
#def-type ?def-type
- #def-meta def-meta
+ #def-anns def-anns
#def-value def-value
#def-args def-args}))))))
-(def: #export (typed-de compiler)
+(def: #export (typed-def compiler)
+ {#;doc "A parser for definitions that ensures the input syntax is typed."}
(-> Compiler (Syntax Def-Syntax))
(do s;Monad<Syntax>
[_def (def compiler)
@@ -152,14 +165,17 @@
)]
(wrap _def)))
-(def: #export def-meta
+(def: #export def-anns
+ {#;doc "Parser for the common annotations syntax used by def: statements."}
(Syntax (List [Ident AST]))
(s;record (s;some (s;seq s;tag s;any))))
(def: #export typed-arg
+ {#;doc "Parser for the common typed-argument syntax used by many macros."}
(Syntax [Text AST])
(s;tuple (s;seq s;local-symbol s;any)))
(def: #export type-params
+ {#;doc "Parser for the common type var/param used by many macros."}
(Syntax (List Text))
(s;tuple (s;some s;local-symbol)))
diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux
index e66d386d8..293c87509 100644
--- a/stdlib/source/lux/macro/template.lux
+++ b/stdlib/source/lux/macro/template.lux
@@ -15,40 +15,18 @@
(syntax [common]))))
## [Syntax]
-(def: decl^
- (Syntax [Text (List Text)])
- (s;form (s;seq s;local-symbol (s;many s;local-symbol))))
-
-(def: (prepare bindings template)
- (-> (Dict Text AST) AST AST)
- (case template
- (^=> [_ (#;SymbolS "" name)]
- [(dict;get name bindings) (#;Some found)])
- found
-
- (^template [<tag>]
- [meta (<tag> parts)]
- [meta (<tag> (map (prepare bindings ) parts))])
- ([#;FormS]
- [#;TupleS])
-
-
- [meta (#;RecordS pairs)]
- [meta (#;RecordS (map (lambda [[slot value]]
- [(prepare bindings slot)
- (prepare bindings value)])
- pairs))]
-
- _
- template
- ))
-
-(syntax: #export (template: [_ex-lev common;export-level] [[name args] decl^] template)
- (let [bindings (fold (lambda [arg bindings]
- (dict;put arg (` ((~' ~) (~ (ast;symbol ["" arg])))) bindings))
- (: (Dict Text AST) (dict;new text;Hash<Text>))
- args)]
+(syntax: #export (template: [_ex-lev common;export-level] [[name args] common;decl] input-template)
+ {#;doc (doc "Define macros in the style of do-template and ^template."
+ "For simple macros that don't need any fancy features."
+ (template: (square x)
+ (i.* x x)))}
+ (let [output-template (fold (lambda [arg' template']
+ (ast;replace arg'
+ (` ((~' ~) (~ arg')))
+ template'))
+ input-template
+ (map ast;local-symbol args))]
(wrap (list (` (syntax: (~@ (common;gen-export-level _ex-lev)) ((~ (ast;symbol ["" name]))
(~@ (map (|>. [""] ast;symbol) args)))
- ((~' wrap) (list (` (~ (prepare bindings template)))))))))
+ ((~' wrap) (list (` (~ output-template))))))))
))
diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux
index 110561901..4c7c2e92e 100644
--- a/stdlib/source/lux/math.lux
+++ b/stdlib/source/lux/math.lux
@@ -3,7 +3,7 @@
## If a copy of the MPL was not distributed with this file,
## You can obtain one at http://mozilla.org/MPL/2.0/.
-(;module: {#;doc "Common numerical operations."}
+(;module: {#;doc "Common mathematical constants and functions."}
lux
(lux (control monad)
(data (struct [list "" Fold<List>])
@@ -25,7 +25,10 @@
[pi "getstatic:java.lang.Math:PI"]
)
-(def: #export tau Real 6.28318530717958647692)
+(def: #export tau
+ {#;doc "The same as 2*PI."}
+ Real
+ 6.28318530717958647692)
(do-template [<name> <method>]
[(def: #export (<name> n)
@@ -153,4 +156,15 @@
))
(syntax: #export (infix [expr (infix^ [])])
+ {#;doc (doc "Infix math syntax."
+ (infix [x i.* 10])
+ (infix [[x i.+ y] i.* [x i.- y]])
+ (infix [[x n.< y] and [y n.< z]])
+ (infix [#and x n.< y n.< z])
+ (infix [(n.* +3 +9) gcd +450])
+
+ "The rules for infix syntax are simple."
+ "If you want your binary function to work well with it."
+ "Then take the argument to the right (y) as your first argument,"
+ "and take the argument to the left (x) as your second argument.")}
(wrap (list (infix-to-prefix expr))))
diff --git a/stdlib/source/lux/math/complex.lux b/stdlib/source/lux/math/complex.lux
index 1da82b290..9666abdab 100644
--- a/stdlib/source/lux/math/complex.lux
+++ b/stdlib/source/lux/math/complex.lux
@@ -3,7 +3,7 @@
## If a copy of the MPL was not distributed with this file,
## You can obtain one at http://mozilla.org/MPL/2.0/.
-(;module:
+(;module: {#;doc "Complex arithmetic."}
lux
(lux [math]
(control eq
@@ -29,8 +29,12 @@
#imaginary Real})
(syntax: #export (complex real [?imaginary (s;opt s;any)])
+ {#;doc (doc "Complex literals."
+ (complex real imaginary)
+ "The imaginary part can be omitted if it's 0."
+ (complex real))}
(wrap (list (` {#;;real (~ real)
- #;;imaginary (~ (default (` 0.0)
+ #;;imaginary (~ (default (' 0.0)
?imaginary))}))))
(def: #export i Complex (complex 0.0 1.0))
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
index 0a76f3365..802dbfae6 100644
--- a/stdlib/source/lux/math/random.lux
+++ b/stdlib/source/lux/math/random.lux
@@ -3,7 +3,7 @@
## If a copy of the MPL was not distributed with this file,
## You can obtain one at http://mozilla.org/MPL/2.0/.
-(;module:
+(;module: {#;doc "Pseudo-random number generation (PRNG) algorithms."}
[lux #- list]
(lux (control functor
applicative
@@ -27,9 +27,11 @@
## [Exports]
(type: #export #rec PRNG
+ {#;doc "An abstract way to represent any PRNG."}
(-> Unit [PRNG Nat]))
(type: #export (Random a)
+ {#;doc "A producer of random values based on a PRNG."}
(-> PRNG [PRNG a]))
(struct: #export _ (Functor Random)
@@ -134,6 +136,7 @@
)
(def: #export (seq left right)
+ {#;doc "Sequencing combinator."}
(All [a b] (-> (Random a) (Random b) (Random [a b])))
(do Monad<Random>
[=left left
@@ -141,6 +144,7 @@
(wrap [=left =right])))
(def: #export (alt left right)
+ {#;doc "Heterogeneous alternative combinator."}
(All [a b] (-> (Random a) (Random b) (Random (| a b))))
(do Monad<Random>
[? bool]
@@ -153,6 +157,7 @@
(wrap (+1 =right))))))
(def: #export (either left right)
+ {#;doc "Homogeneous alternative combinator."}
(All [a] (-> (Random a) (Random a) (Random a)))
(do Monad<Random>
[? bool]
@@ -161,12 +166,14 @@
right)))
(def: #export (rec gen)
+ {#;doc "A combinator for producing recursive random generators."}
(All [a] (-> (-> (Random a) (Random a)) (Random a)))
(lambda [state]
(let [gen' (gen (rec gen))]
(gen' state))))
(def: #export (filter pred gen)
+ {#;doc "Retries the generator until the output satisfies a predicate."}
(All [a] (-> (-> a Bool) (Random a) (Random a)))
(do Monad<Random>
[sample gen]
@@ -210,11 +217,11 @@
[stack ST;Stack (List/fold ST;push ST;empty)]
)
-(def: #export (set a/Hash size value-gen)
+(def: #export (set Hash<a> size value-gen)
(All [a] (-> (Hash a) Nat (Random a) (Random (S;Set a))))
(if (n.> +0 size)
(do Monad<Random>
- [xs (set a/Hash (n.dec size) value-gen)]
+ [xs (set Hash<a> (n.dec size) value-gen)]
(loop [_ []]
(do @
[x value-gen
@@ -222,13 +229,13 @@
(if (n.= size (S;size xs+))
(wrap xs+)
(recur [])))))
- (:: Monad<Random> wrap (S;new a/Hash))))
+ (:: Monad<Random> wrap (S;new Hash<a>))))
-(def: #export (dict a/Hash size key-gen value-gen)
+(def: #export (dict Hash<a> size key-gen value-gen)
(All [k v] (-> (Hash k) Nat (Random k) (Random v) (Random (D;Dict k v))))
(if (n.> +0 size)
(do Monad<Random>
- [kv (dict a/Hash (n.dec size) key-gen value-gen)]
+ [kv (dict Hash<a> (n.dec size) key-gen value-gen)]
(loop [_ []]
(do @
[k key-gen
@@ -237,7 +244,7 @@
(if (n.= size (D;size kv+))
(wrap kv+)
(recur [])))))
- (:: Monad<Random> wrap (D;new a/Hash))))
+ (:: Monad<Random> wrap (D;new Hash<a>))))
(def: #export (run prng calc)
(All [a] (-> PRNG (Random a) [PRNG a]))
@@ -250,6 +257,9 @@
(def: pcg-32-magic-mult Nat +6364136223846793005)
(def: #export (pcg-32 [inc seed])
+ {#;doc "An implementation of the PCG32 algorithm.
+
+ For more information, please see: http://www.pcg-random.org/"}
(-> [Nat Nat] PRNG)
(lambda [_]
(let [seed' (|> seed (n.* pcg-32-magic-mult) (n.+ inc))
@@ -260,6 +270,9 @@
## Xoroshiro128+ http://xoroshiro.di.unimi.it/
(def: #export (xoroshiro-128+ [s0 s1])
+ {#;doc "An implementation of the Xoroshiro128+ algorithm.
+
+ For more information, please see: http://xoroshiro.di.unimi.it/"}
(-> [Nat Nat] PRNG)
(lambda [_]
(let [result (n.+ s0 s1)
@@ -279,6 +292,7 @@
vec))
(def: #export (shuffle seed vector)
+ {#;doc "Shuffle a vector randomly based on a seed value."}
(All [a] (-> Nat (V;Vector a) (V;Vector a)))
(let [_size (V;size vector)
_shuffle (foldM Monad<Random>
diff --git a/stdlib/source/lux/math/ratio.lux b/stdlib/source/lux/math/ratio.lux
index c0e077c8a..c4a369866 100644
--- a/stdlib/source/lux/math/ratio.lux
+++ b/stdlib/source/lux/math/ratio.lux
@@ -3,7 +3,7 @@
## If a copy of the MPL was not distributed with this file,
## You can obtain one at http://mozilla.org/MPL/2.0/.
-(;module:
+(;module: {#;doc "Rational arithmetic."}
lux
(lux [math]
(control eq
@@ -154,6 +154,11 @@
#;None
(#;Left (Text/append "Invalid syntax for ratio: " input)))))
-(syntax: #export (ratio numerator denominator)
+(syntax: #export (ratio numerator [?denominator (s;opt s;any)])
+ {#;doc (doc "Rational literals."
+ (ratio numerator denominator)
+ "The denominator can be omitted if it's 1."
+ (ratio numerator))}
(wrap (list (` (normalize {#;;numerator (~ numerator)
- #;;denominator (~ denominator)})))))
+ #;;denominator (~ (default (' +1)
+ ?denominator))})))))
diff --git a/stdlib/source/lux/math/simple.lux b/stdlib/source/lux/math/simple.lux
index 31a8bb3ca..4fa69a8a1 100644
--- a/stdlib/source/lux/math/simple.lux
+++ b/stdlib/source/lux/math/simple.lux
@@ -3,7 +3,7 @@
## If a copy of the MPL was not distributed with this file,
## You can obtain one at http://mozilla.org/MPL/2.0/.
-(;module:
+(;module: {#;doc "Polymorphic arithmetic operators that work with all primitive numeric types, without requiring any prefixes."}
lux
(lux (control monad)
(data text/format
@@ -53,6 +53,14 @@
s;symbol
s;any
s;end)])
+ {#;doc (doc (= (<name> +1 +2)
+ (<nat-op> +1 +2))
+ (= (<name> 1 2)
+ (<int-op> 1 2))
+ (= (<name> 1.0 2.0)
+ (<real-op> 1.0 2.0))
+ (= (<name> .1 .2)
+ (<frac-op> .1 .2)))}
(case args
(+0 [x y])
(do @
@@ -142,6 +150,14 @@
s;symbol
s;any
s;end)])
+ {#;doc (doc (= (<name> +1 +2)
+ (<nat-op> +1 +2))
+ (= (<name> 1 2)
+ (<int-op> 1 2))
+ (= (<name> 1.0 2.0)
+ (<real-op> 1.0 2.0))
+ (= (<name> .1 .2)
+ (<frac-op> .1 .2)))}
(case args
(+0 [x y])
(do @
@@ -231,6 +247,10 @@
s;symbol
s;any
s;end)])
+ {#;doc (doc (= (<name> +1 +2)
+ (<nat-op> +1 +2))
+ (= (<name> 1 2)
+ (<int-op> 1 2)))}
(case args
(+0 [x y])
(do @
@@ -295,6 +315,10 @@
s;symbol
s;any
s;end)])
+ {#;doc (doc (= (<name> +1 +2)
+ (<nat-op> +1 +2))
+ (= (<name> 1 2)
+ (<int-op> 1 2)))}
(case args
(+0 x)
(do @
@@ -336,6 +360,10 @@
s;symbol
s;any
s;end)])
+ {#;doc (doc (= (<name> +1 +2)
+ (<nat-op> +1 +2))
+ (= (<name> 1 2)
+ (<int-op> 1 2)))}
(case args
(+0 x)
(do @
diff --git a/stdlib/source/lux/pipe.lux b/stdlib/source/lux/pipe.lux
index 5c553b7ec..c0b99bd5b 100644
--- a/stdlib/source/lux/pipe.lux
+++ b/stdlib/source/lux/pipe.lux
@@ -70,12 +70,11 @@
g!temp)))))))))
(syntax: #export (!> [test body^] [then body^] prev)
- {#;doc (doc
- "Loops for pipes."
- "Both the testing and calculating steps are pipes and must be given inside tuples."
- (|> 1
- (!> [(i.< 10)]
- [i.inc])))}
+ {#;doc (doc "Loops for pipes."
+ "Both the testing and calculating steps are pipes and must be given inside tuples."
+ (|> 1
+ (!> [(i.< 10)]
+ [i.inc])))}
(with-gensyms [g!temp]
(wrap (list (` (loop [(~ g!temp) (~ prev)]
(if (|> (~ g!temp) (~@ test))
diff --git a/stdlib/source/lux/regex.lux b/stdlib/source/lux/regex.lux
index e3cd95811..417abc086 100644
--- a/stdlib/source/lux/regex.lux
+++ b/stdlib/source/lux/regex.lux
@@ -421,6 +421,64 @@
## [Syntax]
(syntax: #export (regex [pattern syntax;text])
+ {#;doc (doc "Create lexers using regular-expression syntax."
+ "For example:"
+
+ "Literals"
+ (regex "a")
+
+ "Wildcards"
+ (regex ".")
+
+ "Escaping"
+ (regex "\\.")
+
+ "Character classes"
+ (regex "\\d")
+ (regex "\\p{Lower}")
+ (regex "[abc]")
+ (regex "[a-z]")
+ (regex "[a-zA-Z]")
+ (regex "[a-z&&[def]]")
+
+ "Negation"
+ (regex "[^abc]")
+ (regex "[^a-z]")
+ (regex "[^a-zA-Z]")
+ (regex "[a-z&&[^bc]]")
+ (regex "[a-z&&[^m-p]]")
+
+ "Combinations"
+ (regex "aa")
+ (regex "a?")
+ (regex "a*")
+ (regex "a+")
+
+ "Specific amounts"
+ (regex "a{2}")
+
+ "At least"
+ (regex "a{1,}")
+
+ "At most"
+ (regex "a{,1}")
+
+ "Between"
+ (regex "a{1,2}")
+
+ "Groups"
+ (regex "a(.)c")
+ (regex "a(b+)c")
+ (regex "(\\d{3})-(\\d{3})-(\\d{4})")
+ (regex "(\\d{3})-(?:\\d{3})-(\\d{4})")
+ (regex "(?<code>\\d{3})-\\k<code>-(\\d{4})")
+ (regex "(?<code>\\d{3})-\\k<code>-(\\d{4})-\\0")
+ (regex "(\\d{3})-((\\d{3})-(\\d{4}))")
+
+ "Alternation"
+ (regex "a|b")
+ (regex "a(.)(.)|b(.)(.)")
+ )}
(do @
[current-module compiler;current-module-name]
(case (&;run (&;&_ (regex^ current-module) &;end) pattern)
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index 2230282da..e2bff250e 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -3,7 +3,7 @@
## If a copy of the MPL was not distributed with this file,
## You can obtain one at http://mozilla.org/MPL/2.0/.
-(;module:
+(;module: {#;doc "Tools for unit & property-based/generative testing."}
lux
(lux [compiler #+ Monad<Lux> with-gensyms]
(macro ["s" syntax #+ syntax: Syntax]
@@ -35,6 +35,7 @@
## [Types]
(type: #export Test
+ {#;doc "Tests are asynchronous process which may fail."}
(Promise (Error Unit)))
## [Values]
@@ -42,9 +43,10 @@
(All [a] (-> Text Test))
(:: Monad<Promise> wrap (#;Left message)))
-(def: #export (assert message test)
+(def: #export (assert message condition)
+ {#;doc "Check that a condition is true, and fail with the given message otherwise."}
(-> Text Bool Test)
- (if test
+ (if condition
(:: Monad<Promise> wrap (#;Right []))
(fail message)))
@@ -72,7 +74,9 @@
(def: pcg-32-magic-inc Nat +12345)
-(type: #export Seed Nat)
+(type: #export Seed
+ {#;doc "The seed value used for random testing (if that feature is used)."}
+ Nat)
(def: (try seed random-test)
(-> Seed (R;Random Test) (Promise (Error Seed)))
@@ -106,7 +110,7 @@
(repeat' seed' (n.dec times) random-test))
))))
-(def: #export (repeat ?seed times random-test)
+(def: #hidden (repeat ?seed times random-test)
(-> (Maybe Nat) Nat (R;Random Test) Test)
(repeat' (default (int-to-nat (io;run (System.currentTimeMillis [])))
?seed)
@@ -165,18 +169,62 @@
(syntax: #export (test: description [body test^])
{#;doc (doc "Macro for definint tests."
- (test: "lux/pipe exports"
- (all (match 1 (|> 20
- (i.* 3)
- (i.+ 4)
- (_> 0 i.inc)))
- (match 10 (|> 5
- (@> (i.+ @ @))))
- (match 15 (|> 5
- (?> [i.even?] [(i.* 2)]
- [i.odd?] [(i.* 3)]
- [(_> -1)])))
- )))}
+ (test: "Simple macros and constructs"
+ ($_ seq
+ (assert "Can write easy loops for iterative programming."
+ (i.= 1000
+ (loop [counter 0
+ value 1]
+ (if (i.< 3 counter)
+ (recur (i.inc counter) (i.* 10 value))
+ value))))
+
+ (assert "Can create lists easily through macros."
+ (and (case (list 1 2 3)
+ (#;Cons 1 (#;Cons 2 (#;Cons 3 #;Nil)))
+ true
+
+ _
+ false)
+
+ (case (list& 1 2 3 (list 4 5 6))
+ (#;Cons 1 (#;Cons 2 (#;Cons 3 (#;Cons 4 (#;Cons 5 (#;Cons 6 #;Nil))))))
+ true
+
+ _
+ false)))
+
+ (assert "Can have defaults for Maybe values."
+ (and (is "yolo" (default "yolo"
+ #;None))
+
+ (is "lol" (default "yolo"
+ (#;Some "lol")))))
+ ))
+ "Also works with random generation of values for property-based testing."
+ (test: "Addition & Substraction"
+ [x (:: @ map <prep> rand-gen)
+ y (:: @ map <prep> rand-gen)]
+ (assert ""
+ (and (|> x (- y) (+ y) (= x))
+ (|> x (+ y) (- y) (= x)))))
+ "By default, random tests will be tried 100 times, you can specify the amount you want:"
+ (test: "Addition & Substraction"
+ #times +1234
+ [x (:: @ map <prep> rand-gen)
+ y (:: @ map <prep> rand-gen)]
+ (assert ""
+ (and (|> x (- y) (+ y) (= x))
+ (|> x (+ y) (- y) (= x)))))
+ "If a test fails, you'll be shown a seed that you can then use to reproduce a failing scenario."
+ (test: "Addition & Substraction"
+ #seed +987654321
+ [x (:: @ map <prep> rand-gen)
+ y (:: @ map <prep> rand-gen)]
+ (assert ""
+ (and (|> x (- y) (+ y) (= x))
+ (|> x (+ y) (- y) (= x)))))
+ )}
(let [body (case body
(#Property config bindings body)
(let [[=seed =times] (case config
@@ -261,6 +309,7 @@
[])))))))))
(def: #export (seq left right)
+ {#;doc "Sequencing combinator."}
(-> Test Test Test)
(do Monad<Promise>
[=left left
@@ -274,6 +323,7 @@
(wrap (#;Right [])))))
(def: #export (alt left right)
+ {#;doc "Alternative combinator."}
(-> Test Test Test)
(do Monad<Promise>
[=left left
diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux
index 1fb0afa6f..cda44670b 100644
--- a/stdlib/source/lux/type.lux
+++ b/stdlib/source/lux/type.lux
@@ -3,7 +3,7 @@
## If a copy of the MPL was not distributed with this file,
## You can obtain one at http://mozilla.org/MPL/2.0/.
-(;module:
+(;module: {#;doc "Basic functionality for working with types."}
lux
(lux (control eq
monad)
@@ -145,12 +145,12 @@
[flatten-tuple #;ProdT]
)
-(def: #export (apply-type type-fun param)
+(def: #export (apply-type type-func param)
(-> Type Type (Maybe Type))
- (case type-fun
+ (case type-func
(^template [<tag>]
(<tag> env body)
- (#;Some (beta-reduce (list& type-fun param env) body)))
+ (#;Some (beta-reduce (list& type-func param env) body)))
([#;UnivQ] [#;ExQ])
(#;AppT F A)
@@ -252,8 +252,8 @@
($_ Text/append "⟨e:" (Nat/encode id) "⟩")
(#;AppT fun param)
- (let [[type-fun type-args] (flatten-application type)]
- ($_ Text/append "(" (to-text type-fun) " " (|> type-args (List/map to-text) list;reverse (list;interpose " ") (List/fold Text/append "")) ")"))
+ (let [[type-func type-args] (flatten-application type)]
+ ($_ Text/append "(" (to-text type-func) " " (|> type-args (List/map to-text) list;reverse (list;interpose " ") (List/fold Text/append "")) ")"))
(^template [<tag> <desc>]
(<tag> env body)
diff --git a/stdlib/source/lux/type/auto.lux b/stdlib/source/lux/type/auto.lux
index 27c1472c0..2266827c9 100644
--- a/stdlib/source/lux/type/auto.lux
+++ b/stdlib/source/lux/type/auto.lux
@@ -5,7 +5,8 @@
(;module:
lux
- (lux (control monad)
+ (lux (control monad
+ [eq])
(data [text "Text/" Eq<Text>]
text/format
[number]
@@ -324,6 +325,29 @@
(syntax: #export (::: [member s;symbol]
[args (s;alt (s;seq (s;some s;symbol) s;end)
(s;seq (s;some s;any) s;end))])
+ {#;doc (doc "Automatic structure selection (for type-class style polymorphism)."
+ "This feature layers type-class style polymorphism on top of Lux's signatures and structures."
+ "When calling a polymorphic function, or using a polymorphic constant,"
+ "this macro will check the types of the arguments, and the expected type for the whole expression"
+ "and it will search in the local scope, the module's scope and the imports' scope"
+ "in order to find suitable structures to satisfy those requirements."
+ "If a single alternative is found, that one will be used automatically."
+ "If no alternative is found, or if more than one alternative is found (ambiguity)"
+ "a compile-time error will be raised, to alert the user."
+ "Examples:"
+ "Nat equality"
+ (:: number;Eq<Nat> = x y)
+ (::: = x y)
+ "Can optionally add the prefix of the module where the signature was defined."
+ (::: eq;= x y)
+ "(List Nat) equality"
+ (::: =
+ (list;n.range +1 +10)
+ (list;n.range +1 +10))
+ "Functor map"
+ (::: map n.inc (list;n.range +0 +9))
+ "Caveat emptor: You need to make sure to import the module of any structure you want to use."
+ "Otherwise, this macro won't find it.")}
(case args
(#;Left [args _])
(do @
diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux
index 97a01d8ce..25cf19834 100644
--- a/stdlib/source/lux/type/check.lux
+++ b/stdlib/source/lux/type/check.lux
@@ -3,7 +3,9 @@
## If a copy of the MPL was not distributed with this file,
## You can obtain one at http://mozilla.org/MPL/2.0/.
-(;module:
+(;module: {#;doc "Type-checking functionality.
+
+ Very useful for writing advanced macros."}
lux
(lux (control functor
applicative
@@ -109,6 +111,7 @@
(#;Right [context output]))))
(def: #export existential
+ {#;doc "A producer of existential types."}
(Check [Id Type])
(lambda [context]
(let [id (get@ #ex-counter context)]
@@ -128,7 +131,7 @@
#;None
(#;Left (format "Unknown type-var: " (%n id))))))
-(def: #export (deref id)
+(def: #export (read-var id)
(-> Id (Check Type))
(lambda [context]
(case (|> context (get@ #bindings) (dict;get id))
@@ -141,8 +144,8 @@
#;None
(#;Left (format "Unknown type-var: " (%n id))))))
-(def: (set-var id type)
- (-> Id Type (Check []))
+(def: #export (write-var id type)
+ (-> Id Type (Check Unit))
(lambda [context]
(case (|> context (get@ #bindings) (dict;get id))
(#;Some (#;Some bound))
@@ -155,8 +158,8 @@
#;None
(#;Left (format "Unknown type-var: " (%n id))))))
-(def: (reset-var id type)
- (-> Id Type (Check []))
+(def: (rewrite-var id type)
+ (-> Id Type (Check Unit))
(lambda [context]
(case (|> context (get@ #bindings) (dict;get id))
(#;Some _)
@@ -166,8 +169,8 @@
#;None
(#;Left (format "Unknown type-var: " (%n id))))))
-(def: (unset-var id)
- (-> Id (Check []))
+(def: #export (clear-var id)
+ (-> Id (Check Unit))
(lambda [context]
(case (|> context (get@ #bindings) (dict;get id))
(#;Some _)
@@ -185,27 +188,27 @@
(do Monad<Check>
[? (bound? id)]
(if ?
- (deref id)
+ (read-var id)
(wrap type)))
(do Monad<Check>
[? (bound? id)]
(if ?
(do Monad<Check>
- [=type (deref id)
+ [=type (read-var id)
==type (clean t-id =type)]
(case ==type
(#;VarT =id)
(if (n.= t-id =id)
(do Monad<Check>
- [_ (unset-var id)]
+ [_ (clear-var id)]
(wrap type))
(do Monad<Check>
- [_ (reset-var id ==type)]
+ [_ (rewrite-var id ==type)]
(wrap type)))
_
(do Monad<Check>
- [_ (reset-var id ==type)]
+ [_ (rewrite-var id ==type)]
(wrap type))))
(wrap type))))
@@ -255,7 +258,7 @@
(get@ <tag> context)])))
(def: (<set> value)
- (-> <type> (Check []))
+ (-> <type> (Check Unit))
(lambda [context]
(#;Right [(set@ <tag> value context)
[]])))]
@@ -265,14 +268,14 @@
)
(def: #export (delete-var id)
- (-> Id (Check []))
+ (-> Id (Check Unit))
(do Monad<Check>
[? (bound? id)
_ (if ?
(wrap [])
(do Monad<Check>
[[ex-id ex] existential]
- (set-var id ex)))
+ (write-var id ex)))
bindings get-bindings
bindings' (mapM @
(lambda [(^@ binding [b-id b-type])]
@@ -329,11 +332,11 @@
(#;Left message)))
(def: (fail-check expected actual)
- (-> Type Type (Check []))
+ (-> Type Type (Check Unit))
(fail (format "Expected: " (%type expected) "\n\n"
"Actual: " (%type actual))))
-(def: success (Check []) (Check/wrap []))
+(def: success (Check Unit) (Check/wrap []))
(def: (either left right)
(All [a] (-> (Check a) (Check a) (Check a)))
@@ -358,7 +361,8 @@
(#;Cons [ea status] fixpoints))
(def: #export (check expected actual)
- (-> Type Type (Check []))
+ {#;doc "Type-check to ensure that the 'expected' type subsumes the 'actual' type."}
+ (-> Type Type (Check Unit))
(if (is expected actual)
success
(case [expected actual]
@@ -366,11 +370,11 @@
(if (n.= e-id a-id)
success
(do Monad<Check>
- [ebound (attempt (deref e-id))
- abound (attempt (deref a-id))]
+ [ebound (attempt (read-var e-id))
+ abound (attempt (read-var a-id))]
(case [ebound abound]
[#;None #;None]
- (set-var e-id actual)
+ (write-var e-id actual)
[(#;Some etype) #;None]
(check etype actual)
@@ -382,15 +386,15 @@
(check etype atype))))
[(#;VarT id) _]
- (either (set-var id actual)
+ (either (write-var id actual)
(do Monad<Check>
- [bound (deref id)]
+ [bound (read-var id)]
(check bound actual)))
[_ (#;VarT id)]
- (either (set-var id expected)
+ (either (write-var id expected)
(do Monad<Check>
- [bound (deref id)]
+ [bound (read-var id)]
(check expected bound)))
[(#;AppT (#;ExT eid) eA) (#;AppT (#;ExT aid) aA)]
@@ -400,7 +404,7 @@
[(#;AppT (#;VarT id) A1) (#;AppT F2 A2)]
(either (do Monad<Check>
- [F1 (deref id)]
+ [F1 (read-var id)]
(check (#;AppT F1 A1) actual))
(do Monad<Check>
[_ (check (#;VarT id) F2)
@@ -410,7 +414,7 @@
[(#;AppT F1 A1) (#;AppT (#;VarT id) A2)]
(either (do Monad<Check>
- [F2 (deref id)]
+ [F2 (read-var id)]
(check expected (#;AppT F2 A2)))
(do Monad<Check>
[_ (check F1 (#;VarT id))
@@ -509,6 +513,7 @@
(fail-check expected actual))))
(def: #export (checks? expected actual)
+ {#;doc "A simple type-checking function that just returns a yes/no answer."}
(-> Type Type Bool)
(case (run fresh-context (check expected actual))
(#;Left error)
diff --git a/stdlib/test/test/lux/concurrency/actor.lux b/stdlib/test/test/lux/concurrency/actor.lux
index abf8828d7..7136ab30d 100644
--- a/stdlib/test/test/lux/concurrency/actor.lux
+++ b/stdlib/test/test/lux/concurrency/actor.lux
@@ -27,7 +27,7 @@
(wrap [])))
(test: "Actors"
- (let [counter-proc (: (&;Proc Int (Promise Int))
+ (let [counter-proc (: (&;Behavior Int (Promise Int))
[(lambda [self output state]
(let [state' (i.inc state)]
(exec (io;run (promise;resolve state' output))
diff --git a/stdlib/test/test/lux/data/struct/queue.lux b/stdlib/test/test/lux/data/struct/queue.lux
index 98379e30a..095d066f6 100644
--- a/stdlib/test/test/lux/data/struct/queue.lux
+++ b/stdlib/test/test/lux/data/struct/queue.lux
@@ -17,7 +17,7 @@
[size (:: @ map (n.% +100) R;nat)
sample (R;queue size R;nat)
non-member (|> R;nat
- (R;filter (. not (&;enqueued? number;Eq<Nat> sample))))]
+ (R;filter (. not (&;member? number;Eq<Nat> sample))))]
($_ seq
(assert "I can query the size of a queue (and empty queues have size 0)."
(if (n.= +0 size)
@@ -25,10 +25,10 @@
(n.= size (&;size sample))))
(assert "Enqueueing and dequeing affects the size of queues."
- (and (n.= (n.inc size) (&;size (&;enqueue non-member sample)))
+ (and (n.= (n.inc size) (&;size (&;push non-member sample)))
(or (&;empty? sample)
- (n.= (n.dec size) (&;size (&;dequeue sample))))
- (n.= size (&;size (&;dequeue (&;enqueue non-member sample))))))
+ (n.= (n.dec size) (&;size (&;pop sample))))
+ (n.= size (&;size (&;pop (&;push non-member sample))))))
(assert "Transforming to/from list can't change the queue."
(let [(^open "&/") (&;Eq<Queue> number;Eq<Nat>)]
@@ -42,14 +42,14 @@
(#;Some _) true))
(assert "I can query whether an element belongs to a queue."
- (and (not (&;enqueued? number;Eq<Nat> sample non-member))
- (&;enqueued? number;Eq<Nat> (&;enqueue non-member sample)
- non-member)
+ (and (not (&;member? number;Eq<Nat> sample non-member))
+ (&;member? number;Eq<Nat> (&;push non-member sample)
+ non-member)
(case (&;peek sample)
#;None
(&;empty? sample)
(#;Some first)
- (and (&;enqueued? number;Eq<Nat> sample first)
- (not (&;enqueued? number;Eq<Nat> (&;dequeue sample) first))))))
+ (and (&;member? number;Eq<Nat> sample first)
+ (not (&;member? number;Eq<Nat> (&;pop sample) first))))))
))