diff options
Diffstat (limited to 'stdlib/source/library')
51 files changed, 623 insertions, 274 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 16123c586..f534a51d9 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -2496,10 +2496,11 @@ [(def:''' .private (<name> xy) #End (All [a b] (-> (Tuple a b) <type>)) - (let' [[x y] xy] <value>))] + (let' [[x y] xy] + <value>))] - [first a x] - [second b y]) + [product\left a x] + [product\right b y]) (def:''' .private (type_declaration type_codes) #End @@ -2516,8 +2517,8 @@ (failure "Wrong syntax for variant case.")} pair))) pairs)] - (in_meta [(` (Tuple (~+ (list\map second members)))) - (#Some (list\map first members))])) + (in_meta [(` (Tuple (~+ (list\map product\right members)))) + (#Some (list\map product\left members))])) (#Item type #End) ({[_ (#Tag "" member_name)] @@ -2548,8 +2549,8 @@ (failure "Wrong syntax for variant case.")} case))) (list& case cases))] - (in_meta [(` (..Variant (~+ (list\map second members)))) - (#Some (list\map first members))])) + (in_meta [(` (..Variant (~+ (list\map product\right members)))) + (#Some (list\map product\left members))])) _ (failure "Improper type-definition syntax")} @@ -3551,7 +3552,7 @@ _ (failure "No tags available for type."))) .let [tag_mappings (: (List [Text Code]) - (list\map (function (_ tag) [(second tag) (tag$ tag)]) + (list\map (function (_ tag) [(product\right tag) (tag$ tag)]) tags))] members (monad\map meta_monad (: (-> Code (Meta [Code Code])) @@ -5033,8 +5034,8 @@ [[_ _ column] (#Record pairs)] (list\fold n/min column - (list\compose (list\map (|>> first baseline_column) pairs) - (list\map (|>> second baseline_column) pairs))) + (list\compose (list\map (|>> product\left baseline_column) pairs) + (list\map (|>> product\right baseline_column) pairs))) )) (type: Documentation_Fragment @@ -5086,16 +5087,11 @@ (-> Location Text Location) [file line ("lux i64 +" column (text\size code_text))]) -(def: (delimiter_updated_location [file line column]) - (-> Location Location) - [file line (inc column)]) - (def: un_paired (-> (List [Code Code]) (List Code)) (let [pair_list (: (-> [Code Code] (List Code)) - (function (_ pair) - (let [[left right] pair] - (list left right))))] + (function (_ [left right]) + (list left right)))] (|>> (list\map pair_list) list\join))) @@ -5121,9 +5117,9 @@ (let [[group_location' parts_text] (list\fold (function (_ part [last_location text_accum]) (let [[part_location part_text] (example_documentation last_location baseline part)] [part_location (text\compose text_accum part_text)])) - [(delimiter_updated_location group_location) ""] + [(update@ #column inc group_location) ""] (<prep> parts))] - [(delimiter_updated_location group_location') + [(update@ #column inc group_location') ($_ text\compose (location_padding baseline prev_location group_location) <open> parts_text @@ -5136,10 +5132,6 @@ ("lux io error" "@example_documentation Undefined behavior.") )) -(def: (with_baseline baseline [file line column]) - (-> Nat Location Location) - [file line baseline]) - (def: (fragment_documentation fragment) (-> Documentation_Fragment Text) (case fragment @@ -5152,7 +5144,7 @@ (#Documentation_Example example) (let [baseline (baseline_column example) [location _] example - [_ text] (..example_documentation (with_baseline baseline location) baseline example)] + [_ text] (..example_documentation (set@ #.column baseline location) baseline example)] (text\compose text __paragraph)))) (macro: .public (example tokens) @@ -5246,8 +5238,8 @@ (case ?params (#.Some [name bindings body]) (let [pairs (pairs bindings) - vars (list\map first pairs) - inits (list\map second pairs)] + vars (list\map product\left pairs) + inits (list\map product\right pairs)] (if (every? identifier? inits) (do meta_monad [inits' (: (Meta (List Name)) diff --git a/stdlib/source/library/lux/abstract/apply.lux b/stdlib/source/library/lux/abstract/apply.lux index 051809cc0..adac4d3a2 100644 --- a/stdlib/source/library/lux/abstract/apply.lux +++ b/stdlib/source/library/lux/abstract/apply.lux @@ -6,7 +6,6 @@ ["." functor (#+ Functor)]]) (interface: .public (Apply f) - {#.doc "Applicative functors."} (: (Functor f) &functor) (: (All [a b] @@ -14,7 +13,6 @@ apply)) (implementation: .public (compose f_monad f_apply g_apply) - {#.doc "Applicative functor composition."} (All [F G] (-> (Monad F) (Apply F) (Apply G) ... TODO: Replace (All [a] (F (G a))) with (functor.Then F G) diff --git a/stdlib/source/library/lux/abstract/codec.lux b/stdlib/source/library/lux/abstract/codec.lux index bf6da6f54..0c3901361 100644 --- a/stdlib/source/library/lux/abstract/codec.lux +++ b/stdlib/source/library/lux/abstract/codec.lux @@ -8,14 +8,12 @@ ["." functor]]) (interface: .public (Codec m a) - {#.doc "A way to move back-and-forth between a type and an alternative representation for it."} (: (-> a m) encode) (: (-> m (Try a)) decode)) (implementation: .public (compose cb_codec ba_codec) - {#.doc "Codec composition."} (All [a b c] (-> (Codec c b) (Codec b a) (Codec c a))) diff --git a/stdlib/source/library/lux/abstract/comonad.lux b/stdlib/source/library/lux/abstract/comonad.lux index 6de44d5f2..8803eed86 100644 --- a/stdlib/source/library/lux/abstract/comonad.lux +++ b/stdlib/source/library/lux/abstract/comonad.lux @@ -13,8 +13,6 @@ [functor (#+ Functor)]]) (interface: .public (CoMonad w) - {#.doc (example "CoMonads are the opposite/complement to monads." - "CoMonadic structures are often infinite in size and built upon lazily-evaluated functions.")} (: (Functor w) &functor) (: (All [a] @@ -25,11 +23,6 @@ split)) (macro: .public (be tokens state) - {#.doc (example "A co-monadic parallel to the 'do' macro." - (let [square (function (_ n) (* n n))] - (be comonad - [inputs (iterate inc +2)] - (square (head inputs)))))} (case (: (Maybe [(Maybe Text) Code (List Code) Code]) (case tokens (^ (list [_ (#.Record (list [[_ (#.Identifier ["" name])] comonad]))] [_ (#.Tuple bindings)] body)) diff --git a/stdlib/source/library/lux/abstract/comonad/cofree.lux b/stdlib/source/library/lux/abstract/comonad/cofree.lux index 1431ee3cc..c5d61dbb4 100644 --- a/stdlib/source/library/lux/abstract/comonad/cofree.lux +++ b/stdlib/source/library/lux/abstract/comonad/cofree.lux @@ -6,7 +6,6 @@ [functor (#+ Functor)]]]) (type: .public (CoFree F a) - {#.doc "The CoFree CoMonad."} [a (F (CoFree F a))]) (implementation: .public (functor dsl) diff --git a/stdlib/source/library/lux/abstract/enum.lux b/stdlib/source/library/lux/abstract/enum.lux index 0cb26b8a4..bb82c2936 100644 --- a/stdlib/source/library/lux/abstract/enum.lux +++ b/stdlib/source/library/lux/abstract/enum.lux @@ -5,13 +5,11 @@ ["." order (#+ Order)]]) (interface: .public (Enum e) - {#.doc "Enumerable types, with a notion of moving forward and backwards through a type's instances."} (: (Order e) &order) (: (-> e e) succ) (: (-> e e) pred)) (def: .public (range enum from to) - {#.doc "An inclusive [from, to] range of values."} (All [a] (-> (Enum a) a a (List a))) (let [(^open "/\.") enum] (loop [end to diff --git a/stdlib/source/library/lux/abstract/equivalence.lux b/stdlib/source/library/lux/abstract/equivalence.lux index ad3e90d00..43598f09e 100644 --- a/stdlib/source/library/lux/abstract/equivalence.lux +++ b/stdlib/source/library/lux/abstract/equivalence.lux @@ -6,12 +6,10 @@ ["." contravariant]]]) (interface: .public (Equivalence a) - {#.doc "Equivalence for a type's instances."} (: (-> a a Bit) =)) (def: .public (rec sub) - {#.doc (example "A recursive equivalence combinator.")} (All [a] (-> (-> (Equivalence a) (Equivalence a)) (Equivalence a))) (implementation (def: (= left right) diff --git a/stdlib/source/library/lux/abstract/functor.lux b/stdlib/source/library/lux/abstract/functor.lux index 3d6e38883..d06f82ed7 100644 --- a/stdlib/source/library/lux/abstract/functor.lux +++ b/stdlib/source/library/lux/abstract/functor.lux @@ -15,7 +15,6 @@ (All [a] (.Or (f a) (g a)))) (def: .public (sum (^open "f\.") (^open "g\.")) - {#.doc (example "Co-product (sum) composition for functors.")} (All [F G] (-> (Functor F) (Functor G) (Functor (..Or F G)))) (implementation (def: (map f fa|ga) @@ -30,7 +29,6 @@ (All [a] (.And (f a) (g a)))) (def: .public (product (^open "f\.") (^open "g\.")) - {#.doc (example "Product composition for functors.")} (All [F G] (-> (Functor F) (Functor G) (Functor (..And F G)))) (implementation (def: (map f [fa ga]) @@ -41,7 +39,6 @@ (All [a] (f (g a)))) (def: .public (compose (^open "f\.") (^open "g\.")) - {#.doc "Functor composition."} (All [F G] (-> (Functor F) (Functor G) (Functor (..Then F G)))) (implementation (def: (map f fga) diff --git a/stdlib/source/library/lux/abstract/monad.lux b/stdlib/source/library/lux/abstract/monad.lux index 31002b5be..6ba4f74aa 100644 --- a/stdlib/source/library/lux/abstract/monad.lux +++ b/stdlib/source/library/lux/abstract/monad.lux @@ -44,9 +44,6 @@ #.End)) (interface: .public (Monad m) - {#.doc (example "A monad is a monoid in the category of endofunctors." - "What's the problem?")} - (: (Functor m) &functor) (: (All [a] @@ -57,11 +54,6 @@ join)) (macro: .public (do tokens state) - {#.doc (example "Macro for easy concatenation of monadic operations." - (do monad - [y (f1 x) - z (f2 z)] - (in (f3 z))))} (case (: (Maybe [(Maybe Text) Code (List Code) Code]) (case tokens (^ (list [_ (#.Record (list [[_ (#.Identifier ["" name])] monad]))] [_ (#.Tuple bindings)] body)) @@ -114,7 +106,6 @@ (#.Left "Wrong syntax for 'do'"))) (def: .public (bind monad f) - {#.doc (example "Apply a function with monadic effects to a monadic value and yield a new monadic value.")} (All [! a b] (-> (Monad !) (-> a (! b)) (-> (! a) (! b)))) @@ -122,7 +113,6 @@ (\ monad join))) (def: .public (seq monad) - {#.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)))) @@ -139,7 +129,6 @@ !\join))))) (def: .public (map monad f) - {#.doc "Apply a monadic function to all values in a list."} (All [M a b] (-> (Monad M) (-> a (M b)) (List a) (M (List b)))) @@ -156,7 +145,6 @@ !\join))))) (def: .public (only monad f) - {#.doc "Filter the values in a list with a monadic function."} (All [! a b] (-> (Monad !) (-> a (! Bit)) (List a) (! (List a)))) @@ -177,7 +165,6 @@ !\join))))) (def: .public (fold monad f init xs) - {#.doc "Fold a list with a monadic function."} (All [M a b] (-> (Monad M) (-> b a (M a)) a (List b) (M a))) diff --git a/stdlib/source/library/lux/abstract/monad/free.lux b/stdlib/source/library/lux/abstract/monad/free.lux index d954c5581..67aa94755 100644 --- a/stdlib/source/library/lux/abstract/monad/free.lux +++ b/stdlib/source/library/lux/abstract/monad/free.lux @@ -7,7 +7,6 @@ [monad (#+ Monad)]]) (type: .public (Free F a) - {#.doc "The Free Monad."} (#Pure a) (#Effect (F (Free F a)))) diff --git a/stdlib/source/library/lux/control/concurrency/semaphore.lux b/stdlib/source/library/lux/control/concurrency/semaphore.lux index 789c0a28f..f7f4f5f50 100644 --- a/stdlib/source/library/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/library/lux/control/concurrency/semaphore.lux @@ -58,7 +58,7 @@ [[_ state'] (atom.update! (|>> (update@ #open_positions dec) (if> [<had_open_position?>] [] - [(update@ #waiting_list (queue.push sink))])) + [(update@ #waiting_list (queue.end sink))])) semaphore)] (with_expansions [<go_ahead> (sink []) <get_in_line> (in false)] @@ -83,12 +83,12 @@ state (|> state (update@ #open_positions inc) - (update@ #waiting_list queue.pop)))) + (update@ #waiting_list queue.next)))) semaphore)] (if (same? pre post) (in (exception.except ..semaphore_is_maxed_out [(get@ #max_positions pre)])) (do ! - [_ (case (queue.peek (get@ #waiting_list pre)) + [_ (case (queue.front (get@ #waiting_list pre)) #.None (in true) diff --git a/stdlib/source/library/lux/control/concurrency/stm.lux b/stdlib/source/library/lux/control/concurrency/stm.lux index 7e57abc62..f3bdbcbb6 100644 --- a/stdlib/source/library/lux/control/concurrency/stm.lux +++ b/stdlib/source/library/lux/control/concurrency/stm.lux @@ -37,7 +37,7 @@ (All [a] (-> (Var a) a)) (|>> :representation atom.read! io.run! product.left)) - (def: (un_follow sink var) + (def: (un_follow! sink var) (All [a] (-> (Sink a) (Var a) (IO Any))) (do io.monad [_ (atom.update! (function (_ [value observers]) @@ -61,12 +61,12 @@ (in []) (#try.Failure _) - (un_follow sink var)))) + (un_follow! sink var)))) observers)] (in [])) (write! new_value var)))) - (def: .public (follow target) + (def: .public (follow! target) {#.doc "Creates a channel that will receive all changes to the value of the given var."} (All [a] (-> (Var a) (IO [(Channel a) (Sink a)]))) (do io.monad @@ -260,7 +260,7 @@ (in []))) ))) -(def: .public (commit stm_proc) +(def: .public (commit! stm_proc) {#.doc (example "Commits a transaction and returns its result (asynchronously)." "Note that a transaction may be re-run an indeterminate number of times if other transactions involving the same variables successfully commit first." "For this reason, it's important to note that transactions must be free from side-effects, such as I/O.")} diff --git a/stdlib/source/library/lux/control/parser/text.lux b/stdlib/source/library/lux/control/parser/text.lux index 8ca2af321..ffe6e6f27 100644 --- a/stdlib/source/library/lux/control/parser/text.lux +++ b/stdlib/source/library/lux/control/parser/text.lux @@ -39,7 +39,7 @@ (def: (remaining' offset tape) (-> Offset Text Text) - (|> tape (/.split offset) maybe.assume product.right)) + (|> tape (/.split_at offset) maybe.assume product.right)) (exception: .public (unconsumed_input {offset Offset} {tape Text}) (exception.report @@ -152,7 +152,7 @@ (#try.Success [input []]) (exception.except ..unconsumed_input input)))) -(def: .public peek +(def: .public next {#.doc "Yields the next character (without consuming it from the input)."} (Parser Text) (function (_ (^@ input [offset tape])) diff --git a/stdlib/source/library/lux/control/parser/type.lux b/stdlib/source/library/lux/control/parser/type.lux index 3dfea1a30..619526cdb 100644 --- a/stdlib/source/library/lux/control/parser/type.lux +++ b/stdlib/source/library/lux/control/parser/type.lux @@ -109,7 +109,7 @@ (#try.Success [[_ remaining] output]) (#try.Success [[env remaining] output])))) -(def: .public peek +(def: .public next {#.doc (example "Inspect a type in the input stream without consuming it.")} (Parser Type) (.function (_ [env inputs]) diff --git a/stdlib/source/library/lux/control/region.lux b/stdlib/source/library/lux/control/region.lux index d84f0e027..ba3962400 100644 --- a/stdlib/source/library/lux/control/region.lux +++ b/stdlib/source/library/lux/control/region.lux @@ -64,7 +64,7 @@ (monad.map ! (function (_ cleaner) (cleaner []))) (\ ! map (list\fold clean output))))) -(def: .public (acquire monad cleaner value) +(def: .public (acquire! monad cleaner value) {#.doc (example "Acquire a resource while pairing it a function that knows how to reclaim it.")} (All [! a] (-> (Monad !) (-> a (! (Try Any))) a (All [r] (Region r ! a)))) diff --git a/stdlib/source/library/lux/control/thread.lux b/stdlib/source/library/lux/control/thread.lux index c0a8c5955..266c12afc 100644 --- a/stdlib/source/library/lux/control/thread.lux +++ b/stdlib/source/library/lux/control/thread.lux @@ -31,7 +31,7 @@ (array.write! 0 init) :abstraction))) - (def: .public (read box) + (def: .public (read! box) {#.doc (example "Reads the current value in the box.")} (All [! a] (-> (Box ! a) (Thread ! a))) (function (_ !) @@ -53,7 +53,7 @@ @.php ("php array read" 0 (:representation box)) @.scheme ("scheme array read" 0 (:representation box))}))) - (def: .public (write value box) + (def: .public (write! value box) {#.doc (example "Mutates the value in the box.")} (All [a] (-> a (All [!] (-> (Box ! a) (Thread ! Any))))) (function (_ !) @@ -104,10 +104,10 @@ (function (_ !) ((ffa !) !)))) -(def: .public (update f box) +(def: .public (update! f box) {#.doc (example "Update a box's value by applying a function to it.")} (All [a !] (-> (-> a a) (Box ! a) (Thread ! a))) (do ..monad - [old (read box) - _ (write (f old) box)] + [old (read! box) + _ (write! (f old) box)] (in old))) diff --git a/stdlib/source/library/lux/data/binary.lux b/stdlib/source/library/lux/data/binary.lux index b1290557f..cff9714e2 100644 --- a/stdlib/source/library/lux/data/binary.lux +++ b/stdlib/source/library/lux/data/binary.lux @@ -143,7 +143,7 @@ ... Default (|> binary - (array.read index) + (array.read! index) (maybe.else (: (I64 Any) 0)) (:as I64)))]) @@ -358,7 +358,7 @@ ... Default (..copy length offset binary 0 (..empty length))))))) -(def: .public (drop bytes binary) +(def: .public (after bytes binary) {#.doc (example "Yields a binary BLOB with at most the specified number of bytes removed.")} (-> Nat Binary Binary) (case bytes diff --git a/stdlib/source/library/lux/data/collection/array.lux b/stdlib/source/library/lux/data/collection/array.lux index a141fad68..5d306f773 100644 --- a/stdlib/source/library/lux/data/collection/array.lux +++ b/stdlib/source/library/lux/data/collection/array.lux @@ -77,13 +77,13 @@ @.php ("php array length" array) @.scheme ("scheme array length" array)})) - (template: (!read <read> <null?>) - [(let [output (<read> index array)] + (template: (!read! <read!> <null?>) + [(let [output (<read!> index array)] (if (<null?> output) #.None (#.Some output)))]) - (def: .public (read index array) + (def: .public (read! index array) (All [a] (-> Nat (Array a) (Maybe a))) (if (n.< (size array) index) @@ -101,12 +101,12 @@ #.None (#.Some (:expected value)))) - @.js (!read "js array read" "js object undefined?") - @.python (!read "python array read" "python object none?") - @.lua (!read "lua array read" "lua object nil?") - @.ruby (!read "ruby array read" "ruby object nil?") - @.php (!read "php array read" "php object null?") - @.scheme (!read "scheme array read" "scheme object nil?")}) + @.js (!read! "js array read" "js object undefined?") + @.python (!read! "python array read" "python object none?") + @.lua (!read! "lua array read" "lua object nil?") + @.ruby (!read! "ruby array read" "ruby object nil?") + @.php (!read! "php array read" "php object null?") + @.scheme (!read! "scheme array read" "scheme object nil?")}) #.None)) (def: .public (write! index value array) @@ -152,7 +152,7 @@ (def: .public (contains? index array) (All [a] (-> Nat (Array a) Bit)) - (case (..read index array) + (case (..read! index array) (#.Some _) true @@ -163,7 +163,7 @@ {#.doc (.example "Mutate the array by updating the value at the specified index.")} (All [a] (-> Nat (-> a a) (Array a) (Array a))) - (case (read index array) + (case (read! index array) #.None array @@ -176,7 +176,7 @@ (All [a] (-> Nat a (-> a a) (Array a) (Array a))) (write! index - (|> array (read index) (maybe.else default) transform) + (|> array (read! index) (maybe.else default) transform) array)) (def: .public (copy! length src_start src_array dest_start dest_array) @@ -187,7 +187,7 @@ (if (n.= 0 length) dest_array (list\fold (function (_ offset target) - (case (read (n.+ offset src_start) src_array) + (case (read! (n.+ offset src_start) src_array) #.None target @@ -200,7 +200,7 @@ {#.doc "Finds out how many cells in an array are occupied."} (All [a] (-> (Array a) Nat)) (list\fold (function (_ idx count) - (case (read idx array) + (case (read! idx array) #.None count @@ -219,7 +219,7 @@ (All [a] (-> (Predicate a) (Array a) (Array a))) (list\fold (function (_ idx xs') - (case (read idx xs) + (case (read! idx xs) #.None xs' @@ -237,7 +237,7 @@ (let [arr_size (size xs)] (loop [idx 0] (if (n.< arr_size idx) - (case (read idx xs) + (case (read! idx xs) #.None (recur (inc idx)) @@ -254,7 +254,7 @@ (let [arr_size (size xs)] (loop [idx 0] (if (n.< arr_size idx) - (case (read idx xs) + (case (read! idx xs) #.None (recur (inc idx)) @@ -269,7 +269,7 @@ (All [a] (-> (Array a) (Array a))) (let [arr_size (size xs)] (list\fold (function (_ idx ys) - (case (read idx xs) + (case (read! idx xs) #.None ys @@ -300,7 +300,7 @@ _ (recur (dec idx) - (case (read idx array) + (case (read! idx array) (#.Some head) (#.Item head output) @@ -318,7 +318,7 @@ _ (recur (dec idx) - (#.Item (maybe.else default (read idx array)) + (#.Item (maybe.else default (read! idx array)) output))))) (implementation: .public (equivalence (^open ",\.")) @@ -330,7 +330,7 @@ (and (n.= sxy sxs) (list\fold (function (_ idx prev) (and prev - (case [(read idx xs) (read idx ys)] + (case [(read! idx xs) (read! idx ys)] [#.None #.None] true @@ -362,7 +362,7 @@ (if (n.= 0 arr_size) (empty arr_size) (list\fold (function (_ idx mb) - (case (read idx ma) + (case (read! idx ma) #.None mb @@ -380,7 +380,7 @@ (loop [so_far init idx 0] (if (n.< arr_size idx) - (case (read idx xs) + (case (read! idx xs) #.None (recur so_far (inc idx)) @@ -396,7 +396,7 @@ (let [size (..size array)] (loop [idx 0] (if (n.< size idx) - (case (..read idx array) + (case (..read! idx array) (#.Some value) (<op> (predicate value) (recur (inc idx))) diff --git a/stdlib/source/library/lux/data/collection/bits.lux b/stdlib/source/library/lux/data/collection/bits.lux index ef10e0f6d..e5e85e361 100644 --- a/stdlib/source/library/lux/data/collection/bits.lux +++ b/stdlib/source/library/lux/data/collection/bits.lux @@ -52,14 +52,14 @@ (-> Nat Bits Bit) (let [[chunk_index bit_index] (n./% chunk_size index)] (.and (n.< (array.size bits) chunk_index) - (|> (array.read chunk_index bits) + (|> (array.read! chunk_index bits) (maybe.else empty_chunk) (i64.one? bit_index))))) (def: (chunk idx bits) (-> Nat Bits Chunk) (if (n.< (array.size bits) idx) - (|> bits (array.read idx) (maybe.else empty_chunk)) + (|> bits (array.read! idx) (maybe.else empty_chunk)) empty_chunk)) (template [<name> <op>] diff --git a/stdlib/source/library/lux/data/collection/dictionary.lux b/stdlib/source/library/lux/data/collection/dictionary.lux index 642b19b57..fb7aaaa83 100644 --- a/stdlib/source/library/lux/data/collection/dictionary.lux +++ b/stdlib/source/library/lux/data/collection/dictionary.lux @@ -130,7 +130,7 @@ ... Expands a copy of the array, to have 1 extra slot, which is used ... for storing the value. -(def: (insert! idx value old_array) +(def: (array\has idx value old_array) (All [a] (-> Index a (Array a) (Array a))) (let [old_size (array.size old_array)] (|> (array.empty (inc old_size)) @@ -139,17 +139,17 @@ (array.copy! (n.- idx old_size) idx old_array (inc idx))))) ... Creates a copy of an array with an index set to a particular value. -(def: (revised! idx value array) +(def: (array\revised idx value array) (All [a] (-> Index a (Array a) (Array a))) (|> array array.clone (array.write! idx value))) ... Creates a clone of the array, with an empty position at index. -(def: (vacant! idx array) +(def: (array\lacks' idx array) (All [a] (-> Index (Array a) (Array a))) (|> array array.clone (array.delete! idx))) ... Shrinks a copy of the array by removing the space at index. -(def: (lacks! idx array) +(def: (array\lacks idx array) (All [a] (-> Index (Array a) (Array a))) (let [new_size (dec (array.size array))] (|> (array.empty new_size) @@ -236,7 +236,7 @@ (All [k v] (-> Index (Hierarchy k v) [Bit_Map (Base k v)])) (product.right (list\fold (function (_ idx [insertion_idx node]) (let [[bitmap base] node] - (case (array.read idx h_array) + (case (array.read! idx h_array) #.None [insertion_idx node] (#.Some sub_node) (if (n.= except_idx idx) [insertion_idx node] @@ -254,7 +254,7 @@ (List Index) (list.indices hierarchy_nodes_size)) -(def: (promotion has' key_hash level bitmap base) +(def: (promotion node\has key_hash level bitmap base) (All [k v] (-> (-> Level Hash_Code k v (Hash k) (Node k v) (Node k v)) (Hash k) Level @@ -264,13 +264,13 @@ (if (with_bit_position? (to_bit_position hierarchy_idx) bitmap) [(inc base_idx) - (case (array.read base_idx base) + (case (array.read! base_idx base) (#.Some (#.Left sub_node)) (array.write! hierarchy_idx sub_node h_array) (#.Some (#.Right [key' val'])) (array.write! hierarchy_idx - (has' (level_up level) (\ key_hash hash key') key' val' key_hash empty_node) + (node\has (level_up level) (\ key_hash hash key') key' val' key_hash empty_node) h_array) #.None @@ -292,22 +292,22 @@ _ #0))) -(def: (has' level hash key val key_hash node) +(def: (node\has level hash key val key_hash node) (All [k v] (-> Level Hash_Code k v (Hash k) (Node k v) (Node k v))) (case node ... For #Hierarchy nodes, check whether one can add the element to ... a sub-node. If impossible, introduce a new singleton sub-node. (#Hierarchy _size hierarchy) (let [idx (level_index level hash) - [_size' sub_node] (case (array.read idx hierarchy) + [_size' sub_node] (case (array.read! idx hierarchy) (#.Some sub_node) [_size sub_node] _ [(inc _size) empty_node])] (#Hierarchy _size' - (revised! idx (has' (level_up level) hash key val key_hash sub_node) - hierarchy))) + (array\revised idx (node\has (level_up level) hash key val key_hash sub_node) + hierarchy))) ... For #Base nodes, check if the corresponding Bit_Position has ... already been used. @@ -316,38 +316,38 @@ (if (with_bit_position? bit bitmap) ... If so... (let [idx (base_index bit bitmap)] - (case (array.read idx base) + (case (array.read! idx base) ... If it's being used by a node, add the KV to it. (#.Some (#.Left sub_node)) - (let [sub_node' (has' (level_up level) hash key val key_hash sub_node)] - (#Base bitmap (revised! idx (#.Left sub_node') base))) + (let [sub_node' (node\has (level_up level) hash key val key_hash sub_node)] + (#Base bitmap (array\revised idx (#.Left sub_node') base))) ... Otherwise, if it's being used by a KV, compare the keys. (#.Some (#.Right key' val')) (if (\ key_hash = key key') ... If the same key is found, replace the value. - (#Base bitmap (revised! idx (#.Right key val) base)) + (#Base bitmap (array\revised idx (#.Right key val) base)) ... Otherwise, compare the hashes of the keys. - (#Base bitmap (revised! idx - (#.Left (let [hash' (\ key_hash hash key')] - (if (n.= hash hash') - ... If the hashes are - ... the same, a new - ... #Collisions node - ... is added. - (#Collisions hash (|> (array.empty 2) - (array.write! 0 [key' val']) - (array.write! 1 [key val]))) - ... Otherwise, one can - ... just keep using - ... #Base nodes, so - ... add both KV-pairs - ... to the empty one. - (let [next_level (level_up level)] - (|> empty_node - (has' next_level hash' key' val' key_hash) - (has' next_level hash key val key_hash)))))) - base))) + (#Base bitmap (array\revised idx + (#.Left (let [hash' (\ key_hash hash key')] + (if (n.= hash hash') + ... If the hashes are + ... the same, a new + ... #Collisions node + ... is added. + (#Collisions hash (|> (array.empty 2) + (array.write! 0 [key' val']) + (array.write! 1 [key val]))) + ... Otherwise, one can + ... just keep using + ... #Base nodes, so + ... add both KV-pairs + ... to the empty one. + (let [next_level (level_up level)] + (|> empty_node + (node\has next_level hash' key' val' key_hash) + (node\has next_level hash key val key_hash)))))) + base))) #.None (undefined))) @@ -359,13 +359,13 @@ ... KV-pair as a singleton node to it. (#Hierarchy (inc base_count) (|> base - (promotion has' key_hash level bitmap) + (promotion node\has key_hash level bitmap) (array.write! (level_index level hash) - (has' (level_up level) hash key val key_hash empty_node)))) + (node\has (level_up level) hash key val key_hash empty_node)))) ... Otherwise, just resize the #Base node to accommodate the ... new KV-pair. (#Base (with_bit_position bit bitmap) - (insert! (base_index bit bitmap) (#.Right [key val]) base)))))) + (array\has (base_index bit bitmap) (#.Right [key val]) base)))))) ... For #Collisions nodes, compare the hashes. (#Collisions _hash _colls) @@ -376,17 +376,17 @@ ... If the key was already present in the collisions-list, its ... value gets updated. (#.Some coll_idx) - (#Collisions _hash (revised! coll_idx [key val] _colls)) + (#Collisions _hash (array\revised coll_idx [key val] _colls)) ... Otherwise, the KV-pair is added to the collisions-list. #.None - (#Collisions _hash (insert! (array.size _colls) [key val] _colls))) + (#Collisions _hash (array\has (array.size _colls) [key val] _colls))) ... If the hashes are not equal, create a new #Base node that ... contains the old #Collisions node, plus the new KV-pair. (|> (#Base (level_bit_position level _hash) (|> (array.empty 1) (array.write! 0 (#.Left node)))) - (has' level hash key val key_hash))) + (node\has level hash key val key_hash))) )) (def: (lacks' level hash key key_hash node) @@ -396,7 +396,7 @@ ... the Hash-Code. (#Hierarchy h_size h_array) (let [idx (level_index level hash)] - (case (array.read idx h_array) + (case (array.read! idx h_array) ... If not, there's nothing to remove. #.None node @@ -415,17 +415,17 @@ ... If so, perform it. (#Base (demotion idx [h_size h_array])) ... Otherwise, just clear the space. - (#Hierarchy (dec h_size) (vacant! idx h_array))) + (#Hierarchy (dec h_size) (array\lacks' idx h_array))) ... But if the sub_removal yielded a non_empty node, then ... just update the hiearchy branch. - (#Hierarchy h_size (revised! idx sub_node' h_array))))))) + (#Hierarchy h_size (array\revised idx sub_node' h_array))))))) ... For #Base nodes, check whether the Bit_Position is set. (#Base bitmap base) (let [bit (level_bit_position level hash)] (if (with_bit_position? bit bitmap) (let [idx (base_index bit bitmap)] - (case (array.read idx base) + (case (array.read! idx base) ... If set, check if it's a sub_node, and remove the KV ... from it. (#.Some (#.Left sub_node)) @@ -443,11 +443,11 @@ ... But if not, then just unset the position and ... remove the node. (#Base (without_bit_position bit bitmap) - (lacks! idx base))) + (array\lacks idx base))) ... But, if it did not come out empty, then the ... position is kept, and the node gets updated. (#Base bitmap - (revised! idx (#.Left sub_node') base))))) + (array\revised idx (#.Left sub_node') base))))) ... If, however, there was a KV-pair instead of a sub-node. (#.Some (#.Right [key' val'])) @@ -455,7 +455,7 @@ (if (\ key_hash = key key') ... If so, remove the KV-pair and unset the Bit_Position. (#Base (without_bit_position bit bitmap) - (lacks! idx base)) + (array\lacks idx base)) ... Otherwise, there's nothing to remove. node) @@ -478,7 +478,7 @@ ... an empty node. empty_node ... Otherwise, just shrink the array by removing the KV-pair. - (#Collisions _hash (lacks! idx _colls)))) + (#Collisions _hash (array\lacks idx _colls)))) )) (def: (value' level hash key key_hash node) @@ -486,7 +486,7 @@ (case node ... For #Hierarchy nodes, just look-up the key on its children. (#Hierarchy _size hierarchy) - (case (array.read (level_index level hash) hierarchy) + (case (array.read! (level_index level hash) hierarchy) #.None #.None (#.Some sub_node) (value' (level_up level) hash key key_hash sub_node)) @@ -494,7 +494,7 @@ (#Base bitmap base) (let [bit (level_bit_position level hash)] (if (with_bit_position? bit bitmap) - (case (array.read (base_index bit bitmap) base) + (case (array.read! (base_index bit bitmap) base) (#.Some (#.Left sub_node)) (value' (level_up level) hash key key_hash sub_node) @@ -573,7 +573,7 @@ (def: .public (has key val dict) (All [k v] (-> k v (Dictionary k v) (Dictionary k v))) (let [[key_hash node] dict] - [key_hash (has' root_level (\ key_hash hash key) key val key_hash node)])) + [key_hash (node\has root_level (\ key_hash hash key) key val key_hash node)])) (def: .public (lacks key dict) (All [k v] (-> k (Dictionary k v) (Dictionary k v))) @@ -593,7 +593,7 @@ (exception: .public key_already_exists) -(def: .public (try_put key val dict) +(def: .public (has' key val dict) {#.doc "Only puts the KV-pair if the key is not already present."} (All [k v] (-> k v (Dictionary k v) (Try (Dictionary k v)))) (case (value key dict) @@ -610,7 +610,7 @@ (#.Some val) (has key (f val) dict))) -(def: .public (upsert key default f dict) +(def: .public (revised' key default f dict) {#.doc (example "Updates the value at the key; if it exists." "Otherwise, puts a value by applying the function to a default.")} (All [k v] (-> k v (-> v v) (Dictionary k v) (Dictionary k v))) @@ -672,7 +672,7 @@ dict1 (entries dict2))) -(def: .public (re_bind from_key to_key dict) +(def: .public (re_bound from_key to_key dict) {#.doc (example "If there is a value under 'from_key', remove 'from_key' and store the value under 'to_key'.")} (All [k v] (-> k k (Dictionary k v) (Dictionary k v))) (case (value from_key dict) diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux index ff5a1fe12..7298a5039 100644 --- a/stdlib/source/library/lux/data/collection/list.lux +++ b/stdlib/source/library/lux/data/collection/list.lux @@ -100,8 +100,8 @@ <then>) <else>))] - [take (#.Item x (take (dec n) xs')) #.End] - [drop (drop (dec n) xs') xs] + [first (#.Item x (first (dec n) xs')) #.End] + [after (after (dec n) xs') xs] ) (template [<name> <then> <else>] @@ -121,7 +121,7 @@ [until (until predicate xs') xs] ) -(def: .public (split n xs) +(def: .public (split_at n xs) (All [a] (-> Nat (List a) [(List a) (List a)])) (if (n.> 0 n) @@ -130,7 +130,7 @@ [#.End #.End] (#.Item x xs') - (let [[tail rest] (split (dec n) xs')] + (let [[tail rest] (split_at (dec n) xs')] [(#.Item x tail) rest])) [#.End xs])) @@ -161,7 +161,7 @@ #.End _ - (let [[pre post] (split size list)] + (let [[pre post] (split_at size list)] (#.Item pre (sub size post))))) (def: .public (repeated n x) diff --git a/stdlib/source/library/lux/data/collection/queue.lux b/stdlib/source/library/lux/data/collection/queue.lux index 04fd1c6b5..3e017d382 100644 --- a/stdlib/source/library/lux/data/collection/queue.lux +++ b/stdlib/source/library/lux/data/collection/queue.lux @@ -31,7 +31,7 @@ (let [(^slots [#front #rear]) queue] (list\compose front (list.reversed rear)))) -(def: .public peek +(def: .public front {#.doc (example "Yields the first value in the queue, if any.")} (All [a] (-> (Queue a) (Maybe a))) (|>> (get@ #front) list.head)) @@ -52,7 +52,7 @@ (or (list.member? equivalence front member) (list.member? equivalence rear member)))) -(def: .public (pop queue) +(def: .public (next queue) (All [a] (-> (Queue a) (Queue a))) (case (get@ #front queue) ... Empty... @@ -70,7 +70,7 @@ (|> queue (set@ #front front')))) -(def: .public (push val queue) +(def: .public (end val queue) (All [a] (-> a (Queue a) (Queue a))) (case (get@ #front queue) #.End diff --git a/stdlib/source/library/lux/data/collection/queue/priority.lux b/stdlib/source/library/lux/data/collection/queue/priority.lux index 138b86876..88da217c3 100644 --- a/stdlib/source/library/lux/data/collection/queue/priority.lux +++ b/stdlib/source/library/lux/data/collection/queue/priority.lux @@ -46,7 +46,7 @@ Queue (:abstraction #.None)) - (def: .public (peek queue) + (def: .public (front queue) (All [a] (-> (Queue a) (Maybe a))) (do maybe.monad [tree (:representation queue)] @@ -84,7 +84,7 @@ (or (recur left) (recur right)))))) - (def: .public (pop queue) + (def: .public (next queue) (All [a] (-> (Queue a) (Queue a))) (:abstraction (do maybe.monad @@ -112,7 +112,7 @@ (#.Some =right) (#.Some (\ ..builder branch left =right))))))))) - (def: .public (push priority value queue) + (def: .public (end priority value queue) (All [a] (-> Priority a (Queue a) (Queue a))) (let [addition (\ ..builder leaf priority value)] (:abstraction diff --git a/stdlib/source/library/lux/data/collection/row.lux b/stdlib/source/library/lux/data/collection/row.lux index c36a5377e..230de34a1 100644 --- a/stdlib/source/library/lux/data/collection/row.lux +++ b/stdlib/source/library/lux/data/collection/row.lux @@ -105,7 +105,7 @@ ... Just add the tail to it (#Base tail) ... Otherwise, check whether there's a vacant spot - (case (array.read sub_idx parent) + (case (array.read! sub_idx parent) ... If so, set the path to the tail #.None (..path (level_down level) tail) @@ -129,7 +129,7 @@ (def: (put' level idx val hierarchy) (All [a] (-> Level Index a (Hierarchy a) (Hierarchy a))) (let [sub_idx (branch_idx (i64.right_shifted level idx))] - (case (array.read sub_idx hierarchy) + (case (array.read! sub_idx hierarchy) (#.Some (#Hierarchy sub_node)) (|> (array.clone hierarchy) (array.write! sub_idx (#Hierarchy (put' (level_down level) idx val sub_node)))) @@ -152,7 +152,7 @@ (n.> branching_exponent level) (do maybe.monad - [base|hierarchy (array.read sub_idx hierarchy) + [base|hierarchy (array.read! sub_idx hierarchy) sub (case base|hierarchy (#Hierarchy sub) (without_tail size (level_down level) sub) @@ -254,7 +254,7 @@ (loop [level (get@ #level row) hierarchy (get@ #root row)] (case [(n.> branching_exponent level) - (array.read (branch_idx (i64.right_shifted level idx)) hierarchy)] + (array.read! (branch_idx (i64.right_shifted level idx)) hierarchy)] [#1 (#.Some (#Hierarchy sub))] (recur (level_down level) sub) @@ -272,7 +272,7 @@ (All [a] (-> Nat (Row a) (Try a))) (do try.monad [base (base_for idx row)] - (case (array.read (branch_idx idx) base) + (case (array.read! (branch_idx idx) base) (#.Some value) (#try.Success value) @@ -324,7 +324,7 @@ root (maybe.else (empty_hierarchy []) (without_tail row_size init_level (get@ #root row)))] (if (n.> branching_exponent level) - (case [(array.read 1 root) (array.read 0 root)] + (case [(array.read! 1 root) (array.read! 0 root)] [#.None (#.Some (#Hierarchy sub_node))] (recur (level_down level) sub_node) diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux index 6264d6083..d60fd99d4 100644 --- a/stdlib/source/library/lux/data/collection/sequence.lux +++ b/stdlib/source/library/lux/data/collection/sequence.lux @@ -84,7 +84,7 @@ xs)))] [while until (-> a Bit) (pred x) pred |>] - [take drop Nat (n.= 0 pred) (dec pred) not] + [first after Nat (n.= 0 pred) (dec pred) not] ) (template [<splitter> <pred_type> <pred_test> <pred_step>] @@ -98,7 +98,7 @@ [(#.Item [x tail]) next]))))] [split_when (-> a Bit) (pred x) pred] - [split Nat (n.= 0 pred) (dec pred)] + [split_at Nat (n.= 0 pred) (dec pred)] ) (def: .public (unfold step init) diff --git a/stdlib/source/library/lux/data/collection/set/multi.lux b/stdlib/source/library/lux/data/collection/set/multi.lux index 46f395b21..b4786c825 100644 --- a/stdlib/source/library/lux/data/collection/set/multi.lux +++ b/stdlib/source/library/lux/data/collection/set/multi.lux @@ -37,7 +37,7 @@ 0 set _ (|> set :representation - (dictionary.upsert elem 0 (n.+ multiplicity)) + (dictionary.revised' elem 0 (n.+ multiplicity)) :abstraction))) (def: .public (lacks multiplicity elem set) diff --git a/stdlib/source/library/lux/data/collection/stack.lux b/stdlib/source/library/lux/data/collection/stack.lux index af2b3c3ea..2b9cbc2e4 100644 --- a/stdlib/source/library/lux/data/collection/stack.lux +++ b/stdlib/source/library/lux/data/collection/stack.lux @@ -27,7 +27,7 @@ (All [a] (-> (Stack a) Bit)) (|>> :representation //.empty?)) - (def: .public (peek stack) + (def: .public (value stack) {#.doc (example "Yields the top value in the stack, if any.")} (All [a] (-> (Stack a) (Maybe a))) (case (:representation stack) @@ -37,7 +37,7 @@ (#.Item value _) (#.Some value))) - (def: .public (pop stack) + (def: .public (next stack) (All [a] (-> (Stack a) (Maybe [a (Stack a)]))) (case (:representation stack) #.End @@ -46,7 +46,7 @@ (#.Item top stack') (#.Some [top (:abstraction stack')]))) - (def: .public (push value stack) + (def: .public (top value stack) (All [a] (-> a (Stack a) (Stack a))) (:abstraction (#.Item value (:representation stack)))) diff --git a/stdlib/source/library/lux/data/format/binary.lux b/stdlib/source/library/lux/data/format/binary.lux index f3ce9f830..e16c2cebd 100644 --- a/stdlib/source/library/lux/data/format/binary.lux +++ b/stdlib/source/library/lux/data/format/binary.lux @@ -192,7 +192,7 @@ original_count) value (if (n.= original_count capped_count) value - (|> value row.list (list.take capped_count) row.of_list)) + (|> value row.list (list.first capped_count) row.of_list)) (^open "specification\.") ..monoid [size mutation] (|> value (row\map valueW) diff --git a/stdlib/source/library/lux/data/format/css/value.lux b/stdlib/source/library/lux/data/format/css/value.lux index a39469994..c2fb914c2 100644 --- a/stdlib/source/library/lux/data/format/css/value.lux +++ b/stdlib/source/library/lux/data/format/css/value.lux @@ -61,7 +61,7 @@ (let [raw (%.frac value)] (if (f.< +0.0 value) raw - (|> raw (text.split 1) maybe.assume product.right)))) + (|> raw (text.split_at 1) maybe.assume product.right)))) (abstract: .public (Value brand) {} diff --git a/stdlib/source/library/lux/data/format/json.lux b/stdlib/source/library/lux/data/format/json.lux index 45ac870c0..7f6ca24a8 100644 --- a/stdlib/source/library/lux/data/format/json.lux +++ b/stdlib/source/library/lux/data/format/json.lux @@ -227,7 +227,7 @@ value (let [raw (\ f.decimal encode value)] (if (f.< +0.0 value) raw - (|> raw (text.split 1) maybe.assume product.right)))))) + (|> raw (text.split_at 1) maybe.assume product.right)))))) (def: escape "\") (def: escaped_dq (text\compose ..escape text.double_quote)) @@ -372,7 +372,7 @@ (loop [_ []]) (do {! <>.monad} [chars (<text>.some (<text>.none_of (text\compose "\" text.double_quote))) - stop <text>.peek]) + stop <text>.next]) (if (text\= "\" stop) (do ! [escaped escaped_parser diff --git a/stdlib/source/library/lux/data/format/markdown.lux b/stdlib/source/library/lux/data/format/markdown.lux index 08b26a686..281425105 100644 --- a/stdlib/source/library/lux/data/format/markdown.lux +++ b/stdlib/source/library/lux/data/format/markdown.lux @@ -52,7 +52,7 @@ (template [<name> <prefix>] [(def: .public (<name> content) - (-> Text Markdown) + (-> Text (Markdown Block)) (:abstraction (format <prefix> " " (..safe content) ..blank_line)))] [heading/1 "#"] @@ -110,10 +110,14 @@ (Markdown Block)) (|>> list.enumeration (list\map (function (_ [idx [summary detail]]) - (format (%.nat (inc idx)) ". " (:representation summary) text.new_line + (format "1. " (:representation summary) (case detail (#.Some detail) - (|> detail :representation ..indent (text.enclosed [text.new_line text.new_line])) + (|> detail + :representation + ..indent + (text.enclosed [text.new_line text.new_line]) + (format text.new_line)) #.None "")))) @@ -124,10 +128,14 @@ (-> (List [(Markdown Span) (Maybe (Markdown Block))]) (Markdown Block)) (|>> (list\map (function (_ [summary detail]) - (format "*. " (:representation summary) text.new_line + (format "* " (:representation summary) (case detail (#.Some detail) - (|> detail :representation ..indent (text.enclosed [text.new_line text.new_line])) + (|> detail + :representation + ..indent + (text.enclosed [text.new_line text.new_line]) + (format text.new_line)) #.None "")))) @@ -137,7 +145,7 @@ (def: .public snippet {#.doc "A snippet of code."} (-> Text (Markdown Span)) - (|>> ..safe (text.enclosed ["`" "`"]) :abstraction)) + (|>> (text.enclosed ["`` " " ``"]) :abstraction)) (def: .public code {#.doc "A block of code."} @@ -180,6 +188,6 @@ ) (def: .public markdown - (-> (Markdown Any) Text) + (All [a] (-> (Markdown a) Text)) (|>> :representation)) ) diff --git a/stdlib/source/library/lux/data/text.lux b/stdlib/source/library/lux/data/text.lux index 096a968ee..e2f781d64 100644 --- a/stdlib/source/library/lux/data/text.lux +++ b/stdlib/source/library/lux/data/text.lux @@ -154,7 +154,7 @@ (#.Some ("lux text clip" offset (n.- offset size) input)) #.None))) -(def: .public (split at x) +(def: .public (split_at at x) (-> Nat Text (Maybe [Text Text])) (case [(..clip 0 at x) (..clip' at x)] [(#.Some pre) (#.Some post)] @@ -167,8 +167,8 @@ (-> Text Text (Maybe [Text Text])) (do maybe.monad [index (index_of token sample) - [pre post'] (split index sample) - [_ post] (split (size token) post')] + [pre post'] (split_at index sample) + [_ post] (split_at (size token) post')] (in [pre post]))) (def: .public (all_split_by token sample) diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux index 234333bd8..488933f58 100644 --- a/stdlib/source/library/lux/debug.lux +++ b/stdlib/source/library/lux/debug.lux @@ -158,12 +158,12 @@ (case (ffi.check [java/lang/Object] object) (#.Some value) (let [value (:as (array.Array java/lang/Object) value)] - (case (array.read 0 value) + (case (array.read! 0 value) (^multi (#.Some tag) {(ffi.check java/lang/Integer tag) (#.Some tag)} - {[(array.read 1 value) - (array.read 2 value)] + {[(array.read! 1 value) + (array.read! 2 value)] [last? (#.Some choice)]}) (let [last? (case last? diff --git a/stdlib/source/library/lux/documentation.lux b/stdlib/source/library/lux/documentation.lux new file mode 100644 index 000000000..798bf3056 --- /dev/null +++ b/stdlib/source/library/lux/documentation.lux @@ -0,0 +1,366 @@ +(.module: + [library + [lux (#- Definition Module example type) + ["." meta] + [abstract + [monad (#+ do)]] + [control + ["." maybe ("#\." functor)] + ["." exception (#+ exception:)] + ["<>" parser + ["<.>" code (#+ Parser)]]] + [data + ["." product] + ["." text (#+ \n) ("#\." order) + ["%" format (#+ format)]] + [collection + ["." list ("#\." monad fold monoid)] + ["." set (#+ Set)]] + [format + ["md" markdown (#+ Markdown Block)]]] + [macro + [syntax (#+ syntax:)] + ["." code] + ["." template]] + [math + [number + ["n" nat]]] + [tool + [compiler + [language + [lux + ["." syntax]]]]]]]) + +(type: Fragment + (#Comment Text) + (#Code Code)) + +(def: fragment + (Parser Fragment) + (<>.or <code>.text + <code>.any)) + +(def: (reference_column code) + (-> Code Nat) + (case code + (^template [<tag>] + [[[_ _ column] (<tag> _)] + column]) + ([#.Bit] + [#.Nat] + [#.Int] + [#.Rev] + [#.Frac] + [#.Text] + [#.Identifier] + [#.Tag]) + + (^template [<tag>] + [[[_ _ column] (<tag> members)] + (|> members + (list\map reference_column) + (list\fold n.min column))]) + ([#.Form] + [#.Tuple]) + + [[_ _ column] (#.Record pairs)] + (|> (list\compose (list\map (|>> product.left reference_column) pairs) + (list\map (|>> product.right reference_column) pairs)) + (list\fold n.min column)) + )) + +(def: (padding reference_column [_ old_line old_column] [_ new_line new_column]) + (-> Nat Location Location Text) + (if (n.= old_line new_line) + (text.joined (list.repeated (n.- old_column new_column) " ")) + (format (if (n.< new_line old_line) + (text.joined (list.repeated (n.- old_line new_line) \n)) + "") + (if (n.< new_column reference_column) + (text.joined (list.repeated (n.- reference_column new_column) " ")) + "")))) + +(def: un_paired + (All [a] (-> (List [a a]) (List a))) + (let [melded (: (All [a] (-> [a a] (List a) (List a))) + (function (_ [left right] tail) + (list& left right tail)))] + (|>> list.reversed + (list\fold melded #.End)))) + +(def: (code_documentation old_location reference_column example) + (-> Location Nat Code [Location Text]) + (case example + (^template [<tag> <format>] + [[new_location (<tag> value)] + (let [documentation (`` (|> value (~~ (template.spliced <format>))))] + [(update@ #.column (n.+ (text.size documentation)) new_location) + (format (padding reference_column old_location new_location) + documentation)])]) + ([#.Bit [%.bit]] + [#.Nat [%.nat]] + [#.Int [%.int]] + [#.Rev [%.rev]] + [#.Frac [%.frac]] + [#.Text [%.text]] + [#.Identifier [%.name]] + [#.Tag [%.name (text.prefix syntax.sigil)]]) + + (^template [|<| |>| <tag> <prep>] + [[group_location (<tag> members)] + (let [[group_location' members_documentation] (list\fold (function (_ part [last_location text_accum]) + (let [[member_location member_documentation] (code_documentation last_location reference_column part)] + [member_location (format text_accum member_documentation)])) + [(update@ #.column inc group_location) ""] + (<prep> members))] + [(update@ #.column inc group_location') + (format (padding reference_column old_location group_location) + |<| members_documentation |>|)])]) + ([syntax.open_form syntax.close_form #.Form |>] + [syntax.open_tuple syntax.close_tuple #.Tuple |>] + [syntax.open_record syntax.close_record #.Record ..un_paired]) + )) + +(def: blank_line + Text + (format \n \n)) + +(def: single_line_comment + (-> Text Text) + (text.prefix "... ")) + +(def: (fragment_documentation fragment) + (-> Fragment Text) + (case fragment + (#Comment comment) + (..single_line_comment comment) + + (#Code example) + (let [reference_column (..reference_column example) + [location _] example] + (|> example + (..code_documentation (set@ #.column reference_column location) reference_column) + product.right)))) + +(def: type + (-> Type Text) + %.type) + +(def: description + (Parser (Maybe Code)) + (<>.or (<code>.text! "") + <code>.any)) + +(exception: .public (unqualified_identifier {name Name}) + (exception.report + ["Name" (%.name name)])) + +(def: qualified_identifier + (Parser Name) + (do <>.monad + [name <code>.identifier] + (case name + ["" _] + (<>.failure (exception.error ..unqualified_identifier [name])) + + _ + (in name)))) + +(def: example_separator + Code + (let [c/01 "...." + c/04 (format c/01 c/01 c/01 c/01) + c/16 (format c/04 c/04 c/04 c/04)] + (code.text (format blank_line + c/16 \n c/16 + blank_line)))) + +(type: Example + (List Fragment)) + +(def: example + (Parser Example) + (<code>.tuple (<>.many ..fragment))) + +(def: example_documentation + (-> Example Code) + (|>> (list\map ..fragment_documentation) + (list.interposed ..blank_line) + (text.join_with "") + code.text)) + +(syntax: (minimal_definition_documentation + [name ..qualified_identifier]) + (with_expansions [<\n> (~! text.\n)] + (in (list (` ($_ ((~! md.then)) + ... Name + (<| ((~! md.heading/3)) + (~ (code.text (|> name product.right [""] %.name)))) + ... Type + (<| ((~! md.code)) + ((~! ..type) ("lux in-module" + (~ (code.text (product.left name))) + (.:of (~ (code.identifier name))))))) + ))))) + +(syntax: (definition_documentation + [name ..qualified_identifier + description ..description + examples (<>.some ..example)]) + (with_expansions [<\n> (~! text.\n)] + (in (list (` ($_ ((~! md.then)) + ((~! ..minimal_definition_documentation) + (~ (code.identifier name))) + ... Description + (~+ (case description + (#.Some description) + (list (` (<| ((~! md.paragraph)) + ((~! md.text)) + (~ description)))) + + #.None + (list))) + ... Examples + (~+ (case examples + #.End + (list) + + _ + (list (` (<| ((~! md.code)) + ((~! %.format) + (~+ (|> examples + (list\map ..example_documentation) + (list.interposed ..example_separator)))))))))) + ))))) + +(type: .public Definition + {#definition Text + #documentation (Markdown Block)}) + +(type: .public #rec Module + {#module Text + #expected (Set Text) + #definitions (List Definition)}) + +(syntax: .public (default [name ..qualified_identifier]) + (let [[_ short] name] + (in (list (` (: ..Definition + {#..definition (~ (code.text short)) + #..documentation ((~! ..minimal_definition_documentation) + (~ (code.identifier name)))})))))) + +(syntax: .public (documentation: [name ..qualified_identifier + extra (<>.some <code>.any)]) + (let [[_ short] name] + (in (list (` (.def: .public (~ (code.local_identifier short)) + ..Definition + {#..definition (~ (code.text short)) + #..documentation ((~! ..definition_documentation) + (~ (code.identifier name)) + (~+ extra))})))))) + +(def: definitions_documentation + (-> (List Definition) (Markdown Block)) + (|>> (list.sorted (function (_ left right) + (text\< (get@ #definition right) + (get@ #definition left)))) + (list\map (get@ #documentation)) + (list\fold md.then md.empty))) + +(def: expected_separator + Text + (text.of_char 31)) + +(def: expected_format + (-> (List Text) Text) + (list\fold (function (_ short aggregate) + (case aggregate + "" short + _ (format aggregate ..expected_separator short))) + "")) + +(def: expected + (-> Text (Set Text)) + (|>> (text.all_split_by ..expected_separator) + (set.of_list text.hash))) + +(def: (module' name expected definitions) + (-> Text Text (List Definition) Module) + {#module name + #expected (..expected expected) + #definitions definitions}) + +(syntax: .public (module [[name _] ..qualified_identifier + definitions (<code>.tuple (<>.some <code>.any)) + subs (<code>.tuple (<>.some <code>.any))]) + (do meta.monad + [expected (meta.exports name)] + (in (list (` (: (List Module) + (list& ((~! module') + (~ (code.text name)) + (~ (code.text (|> expected + (list\map product.left) + ..expected_format))) + (list (~+ definitions))) + ($_ (\ (~! list.monoid) (~' compose)) + (: (List Module) + (\ (~! list.monoid) (~' identity))) + (~+ subs))))))))) + +(def: listing + (-> (List Text) (Markdown Block)) + (|>> (list.sorted text\<) + (list\map (function (_ definition) + [(md.snippet definition) + #.None])) + md.numbered_list)) + +(def: (module_documentation module) + (-> Module (Markdown Block)) + (let [(^slots [#expected]) module] + ($_ md.then + ... Name + (md.heading/1 (get@ #module module)) + ... Definitions + (md.heading/2 "Definitions") + (|> module + (get@ #definitions) + (list.only (|>> (get@ #definition) + (set.member? expected))) + ..definitions_documentation) + ... Missing documentation + (case (|> module + (get@ #definitions) + (list\fold (function (_ definition missing) + (set.lacks (get@ #definition definition) missing)) + expected) + set.list) + #.End + md.empty + + missing + ($_ md.then + (md.heading/2 "Missing documentation") + (..listing missing))) + ... Un-expected documentation + (case (|> module + (get@ #definitions) + (list.only (|>> (get@ #definition) (set.member? expected) not)) + (list\map (get@ #definition))) + #.End + md.empty + + un_expected + ($_ md.then + (md.heading/2 "Un-expected documentation") + (..listing un_expected))) + ))) + +(def: .public documentation + (-> (List Module) Text) + (|>> (list.sorted (function (_ left right) + (text\< (get@ #module right) (get@ #module left)))) + (list\map ..module_documentation) + (list.interposed md.horizontal_rule) + (list\fold md.then (: (Markdown Block) md.empty)) + md.markdown)) diff --git a/stdlib/source/library/lux/math/number/rev.lux b/stdlib/source/library/lux/math/number/rev.lux index 5c0ce4d8e..4eea3ecf7 100644 --- a/stdlib/source/library/lux/math/number/rev.lux +++ b/stdlib/source/library/lux/math/number/rev.lux @@ -295,7 +295,7 @@ (def: (digit idx digits) (-> Nat Digits Nat) (|> digits - (array.read idx) + (array.read! idx) (maybe.else 0))) (def: digits\put! diff --git a/stdlib/source/library/lux/math/random.lux b/stdlib/source/library/lux/math/random.lux index 2ba47c5cd..bb66000be 100644 --- a/stdlib/source/library/lux/math/random.lux +++ b/stdlib/source/library/lux/math/random.lux @@ -268,7 +268,7 @@ [array Array array.of_list] [queue Queue queue.of_list] - [stack Stack (list\fold stack.push stack.empty)] + [stack Stack (list\fold stack.top stack.empty)] ) (def: .public (set hash size value_gen) diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index 8ed6e30f5..72f0b2b51 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -284,6 +284,22 @@ #.None (#try.Failure ($_ text\compose "Unknown variable: " name)))))) +(def: without_lux_runtime + (-> (List Text) (List Text)) + ... The Lux runtime shows up as "" + ... so I'm excluding it. + (list.only (|>> text.empty? not))) + +(def: listing_separator + Text + ($_ text\compose text.new_line " ")) + +(def: module_listing + (-> (List Text) Text) + (|>> ..without_lux_runtime + (list.sorted text\<) + (text.join_with ..listing_separator))) + (def: .public (definition name) {#.doc "Looks-up a definition's whole data in the available modules (including the current one)."} (-> Name (Meta Global)) @@ -302,12 +318,10 @@ _ (let [current_module (|> lux (get@ #.current_module) (maybe.else "???")) - separator ($_ text\compose text.new_line " ") all_known_modules (|> lux (get@ #.modules) (list\map product.left) - (list.sorted text\<) - (text.join_with separator))] + ..module_listing)] (#try.Failure ($_ text\compose "Unknown definition: " (name\encode name) text.new_line " Current module: " current_module text.new_line @@ -330,16 +344,15 @@ #.None)))))) list.joined (list.sorted text\<) - (text.join_with separator)) + (text.join_with ..listing_separator)) imports (|> this_module (get@ #.imports) - (list.sorted text\<) - (text.join_with separator)) + ..module_listing) aliases (|> this_module (get@ #.module_aliases) (list\map (function (_ [alias real]) ($_ text\compose alias " => " real))) (list.sorted text\<) - (text.join_with separator))] + (text.join_with ..listing_separator))] ($_ text\compose " Candidates: " candidates text.new_line " Imports: " imports text.new_line diff --git a/stdlib/source/library/lux/target/jvm/reflection.lux b/stdlib/source/library/lux/target/jvm/reflection.lux index 813395886..f68b6b59d 100644 --- a/stdlib/source/library/lux/target/jvm/reflection.lux +++ b/stdlib/source/library/lux/target/jvm/reflection.lux @@ -197,8 +197,8 @@ (#.Some reflection) ... TODO: Instead of having single lower/upper bounds, should ... allow for multiple ones. - (case [(array.read 0 (java/lang/reflect/WildcardType::getLowerBounds reflection)) - (array.read 0 (java/lang/reflect/WildcardType::getUpperBounds reflection))] + (case [(array.read! 0 (java/lang/reflect/WildcardType::getLowerBounds reflection)) + (array.read! 0 (java/lang/reflect/WildcardType::getUpperBounds reflection))] (^template [<pattern> <kind>] [<pattern> (case (ffi.check java/lang/reflect/GenericArrayType bound) diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index 174058fab..f19ec248c 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -328,10 +328,10 @@ (function (_ mapping) (let [with_dependence+transitives (|> mapping - (dictionary.upsert source ..empty (set.has target)) + (dictionary.revised' source ..empty (set.has target)) (dictionary.revised source (set.union forward)))] (list\fold (function (_ previous) - (dictionary.upsert previous ..empty (set.has target))) + (dictionary.revised' previous ..empty (set.has target))) with_dependence+transitives (set.list backward))))))] (|> dependence @@ -414,7 +414,7 @@ archive.ID <Signal>])]) (:expected - (stm.commit + (stm.commit! (do {! stm.monad} [dependence (if (text\= archive.runtime_module importer) (stm.read dependence) @@ -475,12 +475,12 @@ (in result) (#try.Success [resulting_archive resulting_state]) - (stm.commit (do stm.monad - [[_ [merged_archive _]] (stm.update (function (_ [archive state]) - [(archive.merged resulting_archive archive) - state]) - current)] - (in (#try.Success [merged_archive resulting_state]))))) + (stm.commit! (do stm.monad + [[_ [merged_archive _]] (stm.update (function (_ [archive state]) + [(archive.merged resulting_archive archive) + state]) + current)] + (in (#try.Success [merged_archive resulting_state]))))) _ (async.future (resolver result))] (in [])))] return))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux index 454704918..2188bb54a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -198,11 +198,11 @@ num_tags) num_sub_patterns (list.size sub_patterns) matches (cond (n.< num_subs num_sub_patterns) - (let [[prefix suffix] (list.split (dec num_sub_patterns) subs)] + (let [[prefix suffix] (list.split_at (dec num_sub_patterns) subs)] (list.zipped/2 (list\compose prefix (list (type.tuple suffix))) sub_patterns)) (n.> num_subs num_sub_patterns) - (let [[prefix suffix] (list.split (dec num_subs) sub_patterns)] + (let [[prefix suffix] (list.split_at (dec num_subs) sub_patterns)] (list.zipped/2 subs (list\compose prefix (list (code.tuple suffix))))) ... (n.= num_subs num_sub_patterns) @@ -262,7 +262,7 @@ [[testP nextA] (if (and (n.> num_cases size_sum) (n.= (dec num_cases) idx)) (analyse_pattern #.None - (type.variant (list.drop (dec num_cases) flat_sum)) + (type.variant (list.after (dec num_cases) flat_sum)) (` [(~+ values)]) next) (analyse_pattern #.None caseT (` [(~+ values)]) next))] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux index 1a8d43477..af25a5856 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux @@ -279,7 +279,7 @@ (/.except ..smaller_variant_than_expected [expected_size actual_size]) (n.= boundary tag) - (let [caseT (type.variant (list.drop boundary cases))] + (let [caseT (type.variant (list.after boundary cases))] (///\in (if (n.= 0 depth) (type.function (list caseT) currentT) (let [replace' (replace (|> depth dec (n.* 2)) inferT)] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/scope.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/scope.lux index ae6034b65..98c36ec05 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/scope.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/scope.lux @@ -23,8 +23,11 @@ ["." variable (#+ Register Variable)]] ["#" phase]]]]) -(type: Local (Bindings Text [Type Register])) -(type: Foreign (Bindings Text [Type Variable])) +(type: Local + (Bindings Text [Type Register])) + +(type: Foreign + (Bindings Text [Type Variable])) (def: (local? name scope) (-> Text Scope Bit) @@ -79,7 +82,7 @@ (function (_ state) (let [[inner outer] (|> state (get@ #.scopes) - (list.split_when (|>> (reference? name) not)))] + (list.split_when (|>> (reference? name))))] (case outer #.End (#.Right [state #.None]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index 4913607a6..6fc53dd20 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -1169,7 +1169,7 @@ [name (index_parameter idx)])) list.reversed) num_owner_tvars (list.size owner_tvars) - owner_tvarsT (|> lux_tvars (list.take num_owner_tvars) (list\map product.right)) + owner_tvarsT (|> lux_tvars (list.first num_owner_tvars) (list\map product.right)) mapping (dictionary.of_list text.hash lux_tvars)] [owner_tvarsT mapping])) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux index b59e5ce37..6a5f40ef7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux @@ -5,7 +5,7 @@ ["." monad (#+ do)]] [control [parser - ["s" code]]] + ["<.>" code]]] [data [collection ["." list ("#\." functor)]]] @@ -21,7 +21,7 @@ [/// ["#" phase]]]]) -(syntax: (Vector [size s.nat +(syntax: (Vector [size <code>.nat elemT <code>.any]) (in (list (` [(~+ (list.repeated size elemT))])))) @@ -31,8 +31,8 @@ (type: .public (Trinary of) (-> (Vector 3 of) of)) (type: .public (Variadic of) (-> (List of) of)) -(syntax: (arity: [arity s.nat - name s.local_identifier +(syntax: (arity: [arity <code>.nat + name <code>.local_identifier type <code>.any]) (with_identifiers [g!_ g!extension g!name g!phase g!archive g!inputs g!of g!anchor g!expression g!directive] (do {! meta.monad} diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/context.lux b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux index 3e797c325..0c7969507 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux @@ -147,7 +147,7 @@ (if (text.ends_with? ..lux_extension file) (do ! [source_code (\ fs read file)] - (async\in (dictionary.try_put (file.name fs file) source_code enumeration))) + (async\in (dictionary.has' (file.name fs file) source_code enumeration))) (in enumeration))) enumeration)) (\ ! join))] diff --git a/stdlib/source/library/lux/type/check.lux b/stdlib/source/library/lux/type/check.lux index 0201a446a..b4aedaef1 100644 --- a/stdlib/source/library/lux/type/check.lux +++ b/stdlib/source/library/lux/type/check.lux @@ -222,7 +222,7 @@ #.None (..except ..unbound_type_var id)))) -(def: (peek id) +(def: (bound id) (-> Var (Check Type)) (function (_ context) (case (|> context (get@ #.var_bindings) (var::get id)) @@ -404,8 +404,8 @@ (if (!n\= idE idA) (check\in assumptions) (do {! ..monad} - [ebound (attempt (peek idE)) - abound (attempt (peek idA))] + [ebound (attempt (..bound idE)) + abound (attempt (..bound idA))] (case [ebound abound] ... Link the 2 variables circularly [#.None #.None] diff --git a/stdlib/source/library/lux/type/implicit.lux b/stdlib/source/library/lux/type/implicit.lux index d8aeeebb1..6d5195708 100644 --- a/stdlib/source/library/lux/type/implicit.lux +++ b/stdlib/source/library/lux/type/implicit.lux @@ -133,7 +133,7 @@ (do meta.monad [local_batches meta.locals .let [total_locals (list\fold (function (_ [name type] table) - (try.else table (dictionary.try_put name type table))) + (try.else table (dictionary.has' name type table))) (: (Dictionary Text Type) (dictionary.empty text.hash)) (list\join local_batches))]] diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux index 293856d25..e6c10352f 100644 --- a/stdlib/source/library/lux/world/file.lux +++ b/stdlib/source/library/lux/world/file.lux @@ -88,8 +88,8 @@ (#.Some last_separator) (do maybe.monad - [[parent temp] (text.split last_separator path) - [_ child] (text.split (text.size /) temp)] + [[parent temp] (text.split_at last_separator path) + [_ child] (text.split_at (text.size /) temp)] (in [parent child]))))) (def: .public (parent fs path) @@ -1193,13 +1193,13 @@ (|>> (<retrieve> separator path) (try\map (function.constant true)) (try.else false))) - stm.commit))] + stm.commit!))] [file? ..retrieve_mock_file!] [directory? ..retrieve_mock_directory!])) (def: (make_directory path) - (stm.commit + (stm.commit! (do {! stm.monad} [|store| (stm.read store)] (case (..make_mock_directory! separator path |store|) @@ -1213,7 +1213,7 @@ (~~ (template [<method> <tag>] [(def: (<method> path) - (stm.commit + (stm.commit! (do stm.monad [|store| (stm.read store)] (in (do try.monad @@ -1233,7 +1233,7 @@ )) (def: (file_size path) - (stm.commit + (stm.commit! (do stm.monad [|store| (stm.read store)] (in (|> |store| @@ -1243,7 +1243,7 @@ binary.size))))))) (def: (last_modified path) - (stm.commit + (stm.commit! (do stm.monad [|store| (stm.read store)] (in (|> |store| @@ -1252,7 +1252,7 @@ (get@ #mock_last_modified)))))))) (def: (can_execute? path) - (stm.commit + (stm.commit! (do stm.monad [|store| (stm.read store)] (in (|> |store| @@ -1261,7 +1261,7 @@ (get@ #mock_can_execute)))))))) (def: (read path) - (stm.commit + (stm.commit! (do stm.monad [|store| (stm.read store)] (in (|> |store| @@ -1270,11 +1270,11 @@ (get@ #mock_content)))))))) (def: (delete path) - (stm.commit + (stm.commit! (..attempt! (..delete_mock_node! separator path) store))) (def: (modify now path) - (stm.commit + (stm.commit! (..attempt! (function (_ |store|) (do try.monad [[name file] (..retrieve_mock_file! separator path |store|)] @@ -1284,13 +1284,13 @@ (def: (write content path) (do async.monad [now (async.future instant.now)] - (stm.commit + (stm.commit! (..attempt! (..update_mock_file! separator path now content) store)))) (def: (append content path) (do async.monad [now (async.future instant.now)] - (stm.commit + (stm.commit! (..attempt! (function (_ |store|) (do try.monad [[name file] (..retrieve_mock_file! separator path |store|)] @@ -1302,7 +1302,7 @@ store)))) (def: (move destination origin) - (stm.commit + (stm.commit! (do {! stm.monad} [|store| (stm.read store)] (case (do try.monad @@ -1333,7 +1333,7 @@ (let [rooted? (text.starts_with? (\ fs separator) path) segments (text.all_split_by (\ fs separator) path)] (case (if rooted? - (list.drop 1 segments) + (list.after 1 segments) segments) #.End (\ monad in (exception.except ..cannot_make_directory [path])) diff --git a/stdlib/source/library/lux/world/file/watch.lux b/stdlib/source/library/lux/world/file/watch.lux index 0bbc37e35..3a0b98f86 100644 --- a/stdlib/source/library/lux/world/file/watch.lux +++ b/stdlib/source/library/lux/world/file/watch.lux @@ -198,17 +198,17 @@ [exists? (\ fs directory? path)] (if exists? (do ! - [updated? (stm.commit (..update_watch! new_concern path tracker))] + [updated? (stm.commit! (..update_watch! new_concern path tracker))] (if updated? (in (#try.Success [])) (do (try.with !) [file_tracker (..file_tracker fs path)] (do ! - [_ (stm.commit (stm.update (dictionary.has path [new_concern file_tracker]) tracker))] + [_ (stm.commit! (stm.update (dictionary.has path [new_concern file_tracker]) tracker))] (in (#try.Success [])))))) (in (exception.except ..cannot_poll_a_non_existent_directory [path]))))) (def: (concern path) - (stm.commit + (stm.commit! (do stm.monad [@tracker (stm.read tracker)] (in (case (dictionary.value path @tracker) @@ -218,7 +218,7 @@ #.None (exception.except ..not_being_watched [path])))))) (def: (stop path) - (stm.commit + (stm.commit! (do {! stm.monad} [@tracker (stm.read tracker)] (case (dictionary.value path @tracker) @@ -231,16 +231,16 @@ (in (exception.except ..not_being_watched [path])))))) (def: (poll _) (do async.monad - [@tracker (stm.commit (stm.read tracker))] + [@tracker (stm.commit! (stm.read tracker))] (do {! (try.with async.monad)} [changes (|> @tracker dictionary.entries (monad.map ! (..available_directory_changes fs))) _ (do async.monad - [_ (stm.commit (stm.write (|> changes - (list\map product.left) - (dictionary.of_list text.hash)) - tracker))] + [_ (stm.commit! (stm.write (|> changes + (list\map product.left) + (dictionary.of_list text.hash)) + tracker))] (in (#try.Success []))) .let [[creations modifications deletions] (list\fold (function (_ [_ [creations modifications deletions]] @@ -425,13 +425,13 @@ stop (: (-> //.Path (Async (Try Concern))) (function (_ path) (do {! async.monad} - [@tracker (stm.commit (stm.read tracker))] + [@tracker (stm.commit! (stm.read tracker))] (case (dictionary.value path @tracker) (#.Some [concern key]) (do ! [_ (async.future (java/nio/file/WatchKey::cancel key)) - _ (stm.commit (stm.update (dictionary.lacks path) tracker))] + _ (stm.commit! (stm.update (dictionary.lacks path) tracker))] (in (#try.Success concern))) #.None @@ -447,11 +447,11 @@ watcher path)] (do async.monad - [_ (stm.commit (stm.update (dictionary.has path [concern key]) tracker))] + [_ (stm.commit! (stm.update (dictionary.has path [concern key]) tracker))] (in (#try.Success [])))))) (def: (concern path) (do async.monad - [@tracker (stm.commit (stm.read tracker))] + [@tracker (stm.commit! (stm.read tracker))] (case (dictionary.value path @tracker) (#.Some [concern key]) (in (#try.Success concern)) diff --git a/stdlib/source/library/lux/world/net/http/header.lux b/stdlib/source/library/lux/world/net/http/header.lux index 76e96c815..5b5a20194 100644 --- a/stdlib/source/library/lux/world/net/http/header.lux +++ b/stdlib/source/library/lux/world/net/http/header.lux @@ -14,13 +14,13 @@ (def: .public (has name value) (-> Text Text Header) - (dictionary.upsert name "" - (|>> (case> - "" - value - - previous - (format previous "," value))))) + (dictionary.revised' name "" + (|>> (case> + "" + value + + previous + (format previous "," value))))) (def: .public content_length (-> Nat Header) diff --git a/stdlib/source/library/lux/world/program.lux b/stdlib/source/library/lux/world/program.lux index 488d0ba36..d5195e39f 100644 --- a/stdlib/source/library/lux/world/program.lux +++ b/stdlib/source/library/lux/world/program.lux @@ -319,7 +319,7 @@ (#.Some process/env) (|> (Object::entries [process/env]) array.list - (list\map (|>> (array.read 0) maybe.assume))) + (list\map (|>> (array.read! 0) maybe.assume))) #.None (list)) @@ -365,8 +365,8 @@ @.js (io.io (if ffi.on_node_js? (case (do maybe.monad [process/env (ffi.constant Object [process env])] - (array.read (:as Nat name) - (:as (Array Text) process/env))) + (array.read! (:as Nat name) + (:as (Array Text) process/env))) (#.Some value) (#try.Success value) |