diff options
Diffstat (limited to 'stdlib/source')
52 files changed, 786 insertions, 347 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) |