diff options
Diffstat (limited to '')
41 files changed, 1714 insertions, 1714 deletions
diff --git a/stdlib/source/lux/data/bit.lux b/stdlib/source/lux/data/bit.lux index b0b31d2dd..4f9474a90 100644 --- a/stdlib/source/lux/data/bit.lux +++ b/stdlib/source/lux/data/bit.lux @@ -1,11 +1,11 @@ -(;module: [lux #- and or not]) +(.module: [lux #- and or not]) (def: #export width Nat +64) ## [Values] (do-template [<short-name> <op> <doc> <type>] [(def: #export (<short-name> param subject) - {#;doc <doc>} + {#.doc <doc>} (-> Nat <type> <type>) (<op> subject param))] @@ -18,40 +18,40 @@ ) (def: #export (count subject) - {#;doc "Count the number of 1s in a bit-map."} + {#.doc "Count the number of 1s in a bit-map."} (-> Nat Nat) ("lux bit count" subject)) (def: #export not - {#;doc "Bitwise negation."} + {#.doc "Bitwise negation."} (-> Nat Nat) (let [mask (int-to-nat -1)] (xor mask))) (def: #export (clear idx input) - {#;doc "Clear bit at given index."} + {#.doc "Clear bit at given index."} (-> Nat Nat Nat) - (;;and (;;not (shift-left idx +1)) + (..and (..not (shift-left idx +1)) input)) (do-template [<name> <op> <doc>] [(def: #export (<name> idx input) - {#;doc <doc>} + {#.doc <doc>} (-> Nat Nat Nat) (<op> (shift-left idx +1) input))] - [set ;;or "Set bit at given index."] - [flip ;;xor "Flip bit at given index."] + [set ..or "Set bit at given index."] + [flip ..xor "Flip bit at given index."] ) (def: #export (set? idx input) (-> Nat Nat Bool) - (|> input (;;and (shift-left idx +1)) (n/= +0) ;not)) + (|> input (..and (shift-left idx +1)) (n/= +0) .not)) (do-template [<name> <main> <comp>] [(def: #export (<name> distance input) (-> Nat Nat Nat) - (;;or (<main> distance input) + (..or (<main> distance input) (<comp> (n/- (n/% width distance) width) input)))] diff --git a/stdlib/source/lux/data/bool.lux b/stdlib/source/lux/data/bool.lux index e737c6118..9ccbc87ab 100644 --- a/stdlib/source/lux/data/bool.lux +++ b/stdlib/source/lux/data/bool.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monoid #+ Monoid] [eq #+ Eq] @@ -38,13 +38,13 @@ (def: (decode input) (case input - "true" (#;Right true) - "false" (#;Right false) - _ (#;Left "Wrong syntax for Bool.")))) + "true" (#.Right true) + "false" (#.Right false) + _ (#.Left "Wrong syntax for Bool.")))) ## [Values] (def: #export complement - {#;doc "Generates the complement of a predicate. + {#.doc "Generates the complement of a predicate. That is a predicate that returns the oposite of the original predicate."} (All [a] (-> (-> a Bool) (-> a Bool))) (compose not)) diff --git a/stdlib/source/lux/data/coll/array.lux b/stdlib/source/lux/data/coll/array.lux index ac15bfe9d..b45cab136 100644 --- a/stdlib/source/lux/data/coll/array.lux +++ b/stdlib/source/lux/data/coll/array.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monoid #+ Monoid] [functor #+ Functor] @@ -38,29 +38,29 @@ dest-array (list/fold (function [offset target] (case (read (n/+ offset src-start) src-array) - #;None + #.None target - (#;Some value) + (#.Some value) (write (n/+ offset dest-start) value target))) dest-array - (list;n/range +0 (n/dec length))))) + (list.n/range +0 (n/dec length))))) (def: #export (occupied array) - {#;doc "Finds out how many cells in an array are occupied."} + {#.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) - #;None + #.None count - (#;Some _) + (#.Some _) (n/inc count))) +0 - (list;indices (size array)))) + (list.indices (size array)))) (def: #export (vacant array) - {#;doc "Finds out how many cells in an array are vacant."} + {#.doc "Finds out how many cells in an array are vacant."} (All [a] (-> (Array a) Nat)) (n/- (occupied array) (size array))) @@ -70,26 +70,26 @@ (list/fold (: (-> Nat (Array ($ +0)) (Array ($ +0))) (function [idx xs'] (case (read idx xs) - #;None + #.None xs' - (#;Some x) + (#.Some x) (if (p x) xs' (delete idx xs'))))) xs - (list;indices (size xs))) + (list.indices (size xs))) ## (list/fold (function [idx xs'] ## (case (read idx xs) - ## #;None + ## #.None ## xs' - ## (#;Some x) + ## (#.Some x) ## (if (p x) ## xs' ## (delete idx xs')))) ## xs - ## (list;indices (size xs))) + ## (list.indices (size xs))) ) (def: #export (find p xs) @@ -99,50 +99,50 @@ (loop [idx +0] (if (n/< arr-size idx) (case (read idx xs) - #;None + #.None (recur (n/inc idx)) - (#;Some x) + (#.Some x) (if (p x) - (#;Some x) + (#.Some x) (recur (n/inc idx)))) - #;None)))) + #.None)))) (def: #export (find+ p xs) - {#;doc "Just like 'find', but with access to the index of each value."} + {#.doc "Just like 'find', but with access to the index of each value."} (All [a] (-> (-> Nat a Bool) (Array a) (Maybe [Nat a]))) (let [arr-size (size xs)] (loop [idx +0] (if (n/< arr-size idx) (case (read idx xs) - #;None + #.None (recur (n/inc idx)) - (#;Some x) + (#.Some x) (if (p idx x) - (#;Some [idx x]) + (#.Some [idx x]) (recur (n/inc idx)))) - #;None)))) + #.None)))) (def: #export (clone xs) (All [a] (-> (Array a) (Array a))) (let [arr-size (size xs)] (list/fold (function [idx ys] (case (read idx xs) - #;None + #.None ys - (#;Some x) + (#.Some x) (write idx x ys))) (new arr-size) - (list;indices arr-size)))) + (list.indices arr-size)))) (def: #export (from-list xs) (All [a] (-> (List a) (Array a))) - (product;right (list/fold (function [x [idx arr]] + (product.right (list/fold (function [x [idx arr]] [(n/inc idx) (write idx x arr)]) - [+0 (new (list;size xs))] + [+0 (new (list.size xs))] xs))) (def: underflow Nat (n/dec +0)) @@ -150,15 +150,15 @@ (def: #export (to-list array) (All [a] (-> (Array a) (List a))) (loop [idx (n/dec (size array)) - output #;Nil] + output #.Nil] (if (n/= underflow idx) output (recur (n/dec idx) (case (read idx array) - (#;Some head) - (#;Cons head output) + (#.Some head) + (#.Cons head output) - #;None + #.None output))))) (struct: #export (Eq<Array> Eq<a>) @@ -170,16 +170,16 @@ (list/fold (function [idx prev] (and prev (case [(read idx xs) (read idx ys)] - [#;None #;None] + [#.None #.None] true - [(#;Some x) (#;Some y)] + [(#.Some x) (#.Some y)] (:: Eq<a> = x y) _ false))) true - (list;n/range +0 (n/dec sxs))))) + (list.n/range +0 (n/dec sxs))))) )) (struct: #export Monoid<Array> (All [a] @@ -201,22 +201,22 @@ (list/fold (: (-> Nat (Array ($ +1)) (Array ($ +1))) (function [idx mb] (case (read idx ma) - #;None + #.None mb - (#;Some x) + (#.Some x) (write idx (f x) mb)))) (new arr-size) - (list;n/range +0 (n/dec arr-size))) + (list.n/range +0 (n/dec arr-size))) ## (list/fold (function [idx mb] ## (case (read idx ma) - ## #;None + ## #.None ## mb - ## (#;Some x) + ## (#.Some x) ## (write idx (f x) mb))) ## (new arr-size) - ## (list;n/range +0 (n/dec arr-size))) + ## (list.n/range +0 (n/dec arr-size))) )))) (struct: #export _ (Fold Array) @@ -226,9 +226,9 @@ idx +0] (if (n/< arr-size idx) (case (read idx xs) - #;None + #.None (recur so-far (n/inc idx)) - (#;Some value) + (#.Some value) (recur (f value so-far) (n/inc idx))) so-far))))) diff --git a/stdlib/source/lux/data/coll/dict.lux b/stdlib/source/lux/data/coll/dict.lux index 5ab078e28..5b61830d5 100644 --- a/stdlib/source/lux/data/coll/dict.lux +++ b/stdlib/source/lux/data/coll/dict.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control hash [eq #+ Eq]) @@ -97,58 +97,58 @@ ## which is 1/4 of the branching factor (or a left-shift 2). (def: demotion-threshold Nat - (bit;shift-left (n/- +2 branching-exponent) +1)) + (bit.shift-left (n/- +2 branching-exponent) +1)) ## The threshold on which #Base nodes are promoted to #Hierarchy nodes, ## which is 1/2 of the branching factor (or a left-shift 1). (def: promotion-threshold Nat - (bit;shift-left (n/- +1 branching-exponent) +1)) + (bit.shift-left (n/- +1 branching-exponent) +1)) ## The size of hierarchy-nodes, which is 2^(branching-exponent). (def: hierarchy-nodes-size Nat - (bit;shift-left branching-exponent +1)) + (bit.shift-left branching-exponent +1)) ## The cannonical empty node, which is just an empty #Base node. (def: empty Node - (#Base clean-bitmap (array;new +0))) + (#Base clean-bitmap (array.new +0))) ## Expands a copy of the array, to have 1 extra slot, which is used ## for storing the value. (def: (insert! idx value old-array) (All [a] (-> Index a (Array a) (Array a))) - (let [old-size (array;size old-array)] - (|> ## (array;new (n/inc old-size)) + (let [old-size (array.size old-array)] + (|> ## (array.new (n/inc old-size)) (: (Array ($ +0)) - (array;new (n/inc old-size))) - (array;copy idx +0 old-array +0) - (array;write idx value) - (array;copy (n/- idx old-size) idx old-array (n/inc idx))))) + (array.new (n/inc old-size))) + (array.copy idx +0 old-array +0) + (array.write idx value) + (array.copy (n/- idx old-size) idx old-array (n/inc idx))))) ## Creates a copy of an array with an index set to a particular value. (def: (update! idx value array) (All [a] (-> Index a (Array a) (Array a))) - (|> array array;clone (array;write idx value))) + (|> array array.clone (array.write idx value))) ## Creates a clone of the array, with an empty position at index. (def: (vacant! idx array) (All [a] (-> Index (Array a) (Array a))) - (|> array array;clone (array;delete idx))) + (|> array array.clone (array.delete idx))) ## Shrinks a copy of the array by removing the space at index. (def: (remove! idx array) (All [a] (-> Index (Array a) (Array a))) - (let [new-size (n/dec (array;size array))] - (|> (array;new new-size) - (array;copy idx +0 array +0) - (array;copy (n/- idx new-size) (n/inc idx) array idx)))) + (let [new-size (n/dec (array.size array))] + (|> (array.new new-size) + (array.copy idx +0 array +0) + (array.copy (n/- idx new-size) (n/inc idx) array idx)))) ## Given a top-limit for indices, produces all indices in [0, R). (def: indices-for (-> Nat (List Index)) - (|>> n/dec (list;n/range +0))) + (|>> n/dec (list.n/range +0))) ## Increases the level-shift by the branching-exponent, to explore ## levels further down the tree. @@ -162,13 +162,13 @@ ## to a particular level, and uses that as an index into the array. (def: (level-index level hash) (-> Level Hash-Code Index) - (bit;and hierarchy-mask - (bit;shift-right level hash))) + (bit.and hierarchy-mask + (bit.shift-right level hash))) ## A mechanism to go from indices to bit-positions. (def: (->bit-position index) (-> Index BitPosition) - (bit;shift-left index +1)) + (bit.shift-left index +1)) ## The bit-position within a base that a given hash-code would have. (def: (bit-position level hash) @@ -177,7 +177,7 @@ (def: (bit-position-is-set? bit bitmap) (-> BitPosition BitMap Bool) - (not (n/= clean-bitmap (bit;and bit bitmap)))) + (not (n/= clean-bitmap (bit.and bit bitmap)))) ## Figures out whether a bitmap only contains a single bit-position. (def: only-bit-position? @@ -186,17 +186,17 @@ (def: (set-bit-position bit bitmap) (-> BitPosition BitMap BitMap) - (bit;or bit bitmap)) + (bit.or bit bitmap)) (def: unset-bit-position (-> BitPosition BitMap BitMap) - bit;xor) + bit.xor) ## Figures out the size of a bitmap-indexed array by counting all the ## 1s within the bitmap. (def: bitmap-size (-> BitMap Nat) - bit;count) + bit.count) ## A mask that, for a given bit position, only allows all the 1s prior ## to it, which would indicate the bitmap-size (and, thus, index) @@ -208,14 +208,14 @@ ## The index on the base array, based on it's bit-position. (def: (base-index bit-position bitmap) (-> BitPosition BitMap Index) - (bitmap-size (bit;and (bit-position-mask bit-position) + (bitmap-size (bit.and (bit-position-mask bit-position) bitmap))) ## Produces the index of a KV-pair within a #Collisions node. (def: (collision-index Hash<k> key colls) (All [k v] (-> (Hash k) k (Collisions k v) (Maybe Index))) - (:: Monad<Maybe> map product;left - (array;find+ (function [idx [key' val']] + (:: Monad<Maybe> map product.left + (array.find+ (function [idx [key' val']] (:: Hash<k> = key key')) colls))) @@ -223,22 +223,22 @@ ## nodes to save space. (def: (demote-hierarchy except-idx [h-size h-array]) (All [k v] (-> Index (Hierarchy k v) [BitMap (Base k v)])) - (product;right (list/fold (function [idx [insertion-idx node]] + (product.right (list/fold (function [idx [insertion-idx node]] (let [[bitmap base] node] - (case (array;read idx h-array) - #;None [insertion-idx node] - (#;Some sub-node) (if (n/= except-idx idx) + (case (array.read idx h-array) + #.None [insertion-idx node] + (#.Some sub-node) (if (n/= except-idx idx) [insertion-idx node] [(n/inc insertion-idx) [(set-bit-position (->bit-position idx) bitmap) - (array;write insertion-idx (#;Left sub-node) base)]]) + (array.write insertion-idx (#.Left sub-node) base)]]) ))) [+0 [clean-bitmap - ## (array;new (n/dec h-size)) + ## (array.new (n/dec h-size)) (: (Base ($ +0) ($ +1)) - (array;new (n/dec h-size))) + (array.new (n/dec h-size))) ]] - (list;indices (array;size h-array))))) + (list.indices (array.size h-array))))) ## When #Base nodes grow too large, they're promoted to #Hierarchy to ## add some depth to the tree and help keep it's balance. @@ -250,26 +250,26 @@ (Hash k) Level BitMap (Base k v) (Array (Node k v)))) - (product;right (list/fold (function [hierarchy-idx (^@ default [base-idx h-array])] + (product.right (list/fold (function [hierarchy-idx (^@ default [base-idx h-array])] (if (bit-position-is-set? (->bit-position hierarchy-idx) bitmap) [(n/inc base-idx) - (case (array;read base-idx base) - (#;Some (#;Left sub-node)) - (array;write hierarchy-idx sub-node h-array) + (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 + (#.Some (#.Right [key' val'])) + (array.write hierarchy-idx (put' (level-up level) (:: Hash<k> hash key') key' val' Hash<k> empty) h-array) - #;None + #.None (undefined))] default)) [+0 - ## (array;new hierarchy-nodes-size) + ## (array.new hierarchy-nodes-size) (: (Array (Node ($ +0) ($ +1))) - (array;new hierarchy-nodes-size)) + (array.new hierarchy-nodes-size)) ] hierarchy-indices))) @@ -279,7 +279,7 @@ (def: (empty?' node) (All [k v] (-> (Node k v) Bool)) (case node - (^~ (#Base ;;clean-bitmap _)) + (^~ (#Base ..clean-bitmap _)) true _ @@ -292,15 +292,15 @@ ## a sub-node. If impossible, I introduced a new singleton sub-node. (#Hierarchy _size hierarchy) (let [idx (level-index level hash) - ## [_size' sub-node] (case (array;read idx hierarchy) - ## (#;Some sub-node) + ## [_size' sub-node] (case (array.read idx hierarchy) + ## (#.Some sub-node) ## [_size sub-node] ## _ ## [(n/inc _size) empty]) [_size' sub-node] (: [Nat (Node ($ +0) ($ +1))] - (case (array;read idx hierarchy) - (#;Some sub-node) + (case (array.read idx hierarchy) + (#.Some sub-node) [_size sub-node] _ @@ -317,33 +317,33 @@ (if (bit-position-is-set? bit bitmap) ## If so... (let [idx (base-index bit bitmap)] - (case (array;read idx base) - #;None + (case (array.read idx base) + #.None (undefined) ## If it's being used by a node, I add the KV to it. - (#;Some (#;Left sub-node)) + (#.Some (#.Left sub-node)) (let [sub-node' (put' (level-up level) hash key val Hash<k> sub-node)] - (#Base bitmap (update! idx (#;Left sub-node') base))) + (#Base bitmap (update! idx (#.Left sub-node') base))) ## Otherwise, if it's being used by a KV, I compare the keys. - (#;Some (#;Right key' val')) + (#.Some (#.Right key' val')) (if (:: Hash<k> = key key') ## If the same key is found, I replace the value. - (#Base bitmap (update! idx (#;Right key val) base)) + (#Base bitmap (update! idx (#.Right key val) base)) ## Otherwise, I compare the hashes of the keys. (#Base bitmap (update! idx - (#;Left (let [hash' (:: Hash<k> hash key')] + (#.Left (let [hash' (:: Hash<k> hash key')] (if (n/= hash hash') ## If the hashes are ## the same, a new ## #Collisions node ## is added. - (#Collisions hash (|> ## (array;new +2) + (#Collisions hash (|> ## (array.new +2) (: (Array [($ +0) ($ +1)]) - (array;new +2)) - (array;write +0 [key' val']) - (array;write +1 [key val]))) + (array.new +2)) + (array.write +0 [key' val']) + (array.write +1 [key val]))) ## Otherwise, I can ## just keep using ## #Base nodes, so I @@ -362,12 +362,12 @@ ## KV-pair as a singleton node to it. (#Hierarchy (n/inc base-count) (|> (promote-base put' Hash<k> level bitmap base) - (array;write (level-index level hash) + (array.write (level-index level hash) (put' (level-up level) hash key val Hash<k> empty)))) ## Otherwise, I just resize the #Base node to accommodate the ## new KV-pair. (#Base (set-bit-position bit bitmap) - (insert! (base-index bit bitmap) (#;Right [key val]) base)))))) + (insert! (base-index bit bitmap) (#.Right [key val]) base)))))) ## For #Collisions nodes, I compare the hashes. (#Collisions _hash _colls) @@ -377,19 +377,19 @@ (case (collision-index Hash<k> key _colls) ## If the key was already present in the collisions-list, it's ## value gets updated. - (#;Some coll-idx) + (#.Some coll-idx) (#Collisions _hash (update! 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))) + #.None + (#Collisions _hash (insert! (array.size _colls) [key val] _colls))) ## If the hashes are not equal, I create a new #Base node that ## contains the old #Collisions node, plus the new KV-pair. (|> (#Base (bit-position level _hash) - (|> ## (array;new +1) + (|> ## (array.new +1) (: (Base ($ +0) ($ +1)) - (array;new +1)) - (array;write +0 (#;Left node)))) + (array.new +1)) + (array.write +0 (#.Left node)))) (put' level hash key val Hash<k>))) )) @@ -400,13 +400,13 @@ ## 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 + #.None node ## But if there is, try to remove the key from the sub-node. - (#;Some sub-node) + (#.Some sub-node) (let [sub-node' (remove' (level-up level) hash key Hash<k> sub-node)] ## Then check if a removal was actually done. (if (is sub-node sub-node') @@ -429,13 +429,13 @@ (let [bit (bit-position level hash)] (if (bit-position-is-set? bit bitmap) (let [idx (base-index bit bitmap)] - (case (array;read idx base) - #;None + (case (array.read idx base) + #.None (undefined) ## If set, check if it's a sub-node, and remove the KV ## from it. - (#;Some (#;Left sub-node)) + (#.Some (#.Left sub-node)) (let [sub-node' (remove' (level-up level) hash key Hash<k> sub-node)] ## Verify that it was removed. (if (is sub-node sub-node') @@ -454,10 +454,10 @@ ## But, if it did not come out empty, then the ## position is kept, and the node gets updated. (#Base bitmap - (update! idx (#;Left sub-node') base))))) + (update! idx (#.Left sub-node') base))))) ## If, however, there was a KV-pair instead of a sub-node. - (#;Some (#;Right [key' val'])) + (#.Some (#.Right [key' val'])) ## Check if the keys match. (if (:: Hash<k> = key key') ## If so, remove the KV-pair and unset the BitPosition. @@ -472,12 +472,12 @@ (#Collisions _hash _colls) (case (collision-index Hash<k> key _colls) ## If not, then there's nothing to remove. - #;None + #.None node ## But if so, then check the size of the collisions list. - (#;Some idx) - (if (n/= +1 (array;size _colls)) + (#.Some idx) + (if (n/= +1 (array.size _colls)) ## If there's only one left, then removing it leaves us with ## an empty node. empty @@ -490,31 +490,31 @@ (case node ## For #Hierarchy nodes, just look-up the key on its children. (#Hierarchy _size hierarchy) - (case (array;read (level-index level hash) hierarchy) - #;None #;None - (#;Some sub-node) (get' (level-up level) hash key Hash<k> sub-node)) + (case (array.read (level-index level hash) hierarchy) + #.None #.None + (#.Some sub-node) (get' (level-up level) hash key Hash<k> sub-node)) ## For #Base nodes, check the leaves, and recursively check the branches. (#Base bitmap base) (let [bit (bit-position level hash)] (if (bit-position-is-set? bit bitmap) - (case (array;read (base-index bit bitmap) base) - #;None + (case (array.read (base-index bit bitmap) base) + #.None (undefined) - (#;Some (#;Left sub-node)) + (#.Some (#.Left sub-node)) (get' (level-up level) hash key Hash<k> sub-node) - (#;Some (#;Right [key' val'])) + (#.Some (#.Right [key' val'])) (if (:: Hash<k> = key key') - (#;Some val') - #;None)) - #;None)) + (#.Some val') + #.None)) + #.None)) ## For #Collisions nodes, do a linear scan of all the known KV-pairs. (#Collisions _hash _colls) - (:: Monad<Maybe> map product;right - (array;find (|>> product;left (:: Hash<k> = key)) + (:: Monad<Maybe> map product.right + (array.find (|>> product.left (:: Hash<k> = key)) _colls)) )) @@ -527,12 +527,12 @@ (#Base _ base) (array/fold n/+ +0 (array/map (function [sub-node'] (case sub-node' - (#;Left sub-node) (size' sub-node) - (#;Right _) +1)) + (#.Left sub-node) (size' sub-node) + (#.Right _) +1)) base)) (#Collisions hash colls) - (array;size colls) + (array.size colls) )) (def: (entries' node) @@ -540,28 +540,28 @@ (case node (#Hierarchy _size hierarchy) (array/fold (function [sub-node tail] (list/compose (entries' sub-node) tail)) - #;Nil + #.Nil hierarchy) (#Base bitmap base) (array/fold (function [branch tail] (case branch - (#;Left sub-node) + (#.Left sub-node) (list/compose (entries' sub-node) tail) - (#;Right [key' val']) - (#;Cons [key' val'] tail))) - #;Nil + (#.Right [key' val']) + (#.Cons [key' val'] tail))) + #.Nil base) (#Collisions hash colls) - (array/fold (function [[key' val'] tail] (#;Cons [key' val'] tail)) - #;Nil + (array/fold (function [[key' val'] tail] (#.Cons [key' val'] tail)) + #.Nil colls))) ## [Exports] (type: #export (Dict k v) - {#;doc "A dictionary implemented as a Hash-Array Mapped Trie (HAMT)."} + {#.doc "A dictionary implemented as a Hash-Array Mapped Trie (HAMT)."} {#hash (Hash k) #root (Node k v)}) @@ -588,29 +588,29 @@ (def: #export (contains? key dict) (All [k v] (-> k (Dict k v) Bool)) (case (get key dict) - #;None false - (#;Some _) true)) + #.None false + (#.Some _) true)) (def: #export (put~ key val dict) - {#;doc "Only puts the KV-pair if the key is not already present."} + {#.doc "Only puts the KV-pair if the key is not already present."} (All [k v] (-> k v (Dict k v) (Dict k v))) (if (contains? key dict) dict (put key val dict))) (def: #export (update key f dict) - {#;doc "Transforms the value located at key (if available), using the given function."} + {#.doc "Transforms the value located at key (if available), using the given function."} (All [k v] (-> k (-> v v) (Dict k v) (Dict k v))) (case (get key dict) - #;None + #.None dict - (#;Some val) + (#.Some val) (put key (f val) dict))) (def: #export size (All [k v] (-> (Dict k v) Nat)) - (|>> product;right size')) + (|>> product.right size')) (def: #export empty? (All [k v] (-> (Dict k v) Bool)) @@ -618,7 +618,7 @@ (def: #export (entries dict) (All [k v] (-> (Dict k v) (List [k v]))) - (entries' (product;right dict))) + (entries' (product.right dict))) (def: #export (from-list Hash<k> kvs) (All [k v] (-> (Hash k) (List [k v]) (Dict k v))) @@ -632,12 +632,12 @@ (All [k v] (-> (Dict k v) (List <elem-type>))) (|> dict entries (list/map <side>)))] - [keys k product;left] - [values v product;right] + [keys k product.left] + [values v product.right] ) (def: #export (merge dict2 dict1) - {#;doc "Merges 2 dictionaries. + {#.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))) @@ -646,16 +646,16 @@ (entries dict2))) (def: #export (merge-with f dict2 dict1) - {#;doc "Merges 2 dictionaries. + {#.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 (function [[key val2] dict] (case (get key dict) - #;None + #.None (put key val2 dict) - (#;Some val1) + (#.Some val1) (put key (f val2 val1) dict))) dict1 (entries dict2))) @@ -663,22 +663,22 @@ (def: #export (re-bind from-key to-key dict) (All [k v] (-> k k (Dict k v) (Dict k v))) (case (get from-key dict) - #;None + #.None dict - (#;Some val) + (#.Some val) (|> dict (remove from-key) (put to-key val)))) (def: #export (select keys dict) - {#;doc "Creates a sub-set of the given dict, with only the specified keys."} + {#.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))) (let [[Hash<k> _] dict] (list/fold (function [key new-dict] (case (get key dict) - #;None new-dict - (#;Some val) (put key val new-dict))) + #.None new-dict + (#.Some val) (put key val new-dict))) (new Hash<k>) keys))) @@ -687,9 +687,9 @@ (def: (= test subject) (and (n/= (size test) (size subject)) - (list;every? (function [k] + (list.every? (function [k] (case [(get k test) (get k subject)] - [(#;Some tk) (#;Some sk)] + [(#.Some tk) (#.Some sk)] (:: Eq<v> = tk sk) _ diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux index 28deea034..27f4e8bad 100644 --- a/stdlib/source/lux/data/coll/list.lux +++ b/stdlib/source/lux/data/coll/list.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monoid #+ Monoid] [functor #+ Functor] @@ -16,13 +16,13 @@ ## (#Cons a (List a))) ## [Functions] -(struct: #export _ (fold;Fold List) +(struct: #export _ (fold.Fold List) (def: (fold f init xs) (case xs - #;Nil + #.Nil init - (#;Cons [x xs']) + (#.Cons [x xs']) (fold f (f x init) xs')))) (open Fold<List>) @@ -30,38 +30,38 @@ (def: #export (reverse xs) (All [a] (-> (List a) (List a))) - (fold (function [head tail] (#;Cons head tail)) - #;Nil + (fold (function [head tail] (#.Cons head tail)) + #.Nil xs)) (def: #export (filter p xs) (All [a] (-> (-> a Bool) (List a) (List a))) (case xs - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons [x xs']) + (#.Cons [x xs']) (if (p x) - (#;Cons [x (filter p xs')]) + (#.Cons [x (filter p xs')]) (filter p xs')))) (def: #export (partition p xs) - {#;doc "Divide the list into all elements that satisfy a predicate, and all elements that do not."} + {#.doc "Divide the list into all elements that satisfy a predicate, and all elements that do not."} (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. + {#.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'])])) - (#;Cons [[x1 x2] (as-pairs xs')]) + (^ (#.Cons [x1 (#.Cons [x2 xs'])])) + (#.Cons [[x1 x2] (as-pairs xs')]) _ - #;Nil)) + #.Nil)) (do-template [<name> <then> <else>] [(def: #export (<name> n xs) @@ -69,14 +69,14 @@ (-> Nat (List a) (List a))) (if (n/> +0 n) (case xs - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons [x xs']) + (#.Cons [x xs']) <then>) <else>))] - [take (#;Cons [x (take (n/dec n) xs')]) #;Nil] + [take (#.Cons [x (take (n/dec n) xs')]) #.Nil] [drop (drop (n/dec n) xs') xs] ) @@ -85,15 +85,15 @@ (All [a] (-> (-> a Bool) (List a) (List a))) (case xs - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons [x xs']) + (#.Cons [x xs']) (if (p x) <then> <else>)))] - [take-while (#;Cons [x (take-while p xs')]) #;Nil] + [take-while (#.Cons [x (take-while p xs')]) #.Nil] [drop-while (drop-while p xs') xs] ) @@ -102,99 +102,99 @@ (-> Nat (List a) [(List a) (List a)])) (if (n/> +0 n) (case xs - #;Nil - [#;Nil #;Nil] + #.Nil + [#.Nil #.Nil] - (#;Cons [x xs']) + (#.Cons [x xs']) (let [[tail rest] (split (n/dec n) xs')] - [(#;Cons [x tail]) rest])) - [#;Nil xs])) + [(#.Cons [x tail]) rest])) + [#.Nil xs])) (def: (split-with' p ys xs) (All [a] (-> (-> a Bool) (List a) (List a) [(List a) (List a)])) (case xs - #;Nil + #.Nil [ys xs] - (#;Cons [x xs']) + (#.Cons [x xs']) (if (p x) - (split-with' p (#;Cons [x ys]) xs') + (split-with' p (#.Cons [x ys]) xs') [ys xs]))) (def: #export (split-with p xs) - {#;doc "Segment the list by using a predicate to tell when to cut."} + {#.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)] + (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."} + {#.doc "Segment the list in chunks of size n."} (All [a] (-> Nat (List a) (List (List a)))) (case xs - #;Nil + #.Nil (list) _ (let [[pre post] (split n xs)] - (#;Cons pre (split-all n post))))) + (#.Cons pre (split-all n post))))) (def: #export (repeat n x) - {#;doc "A list of the value x, repeated n times."} + {#.doc "A list of the value x, repeated n times."} (All [a] (-> Nat a (List a))) (if (n/> +0 n) - (#;Cons [x (repeat (n/dec n) x)]) - #;Nil)) + (#.Cons [x (repeat (n/dec n) x)]) + #.Nil)) (def: (iterate' f x) (All [a] (-> (-> a (Maybe a)) a (List a))) (case (f x) - (#;Some x') + (#.Some x') (list& x (iterate' f x')) - #;None + #.None (list))) (def: #export (iterate f x) - {#;doc "Generates a list element by element until the function returns #;None."} + {#.doc "Generates a list element by element until the function returns #.None."} (All [a] (-> (-> a (Maybe a)) a (List a))) (case (f x) - (#;Some x') + (#.Some x') (list& x (iterate' f x')) - #;None + #.None (list x))) (def: #export (find p xs) - {#;doc "Returns the first value in the list for which the predicate is true."} + {#.doc "Returns the first value in the list for which the predicate is true."} (All [a] (-> (-> a Bool) (List a) (Maybe a))) (case xs - #;Nil - #;None + #.Nil + #.None - (#;Cons [x xs']) + (#.Cons [x xs']) (if (p x) - (#;Some x) + (#.Some x) (find p xs')))) (def: #export (interpose sep xs) - {#;doc "Puts a value between every two elements in the list."} + {#.doc "Puts a value between every two elements in the list."} (All [a] (-> a (List a) (List a))) (case xs - #;Nil + #.Nil xs - (#;Cons [x #;Nil]) + (#.Cons [x #.Nil]) xs - (#;Cons [x xs']) - (#;Cons [x (#;Cons [sep (interpose sep xs')])]))) + (#.Cons [x xs']) + (#.Cons [x (#.Cons [sep (interpose sep xs')])]))) (def: #export (size list) (All [a] (-> (List a) Nat)) @@ -206,10 +206,10 @@ (-> (-> a Bool) (List a) Bool)) (loop [xs xs] (case xs - #;Nil + #.Nil <init> - (#;Cons x xs') + (#.Cons x xs') (case (p x) <init> (recur xs') @@ -222,16 +222,16 @@ ) (def: #export (nth i xs) - {#;doc "Fetches the element at the specified index."} + {#.doc "Fetches the element at the specified index."} (All [a] (-> Nat (List a) (Maybe a))) (case xs - #;Nil - #;None + #.Nil + #.None - (#;Cons [x xs']) + (#.Cons [x xs']) (if (n/= +0 i) - (#;Some x) + (#.Some x) (nth (n/dec i) xs')))) ## [Structures] @@ -239,10 +239,10 @@ (All [a] (-> (Eq a) (Eq (List a)))) (def: (= xs ys) (case [xs ys] - [#;Nil #;Nil] + [#.Nil #.Nil] true - [(#;Cons x xs') (#;Cons y ys')] + [(#.Cons x xs') (#.Cons y ys')] (and (:: Eq<a> = x y) (= xs' ys')) @@ -252,19 +252,19 @@ (struct: #export Monoid<List> (All [a] (Monoid (List a))) - (def: identity #;Nil) + (def: identity #.Nil) (def: (compose xs ys) (case xs - #;Nil ys - (#;Cons x xs') (#;Cons x (compose xs' ys))))) + #.Nil ys + (#.Cons x xs') (#.Cons x (compose xs' ys))))) (open Monoid<List>) (struct: #export _ (Functor List) (def: (map f ma) (case ma - #;Nil #;Nil - (#;Cons a ma') (#;Cons (f a) (map f ma'))))) + #.Nil #.Nil + (#.Cons a ma') (#.Cons (f a) (map f ma'))))) (open Functor<List>) @@ -272,14 +272,14 @@ (def: functor Functor<List>) (def: (wrap a) - (#;Cons a #;Nil)) + (#.Cons a #.Nil)) (def: (apply ff fa) (case ff - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons f ff') + (#.Cons f ff') (compose (map f fa) (apply ff' fa))))) (struct: #export _ (Monad List) @@ -291,21 +291,21 @@ (def: #export (sort < xs) (All [a] (-> (-> a a Bool) (List a) (List a))) (case xs - #;Nil + #.Nil (list) - (#;Cons x xs') + (#.Cons x xs') (let [[pre post] (fold (function [x' [pre post]] (if (< x x') - [(#;Cons x' pre) post] - [pre (#;Cons x' post)])) + [(#.Cons x' pre) post] + [pre (#.Cons x' post)])) [(list) (list)] xs')] ($_ compose (sort < pre) (list x) (sort < post))))) (do-template [<name> <type> <comp> <inc>] [(def: #export (<name> from to) - {#;doc "Generates an inclusive interval of values [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)) @@ -318,26 +318,26 @@ (def: #export (empty? xs) (All [a] (-> (List a) Bool)) (case xs - #;Nil true + #.Nil true _ false)) (def: #export (member? eq xs x) (All [a] (-> (Eq a) (List a) a Bool)) (case xs - #;Nil false - (#;Cons x' xs') (or (:: eq = x x') + #.Nil false + (#.Cons x' xs') (or (:: eq = x x') (member? eq xs' x)))) (do-template [<name> <output> <side> <doc>] [(def: #export (<name> xs) - {#;doc <doc>} + {#.doc <doc>} (All [a] (-> (List a) (Maybe <output>))) (case xs - #;Nil - #;None + #.Nil + #.None - (#;Cons x xs') - (#;Some <side>)))] + (#.Cons x xs') + (#.Some <side>)))] [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."] @@ -346,15 +346,15 @@ ## [Syntax] (def: (symbol$ name) (-> Text Code) - [["" +0 +0] (#;Symbol "" name)]) + [["" +0 +0] (#.Symbol "" name)]) (macro: #export (zip tokens state) - {#;doc (doc "Create list zippers with the specified number of input lists." + {#.doc (doc "Create list zippers with the specified number of input lists." (def: #export zip2 (zip +2)) (def: #export zip3 (zip +3)) ((zip +3) xs ys zs))} (case tokens - (^ (list [_ (#;Nat num-lists)])) + (^ (list [_ (#.Nat num-lists)])) (if (n/> +0 num-lists) (let [(^open) Functor<List> indices (n/range +0 (n/dec num-lists)) @@ -369,36 +369,36 @@ (let [base (nat/encode idx)] [(symbol$ base) (symbol$ ("lux text concat" base "'"))])))) - pattern (` [(~@ (map (function [[v vs]] (` (#;Cons (~ v) (~ vs)))) + pattern (` [(~@ (map (function [[v vs]] (` (#.Cons (~ v) (~ vs)))) vars+lists))]) g!step (symbol$ "\tstep\t") g!blank (symbol$ "\t_\t") - list-vars (map product;right vars+lists) + list-vars (map product.right vars+lists) code (` (: (~ zip-type) (function (~ g!step) [(~@ list-vars)] (case [(~@ list-vars)] (~ pattern) - (#;Cons [(~@ (map product;left vars+lists))] + (#.Cons [(~@ (map product.left vars+lists))] ((~ g!step) (~@ list-vars))) (~ g!blank) - #;Nil))))] - (#;Right [state (list code)])) - (#;Left "Cannot zip 0 lists.")) + #.Nil))))] + (#.Right [state (list code)])) + (#.Left "Cannot zip 0 lists.")) _ - (#;Left "Wrong syntax for zip"))) + (#.Left "Wrong syntax for zip"))) (def: #export zip2 (zip +2)) (def: #export zip3 (zip +3)) (macro: #export (zip-with tokens state) - {#;doc (doc "Create list zippers 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))} (case tokens - (^ (list [_ (#;Nat num-lists)])) + (^ (list [_ (#.Nat num-lists)])) (if (n/> +0 num-lists) (let [(^open) Functor<List> indices (n/range +0 (n/dec num-lists)) @@ -416,25 +416,25 @@ (let [base (nat/encode idx)] [(symbol$ base) (symbol$ ("lux text concat" base "'"))])))) - pattern (` [(~@ (map (function [[v vs]] (` (#;Cons (~ v) (~ vs)))) + pattern (` [(~@ (map (function [[v vs]] (` (#.Cons (~ v) (~ vs)))) vars+lists))]) g!step (symbol$ "\tstep\t") g!blank (symbol$ "\t_\t") - list-vars (map product;right vars+lists) + list-vars (map product.right vars+lists) code (` (: (~ zip-type) (function (~ g!step) [(~ g!func) (~@ list-vars)] (case [(~@ list-vars)] (~ pattern) - (#;Cons ((~ g!func) (~@ (map product;left vars+lists))) + (#.Cons ((~ g!func) (~@ (map product.left vars+lists))) ((~ g!step) (~ g!func) (~@ list-vars))) (~ g!blank) - #;Nil))))] - (#;Right [state (list code)])) - (#;Left "Cannot zip-with 0 lists.")) + #.Nil))))] + (#.Right [state (list code)])) + (#.Left "Cannot zip-with 0 lists.")) _ - (#;Left "Wrong syntax for zip-with"))) + (#.Left "Wrong syntax for zip-with"))) (def: #export zip2-with (zip-with +2)) (def: #export zip3-with (zip-with +3)) @@ -442,34 +442,34 @@ (def: #export (last xs) (All [a] (-> (List a) (Maybe a))) (case xs - #;Nil - #;None + #.Nil + #.None - (#;Cons x #;Nil) - (#;Some x) + (#.Cons x #.Nil) + (#.Some x) - (#;Cons x xs') + (#.Cons x xs') (last xs'))) (def: #export (inits xs) - {#;doc "For a list of size N, returns the first N-1 elements. + {#.doc "For a list of size N, returns the first N-1 elements. - Empty lists will result in a #;None value being returned instead."} + Empty lists will result in a #.None value being returned instead."} (All [a] (-> (List a) (Maybe (List a)))) (case xs - #;Nil - #;None + #.Nil + #.None - (#;Cons x #;Nil) - (#;Some #;Nil) + (#.Cons x #.Nil) + (#.Some #.Nil) - (#;Cons x xs') + (#.Cons x xs') (case (inits xs') - #;None + #.None (undefined) - (#;Some tail) - (#;Some (#;Cons x tail))) + (#.Some tail) + (#.Some (#.Cons x tail))) )) (def: #export (concat xss) @@ -478,36 +478,36 @@ (struct: #export (ListT Monad<M>) (All [M] (-> (Monad M) (Monad (All [a] (M (List a)))))) - (def: applicative (applicative;compose (get@ #monad;applicative Monad<M>) Applicative<List>)) + (def: applicative (applicative.compose (get@ #monad.applicative Monad<M>) Applicative<List>)) (def: (join MlMla) (do Monad<M> [lMla MlMla lla (: (($ +0) (List (List ($ +1)))) - (monad;seq @ lMla)) - ## lla (monad;seq @ lMla) + (monad.seq @ lMla)) + ## lla (monad.seq @ lMla) ] (wrap (concat lla))))) (def: #export (lift Monad<M>) (All [M a] (-> (Monad M) (-> (M a) (M (List a))))) - (monad;lift Monad<M> (:: Monad<List> wrap))) + (monad.lift Monad<M> (:: Monad<List> wrap))) (def: (enumerate' idx xs) (All [a] (-> Nat (List a) (List [Nat a]))) (case xs - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons x xs') - (#;Cons [idx x] (enumerate' (n/inc idx) xs')))) + (#.Cons x xs') + (#.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."} + {#.doc "Pairs every element in the list with its index, starting at 0."} (All [a] (-> (List a) (List [Nat a]))) (enumerate' +0 xs)) (def: #export (indices size) - {#;doc "Produces all the valid indices for a given size."} + {#.doc "Produces all the valid indices for a given size."} (All [a] (-> Nat (List Nat))) (if (n/= +0 size) (list) diff --git a/stdlib/source/lux/data/coll/ordered/dict.lux b/stdlib/source/lux/data/coll/ordered/dict.lux index ecf661b15..b011bc366 100644 --- a/stdlib/source/lux/data/coll/ordered/dict.lux +++ b/stdlib/source/lux/data/coll/ordered/dict.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do Monad] eq @@ -41,7 +41,7 @@ (def: #export (new Order<k>) (All [k v] (-> (Order k) (Dict k v))) {#order Order<k> - #root #;None}) + #root #.None}) ## TODO: Doing inneficient access of Order functions due to compiler bug. ## TODO: Must improve it as soon as bug is fixed. @@ -51,14 +51,14 @@ ] (loop [node (get@ #root dict)] (case node - #;None - #;None + #.None + #.None - (#;Some node) + (#.Some node) (let [node-key (get@ #key node)] (cond (:: dict = node-key key) ## (T/= node-key key) - (#;Some (get@ #value node)) + (#.Some (get@ #value node)) (:: dict < node-key key) ## (T/< node-key key) @@ -74,10 +74,10 @@ ] (loop [node (get@ #root dict)] (case node - #;None + #.None false - (#;Some node) + (#.Some node) (let [node-key (get@ #key node)] (or (:: dict = node-key key) ## (T/= node-key key) @@ -90,16 +90,16 @@ [(def: #export (<name> dict) (All [k v] (-> (Dict k v) (Maybe v))) (case (get@ #root dict) - #;None - #;None + #.None + #.None - (#;Some node) + (#.Some node) (loop [node node] (case (get@ <side> node) - #;None - (#;Some (get@ #value node)) + #.None + (#.Some (get@ #value node)) - (#;Some side) + (#.Some side) (recur side)))))] [min #left] @@ -111,10 +111,10 @@ (All [k v] (-> (Dict k v) Nat)) (loop [node (get@ #root dict)] (case node - #;None + #.None +0 - (#;Some node) + (#.Some node) (n/inc (<op> (recur (get@ #left node)) (recur (get@ #right node)))))))] @@ -142,32 +142,32 @@ (with-expansions [<default-behavior> (as-is (black (get@ #key parent) (get@ #value parent) - (#;Some self) + (#.Some self) (get@ #right parent)))] (case (get@ #color self) #Red (case (get@ #left self) - (^multi (#;Some left) + (^multi (#.Some left) [(get@ #color left) #Red]) (red (get@ #key self) (get@ #value self) - (#;Some (blacken left)) - (#;Some (black (get@ #key parent) + (#.Some (blacken left)) + (#.Some (black (get@ #key parent) (get@ #value parent) (get@ #right self) (get@ #right parent)))) _ (case (get@ #right self) - (^multi (#;Some right) + (^multi (#.Some right) [(get@ #color right) #Red]) (red (get@ #key right) (get@ #value right) - (#;Some (black (get@ #key self) + (#.Some (black (get@ #key self) (get@ #value self) (get@ #left self) (get@ #left right))) - (#;Some (black (get@ #key parent) + (#.Some (black (get@ #key parent) (get@ #value parent) (get@ #right right) (get@ #right parent)))) @@ -185,31 +185,31 @@ [<default-behavior> (as-is (black (get@ #key parent) (get@ #value parent) (get@ #left parent) - (#;Some self)))] + (#.Some self)))] (case (get@ #color self) #Red (case (get@ #right self) - (^multi (#;Some right) + (^multi (#.Some right) [(get@ #color right) #Red]) (red (get@ #key self) (get@ #value self) - (#;Some (black (get@ #key parent) + (#.Some (black (get@ #key parent) (get@ #value parent) (get@ #left parent) (get@ #left self))) - (#;Some (blacken right))) + (#.Some (blacken right))) _ (case (get@ #left self) - (^multi (#;Some left) + (^multi (#.Some left) [(get@ #color left) #Red]) (red (get@ #key left) (get@ #value left) - (#;Some (black (get@ #key parent) + (#.Some (black (get@ #key parent) (get@ #value parent) (get@ #left parent) (get@ #left left))) - (#;Some (black (get@ #key self) + (#.Some (black (get@ #key self) (get@ #value self) (get@ #right left) (get@ #right self)))) @@ -225,7 +225,7 @@ (All [k v] (-> (Node k v) (Node k v) (Node k v))) (case (get@ #color center) #Red - (red (get@ #key center) (get@ #value center) (#;Some addition) (get@ #right center)) + (red (get@ #key center) (get@ #value center) (#.Some addition) (get@ #right center)) #Black (balance-left-add center addition) @@ -235,7 +235,7 @@ (All [k v] (-> (Node k v) (Node k v) (Node k v))) (case (get@ #color center) #Red - (red (get@ #key center) (get@ #value center) (get@ #left center) (#;Some addition)) + (red (get@ #key center) (get@ #value center) (get@ #left center) (#.Some addition)) #Black (balance-right-add center addition) @@ -246,10 +246,10 @@ (let [(^open "T/") (get@ #order dict) root' (loop [?root (get@ #root dict)] (case ?root - #;None - (#;Some (red key value #;None #;None)) + #.None + (#.Some (red key value #.None #.None)) - (#;Some root) + (#.Some root) (let [reference (get@ #key root)] (`` (cond (~~ (do-template [<comp> <tag> <add>] [(<comp> reference key) @@ -257,7 +257,7 @@ outcome (recur side-root)] (if (is side-root outcome) ?root - (#;Some (<add> (maybe;assume outcome) + (#.Some (<add> (maybe.assume outcome) root))))] [T/< #left add-left] @@ -273,27 +273,27 @@ (def: (left-balance key value ?left ?right) (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) (case ?left - (^multi (#;Some left) + (^multi (#.Some left) [(get@ #color left) #Red] - [(get@ #left left) (#;Some left.left)] - [(get@ #color left.left) #Red]) + [(get@ #left left) (#.Some left>>left)] + [(get@ #color left>>left) #Red]) (red (get@ #key left) (get@ #value left) - (#;Some (blacken left.left)) - (#;Some (black key value (get@ #right left) ?right))) + (#.Some (blacken left>>left)) + (#.Some (black key value (get@ #right left) ?right))) - (^multi (#;Some left) + (^multi (#.Some left) [(get@ #color left) #Red] - [(get@ #right left) (#;Some left.right)] - [(get@ #color left.right) #Red]) - (red (get@ #key left.right) - (get@ #value left.right) - (#;Some (black (get@ #key left) + [(get@ #right left) (#.Some left>>right)] + [(get@ #color left>>right) #Red]) + (red (get@ #key left>>right) + (get@ #value left>>right) + (#.Some (black (get@ #key left) (get@ #value left) (get@ #left left) - (get@ #left left.right))) - (#;Some (black key value - (get@ #right left.right) + (get@ #left left>>right))) + (#.Some (black key value + (get@ #right left>>right) ?right))) _ @@ -302,25 +302,25 @@ (def: (right-balance key value ?left ?right) (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) (case ?right - (^multi (#;Some right) + (^multi (#.Some right) [(get@ #color right) #Red] - [(get@ #right right) (#;Some right.right)] - [(get@ #color right.right) #Red]) + [(get@ #right right) (#.Some right>>right)] + [(get@ #color right>>right) #Red]) (red (get@ #key right) (get@ #value right) - (#;Some (black key value ?left (get@ #left right))) - (#;Some (blacken right.right))) + (#.Some (black key value ?left (get@ #left right))) + (#.Some (blacken right>>right))) - (^multi (#;Some right) + (^multi (#.Some right) [(get@ #color right) #Red] - [(get@ #left right) (#;Some right.left)] - [(get@ #color right.left) #Red]) - (red (get@ #key right.left) - (get@ #value right.left) - (#;Some (black key value ?left (get@ #left right.left))) - (#;Some (black (get@ #key right) + [(get@ #left right) (#.Some right>>left)] + [(get@ #color right>>left) #Red]) + (red (get@ #key right>>left) + (get@ #value right>>left) + (#.Some (black key value ?left (get@ #left right>>left))) + (#.Some (black (get@ #key right) (get@ #value right) - (get@ #right right.left) + (get@ #right right>>left) (get@ #right right)))) _ @@ -329,27 +329,27 @@ (def: (balance-left-remove key value ?left ?right) (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) (case ?left - (^multi (#;Some left) + (^multi (#.Some left) [(get@ #color left) #Red]) - (red key value (#;Some (blacken left)) ?right) + (red key value (#.Some (blacken left)) ?right) _ (case ?right - (^multi (#;Some right) + (^multi (#.Some right) [(get@ #color right) #Black]) - (right-balance key value ?left (#;Some (redden right))) + (right-balance key value ?left (#.Some (redden right))) - (^multi (#;Some right) + (^multi (#.Some right) [(get@ #color right) #Red] - [(get@ #left right) (#;Some right.left)] - [(get@ #color right.left) #Black]) - (red (get@ #key right.left) - (get@ #value right.left) - (#;Some (black key value ?left (get@ #left right.left))) - (#;Some (right-balance (get@ #key right) + [(get@ #left right) (#.Some right>>left)] + [(get@ #color right>>left) #Black]) + (red (get@ #key right>>left) + (get@ #value right>>left) + (#.Some (black key value ?left (get@ #left right>>left))) + (#.Some (right-balance (get@ #key right) (get@ #value right) - (get@ #right right.left) - (:: maybe;Functor<Maybe> map redden (get@ #right right))))) + (get@ #right right>>left) + (:: maybe.Functor<Maybe> map redden (get@ #right right))))) _ (error! error-message)) @@ -358,27 +358,27 @@ (def: (balance-right-remove key value ?left ?right) (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) (case ?right - (^multi (#;Some right) + (^multi (#.Some right) [(get@ #color right) #Red]) - (red key value ?left (#;Some (blacken right))) + (red key value ?left (#.Some (blacken right))) _ (case ?left - (^multi (#;Some left) + (^multi (#.Some left) [(get@ #color left) #Black]) - (left-balance key value (#;Some (redden left)) ?right) + (left-balance key value (#.Some (redden left)) ?right) - (^multi (#;Some left) + (^multi (#.Some left) [(get@ #color left) #Red] - [(get@ #right left) (#;Some left.right)] - [(get@ #color left.right) #Black]) - (red (get@ #key left.right) - (get@ #value left.right) - (#;Some (left-balance (get@ #key left) + [(get@ #right left) (#.Some left>>right)] + [(get@ #color left>>right) #Black]) + (red (get@ #key left>>right) + (get@ #value left>>right) + (#.Some (left-balance (get@ #key left) (get@ #value left) - (:: maybe;Functor<Maybe> map redden (get@ #left left)) - (get@ #left left.right))) - (#;Some (black key value (get@ #right left.right) ?right))) + (:: maybe.Functor<Maybe> map redden (get@ #left left)) + (get@ #left left>>right))) + (#.Some (black key value (get@ #right left>>right) ?right))) _ (error! error-message) @@ -387,26 +387,26 @@ (def: (prepend ?left ?right) (All [k v] (-> (Maybe (Node k v)) (Maybe (Node k v)) (Maybe (Node k v)))) (case [?left ?right] - [#;None _] + [#.None _] ?right - [_ #;None] + [_ #.None] ?left - [(#;Some left) (#;Some right)] + [(#.Some left) (#.Some right)] (case [(get@ #color left) (get@ #color right)] [#Red #Red] - (do maybe;Monad<Maybe> + (do maybe.Monad<Maybe> [fused (prepend (get@ #right left) (get@ #right right))] (case (get@ #color fused) #Red (wrap (red (get@ #key fused) (get@ #value fused) - (#;Some (red (get@ #key left) + (#.Some (red (get@ #key left) (get@ #value left) (get@ #left left) (get@ #left fused))) - (#;Some (red (get@ #key right) + (#.Some (red (get@ #key right) (get@ #value right) (get@ #right fused) (get@ #right right))))) @@ -415,37 +415,37 @@ (wrap (red (get@ #key left) (get@ #value left) (get@ #left left) - (#;Some (red (get@ #key right) + (#.Some (red (get@ #key right) (get@ #value right) - (#;Some fused) + (#.Some fused) (get@ #right right))))))) [#Red #Black] - (#;Some (red (get@ #key left) + (#.Some (red (get@ #key left) (get@ #value left) (get@ #left left) (prepend (get@ #right left) ?right))) [#Black #Red] - (#;Some (red (get@ #key right) + (#.Some (red (get@ #key right) (get@ #value right) (prepend ?left (get@ #left right)) (get@ #right right))) [#Black #Black] - (do maybe;Monad<Maybe> + (do maybe.Monad<Maybe> [fused (prepend (get@ #right left) (get@ #left right))] (case (get@ #color fused) #Red (wrap (red (get@ #key fused) (get@ #value fused) - (#;Some (black (get@ #key left) + (#.Some (black (get@ #key left) (get@ #value left) (get@ #left left) (get@ #left fused))) - (#;Some (black (get@ #key right) + (#.Some (black (get@ #key right) (get@ #value right) (get@ #right fused) (get@ #right right))))) @@ -454,9 +454,9 @@ (wrap (balance-left-remove (get@ #key left) (get@ #value left) (get@ #left left) - (#;Some (black (get@ #key right) + (#.Some (black (get@ #key right) (get@ #value right) - (#;Some fused) + (#.Some fused) (get@ #right right))))) )) ))) @@ -466,10 +466,10 @@ (let [(^open "T/") (get@ #order dict) [?root found?] (loop [?root (get@ #root dict)] (case ?root - #;None - [#;None false] + #.None + [#.None false] - (#;Some root) + (#.Some root) (let [root-key (get@ #key root) root-val (get@ #value root)] (if (T/= root-key key) @@ -480,40 +480,40 @@ (case (recur (if go-left? (get@ #left root) (get@ #right root))) - [#;None false] - [#;None false] + [#.None false] + [#.None false] [side-outcome _] (if go-left? (case (get@ #left root) - (^multi (#;Some left) + (^multi (#.Some left) [(get@ #color left) #Black]) - [(#;Some (balance-left-remove root-key root-val side-outcome (get@ #right root))) + [(#.Some (balance-left-remove root-key root-val side-outcome (get@ #right root))) false] _ - [(#;Some (red root-key root-val side-outcome (get@ #right root))) + [(#.Some (red root-key root-val side-outcome (get@ #right root))) false]) (case (get@ #right root) - (^multi (#;Some right) + (^multi (#.Some right) [(get@ #color right) #Black]) - [(#;Some (balance-right-remove root-key root-val (get@ #left root) side-outcome)) + [(#.Some (balance-right-remove root-key root-val (get@ #left root) side-outcome)) false] _ - [(#;Some (red root-key root-val (get@ #left root) side-outcome)) + [(#.Some (red root-key root-val (get@ #left root) side-outcome)) false]) ))) )) ))] (case ?root - #;None + #.None (if found? (set@ #root ?root dict) dict) - (#;Some root) - (set@ #root (#;Some (blacken root)) dict) + (#.Some root) + (set@ #root (#.Some (blacken root)) dict) ))) (def: #export (from-list Order<l> list) @@ -528,10 +528,10 @@ (All [k v] (-> (Dict k v) (List <type>))) (loop [node (get@ #root dict)] (case node - #;None + #.None (list) - (#;Some node') + (#.Some node') ($_ L/compose (recur (get@ #left node')) (list <output>) @@ -548,10 +548,10 @@ (loop [entriesR (entries reference) entriesS (entries sample)] (case [entriesR entriesS] - [#;Nil #;Nil] + [#.Nil #.Nil] true - [(#;Cons [keyR valueR] entriesR') (#;Cons [keyS valueS] entriesS')] + [(#.Cons [keyR valueR] entriesR') (#.Cons [keyS valueS] entriesS')] (and (:: Eq<k> = keyR keyS) (:: Eq<v> = valueR valueS) (recur entriesR' entriesS')) diff --git a/stdlib/source/lux/data/coll/ordered/set.lux b/stdlib/source/lux/data/coll/ordered/set.lux index a8f5ed45d..5d6ba5478 100644 --- a/stdlib/source/lux/data/coll/ordered/set.lux +++ b/stdlib/source/lux/data/coll/ordered/set.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do Monad] eq @@ -12,23 +12,23 @@ ["s" syntax #+ syntax: Syntax]))) (type: #export (Set a) - (d;Dict a a)) + (d.Dict a a)) (def: #export new (All [a] (-> (Order a) (Set a))) - d;new) + d.new) (def: #export (member? set elem) (All [a] (-> (Set a) a Bool)) - (d;contains? elem set)) + (d.contains? elem set)) (do-template [<name> <alias>] [(def: #export (<name> set) (All [a] (-> (Set a) (Maybe a))) (<alias> set))] - [min d;min] - [max d;max] + [min d.min] + [max d.max] ) (do-template [<name> <alias>] @@ -36,17 +36,17 @@ (All [a] (-> (Set a) Nat)) (<alias> set))] - [size d;size] - [depth d;depth] + [size d.size] + [depth d.depth] ) (def: #export (add elem set) (All [a] (-> a (Set a) (Set a))) - (d;put elem elem set)) + (d.put elem elem set)) (def: #export (remove elem set) (All [a] (-> a (Set a) (Set a))) - (d;remove elem set)) + (d.remove elem set)) (def: #export (from-list Order<a> list) (All [a] (-> (Order a) (List a) (Set a))) @@ -54,7 +54,7 @@ (def: #export (to-list set) (All [a] (-> (Set a) (List a))) - (d;keys set)) + (d.keys set)) (def: #export (union left right) (All [a] (-> (Set a) (Set a) (Set a))) @@ -63,18 +63,18 @@ (def: #export (intersection left right) (All [a] (-> (Set a) (Set a) (Set a))) (|> (to-list right) - (list;filter (member? left)) - (from-list (get@ #d;order right)))) + (list.filter (member? left)) + (from-list (get@ #d.order right)))) (def: #export (difference param subject) (All [a] (-> (Set a) (Set a) (Set a))) (|> (to-list subject) - (list;filter (|>> (member? param) not)) - (from-list (get@ #d;order subject)))) + (list.filter (|>> (member? param) not)) + (from-list (get@ #d.order subject)))) (def: #export (sub? super sub) (All [a] (-> (Set a) (Set a) Bool)) - (list;every? (member? super) (to-list sub))) + (list.every? (member? super) (to-list sub))) (def: #export (super? sub super) (All [a] (-> (Set a) (Set a) Bool)) @@ -82,5 +82,5 @@ (struct: #export Eq<Set> (All [a] (Eq (Set a))) (def: (= reference sample) - (:: (list;Eq<List> (:: sample eq)) + (:: (list.Eq<List> (:: sample eq)) = (to-list reference) (to-list sample)))) diff --git a/stdlib/source/lux/data/coll/priority-queue.lux b/stdlib/source/lux/data/coll/priority-queue.lux index 5e270518d..833d3b3e1 100644 --- a/stdlib/source/lux/data/coll/priority-queue.lux +++ b/stdlib/source/lux/data/coll/priority-queue.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [eq #+ Eq] [monad #+ do Monad]) @@ -9,94 +9,94 @@ (type: #export Priority Nat) (type: #export (Queue a) - (Maybe (F;Fingers Priority a))) + (Maybe (F.Fingers Priority a))) (def: max-priority Priority ("lux nat max")) (def: min-priority Priority ("lux nat min")) (def: #export empty Queue - #;None) + #.None) (def: #export (peek queue) (All [a] (-> (Queue a) (Maybe a))) - (do maybe;Monad<Maybe> + (do maybe.Monad<Maybe> [fingers queue] - (wrap (maybe;assume (F;search (n/= (F;tag fingers)) fingers))))) + (wrap (maybe.assume (F.search (n/= (F.tag fingers)) fingers))))) (def: #export (size queue) (All [a] (-> (Queue a) Nat)) (case queue - #;None + #.None +0 - (#;Some fingers) - (loop [node (get@ #F;tree fingers)] + (#.Some fingers) + (loop [node (get@ #F.tree fingers)] (case node - (#F;Leaf _ _) + (#F.Leaf _ _) +1 - (#F;Branch _ left right) + (#F.Branch _ left right) (n/+ (recur left) (recur right)))))) (def: #export (member? Eq<a> queue member) (All [a] (-> (Eq a) (Queue a) a Bool)) (case queue - #;None + #.None false - (#;Some fingers) - (loop [node (get@ #F;tree fingers)] + (#.Some fingers) + (loop [node (get@ #F.tree fingers)] (case node - (#F;Leaf _ reference) + (#F.Leaf _ reference) (:: Eq<a> = reference member) - (#F;Branch _ left right) + (#F.Branch _ left right) (or (recur left) (recur right)))))) (def: #export (pop queue) (All [a] (-> (Queue a) (Queue a))) - (do maybe;Monad<Maybe> + (do maybe.Monad<Maybe> [fingers queue - #let [highest-priority (F;tag fingers)] - node' (loop [node (get@ #F;tree fingers)] + #let [highest-priority (F.tag fingers)] + node' (loop [node (get@ #F.tree fingers)] (case node - (#F;Leaf priority reference) + (#F.Leaf priority reference) (if (n/= highest-priority priority) - #;None - (#;Some node)) + #.None + (#.Some node)) - (#F;Branch priority left right) - (if (n/= highest-priority (F;tag (set@ #F;tree left fingers))) + (#F.Branch priority left right) + (if (n/= highest-priority (F.tag (set@ #F.tree left fingers))) (case (recur left) - #;None - (#;Some right) - - (#;Some =left) - (|> (F;branch (set@ #F;tree =left fingers) - (set@ #F;tree right fingers)) - (get@ #F;tree) - #;Some)) + #.None + (#.Some right) + + (#.Some =left) + (|> (F.branch (set@ #F.tree =left fingers) + (set@ #F.tree right fingers)) + (get@ #F.tree) + #.Some)) (case (recur right) - #;None - (#;Some left) - - (#;Some =right) - (|> (F;branch (set@ #F;tree left fingers) - (set@ #F;tree =right fingers)) - (get@ #F;tree) - #;Some)) + #.None + (#.Some left) + + (#.Some =right) + (|> (F.branch (set@ #F.tree left fingers) + (set@ #F.tree =right fingers)) + (get@ #F.tree) + #.Some)) )))] - (wrap (set@ #F;tree node' fingers)))) + (wrap (set@ #F.tree node' fingers)))) (def: #export (push priority value queue) (All [a] (-> Priority a (Queue a) (Queue a))) - (let [addition {#F;monoid number;Max@Monoid<Nat> - #F;tree (#F;Leaf priority value)}] + (let [addition {#F.monoid number.Max@Monoid<Nat> + #F.tree (#F.Leaf priority value)}] (case queue - #;None - (#;Some addition) + #.None + (#.Some addition) - (#;Some fingers) - (#;Some (F;branch fingers addition))))) + (#.Some fingers) + (#.Some (F.branch fingers addition))))) diff --git a/stdlib/source/lux/data/coll/queue.lux b/stdlib/source/lux/data/coll/queue.lux index 2d45dd995..2f48d3035 100644 --- a/stdlib/source/lux/data/coll/queue.lux +++ b/stdlib/source/lux/data/coll/queue.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [eq #+ Eq] ["F" functor]) @@ -21,27 +21,27 @@ (def: #export (to-list queue) (All [a] (-> (Queue a) (List a))) (let [(^slots [#front #rear]) queue] - (L/compose front (list;reverse rear)))) + (L/compose front (list.reverse rear)))) (def: #export peek (All [a] (-> (Queue a) (Maybe a))) - (|>> (get@ #front) list;head)) + (|>> (get@ #front) list.head)) (def: #export (size queue) (All [a] (-> (Queue a) Nat)) (let [(^slots [#front #rear]) queue] - (n/+ (list;size front) - (list;size rear)))) + (n/+ (list.size front) + (list.size rear)))) (def: #export empty? (All [a] (-> (Queue a) Bool)) - (|>> (get@ #front) list;empty?)) + (|>> (get@ #front) list.empty?)) (def: #export (member? Eq<a> queue member) (All [a] (-> (Eq a) (Queue a) a Bool)) (let [(^slots [#front #rear]) queue] - (or (list;member? Eq<a> front member) - (list;member? Eq<a> rear member)))) + (or (list.member? Eq<a> front member) + (list.member? Eq<a> rear member)))) (def: #export (pop queue) (All [a] (-> (Queue a) (Queue a))) @@ -51,7 +51,7 @@ (^ (list _)) ## Front has dried up... (|> queue - (set@ #front (list;reverse (get@ #rear queue))) + (set@ #front (list.reverse (get@ #rear queue))) (set@ #rear (list))) (^ (list& _ front')) ## Consume front! @@ -61,18 +61,18 @@ (def: #export (push val queue) (All [a] (-> a (Queue a) (Queue a))) (case (get@ #front queue) - #;Nil + #.Nil (set@ #front (list val) queue) _ - (update@ #rear (|>> (#;Cons val)) queue))) + (update@ #rear (|>> (#.Cons val)) queue))) (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)))) + (:: (list.Eq<List> Eq<a>) = (to-list qx) (to-list qy)))) -(struct: #export _ (F;Functor Queue) +(struct: #export _ (F.Functor Queue) (def: (map f fa) {#front (|> fa (get@ #front) (L/map f)) #rear (|> fa (get@ #rear) (L/map f))})) diff --git a/stdlib/source/lux/data/coll/sequence.lux b/stdlib/source/lux/data/coll/sequence.lux index b97a51450..e5d2717fc 100644 --- a/stdlib/source/lux/data/coll/sequence.lux +++ b/stdlib/source/lux/data/coll/sequence.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [functor #+ Functor] [applicative #+ Applicative] @@ -48,7 +48,7 @@ (def: full-node-size Nat - (bit;shift-left branching-exponent +1)) + (bit.shift-left branching-exponent +1)) (def: branch-idx-mask Nat @@ -56,19 +56,19 @@ (def: branch-idx (-> Index Index) - (bit;and branch-idx-mask)) + (bit.and branch-idx-mask)) (def: (new-hierarchy _) (All [a] (-> Top (Hierarchy a))) - (array;new full-node-size)) + (array.new full-node-size)) (def: (tail-off vec-size) (-> Nat Nat) (if (n/< full-node-size vec-size) +0 (|> (n/dec vec-size) - (bit;shift-right branching-exponent) - (bit;shift-left branching-exponent)))) + (bit.shift-right branching-exponent) + (bit.shift-left branching-exponent)))) (def: (new-path level tail) (All [a] (-> Level (Base a) (Node a))) @@ -77,61 +77,61 @@ (|> ## (new-hierarchy []) (: (Hierarchy ($ +0)) (new-hierarchy [])) - (array;write +0 (new-path (level-down level) tail)) + (array.write +0 (new-path (level-down level) tail)) #Hierarchy))) (def: (new-tail singleton) (All [a] (-> a (Base a))) - (|> ## (array;new +1) + (|> ## (array.new +1) (: (Base ($ +0)) - (array;new +1)) - (array;write +0 singleton))) + (array.new +1)) + (array.write +0 singleton))) (def: (push-tail size level tail parent) (All [a] (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a))) - (let [sub-idx (branch-idx (bit;shift-right level (n/dec size))) + (let [sub-idx (branch-idx (bit.shift-right level (n/dec size))) ## If we're currently on a bottom node sub-node (if (n/= branching-exponent level) ## 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 + #.None (new-path (level-down level) tail) ## If not, push the tail onto the sub-node. - (#;Some (#Hierarchy sub-node)) + (#.Some (#Hierarchy sub-node)) (#Hierarchy (push-tail size (level-down level) tail sub-node)) _ (undefined)) )] - (|> (array;clone parent) - (array;write sub-idx sub-node)))) + (|> (array.clone parent) + (array.write sub-idx sub-node)))) (def: (expand-tail val tail) (All [a] (-> a (Base a) (Base a))) - (let [tail-size (array;size tail)] - (|> ## (array;new (n/inc tail-size)) + (let [tail-size (array.size tail)] + (|> ## (array.new (n/inc tail-size)) (: (Base ($ +0)) - (array;new (n/inc tail-size))) - (array;copy tail-size +0 tail +0) - (array;write tail-size val) + (array.new (n/inc tail-size))) + (array.copy tail-size +0 tail +0) + (array.write tail-size val) ))) (def: (put' level idx val hierarchy) (All [a] (-> Level Index a (Hierarchy a) (Hierarchy a))) - (let [sub-idx (branch-idx (bit;shift-right level idx))] - (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)))) + (let [sub-idx (branch-idx (bit.shift-right level idx))] + (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)))) - (^multi (#;Some (#Base base)) + (^multi (#.Some (#Base base)) (n/= +0 (level-down level))) - (|> (array;clone hierarchy) - (array;write sub-idx (|> (array;clone base) - (array;write (branch-idx idx) val) + (|> (array.clone hierarchy) + (array.write sub-idx (|> (array.clone base) + (array.write (branch-idx idx) val) #Base))) _ @@ -139,41 +139,41 @@ (def: (pop-tail size level hierarchy) (All [a] (-> Nat Level (Hierarchy a) (Maybe (Hierarchy a)))) - (let [sub-idx (branch-idx (bit;shift-right level (n/- +2 size)))] + (let [sub-idx (branch-idx (bit.shift-right level (n/- +2 size)))] (cond (n/= +0 sub-idx) - #;None + #.None (n/> branching-exponent level) - (do maybe;Monad<Maybe> - [base|hierarchy (array;read sub-idx hierarchy) + (do maybe.Monad<Maybe> + [base|hierarchy (array.read sub-idx hierarchy) sub (case base|hierarchy (#Hierarchy sub) (pop-tail size (level-down level) sub) (#Base _) (undefined))] - (|> (array;clone hierarchy) - (array;write sub-idx (#Hierarchy sub)) - #;Some)) + (|> (array.clone hierarchy) + (array.write sub-idx (#Hierarchy sub)) + #.Some)) ## Else... - (|> (array;clone hierarchy) - (array;delete sub-idx) - #;Some) + (|> (array.clone hierarchy) + (array.delete sub-idx) + #.Some) ))) (def: (to-list' node) (All [a] (-> (Node a) (List a))) (case node (#Base base) - (array;to-list base) + (array.to-list base) (#Hierarchy hierarchy) (|> hierarchy - array;to-list - list;reverse + array.to-list + list.reverse (list/fold (function [sub acc] (list/compose (to-list' sub) acc)) - #;Nil)))) + #.Nil)))) ## [Types] (type: #export (Sequence a) @@ -187,8 +187,8 @@ Sequence {#level (level-up root-level) #size +0 - #root (array;new full-node-size) - #tail (array;new +0)}) + #root (array.new full-node-size) + #tail (array.new +0)}) (def: #export (size sequence) (All [a] (-> (Sequence a) Nat)) @@ -206,16 +206,16 @@ ## Otherwise, push tail into the tree ## -------------------------------------------------------- ## Will the root experience an overflow with this addition? - (|> (if (n/> (bit;shift-left (get@ #level vec) +1) - (bit;shift-right branching-exponent vec-size)) + (|> (if (n/> (bit.shift-left (get@ #level vec) +1) + (bit.shift-right branching-exponent vec-size)) ## If so, a brand-new root must be established, that is ## 1-level taller. (|> vec (set@ #root (|> ## (new-hierarchy []) (: (Hierarchy ($ +0)) (new-hierarchy [])) - (array;write +0 (#Hierarchy (get@ #root vec))) - (array;write +1 (new-path (get@ #level vec) (get@ #tail vec))))) + (array.write +0 (#Hierarchy (get@ #root vec))) + (array.write +1 (new-path (get@ #level vec) (get@ #tail vec))))) (update@ #level level-up)) ## Otherwise, just push the current tail onto the root. (|> vec @@ -232,29 +232,29 @@ (if (and (n/>= +0 idx) (n/< vec-size idx)) (if (n/>= (tail-off vec-size) idx) - (#;Some (get@ #tail vec)) + (#.Some (get@ #tail vec)) (loop [level (get@ #level vec) hierarchy (get@ #root vec)] (case [(n/> branching-exponent level) - (array;read (branch-idx (bit;shift-right level idx)) hierarchy)] - [true (#;Some (#Hierarchy sub))] + (array.read (branch-idx (bit.shift-right level idx)) hierarchy)] + [true (#.Some (#Hierarchy sub))] (recur (level-down level) sub) - [false (#;Some (#Base base))] - (#;Some base) + [false (#.Some (#Base base))] + (#.Some base) - [_ #;None] - #;None + [_ #.None] + #.None _ (error! "Incorrect sequence structure.")))) - #;None))) + #.None))) (def: #export (nth idx vec) (All [a] (-> Nat (Sequence a) (Maybe a))) - (do maybe;Monad<Maybe> + (do maybe.Monad<Maybe> [base (base-for idx vec)] - (array;read (branch-idx idx) base))) + (array.read (branch-idx idx) base))) (def: #export (put idx val vec) (All [a] (-> Nat a (Sequence a) (Sequence a))) @@ -263,9 +263,9 @@ (n/< vec-size idx)) (if (n/>= (tail-off vec-size) idx) (|> vec - ## (update@ #tail (|>> array;clone (array;write (branch-idx idx) val))) + ## (update@ #tail (|>> array.clone (array.write (branch-idx idx) val))) (update@ #tail (: (-> (Base ($ +0)) (Base ($ +0))) - (|>> array;clone (array;write (branch-idx idx) val)))) + (|>> array.clone (array.write (branch-idx idx) val)))) ) (|> vec (update@ #root (put' (get@ #level vec) idx val)))) @@ -274,10 +274,10 @@ (def: #export (update idx f vec) (All [a] (-> Nat (-> a a) (Sequence a) (Sequence a))) (case (nth idx vec) - (#;Some val) + (#.Some val) (put idx (f val) vec) - #;None + #.None vec)) (def: #export (pop vec) @@ -292,28 +292,28 @@ vec-size (if (|> vec-size (n/- (tail-off vec-size)) (n/> +1)) (let [old-tail (get@ #tail vec) - new-tail-size (n/dec (array;size old-tail))] + new-tail-size (n/dec (array.size old-tail))] (|> vec (update@ #size n/dec) - (set@ #tail (|> (array;new new-tail-size) - (array;copy new-tail-size +0 old-tail +0))))) - (maybe;assume - (do maybe;Monad<Maybe> + (set@ #tail (|> (array.new new-tail-size) + (array.copy new-tail-size +0 old-tail +0))))) + (maybe.assume + (do maybe.Monad<Maybe> [new-tail (base-for (n/- +2 vec-size) vec) #let [## [level' root'] (let [init-level (get@ #level vec)] ## (loop [level init-level - ## root (maybe;default (new-hierarchy []) + ## root (maybe.default (new-hierarchy []) ## (pop-tail vec-size init-level (get@ #root vec))) ## ## root (: (Hierarchy ($ +0)) - ## ## (maybe;default (new-hierarchy []) + ## ## (maybe.default (new-hierarchy []) ## ## (pop-tail vec-size init-level (get@ #root vec)))) ## ] ## (if (n/> branching-exponent level) - ## (case [(array;read +1 root) (array;read +0 root)] - ## [#;None (#;Some (#Hierarchy sub-node))] + ## (case [(array.read +1 root) (array.read +0 root)] + ## [#.None (#.Some (#Hierarchy sub-node))] ## (recur (level-down level) sub-node) - ## ## [#;None (#;Some (#Base _))] + ## ## [#.None (#.Some (#Base _))] ## ## (undefined) ## _ @@ -323,14 +323,14 @@ (let [init-level (get@ #level vec)] (loop [level init-level root (: (Hierarchy ($ +0)) - (maybe;default (new-hierarchy []) + (maybe.default (new-hierarchy []) (pop-tail vec-size init-level (get@ #root vec))))] (if (n/> branching-exponent level) - (case [(array;read +1 root) (array;read +0 root)] - [#;None (#;Some (#Hierarchy sub-node))] + (case [(array.read +1 root) (array.read +0 root)] + [#.None (#.Some (#Hierarchy sub-node))] (recur (level-down level) sub-node) - [#;None (#;Some (#Base _))] + [#.None (#.Some (#Base _))] (undefined) _ @@ -359,15 +359,15 @@ (def: #export (member? a/Eq vec val) (All [a] (-> (Eq a) (Sequence a) a Bool)) - (list;member? a/Eq (to-list vec) val)) + (list.member? a/Eq (to-list vec) val)) (def: #export empty? (All [a] (-> (Sequence a) Bool)) (|>> (get@ #size) (n/= +0))) ## [Syntax] -(syntax: #export (sequence [elems (p;some s;any)]) - {#;doc (doc "Sequence literals." +(syntax: #export (sequence [elems (p.some s.any)]) + {#.doc (doc "Sequence literals." (sequence 10 20 30 40))} (wrap (list (` (from-list (list (~@ elems))))))) @@ -376,10 +376,10 @@ (def: (= v1 v2) (case [v1 v2] [(#Base b1) (#Base b2)] - (:: (array;Eq<Array> Eq<a>) = b1 b2) + (:: (array.Eq<Array> Eq<a>) = b1 b2) [(#Hierarchy h1) (#Hierarchy h2)] - (:: (array;Eq<Array> (Eq<Node> Eq<a>)) = h1 h2) + (:: (array.Eq<Array> (Eq<Node> Eq<a>)) = h1 h2) _ false))) diff --git a/stdlib/source/lux/data/coll/set.lux b/stdlib/source/lux/data/coll/set.lux index b8f860353..a08b16d39 100644 --- a/stdlib/source/lux/data/coll/set.lux +++ b/stdlib/source/lux/data/coll/set.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [eq #+ Eq] [hash #*]) @@ -7,28 +7,28 @@ ## [Types] (type: #export (Set a) - (dict;Dict a a)) + (dict.Dict a a)) ## [Values] (def: #export (new Hash<a>) (All [a] (-> (Hash a) (Set a))) - (dict;new Hash<a>)) + (dict.new Hash<a>)) (def: #export (add elem set) (All [a] (-> a (Set a) (Set a))) - (dict;put elem elem set)) + (dict.put elem elem set)) (def: #export (remove elem set) (All [a] (-> a (Set a) (Set a))) - (dict;remove elem set)) + (dict.remove elem set)) (def: #export (member? set elem) (All [a] (-> (Set a) a Bool)) - (dict;contains? elem set)) + (dict.contains? elem set)) (def: #export to-list (All [a] (-> (Set a) (List a))) - dict;keys) + dict.keys) (def: #export (from-list Hash<a> xs) (All [a] (-> (Hash a) (List a) (Set a))) @@ -36,7 +36,7 @@ (def: #export (union xs yx) (All [a] (-> (Set a) (Set a) (Set a))) - (dict;merge xs yx)) + (dict.merge xs yx)) (def: #export (difference sub base) (All [a] (-> (Set a) (Set a) (Set a))) @@ -44,19 +44,19 @@ (def: #export (intersection filter base) (All [a] (-> (Set a) (Set a) (Set a))) - (dict;select (dict;keys filter) base)) + (dict.select (dict.keys filter) base)) (def: #export (size set) (All [a] (-> (Set a) Nat)) - (dict;size set)) + (dict.size set)) (def: #export (empty? set) (All [a] (-> (Set a) Bool)) - (n/= +0 (dict;size set))) + (n/= +0 (dict.size set))) (def: #export (sub? super sub) (All [a] (-> (Set a) (Set a) Bool)) - (list;every? (member? super) (to-list sub))) + (list.every? (member? super) (to-list sub))) (def: #export (super? sub super) (All [a] (-> (Set a) (Set a) Bool)) @@ -65,7 +65,7 @@ ## [Structures] (struct: #export Eq<Set> (All [a] (Eq (Set a))) (def: (= (^@ test [Hash<a> _]) subject) - (:: (list;Eq<List> (get@ #hash;eq Hash<a>)) = (to-list test) (to-list subject)))) + (:: (list.Eq<List> (get@ #hash.eq Hash<a>)) = (to-list test) (to-list subject)))) (struct: #export Hash<Set> (All [a] (Hash (Set a))) (def: eq Eq<Set>) diff --git a/stdlib/source/lux/data/coll/stack.lux b/stdlib/source/lux/data/coll/stack.lux index 6dbb8b817..8f93bdb69 100644 --- a/stdlib/source/lux/data/coll/stack.lux +++ b/stdlib/source/lux/data/coll/stack.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (data (coll [list])))) @@ -13,30 +13,30 @@ (def: #export (size stack) (All [a] (-> (Stack a) Nat)) - (list;size stack)) + (list.size stack)) (def: #export (empty? stack) (All [a] (-> (Stack a) Bool)) - (list;empty? stack)) + (list.empty? stack)) (def: #export (peek stack) (All [a] (-> (Stack a) (Maybe a))) (case stack - #;Nil - #;None + #.Nil + #.None - (#;Cons value _) - (#;Some value))) + (#.Cons value _) + (#.Some value))) (def: #export (pop stack) (All [a] (-> (Stack a) (Stack a))) (case stack - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons _ stack') + (#.Cons _ stack') stack')) (def: #export (push value stack) (All [a] (-> a (Stack a) (Stack a))) - (#;Cons value stack)) + (#.Cons value stack)) diff --git a/stdlib/source/lux/data/coll/stream.lux b/stdlib/source/lux/data/coll/stream.lux index 0f1297e8f..0cfa549bb 100644 --- a/stdlib/source/lux/data/coll/stream.lux +++ b/stdlib/source/lux/data/coll/stream.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control functor monad @@ -12,7 +12,7 @@ ## [Types] (type: #export (Stream a) - {#;doc "An infinite stream of values."} + {#.doc "An infinite stream of values."} (Cont [a (Stream a)])) ## [Utils] @@ -20,36 +20,36 @@ (All [a] (-> a (List a) a (List a) (Stream a))) (case xs - #;Nil (pending [x (cycle' init full init full)]) - (#;Cons x' xs') (pending [x (cycle' x' xs' init full)]))) + #.Nil (pending [x (cycle' init full init full)]) + (#.Cons x' xs') (pending [x (cycle' x' xs' init full)]))) ## [Functions] (def: #export (iterate f x) - {#;doc "Create a stream by applying a function to a value, and to its result, on and on..."} + {#.doc "Create a stream by applying a function to a value, and to its result, on and on..."} (All [a] (-> (-> a a) a (Stream a))) (pending [x (iterate f (f x))])) (def: #export (repeat x) - {#;doc "Repeat a value forever."} + {#.doc "Repeat a value forever."} (All [a] (-> a (Stream a))) (pending [x (repeat x)])) (def: #export (cycle xs) - {#;doc "Go over the elements of a list forever. + {#.doc "Go over the elements of a list forever. The list should not be empty."} (All [a] (-> (List a) (Maybe (Stream a)))) (case xs - #;Nil #;None - (#;Cons x xs') (#;Some (cycle' x xs' x xs')))) + #.Nil #.None + (#.Cons x xs') (#.Some (cycle' x xs' x xs')))) (do-template [<name> <return> <part>] [(def: #export (<name> s) (All [a] (-> (Stream a) <return>)) - (let [[h t] (cont;run s)] + (let [[h t] (cont.run s)] <part>))] [head a h] @@ -57,7 +57,7 @@ (def: #export (nth idx s) (All [a] (-> Nat (Stream a) a)) - (let [[h t] (cont;run s)] + (let [[h t] (cont.run s)] (if (n/> +0 idx) (nth (n/dec idx) t) h))) @@ -66,7 +66,7 @@ [(def: #export (<taker> pred xs) (All [a] (-> <pred-type> (Stream a) (List a))) - (let [[x xs'] (cont;run xs)] + (let [[x xs'] (cont.run xs)] (if <pred-test> (list& x (<taker> <pred-step> xs')) (list)))) @@ -74,7 +74,7 @@ (def: #export (<dropper> pred xs) (All [a] (-> <pred-type> (Stream a) (Stream a))) - (let [[x xs'] (cont;run xs)] + (let [[x xs'] (cont.run xs)] (if <pred-test> (<dropper> <pred-step> xs') xs))) @@ -82,10 +82,10 @@ (def: #export (<splitter> pred xs) (All [a] (-> <pred-type> (Stream a) [(List a) (Stream a)])) - (let [[x xs'] (cont;run xs)] + (let [[x xs'] (cont.run xs)] (if <pred-test> (let [[tail next] (<splitter> <pred-step> xs')] - [(#;Cons [x tail]) next]) + [(#.Cons [x tail]) next]) [(list) xs])))] [take-while drop-while split-while (-> a Bool) (pred x) pred] @@ -93,7 +93,7 @@ ) (def: #export (unfold step init) - {#;doc "A stateful way of infinitely calculating the values of a stream."} + {#.doc "A stateful way of infinitely calculating the values of a stream."} (All [a b] (-> (-> a [a b]) a (Stream b))) (let [[next x] (step init)] @@ -101,13 +101,13 @@ (def: #export (filter p xs) (All [a] (-> (-> a Bool) (Stream a) (Stream a))) - (let [[x xs'] (cont;run xs)] + (let [[x xs'] (cont.run xs)] (if (p x) (pending [x (filter p xs')]) (filter p xs')))) (def: #export (partition p xs) - {#;doc "Split a stream in two based on a predicate. + {#.doc "Split a stream in two based on a predicate. The left side contains all entries for which the predicate is true. @@ -118,26 +118,26 @@ ## [Structures] (struct: #export _ (Functor Stream) (def: (map f fa) - (let [[h t] (cont;run fa)] + (let [[h t] (cont.run fa)] (pending [(f h) (map f t)])))) (struct: #export _ (CoMonad Stream) (def: functor Functor<Stream>) (def: unwrap head) (def: (split wa) - (let [[head tail] (cont;run wa)] + (let [[head tail] (cont.run wa)] (pending [wa (split tail)])))) ## [Pattern-matching] -(syntax: #export (^stream& [patterns (s;form (p;many s;any))] body [branches (p;some s;any)]) - {#;doc (doc "Allows destructuring of streams in pattern-matching expressions." +(syntax: #export (^stream& [patterns (s.form (p.many s.any))] body [branches (p.some s.any)]) + {#.doc (doc "Allows destructuring of streams in pattern-matching expressions." "Caveat emptor: Only use it for destructuring, and not for testing values within the streams." (let [(^stream& x y z _tail) (some-stream-func 1 2 3)] (func x y z)))} (with-gensyms [g!s] (let [body+ (` (let [(~@ (List/join (List/map (function [pattern] (list (` [(~ pattern) (~ g!s)]) - (` (cont;run (~ g!s))))) + (` (cont.run (~ g!s))))) patterns)))] (~ body)))] (wrap (list& g!s body+ branches))))) diff --git a/stdlib/source/lux/data/coll/tree/finger.lux b/stdlib/source/lux/data/coll/tree/finger.lux index 355c89b55..3cf904c3f 100644 --- a/stdlib/source/lux/data/coll/tree/finger.lux +++ b/stdlib/source/lux/data/coll/tree/finger.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["m" monoid]) (data text/format))) @@ -8,7 +8,7 @@ (#Branch m (Node m a) (Node m a))) (type: #export (Fingers m a) - {#monoid (m;Monoid m) + {#monoid (m.Monoid m) #tree (Node m a)}) (def: #export (tag fingers) @@ -36,17 +36,17 @@ (def: #export (search pred fingers) (All [m a] (-> (-> m Bool) (Fingers m a) (Maybe a))) - (let [tag/compose (get@ [#monoid #m;compose] fingers)] + (let [tag/compose (get@ [#monoid #m.compose] fingers)] (if (pred (tag fingers)) - (loop [_tag (get@ [#monoid #m;identity] fingers) + (loop [_tag (get@ [#monoid #m.identity] fingers) _node (get@ #tree fingers)] (case _node (#Leaf _ value) - (#;Some value) + (#.Some value) (#Branch _ left right) (let [shifted-tag (tag/compose _tag (tag (set@ #tree left fingers)))] (if (pred shifted-tag) (recur _tag left) (recur shifted-tag right))))) - #;None))) + #.None))) diff --git a/stdlib/source/lux/data/coll/tree/parser.lux b/stdlib/source/lux/data/coll/tree/parser.lux index ac6dc2a85..2489e991b 100644 --- a/stdlib/source/lux/data/coll/tree/parser.lux +++ b/stdlib/source/lux/data/coll/tree/parser.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["p" parser] ["ex" exception #+ exception:]) @@ -7,25 +7,25 @@ ["Z" zipper])) (type: #export (Parser t a) - (p;Parser (Z;Zipper t) a)) + (p.Parser (Z.Zipper t) a)) (def: #export (run-zipper zipper parser) - (All [t a] (-> (Z;Zipper t) (Parser t a) (E;Error a))) - (case (p;run zipper parser) - (#E;Success [zipper output]) - (#E;Success output) + (All [t a] (-> (Z.Zipper t) (Parser t a) (E.Error a))) + (case (p.run zipper parser) + (#E.Success [zipper output]) + (#E.Success output) - (#E;Error error) - (#E;Error error))) + (#E.Error error) + (#E.Error error))) (def: #export (run tree parser) - (All [t a] (-> (T;Tree t) (Parser t a) (E;Error a))) - (run-zipper (Z;zip tree) parser)) + (All [t a] (-> (T.Tree t) (Parser t a) (E.Error a))) + (run-zipper (Z.zip tree) parser)) (def: #export value (All [t] (Parser t t)) (function [zipper] - (#E;Success [zipper (Z;value zipper)]))) + (#E.Success [zipper (Z.value zipper)]))) (exception: #export Cannot-Move-Further) @@ -35,16 +35,16 @@ (function [zipper] (let [next (<direction> zipper)] (if (is zipper next) - (ex;throw Cannot-Move-Further "") - (#E;Success [next []])))))] - - [up Z;up] - [down Z;down] - [left Z;left] - [right Z;right] - [root Z;root] - [rightmost Z;rightmost] - [leftmost Z;leftmost] - [next Z;next] - [prev Z;prev] + (ex.throw Cannot-Move-Further "") + (#E.Success [next []])))))] + + [up Z.up] + [down Z.down] + [left Z.left] + [right Z.right] + [root Z.root] + [rightmost Z.rightmost] + [leftmost Z.leftmost] + [next Z.next] + [prev Z.prev] ) diff --git a/stdlib/source/lux/data/coll/tree/rose.lux b/stdlib/source/lux/data/coll/tree/rose.lux index e86dac944..077f68191 100644 --- a/stdlib/source/lux/data/coll/tree/rose.lux +++ b/stdlib/source/lux/data/coll/tree/rose.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control functor [monad #+ do Monad] @@ -18,7 +18,7 @@ ## [Values] (def: #export (flatten tree) (All [a] (-> (Tree a) (List a))) - (#;Cons (get@ #value tree) + (#.Cons (get@ #value tree) (L/join (L/map flatten (get@ #children tree))))) (def: #export (leaf value) @@ -37,15 +37,15 @@ (def: tree^ (Syntax Tree-Code) - (|> (|>> p;some s;record (p;seq s;any)) - p;rec - p;some - s;record - (p;seq s;any) - s;tuple)) + (|> (|>> p.some s.record (p.seq s.any)) + p.rec + p.some + s.record + (p.seq s.any) + s.tuple)) (syntax: #export (tree [root tree^]) - {#;doc (doc "Tree literals." + {#.doc (doc "Tree literals." (tree Int [10 {20 {} 30 {} 40 {}}]))} @@ -57,7 +57,7 @@ (struct: #export (Eq<Tree> Eq<a>) (All [a] (-> (Eq a) (Eq (Tree a)))) (def: (= tx ty) (and (:: Eq<a> = (get@ #value tx) (get@ #value ty)) - (:: (list;Eq<List> (Eq<Tree> Eq<a>)) = (get@ #children tx) (get@ #children ty))))) + (:: (list.Eq<List> (Eq<Tree> Eq<a>)) = (get@ #children tx) (get@ #children ty))))) (struct: #export _ (Functor Tree) (def: (map f fa) diff --git a/stdlib/source/lux/data/coll/tree/zipper.lux b/stdlib/source/lux/data/coll/tree/zipper.lux index e355f7238..421c10fe9 100644 --- a/stdlib/source/lux/data/coll/tree/zipper.lux +++ b/stdlib/source/lux/data/coll/tree/zipper.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control functor comonad) @@ -14,7 +14,7 @@ ## [Types] (type: #export (Zipper a) - {#;doc "Tree zippers, for easy navigation and editing over trees."} + {#.doc "Tree zippers, for easy navigation and editing over trees."} {#parent (Maybe (Zipper a)) #lefts (Stack (Tree a)) #rights (Stack (Tree a)) @@ -23,9 +23,9 @@ ## [Values] (def: #export (zip tree) (All [a] (-> (Tree a) (Zipper a))) - {#parent #;None - #lefts stack;empty - #rights stack;empty + {#parent #.None + #lefts stack.empty + #rights stack.empty #node tree}) (def: #export (unzip zipper) @@ -34,15 +34,15 @@ (def: #export (value zipper) (All [a] (-> (Zipper a) a)) - (|> zipper (get@ [#node #rose;value]))) + (|> zipper (get@ [#node #rose.value]))) (def: #export (children zipper) (All [a] (-> (Zipper a) (List (Tree a)))) - (|> zipper (get@ [#node #rose;children]))) + (|> zipper (get@ [#node #rose.children]))) (def: #export (branch? zipper) (All [a] (-> (Zipper a) Bool)) - (|> zipper children list;empty? not)) + (|> zipper children list.empty? not)) (def: #export (leaf? zipper) (All [a] (-> (Zipper a) Bool)) @@ -50,13 +50,13 @@ (def: #export (end? zipper) (All [a] (-> (Zipper a) Bool)) - (and (list;empty? (get@ #rights zipper)) - (list;empty? (children zipper)))) + (and (list.empty? (get@ #rights zipper)) + (list.empty? (children zipper)))) (def: #export (root? zipper) (All [a] (-> (Zipper a) Bool)) (case (get@ #parent zipper) - #;None + #.None true _ @@ -65,27 +65,27 @@ (def: #export (down zipper) (All [a] (-> (Zipper a) (Zipper a))) (case (children zipper) - #;Nil + #.Nil zipper - (#;Cons chead ctail) - {#parent (#;Some zipper) - #lefts stack;empty + (#.Cons chead ctail) + {#parent (#.Some zipper) + #lefts stack.empty #rights ctail #node chead})) (def: #export (up zipper) (All [a] (-> (Zipper a) (Zipper a))) (case (get@ #parent zipper) - #;None + #.None zipper - (#;Some parent) + (#.Some parent) (|> parent (update@ #node (: (-> (Tree ($ +0)) (Tree ($ +0))) (function [node] - (set@ #rose;children (L/compose (list;reverse (get@ #lefts zipper)) - (#;Cons (get@ #node zipper) + (set@ #rose.children (L/compose (list.reverse (get@ #lefts zipper)) + (#.Cons (get@ #node zipper) (get@ #rights zipper))) node))))))) @@ -93,20 +93,20 @@ (All [a] (-> (Zipper a) (Zipper a))) (loop [zipper zipper] (case (get@ #parent zipper) - #;None zipper - (#;Some _) (recur (up zipper))))) + #.None zipper + (#.Some _) (recur (up zipper))))) (do-template [<one-name> <all-name> <side> <op-side>] [(def: #export (<one-name> zipper) (All [a] (-> (Zipper a) (Zipper a))) (case (get@ <side> zipper) - #;Nil + #.Nil zipper - (#;Cons next side') + (#.Cons next side') (|> zipper (update@ <op-side> (function [op-side] - (#;Cons (get@ #node zipper) op-side))) + (#.Cons (get@ #node zipper) op-side))) (set@ <side> side') (set@ #node next)))) @@ -122,7 +122,7 @@ [(def: #export (<name> zipper) (All [a] (-> (Zipper a) (Zipper a))) (case (get@ <h-side> zipper) - #;Nil + #.Nil (<v-op> zipper) _ @@ -134,44 +134,44 @@ (def: #export (set value zipper) (All [a] (-> a (Zipper a) (Zipper a))) - (set@ [#node #rose;value] value zipper)) + (set@ [#node #rose.value] value zipper)) (def: #export (update f zipper) (All [a] (-> (-> a a) (Zipper a) (Zipper a))) - (update@ [#node #rose;value] f zipper)) + (update@ [#node #rose.value] f zipper)) (def: #export (prepend-child value zipper) (All [a] (-> a (Zipper a) (Zipper a))) - (update@ [#node #rose;children] + (update@ [#node #rose.children] (function [children] (list& (: (Tree ($ +0)) - (rose;tree [value {}])) + (rose.tree [value {}])) children)) zipper)) (def: #export (append-child value zipper) (All [a] (-> a (Zipper a) (Zipper a))) - (update@ [#node #rose;children] + (update@ [#node #rose.children] (function [children] (L/compose children (list (: (Tree ($ +0)) - (rose;tree [value {}]))))) + (rose.tree [value {}]))))) zipper)) (def: #export (remove zipper) (All [a] (-> (Zipper a) (Maybe (Zipper a)))) (case (get@ #lefts zipper) - #;Nil + #.Nil (case (get@ #parent zipper) - #;None - #;None + #.None + #.None - (#;Some next) - (#;Some (|> next - (update@ [#node #rose;children] (|>> list;tail (maybe;default (list))))))) + (#.Some next) + (#.Some (|> next + (update@ [#node #rose.children] (|>> list.tail (maybe.default (list))))))) - (#;Cons next side) - (#;Some (|> zipper + (#.Cons next side) + (#.Some (|> zipper (set@ #lefts side) (set@ #node next))))) @@ -179,14 +179,14 @@ [(def: #export (<name> value zipper) (All [a] (-> a (Zipper a) (Maybe (Zipper a)))) (case (get@ #parent zipper) - #;None - #;None + #.None + #.None _ - (#;Some (|> zipper + (#.Some (|> zipper (update@ <side> (function [side] - (#;Cons (: (Tree ($ +0)) - (rose;tree [value {}])) + (#.Cons (: (Tree ($ +0)) + (rose.tree [value {}])) side)))))))] [insert-left #lefts] @@ -203,13 +203,13 @@ ## (struct: #export _ (CoMonad Zipper) ## (def: functor Functor<Zipper>) -## (def: unwrap (get@ [#node #rose;value])) +## (def: unwrap (get@ [#node #rose.value])) ## (def: (split wa) ## (let [tree-splitter (function tree-splitter [tree] -## {#rose;value (zip tree) -## #rose;children (L/map tree-splitter -## (get@ #rose;children tree))})] +## {#rose.value (zip tree) +## #rose.children (L/map tree-splitter +## (get@ #rose.children tree))})] ## {#parent (|> wa (get@ #parent) (M/map split)) ## #lefts (|> wa (get@ #lefts) (L/map tree-splitter)) ## #rights (|> wa (get@ #rights) (L/map tree-splitter)) diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux index 3340629c3..9e5c828e4 100644 --- a/stdlib/source/lux/data/color.lux +++ b/stdlib/source/lux/data/color.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [eq]) (data (coll [list "L/" Functor<List>])) @@ -36,7 +36,7 @@ (-> Color [Nat Nat Nat]) (|>> @repr)) - (struct: #export _ (eq;Eq Color) + (struct: #export _ (eq.Eq Color) (def: (= reference sample) (let [[rr rg rb] (@repr reference) [sr sg sb] (@repr sample)] @@ -148,7 +148,7 @@ (def: #export (from-hsb [hue saturation brightness]) (-> [Frac Frac Frac] Color) (let [hue (|> hue (f/* 6.0)) - i (math;floor hue) + i (math.floor hue) f (|> hue (f/- i)) p (|> 1.0 (f/- saturation) (f/* brightness)) q (|> 1.0 (f/- (f/* f saturation)) (f/* brightness)) @@ -230,7 +230,7 @@ (-> Color Color) (let [[red green blue] (unpack color) adjust (function [value] (|> top (n/- value)))] - (;;color [(adjust red) + (..color [(adjust red) (adjust green) (adjust blue)]))) @@ -289,7 +289,7 @@ (from-hsl [(|> idx nat-to-frac (f/* slice) (f/+ hue) normalize) saturation luminance])) - (list;n/range +0 (n/dec results)))))) + (list.n/range +0 (n/dec results)))))) (def: #export (monochromatic results color) (-> Nat Color (List Color)) @@ -297,7 +297,7 @@ (list) (let [[hue saturation brightness] (to-hsb color) slice (|> 1.0 (f// (nat-to-frac results)))] - (|> (list;n/range +0 (n/dec results)) + (|> (list.n/range +0 (n/dec results)) (L/map (|>> nat-to-frac (f/* slice) (f/+ brightness) diff --git a/stdlib/source/lux/data/env.lux b/stdlib/source/lux/data/env.lux index b6f96be68..880bfa621 100644 --- a/stdlib/source/lux/data/env.lux +++ b/stdlib/source/lux/data/env.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["F" functor] comonad))) @@ -7,7 +7,7 @@ {#env e #value a}) -(struct: #export Functor<Env> (All [e] (F;Functor (Env e))) +(struct: #export Functor<Env> (All [e] (F.Functor (Env e))) (def: (map f fa) (update@ #value f fa))) diff --git a/stdlib/source/lux/data/error.lux b/stdlib/source/lux/data/error.lux index e433d7454..773724321 100644 --- a/stdlib/source/lux/data/error.lux +++ b/stdlib/source/lux/data/error.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["F" functor] ["A" applicative] @@ -10,13 +10,13 @@ (#Success a)) ## [Structures] -(struct: #export _ (F;Functor Error) +(struct: #export _ (F.Functor Error) (def: (map f ma) (case ma (#Error msg) (#Error msg) (#Success datum) (#Success (f datum))))) -(struct: #export _ (A;Applicative Error) +(struct: #export _ (A.Applicative Error) (def: functor Functor<Error>) (def: (wrap a) @@ -46,7 +46,7 @@ (struct: #export (ErrorT Monad<M>) (All [M] (-> (Monad M) (Monad (All [a] (M (Error a)))))) - (def: applicative (A;compose (get@ #M;applicative Monad<M>) Applicative<Error>)) + (def: applicative (A.compose (get@ #M.applicative Monad<M>) Applicative<Error>)) (def: (join MeMea) (do Monad<M> [eMea MeMea] @@ -59,7 +59,7 @@ (def: #export (lift Monad<M>) (All [M a] (-> (Monad M) (-> (M a) (M (Error a))))) - (M;lift Monad<M> (:: Monad<Error> wrap))) + (M.lift Monad<M> (:: Monad<Error> wrap))) (def: #export (succeed value) (All [a] (-> a (Error a))) @@ -79,7 +79,7 @@ (error! message))) (macro: #export (default tokens compiler) - {#;doc (doc "Allows you to provide a default value that will be used" + {#.doc (doc "Allows you to provide a default value that will be used" "if a (Error x) value turns out to be #Error." (is 10 (default 20 (#Success 10))) @@ -88,10 +88,10 @@ (case tokens (^ (list else error)) (#Success [compiler (list (` (case (~ error) - (#;;Success (~' g!temp)) + (#..Success (~' g!temp)) (~' g!temp) - (#;;Error (~ [dummy-cursor (#;Symbol ["" ""])])) + (#..Error (~ [dummy-cursor (#.Symbol ["" ""])])) (~ else))))]) _ diff --git a/stdlib/source/lux/data/format/context.lux b/stdlib/source/lux/data/format/context.lux index 5f0d29b11..a52de9af8 100644 --- a/stdlib/source/lux/data/format/context.lux +++ b/stdlib/source/lux/data/format/context.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["p" parser] ["ex" exception #+ exception:] @@ -9,26 +9,26 @@ (exception: #export Unknown-Property) (type: #export Context - (d;Dict Text Text)) + (d.Dict Text Text)) (type: #export (Property a) - (p;Parser Context a)) + (p.Parser Context a)) (def: #export (property name) (-> Text (Property Text)) (function [context] - (case (d;get name context) - (#;Some value) - (ex;return [context value]) + (case (d.get name context) + (#.Some value) + (ex.return [context value]) - #;None - (ex;throw Unknown-Property name)))) + #.None + (ex.throw Unknown-Property name)))) (def: #export (run context property) - (All [a] (-> Context (Property a) (E;Error a))) + (All [a] (-> Context (Property a) (E.Error a))) (case (property context) - (#E;Success [_ output]) - (#E;Success output) + (#E.Success [_ output]) + (#E.Success output) - (#E;Error error) - (#E;Error error))) + (#E.Error error) + (#E.Error error))) diff --git a/stdlib/source/lux/data/format/css.lux b/stdlib/source/lux/data/format/css.lux index 2b0a1a03b..4f148110f 100644 --- a/stdlib/source/lux/data/format/css.lux +++ b/stdlib/source/lux/data/format/css.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (data [color #+ Color] [number] @@ -13,7 +13,7 @@ (type: #export Value Text) (type: #export Style - {#;doc "The style associated with a CSS selector."} + {#.doc "The style associated with a CSS selector."} (List [Property Value])) (type: #export Rule [Selector Style]) @@ -26,20 +26,20 @@ (-> Style Text) (|> style (L/map (function [[key val]] (format key ": " val))) - (text;join-with "; "))) + (text.join-with "; "))) (def: #export (css sheet) (-> Sheet CSS) (|> sheet (L/map (function [[selector style]] - (if (list;empty? style) + (if (list.empty? style) "" (format selector "{" (inline style) "}")))) - (text;join-with "\n"))) + (text.join-with "\n"))) (def: #export (rgb color) (-> Color Value) - (let [[red green blue] (color;unpack color)] + (let [[red green blue] (color.unpack color)] (format "rgb(" (|> red nat-to-int %i) "," (|> green nat-to-int %i) "," (|> blue nat-to-int %i) @@ -47,11 +47,11 @@ (def: #export (rgba color alpha) (-> Color Deg Value) - (let [[red green blue] (color;unpack color)] + (let [[red green blue] (color.unpack color)] (format "rgba(" (|> red nat-to-int %i) "," (|> green nat-to-int %i) "," (|> blue nat-to-int %i) - "," (if (d/= (:: number;Interval<Deg> top) alpha) + "," (if (d/= (:: number.Interval<Deg> top) alpha) "1.0" (format "0" (%d alpha))) ")"))) diff --git a/stdlib/source/lux/data/format/html.lux b/stdlib/source/lux/data/format/html.lux index e33e7d4ee..0c6b1bf0e 100644 --- a/stdlib/source/lux/data/format/html.lux +++ b/stdlib/source/lux/data/format/html.lux @@ -1,25 +1,25 @@ -(;module: +(.module: [lux #- comment] (lux (data [text] text/format (coll [list "L/" Functor<List>])))) (type: #export Attributes - {#;doc "Attributes for an HTML tag."} + {#.doc "Attributes for an HTML tag."} (List [Text Text])) (type: #export HTML Text) (def: #export (text value) - {#;doc "Properly formats text to ensure no injection can happen on the HTML."} + {#.doc "Properly formats text to ensure no injection can happen on the HTML."} (-> Text HTML) (|> value - (text;replace-all "&" "&") - (text;replace-all "<" "<") - (text;replace-all ">" ">") - (text;replace-all "\"" """) - (text;replace-all "'" "'") - (text;replace-all "/" "/"))) + (text.replace-all "&" "&") + (text.replace-all "<" "<") + (text.replace-all ">" ">") + (text.replace-all "\"" """) + (text.replace-all "'" "'") + (text.replace-all "/" "/"))) (def: #export (comment content) (-> Text HTML) @@ -28,13 +28,13 @@ (def: attrs-to-text (-> Attributes Text) (|>> (L/map (function [[key val]] (format key "=" "\"" (text val) "\""))) - (text;join-with " "))) + (text.join-with " "))) (def: #export (tag name attrs children) - {#;doc "Generates the HTML for a tag."} + {#.doc "Generates the HTML for a tag."} (-> Text Attributes (List HTML) HTML) (format "<" name " " (attrs-to-text attrs) ">" - (text;join-with " " children) + (text.join-with " " children) "</" name ">")) (do-template [<name> <doc-type>] @@ -44,7 +44,7 @@ document))] [html-5 "<!DOCTYPE html>"] - [html-4.01 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">"] - [xhtml-1.0 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"] - [xhtml-1.1 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">"] + [html-4_01 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">"] + [xhtml-1_0 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"] + [xhtml-1_1 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">"] ) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index b007dba42..37d6f954f 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Functionality for reading and writing values in the JSON format. +(.module: {#.doc "Functionality for reading and writing values in the JSON format. For more information, please see: http://www.json.org/"} [lux #- Array] @@ -49,11 +49,11 @@ ) (type: #export (Reader a) - {#;doc "JSON reader."} - (p;Parser (List JSON) a)) + {#.doc "JSON reader."} + (p.Parser (List JSON) a)) (syntax: #export (json token) - {#;doc (doc "A simple way to produce JSON literals." + {#.doc (doc "A simple way to produce JSON literals." (json true) (json 123.456) (json "Some text") @@ -62,86 +62,86 @@ (json {"this" "is" "an" "object"}))} (let [(^open) Monad<Meta> - wrapper (function [x] (` (;;json (~ x))))] + wrapper (function [x] (` (..json (~ x))))] (case token (^template [<ast-tag> <ctor> <json-tag>] [_ (<ast-tag> value)] (wrap (list (` (: JSON (<json-tag> (~ (<ctor> value)))))))) - ([#;Bool code;bool #Boolean] - [#;Frac code;frac #Number] - [#;Text code;text #String]) + ([#.Bool code.bool #Boolean] + [#.Frac code.frac #Number] + [#.Text code.text #String]) - [_ (#;Tag ["" "null"])] + [_ (#.Tag ["" "null"])] (wrap (list (` (: JSON #Null)))) - [_ (#;Tuple members)] + [_ (#.Tuple members)] (wrap (list (` (: JSON (#Array (sequence (~@ (list/map wrapper members)))))))) - [_ (#;Record pairs)] + [_ (#.Record pairs)] (do Monad<Meta> - [pairs' (monad;map @ + [pairs' (monad.map @ (function [[slot value]] (case slot - [_ (#;Text key-name)] - (wrap (` [(~ (code;text key-name)) (~ (wrapper value))])) + [_ (#.Text key-name)] + (wrap (` [(~ (code.text key-name)) (~ (wrapper value))])) _ - (macro;fail "Wrong syntax for JSON object."))) + (macro.fail "Wrong syntax for JSON object."))) pairs)] - (wrap (list (` (: JSON (#Object (dict;from-list text;Hash<Text> (list (~@ pairs'))))))))) + (wrap (list (` (: JSON (#Object (dict.from-list text.Hash<Text> (list (~@ pairs'))))))))) _ (wrap (list token)) ))) (def: #export (get-fields json) - {#;doc "Get all the fields in a JSON object."} - (-> JSON (e;Error (List String))) + {#.doc "Get all the fields in a JSON object."} + (-> JSON (e.Error (List String))) (case json (#Object obj) - (#e;Success (dict;keys obj)) + (#e.Success (dict.keys obj)) _ - (#e;Error ($_ text/compose "Cannot get the fields of a non-object.")))) + (#e.Error ($_ text/compose "Cannot get the fields of a non-object.")))) (def: #export (get key json) - {#;doc "A JSON object field getter."} - (-> String JSON (e;Error JSON)) + {#.doc "A JSON object field getter."} + (-> String JSON (e.Error JSON)) (case json (#Object obj) - (case (dict;get key obj) - (#;Some value) - (#e;Success value) + (case (dict.get key obj) + (#.Some value) + (#e.Success value) - #;None - (#e;Error ($_ text/compose "Missing field \"" key "\" on object."))) + #.None + (#e.Error ($_ text/compose "Missing field \"" key "\" on object."))) _ - (#e;Error ($_ text/compose "Cannot get field \"" key "\" of a non-object.")))) + (#e.Error ($_ text/compose "Cannot get field \"" key "\" of a non-object.")))) (def: #export (set key value json) - {#;doc "A JSON object field setter."} - (-> String JSON JSON (e;Error JSON)) + {#.doc "A JSON object field setter."} + (-> String JSON JSON (e.Error JSON)) (case json (#Object obj) - (#e;Success (#Object (dict;put key value obj))) + (#e.Success (#Object (dict.put key value obj))) _ - (#e;Error ($_ text/compose "Cannot set field \"" key "\" of a non-object.")))) + (#e.Error ($_ text/compose "Cannot set field \"" key "\" of a non-object.")))) (do-template [<name> <tag> <type> <desc>] [(def: #export (<name> key json) - {#;doc (code;text ($_ text/compose "A JSON object field getter for " <desc> "."))} - (-> Text JSON (e;Error <type>)) + {#.doc (code.text ($_ text/compose "A JSON object field getter for " <desc> "."))} + (-> Text JSON (e.Error <type>)) (case (get key json) - (#e;Success (<tag> value)) - (#e;Success value) + (#e.Success (<tag> value)) + (#e.Success value) - (#e;Success _) - (#e;Error ($_ text/compose "Wrong value type at key: " key)) + (#e.Success _) + (#e.Error ($_ text/compose "Wrong value type at key: " key)) - (#e;Error error) - (#e;Error error)))] + (#e.Error error) + (#e.Error error)))] [get-boolean #Boolean Boolean "booleans"] [get-number #Number Number "numbers"] @@ -159,31 +159,31 @@ (^template [<tag> <struct>] [(<tag> x') (<tag> y')] (:: <struct> = x' y')) - ([#Boolean bool;Eq<Bool>] - [#Number number;Eq<Frac>] - [#String text;Eq<Text>]) + ([#Boolean bool.Eq<Bool>] + [#Number number.Eq<Frac>] + [#String text.Eq<Text>]) [(#Array xs) (#Array ys)] - (and (n/= (sequence;size xs) (sequence;size ys)) + (and (n/= (sequence.size xs) (sequence.size ys)) (list/fold (function [idx prev] (and prev - (maybe;default false - (do maybe;Monad<Maybe> - [x' (sequence;nth idx xs) - y' (sequence;nth idx ys)] + (maybe.default false + (do maybe.Monad<Maybe> + [x' (sequence.nth idx xs) + y' (sequence.nth idx ys)] (wrap (= x' y')))))) true - (list;indices (sequence;size xs)))) + (list.indices (sequence.size xs)))) [(#Object xs) (#Object ys)] - (and (n/= (dict;size xs) (dict;size ys)) + (and (n/= (dict.size xs) (dict.size ys)) (list/fold (function [[xk xv] prev] (and prev - (case (dict;get xk ys) - #;None false - (#;Some yv) (= xv yv)))) + (case (dict.get xk ys) + #.None false + (#.Some yv) (= xv yv)))) true - (dict;entries xs))) + (dict.entries xs))) _ false))) @@ -195,40 +195,40 @@ (def: unconsumed-input-error Text "Unconsumed JSON.") (def: #export (run json parser) - (All [a] (-> JSON (Reader a) (e;Error a))) - (case (p;run (list json) parser) - (#e;Success [remainder output]) + (All [a] (-> JSON (Reader a) (e.Error a))) + (case (p.run (list json) parser) + (#e.Success [remainder output]) (case remainder - #;Nil - (#e;Success output) + #.Nil + (#e.Success output) _ - (#e;Error unconsumed-input-error)) + (#e.Error unconsumed-input-error)) - (#e;Error error) - (#e;Error error))) + (#e.Error error) + (#e.Error error))) (def: #export (fail error) (All [a] (-> Text (Reader a))) (function [inputs] - (#e;Error error))) + (#e.Error error))) (def: #export any - {#;doc "Just returns the JSON input without applying any logic."} + {#.doc "Just returns the JSON input without applying any logic."} (Reader JSON) (<| (function [inputs]) (case inputs - #;Nil - (#e;Error "Empty JSON stream.") + #.Nil + (#e.Error "Empty JSON stream.") - (#;Cons head tail) - (#e;Success [tail head])))) + (#.Cons head tail) + (#e.Success [tail head])))) (do-template [<name> <type> <tag> <desc>] [(def: #export <name> - {#;doc (code;text ($_ text/compose "Reads a JSON value as " <desc> "."))} + {#.doc (code.text ($_ text/compose "Reads a JSON value as " <desc> "."))} (Reader <type>) - (do p;Monad<Parser> + (do p.Monad<Parser> [head any] (case head (<tag> value) @@ -245,9 +245,9 @@ (do-template [<test> <check> <type> <eq> <encoder> <tag> <desc> <pre>] [(def: #export (<test> test) - {#;doc (code;text ($_ text/compose "Asks whether a JSON value is a " <desc> "."))} + {#.doc (code.text ($_ text/compose "Asks whether a JSON value is a " <desc> "."))} (-> <type> (Reader Bool)) - (do p;Monad<Parser> + (do p.Monad<Parser> [head any] (case head (<tag> value) @@ -257,9 +257,9 @@ (fail ($_ text/compose "JSON value is not " <desc> "."))))) (def: #export (<check> test) - {#;doc (code;text ($_ text/compose "Ensures a JSON value is a " <desc> "."))} + {#.doc (code.text ($_ text/compose "Ensures a JSON value is a " <desc> "."))} (-> <type> (Reader Unit)) - (do p;Monad<Parser> + (do p.Monad<Parser> [head any] (case head (<tag> value) @@ -271,30 +271,30 @@ _ (fail ($_ text/compose "JSON value is not a " <desc> ".")))))] - [boolean? boolean! Bool bool;Eq<Bool> (:: bool;Codec<Text,Bool> encode) #Boolean "boolean" id] - [number? number! Frac number;Eq<Frac> (:: number;Codec<Text,Frac> encode) #Number "number" id] - [string? string! Text text;Eq<Text> text;encode #String "string" id] + [boolean? boolean! Bool bool.Eq<Bool> (:: bool.Codec<Text,Bool> encode) #Boolean "boolean" id] + [number? number! Frac number.Eq<Frac> (:: number.Codec<Text,Frac> encode) #Number "number" id] + [string? string! Text text.Eq<Text> text.encode #String "string" id] ) (def: #export (nullable parser) (All [a] (-> (Reader a) (Reader (Maybe a)))) - (p;alt null + (p.alt null parser)) (def: #export (array parser) - {#;doc "Parses a JSON array, assuming that every element can be parsed the same way."} + {#.doc "Parses a JSON array, assuming that every element can be parsed the same way."} (All [a] (-> (Reader a) (Reader a))) - (do p;Monad<Parser> + (do p.Monad<Parser> [head any] (case head (#Array values) - (case (p;run (sequence;to-list values) parser) - (#e;Error error) + (case (p.run (sequence.to-list values) parser) + (#e.Error error) (fail error) - (#e;Success [remainder output]) + (#e.Success [remainder output]) (case remainder - #;Nil + #.Nil (wrap output) _ @@ -304,46 +304,46 @@ (fail "JSON value is not an array.")))) (def: #export (object parser) - {#;doc "Parses a JSON object, assuming that every element can be parsed the same way."} + {#.doc "Parses a JSON object, assuming that every element can be parsed the same way."} (All [a] (-> (Reader a) (Reader (Dict Text a)))) - (do p;Monad<Parser> + (do p.Monad<Parser> [head any] (case head (#Object object) - (case (do e;Monad<Error> + (case (do e.Monad<Error> [] - (|> (dict;entries object) - (monad;map @ (function [[key val]] + (|> (dict.entries object) + (monad.map @ (function [[key val]] (do @ [val (run val parser)] (wrap [key val])))) - (:: @ map (dict;from-list text;Hash<Text>)))) - (#e;Success table) + (:: @ map (dict.from-list text.Hash<Text>)))) + (#e.Success table) (wrap table) - (#e;Error error) + (#e.Error error) (fail error)) _ (fail "JSON value is not an array.")))) (def: #export (field field-name parser) - {#;doc "Parses a field inside a JSON object."} + {#.doc "Parses a field inside a JSON object."} (All [a] (-> Text (Reader a) (Reader a))) - (do p;Monad<Parser> + (do p.Monad<Parser> [head any] (case head (#Object object) - (case (dict;get field-name object) - (#;Some value) + (case (dict.get field-name object) + (#.Some value) (case (run value parser) - (#e;Success output) + (#e.Success output) (function [tail] - (#e;Success [(#;Cons (#Object (dict;remove field-name object)) + (#e.Success [(#.Cons (#Object (dict.remove field-name object)) tail) output])) - (#e;Error error) + (#e.Error error) (fail error)) _ @@ -360,23 +360,23 @@ (do-template [<name> <type> <codec>] [(def: <name> (-> <type> Text) <codec>)] - [show-boolean Boolean (:: bool;Codec<Text,Bool> encode)] - [show-number Number (:: number;Codec<Text,Frac> encode)] - [show-string String text;encode]) + [show-boolean Boolean (:: bool.Codec<Text,Bool> encode)] + [show-number Number (:: number.Codec<Text,Frac> encode)] + [show-string String text.encode]) (def: (show-array show-json elems) (-> (-> JSON Text) (-> Array Text)) ($_ text/compose "[" - (|> elems (sequence/map show-json) sequence;to-list (text;join-with ",")) + (|> elems (sequence/map show-json) sequence.to-list (text.join-with ",")) "]")) (def: (show-object show-json object) (-> (-> JSON Text) (-> Object Text)) ($_ text/compose "{" (|> object - dict;entries + dict.entries (list/map (function [[key value]] ($_ text/compose (show-string key) ":" (show-json value)))) - (text;join-with ",")) + (text.join-with ",")) "}")) (def: (show-json json) @@ -394,24 +394,24 @@ )) (def: space~ - (l;Lexer Text) - (l;some l;space)) + (l.Lexer Text) + (l.some l.space)) (def: data-sep - (l;Lexer [Text Unit Text]) - ($_ p;seq space~ (l;this ",") space~)) + (l.Lexer [Text Unit Text]) + ($_ p.seq space~ (l.this ",") space~)) (def: null~ - (l;Lexer Null) - (do p;Monad<Parser> - [_ (l;this "null")] + (l.Lexer Null) + (do p.Monad<Parser> + [_ (l.this "null")] (wrap []))) (do-template [<name> <token> <value>] [(def: <name> - (l;Lexer Boolean) - (do p;Monad<Parser> - [_ (l;this <token>)] + (l.Lexer Boolean) + (do p.Monad<Parser> + [_ (l.this <token>)] (wrap <value>)))] [t~ "true" true] @@ -419,49 +419,49 @@ ) (def: boolean~ - (l;Lexer Boolean) - (p;either t~ f~)) + (l.Lexer Boolean) + (p.either t~ f~)) (def: number~ - (l;Lexer Number) - (do p;Monad<Parser> - [signed? (l;this? "-") - digits (l;many l;decimal) - decimals (p;default "0" + (l.Lexer Number) + (do p.Monad<Parser> + [signed? (l.this? "-") + digits (l.many l.decimal) + decimals (p.default "0" (do @ - [_ (l;this ".")] - (l;many l;decimal))) - exp (p;default "" + [_ (l.this ".")] + (l.many l.decimal))) + exp (p.default "" (do @ - [mark (l;one-of "eE") - signed?' (l;this? "-") - offset (l;many l;decimal)] + [mark (l.one-of "eE") + signed?' (l.this? "-") + offset (l.many l.decimal)] (wrap ($_ text/compose mark (if signed?' "-" "") offset))))] (case (frac/decode ($_ text/compose (if signed? "-" "") digits "." decimals exp)) - (#e;Error message) - (p;fail message) + (#e.Error message) + (p.fail message) - (#e;Success value) + (#e.Success value) (wrap value)))) (def: escaped~ - (l;Lexer Text) - ($_ p;either - (p;after (l;this "\\t") (parser/wrap "\t")) - (p;after (l;this "\\b") (parser/wrap "\b")) - (p;after (l;this "\\n") (parser/wrap "\n")) - (p;after (l;this "\\r") (parser/wrap "\r")) - (p;after (l;this "\\f") (parser/wrap "\f")) - (p;after (l;this "\\\"") (parser/wrap "\"")) - (p;after (l;this "\\\\") (parser/wrap "\\")))) + (l.Lexer Text) + ($_ p.either + (p.after (l.this "\\t") (parser/wrap "\t")) + (p.after (l.this "\\b") (parser/wrap "\b")) + (p.after (l.this "\\n") (parser/wrap "\n")) + (p.after (l.this "\\r") (parser/wrap "\r")) + (p.after (l.this "\\f") (parser/wrap "\f")) + (p.after (l.this "\\\"") (parser/wrap "\"")) + (p.after (l.this "\\\\") (parser/wrap "\\")))) (def: string~ - (l;Lexer String) - (<| (l;enclosed ["\"" "\""]) + (l.Lexer String) + (<| (l.enclosed ["\"" "\""]) (loop [_ []]) - (do p;Monad<Parser> - [chars (l;some (l;none-of "\\\"")) - stop l;peek]) + (do p.Monad<Parser> + [chars (l.some (l.none-of "\\\"")) + stop l.peek]) (if (text/= "\\" stop) (do @ [escaped escaped~ @@ -470,34 +470,34 @@ (wrap chars)))) (def: (kv~ json~) - (-> (-> Unit (l;Lexer JSON)) (l;Lexer [String JSON])) - (do p;Monad<Parser> + (-> (-> Unit (l.Lexer JSON)) (l.Lexer [String JSON])) + (do p.Monad<Parser> [key string~ _ space~ - _ (l;this ":") + _ (l.this ":") _ space~ value (json~ [])] (wrap [key value]))) (do-template [<name> <type> <open> <close> <elem-parser> <prep>] [(def: (<name> json~) - (-> (-> Unit (l;Lexer JSON)) (l;Lexer <type>)) - (do p;Monad<Parser> - [_ (l;this <open>) + (-> (-> Unit (l.Lexer JSON)) (l.Lexer <type>)) + (do p.Monad<Parser> + [_ (l.this <open>) _ space~ - elems (p;sep-by data-sep <elem-parser>) + elems (p.sep-by data-sep <elem-parser>) _ space~ - _ (l;this <close>)] + _ (l.this <close>)] (wrap (<prep> elems))))] - [array~ Array "[" "]" (json~ []) sequence;from-list] - [object~ Object "{" "}" (kv~ json~) (dict;from-list text;Hash<Text>)] + [array~ Array "[" "]" (json~ []) sequence.from-list] + [object~ Object "{" "}" (kv~ json~) (dict.from-list text.Hash<Text>)] ) (def: (json~' _) - (-> Unit (l;Lexer JSON)) - ($_ p;alt null~ boolean~ number~ string~ (array~ json~') (object~ json~'))) + (-> Unit (l.Lexer JSON)) + ($_ p.alt null~ boolean~ number~ string~ (array~ json~') (object~ json~'))) (struct: #export _ (Codec Text JSON) (def: encode show-json) - (def: decode (function [input] (l;run input (json~' []))))) + (def: decode (function [input] (l.run input (json~' []))))) diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index 957628e94..2d7e0a6f4 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Functionality for reading, generating and processing values in the XML format."} +(.module: {#.doc "Functionality for reading, generating and processing values in the XML format."} lux (lux (control monad [eq #+ Eq] @@ -13,174 +13,173 @@ [maybe "m/" Monad<Maybe>] [ident "ident/" Eq<Ident> Codec<Text,Ident>] (coll [list "L/" Monad<List>] - ["d" dict])) - )) + ["d" dict])))) (type: #export Tag Ident) -(type: #export Attrs (d;Dict Ident Text)) +(type: #export Attrs (d.Dict Ident Text)) -(def: #export attrs Attrs (d;new ident;Hash<Ident>)) +(def: #export attrs Attrs (d.new ident.Hash<Ident>)) (type: #export #rec XML (#Text Text) (#Node Tag Attrs (List XML))) (def: xml-standard-escape-char^ - (l;Lexer Text) - ($_ p;either - (p;after (l;this "<") (p/wrap "<")) - (p;after (l;this ">") (p/wrap ">")) - (p;after (l;this "&") (p/wrap "&")) - (p;after (l;this "'") (p/wrap "'")) - (p;after (l;this """) (p/wrap "\"")))) + (l.Lexer Text) + ($_ p.either + (p.after (l.this "<") (p/wrap "<")) + (p.after (l.this ">") (p/wrap ">")) + (p.after (l.this "&") (p/wrap "&")) + (p.after (l.this "'") (p/wrap "'")) + (p.after (l.this """) (p/wrap "\"")))) (def: xml-unicode-escape-char^ - (l;Lexer Text) - (|> (do p;Monad<Parser> - [hex? (p;maybe (l;this "x")) + (l.Lexer Text) + (|> (do p.Monad<Parser> + [hex? (p.maybe (l.this "x")) code (case hex? - #;None - (p;codec number;Codec<Text,Int> (l;many l;decimal)) + #.None + (p.codec number.Codec<Text,Int> (l.many l.decimal)) - (#;Some _) - (p;codec number;Hex@Codec<Text,Int> (l;many l;hexadecimal)))] - (wrap (|> code int-to-nat text;from-code))) - (p;before (l;this ";")) - (p;after (l;this "&#")))) + (#.Some _) + (p.codec number.Hex@Codec<Text,Int> (l.many l.hexadecimal)))] + (wrap (|> code int-to-nat text.from-code))) + (p.before (l.this ";")) + (p.after (l.this "&#")))) (def: xml-escape-char^ - (l;Lexer Text) - (p;either xml-standard-escape-char^ + (l.Lexer Text) + (p.either xml-standard-escape-char^ xml-unicode-escape-char^)) (def: xml-char^ - (l;Lexer Text) - (p;either (l;none-of "<>&'\"") + (l.Lexer Text) + (p.either (l.none-of "<>&'\"") xml-escape-char^)) (def: xml-identifier - (l;Lexer Text) - (do p;Monad<Parser> - [head (p;either (l;one-of "_") - l;alpha) - tail (l;some (p;either (l;one-of "_.-") - l;alpha-num))] + (l.Lexer Text) + (do p.Monad<Parser> + [head (p.either (l.one-of "_") + l.alpha) + tail (l.some (p.either (l.one-of "_.-") + l.alpha-num))] (wrap ($_ text/compose head tail)))) (def: namespaced-symbol^ - (l;Lexer Ident) - (do p;Monad<Parser> + (l.Lexer Ident) + (do p.Monad<Parser> [first-part xml-identifier - ?second-part (<| p;maybe (p;after (l;this ":")) xml-identifier)] + ?second-part (<| p.maybe (p.after (l.this ":")) xml-identifier)] (case ?second-part - #;None + #.None (wrap ["" first-part]) - (#;Some second-part) + (#.Some second-part) (wrap [first-part second-part])))) (def: tag^ namespaced-symbol^) (def: attr-name^ namespaced-symbol^) (def: spaced^ - (All [a] (-> (l;Lexer a) (l;Lexer a))) - (let [white-space^ (p;some l;space)] - (|>> (p;before white-space^) - (p;after white-space^)))) + (All [a] (-> (l.Lexer a) (l.Lexer a))) + (let [white-space^ (p.some l.space)] + (|>> (p.before white-space^) + (p.after white-space^)))) (def: attr-value^ - (l;Lexer Text) - (let [value^ (l;some xml-char^)] - (p;either (l;enclosed ["\"" "\""] value^) - (l;enclosed ["'" "'"] value^)))) + (l.Lexer Text) + (let [value^ (l.some xml-char^)] + (p.either (l.enclosed ["\"" "\""] value^) + (l.enclosed ["'" "'"] value^)))) (def: attrs^ - (l;Lexer Attrs) - (<| (:: p;Monad<Parser> map (d;from-list ident;Hash<Ident>)) - p;some - (p;seq (spaced^ attr-name^)) - (p;after (l;this "=")) + (l.Lexer Attrs) + (<| (:: p.Monad<Parser> map (d.from-list ident.Hash<Ident>)) + p.some + (p.seq (spaced^ attr-name^)) + (p.after (l.this "=")) (spaced^ attr-value^))) (def: (close-tag^ expected) - (-> Tag (l;Lexer [])) - (do p;Monad<Parser> + (-> Tag (l.Lexer [])) + (do p.Monad<Parser> [actual (|> tag^ spaced^ - (p;after (l;this "/")) - (l;enclosed ["<" ">"]))] - (p;assert ($_ text/compose "Close tag does not match open tag.\n" + (p.after (l.this "/")) + (l.enclosed ["<" ">"]))] + (p.assert ($_ text/compose "Close tag does not match open tag.\n" "Expected: " (ident/encode expected) "\n" " Actual: " (ident/encode actual) "\n") (ident/= expected actual)))) (def: comment^ - (l;Lexer Text) - (|> (l;not (l;this "--")) - l;some - (l;enclosed ["<--" "-->"]) + (l.Lexer Text) + (|> (l.not (l.this "--")) + l.some + (l.enclosed ["<--" "-->"]) spaced^)) (def: xml-header^ - (l;Lexer Attrs) + (l.Lexer Attrs) (|> (spaced^ attrs^) - (p;before (l;this "?>")) - (p;after (l;this "<?xml")) + (p.before (l.this "?>")) + (p.after (l.this "<?xml")) spaced^)) (def: cdata^ - (l;Lexer Text) - (let [end (l;this "]]>")] - (|> (l;some (l;not end)) - (p;after end) - (p;after (l;this "<![CDATA[")) + (l.Lexer Text) + (let [end (l.this "]]>")] + (|> (l.some (l.not end)) + (p.after end) + (p.after (l.this "<![CDATA[")) spaced^))) (def: text^ - (l;Lexer XML) - (|> (p;either cdata^ - (l;many xml-char^)) + (l.Lexer XML) + (|> (p.either cdata^ + (l.many xml-char^)) (p/map (|>> #Text)))) (def: xml^ - (l;Lexer XML) - (|> (p;rec + (l.Lexer XML) + (|> (p.rec (function [node^] - (p;either text^ + (p.either text^ (spaced^ - (do p;Monad<Parser> - [_ (l;this "<") + (do p.Monad<Parser> + [_ (l.this "<") tag (spaced^ tag^) attrs (spaced^ attrs^) - #let [no-children^ (do p;Monad<Parser> - [_ (l;this "/>")] + #let [no-children^ (do p.Monad<Parser> + [_ (l.this "/>")] (wrap (#Node tag attrs (list)))) - with-children^ (do p;Monad<Parser> - [_ (l;this ">") - children (p;some node^) + with-children^ (do p.Monad<Parser> + [_ (l.this ">") + children (p.some node^) _ (close-tag^ tag)] (wrap (#Node tag attrs children)))]] - (p;either no-children^ + (p.either no-children^ with-children^)))))) ## This is put outside of the call to "rec" because comments ## cannot be located inside of XML nodes. ## This way, the comments can only be before or after the main document. - (p;before (p;some comment^)) - (p;after (p;some comment^)) - (p;after (p;maybe xml-header^)))) + (p.before (p.some comment^)) + (p.after (p.some comment^)) + (p.after (p.maybe xml-header^)))) (def: #export (read input) - (-> Text (E;Error XML)) - (l;run input xml^)) + (-> Text (E.Error XML)) + (l.run input xml^)) (def: (sanitize-value input) (-> Text Text) (|> input - (text;replace-all "&" "&") - (text;replace-all "<" "<") - (text;replace-all ">" ">") - (text;replace-all "'" "'") - (text;replace-all "\"" """))) + (text.replace-all "&" "&") + (text.replace-all "<" "<") + (text.replace-all ">" ">") + (text.replace-all "'" "'") + (text.replace-all "\"" """))) (def: (write-tag [namespace name]) (-> Tag Text) @@ -191,10 +190,10 @@ (def: (write-attrs attrs) (-> Attrs Text) (|> attrs - d;entries + d.entries (L/map (function [[key value]] ($_ text/compose (write-tag key) "=" "\""(sanitize-value value) "\""))) - (text;join-with " "))) + (text.join-with " "))) (def: xml-header Text @@ -210,15 +209,15 @@ (#Node xml-tag xml-attrs xml-children) (let [tag (write-tag xml-tag) - attrs (if (d;empty? xml-attrs) + attrs (if (d.empty? xml-attrs) "" ($_ text/compose " " (write-attrs xml-attrs)))] - (if (list;empty? xml-children) + (if (list.empty? xml-children) ($_ text/compose "<" tag attrs "/>") ($_ text/compose "<" tag attrs ">" (|> xml-children (L/map recur) - (text;join-with "")) + (text.join-with "")) "</" tag ">"))))))) (struct: #export _ (Codec Text XML) @@ -234,17 +233,17 @@ [(#Node reference/tag reference/attrs reference/children) (#Node sample/tag sample/attrs sample/children)] (and (ident/= reference/tag sample/tag) - (:: (d;Eq<Dict> text;Eq<Text>) = reference/attrs sample/attrs) - (n/= (list;size reference/children) - (list;size sample/children)) - (|> (list;zip2 reference/children sample/children) - (list;every? (product;uncurry =)))) + (:: (d.Eq<Dict> text.Eq<Text>) = reference/attrs sample/attrs) + (n/= (list.size reference/children) + (list.size sample/children)) + (|> (list.zip2 reference/children sample/children) + (list.every? (product.uncurry =)))) _ false))) (type: #export (Reader a) - (p;Parser (List XML) a)) + (p.Parser (List XML) a)) (exception: #export Empty-Input) (exception: #export Unexpected-Input) @@ -256,81 +255,81 @@ (Reader Text) (function [docs] (case docs - #;Nil - (ex;throw Empty-Input "") + #.Nil + (ex.throw Empty-Input "") - (#;Cons head tail) + (#.Cons head tail) (case head (#Text value) - (#E;Success [tail value]) + (#E.Success [tail value]) (#Node _) - (ex;throw Unexpected-Input ""))))) + (ex.throw Unexpected-Input ""))))) (def: #export (attr name) (-> Ident (Reader Text)) (function [docs] (case docs - #;Nil - (ex;throw Empty-Input "") + #.Nil + (ex.throw Empty-Input "") - (#;Cons head _) + (#.Cons head _) (case head (#Text _) - (ex;throw Unexpected-Input "") + (ex.throw Unexpected-Input "") (#Node tag attrs children) - (case (d;get name attrs) - #;None - (ex;throw Unknown-Attribute "") + (case (d.get name attrs) + #.None + (ex.throw Unknown-Attribute "") - (#;Some value) - (#E;Success [docs value])))))) + (#.Some value) + (#E.Success [docs value])))))) (def: (run' docs reader) - (All [a] (-> (List XML) (Reader a) (E;Error a))) - (case (p;run docs reader) - (#E;Success [remaining output]) - (if (list;empty? remaining) - (#E;Success output) - (ex;throw Unconsumed-Inputs (|> remaining + (All [a] (-> (List XML) (Reader a) (E.Error a))) + (case (p.run docs reader) + (#E.Success [remaining output]) + (if (list.empty? remaining) + (#E.Success output) + (ex.throw Unconsumed-Inputs (|> remaining (L/map (:: Codec<Text,XML> encode)) - (text;join-with "\n\n")))) + (text.join-with "\n\n")))) - (#E;Error error) - (#E;Error error))) + (#E.Error error) + (#E.Error error))) (def: #export (node tag) (-> Ident (Reader Unit)) (function [docs] (case docs - #;Nil - (ex;throw Empty-Input "") + #.Nil + (ex.throw Empty-Input "") - (#;Cons head _) + (#.Cons head _) (case head (#Text _) - (ex;throw Unexpected-Input "") + (ex.throw Unexpected-Input "") (#Node _tag _attrs _children) (if (ident/= tag _tag) - (#E;Success [docs []]) - (ex;throw Wrong-Tag (ident/encode tag))))))) + (#E.Success [docs []]) + (ex.throw Wrong-Tag (ident/encode tag))))))) (def: #export (children reader) (All [a] (-> (Reader a) (Reader a))) (function [docs] (case docs - #;Nil - (ex;throw Empty-Input "") + #.Nil + (ex.throw Empty-Input "") - (#;Cons head tail) + (#.Cons head tail) (case head (#Text _) - (ex;throw Unexpected-Input "") + (ex.throw Unexpected-Input "") (#Node _tag _attrs _children) - (do E;Monad<Error> + (do E.Monad<Error> [output (run' _children reader)] (wrap [tail output])))))) @@ -338,12 +337,12 @@ (Reader Unit) (function [docs] (case docs - #;Nil - (ex;throw Empty-Input "") + #.Nil + (ex.throw Empty-Input "") - (#;Cons head tail) - (#E;Success [tail []])))) + (#.Cons head tail) + (#E.Success [tail []])))) (def: #export (run document reader) - (All [a] (-> XML (Reader a) (E;Error a))) + (All [a] (-> XML (Reader a) (E.Error a))) (run' (list document) reader)) diff --git a/stdlib/source/lux/data/ident.lux b/stdlib/source/lux/data/ident.lux index 57e742433..feb456d94 100644 --- a/stdlib/source/lux/data/ident.lux +++ b/stdlib/source/lux/data/ident.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [eq #+ Eq] [codec #+ Codec] @@ -29,24 +29,24 @@ (def: (encode [module name]) (case module "" name - _ ($_ text/compose module ";" name))) + _ ($_ text/compose module "." name))) (def: (decode input) (if (text/= "" input) - (#;Left (text/compose "Invalid format for Ident: " input)) - (case (text;split-all-with ";" input) + (#.Left (text/compose "Invalid format for Ident: " input)) + (case (text.split-all-with "." input) (^ (list name)) - (#;Right ["" name]) + (#.Right ["" name]) (^ (list module name)) - (#;Right [module name]) + (#.Right [module name]) _ - (#;Left (text/compose "Invalid format for Ident: " input)))))) + (#.Left (text/compose "Invalid format for Ident: " input)))))) (struct: #export _ (Hash Ident) (def: eq Eq<Ident>) (def: (hash [module name]) - (let [(^open) text;Hash<Text>] + (let [(^open) text.Hash<Text>] (n/+ (hash module) (hash name))))) diff --git a/stdlib/source/lux/data/identity.lux b/stdlib/source/lux/data/identity.lux index d2335f121..919c2385f 100644 --- a/stdlib/source/lux/data/identity.lux +++ b/stdlib/source/lux/data/identity.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux/control ["F" functor] ["A" applicative] @@ -10,10 +10,10 @@ a) ## [Structures] -(struct: #export _ (F;Functor Identity) +(struct: #export _ (F.Functor Identity) (def: map id)) -(struct: #export _ (A;Applicative Identity) +(struct: #export _ (A.Applicative Identity) (def: functor Functor<Identity>) (def: wrap id) diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux index 86fdde4a4..75b5e29e2 100644 --- a/stdlib/source/lux/data/lazy.lux +++ b/stdlib/source/lux/data/lazy.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [functor #+ Functor] @@ -14,15 +14,15 @@ (def: #hidden (freeze' generator) (All [a] (-> (-> [] a) (Lazy a))) - (let [cache (atom;atom (: (Maybe ($ +0)) #;None))] + (let [cache (atom.atom (: (Maybe ($ +0)) #.None))] (@opaque (function [_] - (case (io;run (atom;read cache)) - (#;Some value) + (case (io.run (atom.read cache)) + (#.Some value) value _ (let [value (generator [])] - (exec (io;run (atom;compare-and-swap _ (#;Some value) cache)) + (exec (io.run (atom.compare-and-swap _ (#.Some value) cache)) value))))))) (def: #export (thaw l-value) @@ -31,7 +31,7 @@ (syntax: #export (freeze expr) (do @ - [g!_ (macro;gensym "_")] + [g!_ (macro.gensym "_")] (wrap (list (` (freeze' (function [(~ g!_)] (~ expr)))))))) (struct: #export _ (Functor Lazy) diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux index 3c247eea3..02d109981 100644 --- a/stdlib/source/lux/data/maybe.lux +++ b/stdlib/source/lux/data/maybe.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["m" monoid] ["F" functor] @@ -8,52 +8,52 @@ ## [Types] ## (type: (Maybe a) -## #;None -## (#;Some a)) +## #.None +## (#.Some a)) ## [Structures] -(struct: #export Monoid<Maybe> (All [a] (m;Monoid (Maybe a))) - (def: identity #;None) +(struct: #export Monoid<Maybe> (All [a] (m.Monoid (Maybe a))) + (def: identity #.None) (def: (compose xs ys) (case xs - #;None ys - (#;Some x) (#;Some x)))) + #.None ys + (#.Some x) (#.Some x)))) -(struct: #export _ (F;Functor Maybe) +(struct: #export _ (F.Functor Maybe) (def: (map f ma) (case ma - #;None #;None - (#;Some a) (#;Some (f a))))) + #.None #.None + (#.Some a) (#.Some (f a))))) -(struct: #export _ (A;Applicative Maybe) +(struct: #export _ (A.Applicative Maybe) (def: functor Functor<Maybe>) (def: (wrap x) - (#;Some x)) + (#.Some x)) (def: (apply ff fa) (case [ff fa] - [(#;Some f) (#;Some a)] - (#;Some (f a)) + [(#.Some f) (#.Some a)] + (#.Some (f a)) _ - #;None))) + #.None))) (struct: #export _ (Monad Maybe) (def: applicative Applicative<Maybe>) (def: (join mma) (case mma - #;None #;None - (#;Some xs) xs))) + #.None #.None + (#.Some xs) xs))) (struct: #export (Eq<Maybe> Eq<a>) (All [a] (-> (Eq a) (Eq (Maybe a)))) (def: (= mx my) (case [mx my] - [#;None #;None] + [#.None #.None] true - [(#;Some x) (#;Some y)] + [(#.Some x) (#.Some y)] (:: Eq<a> = x y) _ @@ -61,40 +61,40 @@ (struct: #export (MaybeT Monad<M>) (All [M] (-> (Monad M) (Monad (All [a] (M (Maybe a)))))) - (def: applicative (A;compose (get@ #monad;applicative Monad<M>) Applicative<Maybe>)) + (def: applicative (A.compose (get@ #monad.applicative Monad<M>) Applicative<Maybe>)) (def: (join MmMma) (do Monad<M> [mMma MmMma] (case mMma - #;None - (wrap #;None) + #.None + (wrap #.None) - (#;Some Mma) + (#.Some Mma) Mma)))) (def: #export (lift Monad<M>) (All [M a] (-> (Monad M) (-> (M a) (M (Maybe a))))) - (monad;lift Monad<M> (:: Monad<Maybe> wrap))) + (monad.lift Monad<M> (:: Monad<Maybe> wrap))) (macro: #export (default tokens state) - {#;doc "## Allows you to provide a default value that will be used - ## if a (Maybe x) value turns out to be #;None. - (default 20 (#;Some 10)) => 10 + {#.doc "## Allows you to provide a default value that will be used + ## if a (Maybe x) value turns out to be #.None. + (default 20 (#.Some 10)) => 10 - (default 20 #;None) => 20"} + (default 20 #.None) => 20"} (case tokens (^ (list else maybe)) - (let [g!temp (: Code [dummy-cursor (#;Symbol ["" ""])]) + (let [g!temp (: Code [dummy-cursor (#.Symbol ["" ""])]) code (` (case (~ maybe) - (#;Some (~ g!temp)) + (#.Some (~ g!temp)) (~ g!temp) - #;None + #.None (~ else)))] - (#;Right [state (list code)])) + (#.Right [state (list code)])) _ - (#;Left "Wrong syntax for default"))) + (#.Left "Wrong syntax for default"))) (def: #export assume (All [a] (-> (Maybe a) a)) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index de8ba5242..388fa6174 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Implementations of common structures for Lux's primitive number types."} +(.module: {#.doc "Implementations of common structures for Lux's primitive number types."} lux (lux (control number [monoid #+ Monoid] @@ -24,7 +24,7 @@ ) (do-template [<type> <eq> <lt> <lte> <gt> <gte>] - [(struct: #export _ (order;Order <type>) + [(struct: #export _ (order.Order <type>) (def: eq <eq>) (def: < <lt>) (def: <= <lte>) @@ -134,7 +134,7 @@ (do-template [<name> <const> <doc>] [(def: #export <name> - {#;doc <doc>} + {#.doc <doc>} Frac (<const>))] @@ -144,7 +144,7 @@ ) (def: #export (not-a-number? number) - {#;doc "Tests whether a frac is actually not-a-number."} + {#.doc "Tests whether a frac is actually not-a-number."} (-> Frac Bool) (not (f/= number number))) @@ -161,11 +161,11 @@ (def: (decode input) (case (<decoder> [input]) - (#;Some value) - (#e;Success value) + (#.Some value) + (#e.Success value) - #;None - (#e;Error <error>))))] + #.None + (#e.Error <error>))))] [Frac "lux frac encode" "lux frac decode" "Could not decode Frac"] ) @@ -180,7 +180,7 @@ (def: (encode value) (loop [input value output ""] - (let [digit (maybe;assume (get-char <char-set> (n/% <base> input))) + (let [digit (maybe.assume (get-char <char-set> (n/% <base> input))) output' ("lux text concat" digit output) input' (n// <base> input)] (if (n/= +0 input') @@ -191,24 +191,24 @@ (let [input-size ("lux text size" repr)] (if (n/>= +2 input-size) (case ("lux text char" repr +0) - (^ (#;Some (char "+"))) + (^ (#.Some (char "+"))) (let [input ("lux text upper" repr)] (loop [idx +1 output +0] (if (n/< input-size idx) - (let [digit (maybe;assume (get-char input idx))] + (let [digit (maybe.assume (get-char input idx))] (case ("lux text index" <char-set> digit +0) - #;None - (#e;Error ("lux text concat" <error> repr)) + #.None + (#e.Error ("lux text concat" <error> repr)) - (#;Some index) + (#.Some index) (recur (n/inc idx) (|> output (n/* <base>) (n/+ index))))) - (#e;Success output)))) + (#e.Success output)))) _ - (#e;Error ("lux text concat" <error> repr))) - (#e;Error ("lux text concat" <error> repr))))))] + (#e.Error ("lux text concat" <error> repr))) + (#e.Error ("lux text concat" <error> repr))))))] [Binary@Codec<Text,Nat> +2 "01" "Invalid binary syntax for Nat: "] [Octal@Codec<Text,Nat> +8 "01234567" "Invalid octal syntax for Nat: "] @@ -227,10 +227,10 @@ (loop [input (|> value (i// <base>) (:: Number<Int> abs)) output (|> value (i/% <base>) (:: Number<Int> abs) int-to-nat (get-char <char-set>) - maybe;assume)] + maybe.assume)] (if (i/= 0 input) ("lux text concat" sign output) - (let [digit (maybe;assume (get-char <char-set> (int-to-nat (i/% <base> input))))] + (let [digit (maybe.assume (get-char <char-set> (int-to-nat (i/% <base> input))))] (recur (i// <base> input) ("lux text concat" digit output)))))))) @@ -238,7 +238,7 @@ (let [input-size ("lux text size" repr)] (if (n/>= +1 input-size) (let [sign (case (get-char repr +0) - (^ (#;Some "-")) + (^ (#.Some "-")) -1 _ @@ -247,16 +247,16 @@ (loop [idx (if (i/= -1 sign) +1 +0) output 0] (if (n/< input-size idx) - (let [digit (maybe;assume (get-char input idx))] + (let [digit (maybe.assume (get-char input idx))] (case ("lux text index" <char-set> digit +0) - #;None - (#e;Error <error>) + #.None + (#e.Error <error>) - (#;Some index) + (#.Some index) (recur (n/inc idx) (|> output (i/* <base>) (i/+ (:! Int index)))))) - (#e;Success (i/* sign output))))) - (#e;Error <error>)))))] + (#e.Success (i/* sign output))))) + (#e.Error <error>)))))] [Binary@Codec<Text,Int> 2 "01" "Invalid binary syntax for Int: "] [Octal@Codec<Text,Int> 8 "01234567" "Invalid octal syntax for Int: "] @@ -266,7 +266,7 @@ (def: (de-prefix input) (-> Text Text) - (maybe;assume ("lux text clip" input +1 ("lux text size" input)))) + (maybe.assume ("lux text clip" input +1 ("lux text size" input)))) (do-template [<struct> <nat> <char-bit-size> <error>] [(struct: #export <struct> (Codec Text Deg) @@ -287,14 +287,14 @@ (let [repr-size ("lux text size" repr)] (if (n/>= +2 repr-size) (case ("lux text char" repr +0) - (^multi (^ (#;Some (char "."))) + (^multi (^ (#.Some (char "."))) [(:: <nat> decode ("lux text concat" "+" (de-prefix repr))) - (#e;Success output)]) - (#e;Success (:! Deg output)) + (#e.Success output)]) + (#e.Success (:! Deg output)) _ - (#e;Error ("lux text concat" <error> repr))) - (#e;Error ("lux text concat" <error> repr))))))] + (#e.Error ("lux text concat" <error> repr))) + (#e.Error ("lux text concat" <error> repr))))))] [Binary@Codec<Text,Deg> Binary@Codec<Text,Nat> +1 "Invalid binary syntax: "] [Octal@Codec<Text,Deg> Octal@Codec<Text,Nat> +3 "Invalid octal syntax: "] @@ -315,19 +315,19 @@ ("lux text concat" "." output) (let [shifted (f/* <base> dec-left) digit (|> shifted (f/% <base>) frac-to-int int-to-nat - (get-char <char-set>) maybe;assume)] + (get-char <char-set>) maybe.assume)] (recur (f/% 1.0 shifted) ("lux text concat" output digit))))))] ("lux text concat" whole-part decimal-part))) (def: (decode repr) (case ("lux text index" repr "." +0) - (#;Some split-index) - (let [whole-part (maybe;assume ("lux text clip" repr +0 split-index)) - decimal-part (maybe;assume ("lux text clip" repr (n/inc split-index) ("lux text size" repr)))] + (#.Some split-index) + (let [whole-part (maybe.assume ("lux text clip" repr +0 split-index)) + decimal-part (maybe.assume ("lux text clip" repr (n/inc split-index) ("lux text size" repr)))] (case [(:: <int> decode whole-part) (:: <int> decode decimal-part)] - (^multi [(#e;Success whole) (#e;Success decimal)] + (^multi [(#e.Success whole) (#e.Success decimal)] (i/>= 0 decimal)) (let [sign (if (i/< 0 whole) -1.0 @@ -340,19 +340,19 @@ (f/* <base> output)))) adjusted-decimal (|> decimal int-to-frac (f// div-power)) dec-deg (case (:: Hex@Codec<Text,Deg> decode ("lux text concat" "." decimal-part)) - (#e;Success dec-deg) + (#e.Success dec-deg) dec-deg - (#e;Error error) + (#e.Error error) (error! error))] - (#e;Success (f/+ (int-to-frac whole) + (#e.Success (f/+ (int-to-frac whole) (f/* sign adjusted-decimal)))) _ - (#e;Error ("lux text concat" <error> repr)))) + (#e.Error ("lux text concat" <error> repr)))) _ - (#e;Error ("lux text concat" <error> repr)))))] + (#e.Error ("lux text concat" <error> repr)))))] [Binary@Codec<Text,Frac> Binary@Codec<Text,Int> 2.0 "01" "Invalid binary syntax: "] ) @@ -368,8 +368,8 @@ (if (n/<= chunk-size num-digits) (list digits) (let [boundary (n/- chunk-size num-digits) - chunk (maybe;assume ("lux text clip" digits boundary num-digits)) - remaining (maybe;assume ("lux text clip" digits +0 boundary))] + chunk (maybe.assume ("lux text clip" digits boundary num-digits)) + remaining (maybe.assume ("lux text clip" digits +0 boundary))] (list& chunk (segment-digits chunk-size remaining))))))) (def: (bin-segment-to-hex input) @@ -443,19 +443,19 @@ (def: (map f xs) (All [a b] (-> (-> a b) (List a) (List b))) (case xs - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons x xs') - (#;Cons (f x) (map f xs')))) + (#.Cons x xs') + (#.Cons (f x) (map f xs')))) (def: (re-join-chunks xs) (-> (List Text) Text) (case xs - #;Nil + #.Nil "" - (#;Cons x xs') + (#.Cons x xs') ("lux text concat" x (re-join-chunks xs')))) (do-template [<from> <from-translator> <to> <to-translator> <base-bits>] @@ -497,11 +497,11 @@ (def: (encode value) (let [sign (:: Number<Frac> signum value) raw-bin (:: Binary@Codec<Text,Frac> encode value) - dot-idx (maybe;assume ("lux text index" raw-bin "." +0)) - whole-part (maybe;assume ("lux text clip" raw-bin + dot-idx (maybe.assume ("lux text index" raw-bin "." +0)) + whole-part (maybe.assume ("lux text clip" raw-bin (if (f/= -1.0 sign) +1 +0) dot-idx)) - decimal-part (maybe;assume ("lux text clip" raw-bin (n/inc dot-idx) ("lux text size" raw-bin))) + decimal-part (maybe.assume ("lux text clip" raw-bin (n/inc dot-idx) ("lux text size" raw-bin))) hex-output (|> (<from> false decimal-part) ("lux text concat" ".") ("lux text concat" (<from> true whole-part)) @@ -510,28 +510,28 @@ (def: (decode repr) (let [sign (case ("lux text index" repr "-" +0) - (#;Some +0) + (#.Some +0) -1.0 _ 1.0)] (case ("lux text index" repr "." +0) - (#;Some split-index) - (let [whole-part (maybe;assume ("lux text clip" repr (if (f/= -1.0 sign) +1 +0) split-index)) - decimal-part (maybe;assume ("lux text clip" repr (n/inc split-index) ("lux text size" repr))) + (#.Some split-index) + (let [whole-part (maybe.assume ("lux text clip" repr (if (f/= -1.0 sign) +1 +0) split-index)) + decimal-part (maybe.assume ("lux text clip" repr (n/inc split-index) ("lux text size" repr))) as-binary (|> (<to> decimal-part) ("lux text concat" ".") ("lux text concat" (<to> whole-part)) ("lux text concat" (if (f/= -1.0 sign) "-" "")))] (case (:: Binary@Codec<Text,Frac> decode as-binary) - (#e;Error _) - (#e;Error ("lux text concat" <error> repr)) + (#e.Error _) + (#e.Error ("lux text concat" <error> repr)) output output)) _ - (#e;Error ("lux text concat" <error> repr))))))] + (#e.Error ("lux text concat" <error> repr))))))] [Octal@Codec<Text,Frac> "Invalid octaladecimal syntax: " binary-to-octal octal-to-binary] [Hex@Codec<Text,Frac> "Invalid hexadecimal syntax: " binary-to-hex hex-to-binary] @@ -539,30 +539,30 @@ (do-template [<macro> <nat> <int> <deg> <frac> <error> <doc>] [(macro: #export (<macro> tokens state) - {#;doc <doc>} + {#.doc <doc>} (case tokens - (#;Cons [meta (#;Text repr)] #;Nil) + (#.Cons [meta (#.Text repr)] #.Nil) (case (:: <nat> decode repr) - (#e;Success value) - (#e;Success [state (list [meta (#;Nat value)])]) + (#e.Success value) + (#e.Success [state (list [meta (#.Nat value)])]) - (^multi (#e;Error _) - [(:: <int> decode repr) (#e;Success value)]) - (#e;Success [state (list [meta (#;Int value)])]) + (^multi (#e.Error _) + [(:: <int> decode repr) (#e.Success value)]) + (#e.Success [state (list [meta (#.Int value)])]) - (^multi (#e;Error _) - [(:: <deg> decode repr) (#e;Success value)]) - (#e;Success [state (list [meta (#;Deg value)])]) + (^multi (#e.Error _) + [(:: <deg> decode repr) (#e.Success value)]) + (#e.Success [state (list [meta (#.Deg value)])]) - (^multi (#e;Error _) - [(:: <frac> decode repr) (#e;Success value)]) - (#e;Success [state (list [meta (#;Frac value)])]) + (^multi (#e.Error _) + [(:: <frac> decode repr) (#e.Success value)]) + (#e.Success [state (list [meta (#.Frac value)])]) _ - (#e;Error <error>)) + (#e.Error <error>)) _ - (#e;Error <error>)))] + (#e.Error <error>)))] [bin Binary@Codec<Text,Nat> Binary@Codec<Text,Int> Binary@Codec<Text,Deg> Binary@Codec<Text,Frac> "Invalid binary syntax." @@ -592,11 +592,11 @@ (def: (make-digits _) (-> Top Digits) - ("lux array new" bit;width)) + ("lux array new" bit.width)) (def: (digits-get idx digits) (-> Nat Digits Nat) - (maybe;default +0 ("lux array get" digits idx))) + (maybe.default +0 ("lux array get" digits idx))) (def: (digits-put idx digit digits) (-> Nat Nat Digits Digits) @@ -632,7 +632,7 @@ (def: (digits-to-text digits) (-> Digits Text) - (loop [idx (n/dec bit;width) + (loop [idx (n/dec bit.width) all-zeroes? true output ""] (if (i/>= 0 (:! Int idx)) @@ -651,7 +651,7 @@ (def: (digits-add param subject) (-> Digits Digits Digits) - (loop [idx (n/dec bit;width) + (loop [idx (n/dec bit.width) carry +0 output (make-digits [])] (if (i/>= 0 (:! Int idx)) @@ -667,25 +667,25 @@ (def: (text-to-digits input) (-> Text (Maybe Digits)) (let [length ("lux text size" input)] - (if (n/<= bit;width length) + (if (n/<= bit.width length) (loop [idx +0 output (make-digits [])] (if (n/< length idx) - (let [char (maybe;assume (get-char input idx))] + (let [char (maybe.assume (get-char input idx))] (case ("lux text index" "0123456789" char +0) - #;None - #;None + #.None + #.None - (#;Some digit) + (#.Some digit) (recur (n/inc idx) (digits-put idx digit output)))) - (#;Some output))) - #;None))) + (#.Some output))) + #.None))) (def: (digits-lt param subject) (-> Digits Digits Bool) (loop [idx +0] - (and (n/< bit;width idx) + (and (n/< bit.width idx) (let [pd (digits-get idx param) sd (digits-get idx subject)] (if (n/= pd sd) @@ -706,7 +706,7 @@ (def: (digits-sub! param subject) (-> Digits Digits Digits) - (loop [idx (n/dec bit;width) + (loop [idx (n/dec bit.width) output subject] (if (i/>= 0 (nat-to-int idx)) (recur (n/dec idx) @@ -716,13 +716,13 @@ (struct: #export _ (Codec Text Deg) (def: (encode input) (let [input (:! Nat input) - last-idx (n/dec bit;width)] + last-idx (n/dec bit.width)] (if (n/= +0 input) ".0" (loop [idx last-idx digits (make-digits [])] (if (i/>= 0 (:! Int idx)) - (if (bit;set? idx input) + (if (bit.set? idx input) (let [digits' (digits-add (digits-power (n/- idx last-idx)) digits)] (recur (n/dec idx) @@ -735,33 +735,33 @@ (def: (decode input) (let [length ("lux text size" input) dotted? (case ("lux text index" input "." +0) - (#;Some +0) + (#.Some +0) true _ false)] (if (and dotted? - (n/<= (n/inc bit;width) length)) + (n/<= (n/inc bit.width) length)) (case (|> ("lux text clip" input +1 length) - maybe;assume + maybe.assume text-to-digits) - (#;Some digits) + (#.Some digits) (loop [digits digits idx +0 output +0] - (if (n/< bit;width idx) + (if (n/< bit.width idx) (let [power (digits-power idx)] (if (digits-lt power digits) ## Skip power (recur digits (n/inc idx) output) (recur (digits-sub! power digits) (n/inc idx) - (bit;set (n/- idx (n/dec bit;width)) output)))) - (#e;Success (:! Deg output)))) + (bit.set (n/- idx (n/dec bit.width)) output)))) + (#e.Success (:! Deg output)))) - #;None - (#e;Error ("lux text concat" "Wrong syntax for Deg: " input))) - (#e;Error ("lux text concat" "Wrong syntax for Deg: " input)))) + #.None + (#e.Error ("lux text concat" "Wrong syntax for Deg: " input))) + (#e.Error ("lux text concat" "Wrong syntax for Deg: " input)))) )) (def: (log2 input) @@ -797,26 +797,26 @@ (let [sign (:: Number<Frac> signum input) input (:: Number<Frac> abs input) exponent ("lux math floor" (log2 input)) - exponent-mask (|> +1 (bit;shift-left exponent-size) n/dec) + exponent-mask (|> +1 (bit.shift-left exponent-size) n/dec) mantissa (|> input ## Normalize (f// ("lux math pow" 2.0 exponent)) ## Make it int-equivalent (f/* ("lux math pow" 2.0 52.0))) sign-bit (if (f/= -1.0 sign) +1 +0) - exponent-bits (|> exponent frac-to-int int-to-nat (n/+ double-bias) (bit;and exponent-mask)) + exponent-bits (|> exponent frac-to-int int-to-nat (n/+ double-bias) (bit.and exponent-mask)) mantissa-bits (|> mantissa frac-to-int int-to-nat)] - ($_ bit;or - (bit;shift-left +63 sign-bit) - (bit;shift-left mantissa-size exponent-bits) - (bit;clear mantissa-size mantissa-bits))) + ($_ bit.or + (bit.shift-left +63 sign-bit) + (bit.shift-left mantissa-size exponent-bits) + (bit.clear mantissa-size mantissa-bits))) )) (do-template [<getter> <mask> <size> <offset>] - [(def: <mask> (|> +1 (bit;shift-left <size>) n/dec (bit;shift-left <offset>))) + [(def: <mask> (|> +1 (bit.shift-left <size>) n/dec (bit.shift-left <offset>))) (def: (<getter> input) (-> Nat Nat) - (|> input (bit;and <mask>) (bit;shift-right <offset>)))] + (|> input (bit.and <mask>) (bit.shift-right <offset>)))] [mantissa mantissa-mask mantissa-size +0] [exponent exponent-mask exponent-size mantissa-size] @@ -841,7 +841,7 @@ (f/* -1.0 0.0)) ## else - (let [normalized (|> M (bit;set mantissa-size) + (let [normalized (|> M (bit.set mantissa-size) nat-to-int int-to-frac (f// ("lux math pow" 2.0 52.0))) power (|> E (n/- double-bias) diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index 783c8eb81..d17180530 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/data/number/complex.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Complex arithmetic."} +(.module: {#.doc "Complex arithmetic."} lux (lux [math] (control [eq #+ Eq] @@ -20,13 +20,13 @@ {#real Frac #imaginary Frac}) -(syntax: #export (complex real [?imaginary (p;maybe s;any)]) - {#;doc (doc "Complex literals." +(syntax: #export (complex real [?imaginary (p.maybe 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 (~ (maybe;default (' 0.0) + (wrap (list (` {#..real (~ real) + #..imaginary (~ (maybe.default (' 0.0) ?imaginary))})))) (def: #export i Complex (complex 0.0 1.0)) @@ -36,8 +36,8 @@ (def: #export zero Complex (complex 0.0 0.0)) (def: #export (not-a-number? complex) - (or (number;not-a-number? (get@ #real complex)) - (number;not-a-number? (get@ #imaginary complex)))) + (or (number.not-a-number? (get@ #real complex)) + (number.not-a-number? (get@ #imaginary complex)))) (def: #export (c/= param input) (-> Complex Complex Bool) @@ -117,60 +117,60 @@ (-> Complex Complex Complex) (let [scaled (c// param input) quotient (|> scaled - (update@ #real math;floor) - (update@ #imaginary math;floor))] + (update@ #real math.floor) + (update@ #imaginary math.floor))] (c/- (c/* quotient param) input))) (def: #export (cos subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (f/* (math;cosh imaginary) - (math;cos real)) - #imaginary (f/* (math;sinh imaginary) - (frac/negate (math;sin real)))})) + {#real (f/* (math.cosh imaginary) + (math.cos real)) + #imaginary (f/* (math.sinh imaginary) + (frac/negate (math.sin real)))})) (def: #export (cosh subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (f/* (math;cos imaginary) - (math;cosh real)) - #imaginary (f/* (math;sin imaginary) - (math;sinh real))})) + {#real (f/* (math.cos imaginary) + (math.cosh real)) + #imaginary (f/* (math.sin imaginary) + (math.sinh real))})) (def: #export (sin subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (f/* (math;cosh imaginary) - (math;sin real)) - #imaginary (f/* (math;sinh imaginary) - (math;cos real))})) + {#real (f/* (math.cosh imaginary) + (math.sin real)) + #imaginary (f/* (math.sinh imaginary) + (math.cos real))})) (def: #export (sinh subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (f/* (math;cos imaginary) - (math;sinh real)) - #imaginary (f/* (math;sin imaginary) - (math;cosh real))})) + {#real (f/* (math.cos imaginary) + (math.sinh real)) + #imaginary (f/* (math.sin imaginary) + (math.cosh real))})) (def: #export (tan subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject r2 (f/* 2.0 real) i2 (f/* 2.0 imaginary) - d (f/+ (math;cos r2) (math;cosh i2))] - {#real (f// d (math;sin r2)) - #imaginary (f// d (math;sinh i2))})) + d (f/+ (math.cos r2) (math.cosh i2))] + {#real (f// d (math.sin r2)) + #imaginary (f// d (math.sinh i2))})) (def: #export (tanh subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject r2 (f/* 2.0 real) i2 (f/* 2.0 imaginary) - d (f/+ (math;cosh r2) (math;cos i2))] - {#real (f// d (math;sinh r2)) - #imaginary (f// d (math;sin i2))})) + d (f/+ (math.cosh r2) (math.cos i2))] + {#real (f// d (math.sinh r2)) + #imaginary (f// d (math.sin i2))})) (def: #export (c/abs subject) (-> Complex Complex) @@ -180,12 +180,12 @@ (if (f/= 0.0 imaginary) (frac/abs real) (let [q (f// imaginary real)] - (f/* (math;root2 (f/+ 1.0 (f/* q q))) + (f/* (math.root2 (f/+ 1.0 (f/* q q))) (frac/abs imaginary)))) (if (f/= 0.0 real) (frac/abs imaginary) (let [q (f// real imaginary)] - (f/* (math;root2 (f/+ 1.0 (f/* q q))) + (f/* (math.root2 (f/+ 1.0 (f/* q q))) (frac/abs real)))) )))) @@ -208,15 +208,15 @@ (def: #export (exp subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject - r-exp (math;exp real)] - {#real (f/* r-exp (math;cos imaginary)) - #imaginary (f/* r-exp (math;sin imaginary))})) + r-exp (math.exp real)] + {#real (f/* r-exp (math.cos imaginary)) + #imaginary (f/* r-exp (math.sin imaginary))})) (def: #export (log subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (|> subject c/abs (get@ #real) math;log) - #imaginary (math;atan2 real imaginary)})) + {#real (|> subject c/abs (get@ #real) math.log) + #imaginary (math.atan2 real imaginary)})) (do-template [<name> <type> <op>] [(def: #export (<name> param input) @@ -233,7 +233,7 @@ (def: #export (root2 (^@ input (^slots [#real #imaginary]))) (-> Complex Complex) - (let [t (|> input c/abs (get@ #real) (f/+ (frac/abs real)) (f// 2.0) math;root2)] + (let [t (|> input c/abs (get@ #real) (f/+ (frac/abs real)) (f// 2.0) math.root2)] (if (f/>= 0.0 real) {#real t #imaginary (f// (f/* 2.0 t) @@ -286,24 +286,24 @@ (def: #export (argument (^slots [#real #imaginary])) (-> Complex Frac) - (math;atan2 real imaginary)) + (math.atan2 real imaginary)) (def: #export (nth-roots nth input) (-> Nat Complex (List Complex)) (if (n/= +0 nth) (list) (let [r-nth (|> nth nat-to-int int-to-frac) - nth-root-of-abs (|> input c/abs (get@ #real) (math;pow (f// r-nth 1.0))) + nth-root-of-abs (|> input c/abs (get@ #real) (math.pow (f// r-nth 1.0))) nth-phi (|> input argument (f// r-nth)) - slice (|> math;pi (f/* 2.0) (f// r-nth))] - (|> (list;n/range +0 (n/dec nth)) + slice (|> math.pi (f/* 2.0) (f// r-nth))] + (|> (list.n/range +0 (n/dec nth)) (L/map (function [nth'] (let [inner (|> nth' nat-to-int int-to-frac (f/* slice) (f/+ nth-phi)) real (f/* nth-root-of-abs - (math;cos inner)) + (math.cos inner)) imaginary (f/* nth-root-of-abs - (math;sin inner))] + (math.sin inner))] {#real real #imaginary imaginary}))))))) diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux index 23e128464..6f5b64f5e 100644 --- a/stdlib/source/lux/data/number/ratio.lux +++ b/stdlib/source/lux/data/number/ratio.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Rational arithmetic."} +(.module: {#.doc "Rational arithmetic."} lux (lux [math] (control [eq #+ Eq] @@ -23,7 +23,7 @@ (def: #hidden (normalize (^slots [#numerator #denominator])) (-> Ratio Ratio) - (let [common (math;gcd numerator denominator)] + (let [common (math.gcd numerator denominator)] {#numerator (n// common numerator) #denominator (n// common denominator)})) @@ -103,7 +103,7 @@ (struct: #export _ (Eq Ratio) (def: = r/=)) -(struct: #export _ (order;Order Ratio) +(struct: #export _ (order.Order Ratio) (def: eq Eq<Ratio>) (def: < r/<) (def: <= r/<=) @@ -128,10 +128,10 @@ (def: part-encode (-> Nat Text) - (|>> n/encode (text;split +1) maybe;assume product;right)) + (|>> n/encode (text.split +1) maybe.assume product.right)) (def: part-decode - (-> Text (E;Error Nat)) + (-> Text (E.Error Nat)) (|>> (format "+") n/decode)) (struct: #export _ (Codec Text Ratio) @@ -139,22 +139,22 @@ ($_ Text/compose (part-encode numerator) separator (part-encode denominator))) (def: (decode input) - (case (text;split-with separator input) - (#;Some [num denom]) - (do E;Monad<Error> + (case (text.split-with separator input) + (#.Some [num denom]) + (do E.Monad<Error> [numerator (part-decode num) denominator (part-decode denom)] (wrap (normalize {#numerator numerator #denominator denominator}))) - #;None - (#;Left (Text/compose "Invalid syntax for ratio: " input))))) + #.None + (#.Left (Text/compose "Invalid syntax for ratio: " input))))) -(syntax: #export (ratio numerator [?denominator (p;maybe s;any)]) - {#;doc (doc "Rational literals." +(syntax: #export (ratio numerator [?denominator (p.maybe 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 (~ (maybe;default (' +1) + (wrap (list (` (normalize {#..numerator (~ numerator) + #..denominator (~ (maybe.default (' +1) ?denominator))}))))) diff --git a/stdlib/source/lux/data/product.lux b/stdlib/source/lux/data/product.lux index d38350929..712e96437 100644 --- a/stdlib/source/lux/data/product.lux +++ b/stdlib/source/lux/data/product.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Functionality for working with tuples (particularly 2-tuples)."} +(.module: {#.doc "Functionality for working with tuples (particularly 2-tuples)."} lux) ## [Functions] diff --git a/stdlib/source/lux/data/store.lux b/stdlib/source/lux/data/store.lux index 535254ad9..70fd022f4 100644 --- a/stdlib/source/lux/data/store.lux +++ b/stdlib/source/lux/data/store.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["F" functor] comonad) @@ -13,7 +13,7 @@ {#cursor (get@ #cursor wa) #peek (function [s] (f (set@ #cursor s wa)))}) -(struct: #export Functor<Store> (All [s] (F;Functor (Store s))) +(struct: #export Functor<Store> (All [s] (F.Functor (Store s))) (def: (map f fa) (extend (function [store] (f (:: store peek (:: store cursor)))) @@ -39,5 +39,5 @@ (|> store (::: split) (peeks change))) (def: #export (experiment Functor<f> change store) - (All [f s a] (-> (F;Functor f) (-> s (f s)) (Store s a) (f a))) + (All [f s a] (-> (F.Functor f) (-> s (f s)) (Store s a) (f a))) (:: Functor<f> map (::: peek) (change (::: cursor)))) diff --git a/stdlib/source/lux/data/sum.lux b/stdlib/source/lux/data/sum.lux index 2c71f67d4..c2373c238 100644 --- a/stdlib/source/lux/data/sum.lux +++ b/stdlib/source/lux/data/sum.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Functionality for working with variants (particularly 2-variants)."} +(.module: {#.doc "Functionality for working with variants (particularly 2-variants)."} lux) ## [Values] @@ -22,9 +22,9 @@ [(def: #export (<name> es) (All [a b] (-> (List (| a b)) (List <side>))) (case es - #;Nil #;Nil - (#;Cons (<tag> x) es') (#;Cons [x (<name> es')]) - (#;Cons _ es') (<name> es')))] + #.Nil #.Nil + (#.Cons (<tag> x) es') (#.Cons [x (<name> es')]) + (#.Cons _ es') (<name> es')))] [lefts a +0] [rights b +1] @@ -33,11 +33,11 @@ (def: #export (partition xs) (All [a b] (-> (List (| a b)) [(List a) (List b)])) (case xs - #;Nil - [#;Nil #;Nil] + #.Nil + [#.Nil #.Nil] - (#;Cons x xs') + (#.Cons x xs') (let [[lefts rights] (partition xs')] (case x - (+0 x') [(#;Cons x' lefts) rights] - (+1 x') [lefts (#;Cons x' rights)])))) + (+0 x') [(#.Cons x' lefts) rights] + (+1 x') [lefts (#.Cons x' rights)])))) diff --git a/stdlib/source/lux/data/tainted.lux b/stdlib/source/lux/data/tainted.lux index d65e9c56b..2190c3712 100644 --- a/stdlib/source/lux/data/tainted.lux +++ b/stdlib/source/lux/data/tainted.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (data [product]) (type opaque))) @@ -18,8 +18,8 @@ (All [a] (-> (-> a Bool) (Tainted a) (Maybe a))) (let [value (trust tainted)] (if (pred value) - (#;Some value) - #;None))) + (#.Some value) + #.None))) (def: #export (sanitize f tainted) (All [a] (-> (-> a a) (Tainted a) a)) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index bf05df201..0fdbb376f 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monoid #+ Monoid] [eq #+ Eq] @@ -21,7 +21,7 @@ (def: #export (contains? sub text) (-> Text Text Bool) (case ("lux text index" text sub +0) - (#;Some _) + (#.Some _) true _ @@ -59,34 +59,34 @@ (def: (last-index-of'' part part-size since text) (-> Text Nat Nat Text (Maybe Nat)) (case ("lux text index" text part (n/+ part-size since)) - #;None - (#;Some since) + #.None + (#.Some since) - (#;Some since') + (#.Some since') (last-index-of'' part part-size since' text))) (def: #export (last-index-of' part from text) (-> Text Nat Text (Maybe Nat)) (case ("lux text index" text part from) - (#;Some since) + (#.Some since) (last-index-of'' part ("lux text size" part) since text) - #;None - #;None)) + #.None + #.None)) (def: #export (last-index-of part text) (-> Text Text (Maybe Nat)) (case ("lux text index" text part +0) - (#;Some since) + (#.Some since) (last-index-of'' part ("lux text size" part) since text) - #;None - #;None)) + #.None + #.None)) (def: #export (starts-with? prefix x) (-> Text Text Bool) (case (index-of prefix x) - (#;Some +0) + (#.Some +0) true _ @@ -95,7 +95,7 @@ (def: #export (ends-with? postfix x) (-> Text Text Bool) (case (last-index-of postfix x) - (#;Some n) + (#.Some n) (n/= (size x) (n/+ (size postfix) n)) @@ -105,15 +105,15 @@ (def: #export (split at x) (-> Nat Text (Maybe [Text Text])) (case [(clip +0 at x) (clip' at x)] - [(#;Some pre) (#;Some post)] - (#;Some [pre post]) + [(#.Some pre) (#.Some post)] + (#.Some [pre post]) _ - #;None)) + #.None)) (def: #export (split-with token sample) (-> Text Text (Maybe [Text Text])) - (do maybe;Monad<Maybe> + (do maybe.Monad<Maybe> [index (index-of token sample) [pre post'] (split index sample) [_ post] (split (size token) post')] @@ -122,11 +122,11 @@ (def: #export (split-all-with token sample) (-> Text Text (List Text)) (case (split-with token sample) - (#;Some [pre post]) - (#;Cons pre (split-all-with token post)) + (#.Some [pre post]) + (#.Cons pre (split-all-with token post)) - #;None - (#;Cons sample #;Nil))) + #.None + (#.Cons sample #.Nil))) (def: #export split-lines (split-all-with "\n")) @@ -136,7 +136,7 @@ (def: (= test subject) ("lux text =" subject test))) -(struct: #export _ (order;Order Text) +(struct: #export _ (order.Order Text) (def: eq Eq<Text>) (def: (< test subject) @@ -183,13 +183,13 @@ (def: #export concat (-> (List Text) Text) - (let [(^open) list;Fold<List> + (let [(^open) list.Fold<List> (^open) Monoid<Text>] - (|>> list;reverse (fold text/compose identity)))) + (|>> list.reverse (fold text/compose identity)))) (def: #export (join-with sep texts) (-> Text (List Text) Text) - (|> texts (list;interpose sep) concat)) + (|> texts (list.interpose sep) concat)) (def: #export (empty? text) (-> Text Bool) @@ -199,20 +199,20 @@ (def: #export (replace-once pattern value template) (-> Text Text Text Text) - (maybe;default template - (do maybe;Monad<Maybe> + (maybe.default template + (do maybe.Monad<Maybe> [[pre post] (split-with pattern template) #let [(^open) Monoid<Text>]] (wrap ($_ text/compose pre value post))))) (def: #export (enclose [left right] content) - {#;doc "Surrounds the given content text with left and right side additions."} + {#.doc "Surrounds the given content text with left and right side additions."} (-> [Text Text] Text Text) (let [(^open) Monoid<Text>] ($_ text/compose left content right))) (def: #export (enclose' boundary content) - {#;doc "Surrounds the given content text with the same boundary text."} + {#.doc "Surrounds the given content text with the same boundary text."} (-> Text Text Text) (enclose [boundary boundary] content)) @@ -221,7 +221,7 @@ ("lux nat char" code)) (def: #export (space? char) - {#;doc "Checks whether the character is white-space."} + {#.doc "Checks whether the character is white-space."} (-> Nat Bool) (case char (^or (^ (char "\t")) (^ (char "\v")) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index 9f8d2b25f..e1c93bc5f 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do Monad] ["p" parser]) @@ -15,21 +15,22 @@ [macro] (macro [code] ["s" syntax #+ syntax: Syntax]) - (lang [type]))) + (lang [type]) + )) ## [Syntax] (def: #hidden _compose_ (-> Text Text Text) - (:: text;Monoid<Text> compose)) + (:: text.Monoid<Text> compose)) -(syntax: #export (format [fragments (p;many s;any)]) - {#;doc (doc "Text interpolation." +(syntax: #export (format [fragments (p.many s.any)]) + {#.doc (doc "Text interpolation." (format "Static part " (%t static) " does not match URI: " uri))} (wrap (list (` ($_ _compose_ (~@ fragments)))))) ## [Formatters] (type: #export (Formatter a) - {#;doc "A way to produce readable text from values."} + {#.doc "A way to produce readable text from values."} (-> a Text)) (do-template [<name> <type> <formatter>] @@ -37,31 +38,31 @@ (Formatter <type>) <formatter>)] - [%b Bool (:: bool;Codec<Text,Bool> encode)] - [%n Nat (:: number;Codec<Text,Nat> encode)] - [%i Int (:: number;Codec<Text,Int> encode)] - [%d Deg (:: number;Codec<Text,Deg> encode)] - [%f Frac (:: number;Codec<Text,Frac> encode)] - [%t Text text;encode] - [%ident Ident (:: ident;Codec<Text,Ident> encode)] - [%code Code code;to-text] - [%type Type type;to-text] - [%bin Nat (:: number;Binary@Codec<Text,Nat> encode)] - [%oct Nat (:: number;Octal@Codec<Text,Nat> encode)] - [%hex Nat (:: number;Hex@Codec<Text,Nat> encode)] - [%xml xml;XML (:: xml;Codec<Text,XML> encode)] - [%json json;JSON (:: json;Codec<Text,JSON> encode)] - [%instant instant;Instant (:: instant;Codec<Text,Instant> encode)] - [%duration duration;Duration (:: duration;Codec<Text,Duration> encode)] - [%date date;Date (:: date;Codec<Text,Date> encode)] + [%b Bool (:: bool.Codec<Text,Bool> encode)] + [%n Nat (:: number.Codec<Text,Nat> encode)] + [%i Int (:: number.Codec<Text,Int> encode)] + [%d Deg (:: number.Codec<Text,Deg> encode)] + [%f Frac (:: number.Codec<Text,Frac> encode)] + [%t Text text.encode] + [%ident Ident (:: ident.Codec<Text,Ident> encode)] + [%code Code code.to-text] + [%type Type type.to-text] + [%bin Nat (:: number.Binary@Codec<Text,Nat> encode)] + [%oct Nat (:: number.Octal@Codec<Text,Nat> encode)] + [%hex Nat (:: number.Hex@Codec<Text,Nat> encode)] + [%xml xml.XML (:: xml.Codec<Text,XML> encode)] + [%json json.JSON (:: json.Codec<Text,JSON> encode)] + [%instant instant.Instant (:: instant.Codec<Text,Instant> encode)] + [%duration duration.Duration (:: duration.Codec<Text,Duration> encode)] + [%date date.Date (:: date.Codec<Text,Date> encode)] ) (def: #export (%list formatter) (All [a] (-> (Formatter a) (Formatter (List a)))) (function [values] (case values - #;Nil + #.Nil "(list)" _ - (format "(list " (text;join-with " " (list/map formatter values)) ")")))) + (format "(list " (text.join-with " " (list/map formatter values)) ")")))) diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux index 354dc29a9..320e28d6d 100644 --- a/stdlib/source/lux/data/text/lexer.lux +++ b/stdlib/source/lux/data/text/lexer.lux @@ -1,4 +1,4 @@ -(;module: +(.module: [lux #- not] (lux (control [monad #+ do Monad] ["p" parser]) @@ -14,11 +14,11 @@ (def: start-offset Offset +0) (type: #export Lexer - (p;Parser [Offset Text])) + (p.Parser [Offset Text])) (def: (remaining offset tape) (-> Offset Text Text) - (|> tape (text;split offset) maybe;assume product;right)) + (|> tape (text.split offset) maybe.assume product.right)) (def: cannot-lex-error Text "Cannot lex from empty text.") @@ -27,231 +27,231 @@ ($_ text/compose "Unconsumed input: " (remaining offset tape))) (def: #export (run input lexer) - (All [a] (-> Text (Lexer a) (E;Error a))) + (All [a] (-> Text (Lexer a) (E.Error a))) (case (lexer [start-offset input]) - (#E;Error msg) - (#E;Error msg) - - (#E;Success [[end-offset _] output]) - (if (n/= end-offset (text;size input)) - (#E;Success output) - (#E;Error (unconsumed-input-error end-offset input))) - )) + (#E.Error msg) + (#E.Error msg) + + (#E.Success [[end-offset _] output]) + (if (n/= end-offset (text.size input)) + (#E.Success output) + (#E.Error (unconsumed-input-error end-offset input))) + )) (def: #export any - {#;doc "Just returns the next character without applying any logic."} + {#.doc "Just returns the next character without applying any logic."} (Lexer Text) (function [[offset tape]] - (case (text;nth offset tape) - (#;Some output) - (#E;Success [[(n/inc offset) tape] (text;from-code output)]) + (case (text.nth offset tape) + (#.Some output) + (#E.Success [[(n/inc offset) tape] (text.from-code output)]) - _ - (#E;Error cannot-lex-error)) - )) + _ + (#E.Error cannot-lex-error)) + )) (def: #export (not p) - {#;doc "Produce a character if the lexer fails."} + {#.doc "Produce a character if the lexer fails."} (All [a] (-> (Lexer a) (Lexer Text))) (function [input] - (case (p input) - (#E;Error msg) - (any input) - - _ - (#E;Error "Expected to fail; yet succeeded.")))) + (case (p input) + (#E.Error msg) + (any input) + + _ + (#E.Error "Expected to fail; yet succeeded.")))) (def: #export (this reference) - {#;doc "Lex a text if it matches the given sample."} + {#.doc "Lex a text if it matches the given sample."} (-> Text (Lexer Unit)) (function [[offset tape]] - (case (text;index-of' reference offset tape) - (#;Some where) - (if (n/= offset where) - (#E;Success [[(n/+ (text;size reference) offset) tape] []]) - (#E;Error ($_ text/compose "Could not match: " (text;encode reference) " @ " (maybe;assume (text;clip' offset tape))))) + (case (text.index-of' reference offset tape) + (#.Some where) + (if (n/= offset where) + (#E.Success [[(n/+ (text.size reference) offset) tape] []]) + (#E.Error ($_ text/compose "Could not match: " (text.encode reference) " @ " (maybe.assume (text.clip' offset tape))))) - _ - (#E;Error ($_ text/compose "Could not match: " (text;encode reference)))))) + _ + (#E.Error ($_ text/compose "Could not match: " (text.encode reference)))))) (def: #export (this? reference) - {#;doc "Lex a text if it matches the given sample."} + {#.doc "Lex a text if it matches the given sample."} (-> Text (Lexer Bool)) (function [(^@ input [offset tape])] - (case (text;index-of' reference offset tape) - (^multi (#;Some where) (n/= offset where)) - (#E;Success [[(n/+ (text;size reference) offset) tape] true]) + (case (text.index-of' reference offset tape) + (^multi (#.Some where) (n/= offset where)) + (#E.Success [[(n/+ (text.size reference) offset) tape] true]) - _ - (#E;Success [input false])))) + _ + (#E.Success [input false])))) (def: #export end - {#;doc "Ensure the lexer's input is empty."} + {#.doc "Ensure the lexer's input is empty."} (Lexer Unit) (function [(^@ input [offset tape])] - (if (n/= offset (text;size tape)) - (#E;Success [input []]) - (#E;Error (unconsumed-input-error offset tape))))) + (if (n/= offset (text.size tape)) + (#E.Success [input []]) + (#E.Error (unconsumed-input-error offset tape))))) (def: #export end? - {#;doc "Ask if the lexer's input is empty."} + {#.doc "Ask if the lexer's input is empty."} (Lexer Bool) (function [(^@ input [offset tape])] - (#E;Success [input (n/= offset (text;size tape))]))) + (#E.Success [input (n/= offset (text.size tape))]))) (def: #export peek - {#;doc "Lex the next character (without consuming it from the input)."} + {#.doc "Lex the next character (without consuming it from the input)."} (Lexer Text) (function [(^@ input [offset tape])] - (case (text;nth offset tape) - (#;Some output) - (#E;Success [input (text;from-code output)]) + (case (text.nth offset tape) + (#.Some output) + (#E.Success [input (text.from-code output)]) - _ - (#E;Error cannot-lex-error)) - )) + _ + (#E.Error cannot-lex-error)) + )) (def: #export get-input - {#;doc "Get all of the remaining input (without consuming it)."} + {#.doc "Get all of the remaining input (without consuming it)."} (Lexer Text) (function [(^@ input [offset tape])] - (#E;Success [input (remaining offset tape)]))) + (#E.Success [input (remaining offset tape)]))) (def: #export (range bottom top) - {#;doc "Only lex characters within a range."} + {#.doc "Only lex characters within a range."} (-> Nat Nat (Lexer Text)) - (do p;Monad<Parser> - [char any - #let [char' (maybe;assume (text;nth +0 char))] - _ (p;assert ($_ text/compose "Character is not within range: " (text;from-code bottom) "-" (text;from-code top)) - (and (n/>= bottom char') - (n/<= top char')))] - (wrap char))) + (do p.Monad<Parser> + [char any + #let [char' (maybe.assume (text.nth +0 char))] + _ (p.assert ($_ text/compose "Character is not within range: " (text.from-code bottom) "-" (text.from-code top)) + (and (n/>= bottom char') + (n/<= top char')))] + (wrap char))) (do-template [<name> <bottom> <top> <desc>] - [(def: #export <name> - {#;doc (code;text ($_ text/compose "Only lex " <desc> " characters."))} - (Lexer Text) - (range (char <bottom>) (char <top>)))] + [(def: #export <name> + {#.doc (code.text ($_ text/compose "Only lex " <desc> " characters."))} + (Lexer Text) + (range (char <bottom>) (char <top>)))] - [upper "A" "Z" "uppercase"] - [lower "a" "z" "lowercase"] - [decimal "0" "9" "decimal"] - [octal "0" "7" "octal"] - ) + [upper "A" "Z" "uppercase"] + [lower "a" "z" "lowercase"] + [decimal "0" "9" "decimal"] + [octal "0" "7" "octal"] + ) (def: #export alpha - {#;doc "Only lex alphabetic characters."} + {#.doc "Only lex alphabetic characters."} (Lexer Text) - (p;either lower upper)) + (p.either lower upper)) (def: #export alpha-num - {#;doc "Only lex alphanumeric characters."} + {#.doc "Only lex alphanumeric characters."} (Lexer Text) - (p;either alpha decimal)) + (p.either alpha decimal)) (def: #export hexadecimal - {#;doc "Only lex hexadecimal digits."} + {#.doc "Only lex hexadecimal digits."} (Lexer Text) - ($_ p;either + ($_ p.either decimal (range (char "a") (char "f")) (range (char "A") (char "F")))) (def: #export (one-of options) - {#;doc "Only lex characters that are part of a piece of text."} + {#.doc "Only lex characters that are part of a piece of text."} (-> Text (Lexer Text)) (function [[offset tape]] - (case (text;nth offset tape) - (#;Some output) - (let [output (text;from-code output)] - (if (text;contains? output options) - (#E;Success [[(n/inc offset) tape] output]) - (#E;Error ($_ text/compose "Character (" output ") is not one of: " options)))) + (case (text.nth offset tape) + (#.Some output) + (let [output (text.from-code output)] + (if (text.contains? output options) + (#E.Success [[(n/inc offset) tape] output]) + (#E.Error ($_ text/compose "Character (" output ") is not one of: " options)))) - _ - (#E;Error cannot-lex-error)))) + _ + (#E.Error cannot-lex-error)))) (def: #export (none-of options) - {#;doc "Only lex characters that are not part of a piece of text."} + {#.doc "Only lex characters that are not part of a piece of text."} (-> Text (Lexer Text)) (function [[offset tape]] - (case (text;nth offset tape) - (#;Some output) - (let [output (text;from-code output)] - (if (;not (text;contains? output options)) - (#E;Success [[(n/inc offset) tape] output]) - (#E;Error ($_ text/compose "Character (" output ") is one of: " options)))) + (case (text.nth offset tape) + (#.Some output) + (let [output (text.from-code output)] + (if (.not (text.contains? output options)) + (#E.Success [[(n/inc offset) tape] output]) + (#E.Error ($_ text/compose "Character (" output ") is one of: " options)))) - _ - (#E;Error cannot-lex-error)))) + _ + (#E.Error cannot-lex-error)))) (def: #export (satisfies p) - {#;doc "Only lex characters that satisfy a predicate."} + {#.doc "Only lex characters that satisfy a predicate."} (-> (-> Nat Bool) (Lexer Text)) (function [[offset tape]] - (case (text;nth offset tape) - (#;Some output) - (if (p output) - (#E;Success [[(n/inc offset) tape] (text;from-code output)]) - (#E;Error ($_ text/compose "Character does not satisfy predicate: " (text;from-code output)))) + (case (text.nth offset tape) + (#.Some output) + (if (p output) + (#E.Success [[(n/inc offset) tape] (text.from-code output)]) + (#E.Error ($_ text/compose "Character does not satisfy predicate: " (text.from-code output)))) - _ - (#E;Error cannot-lex-error)))) + _ + (#E.Error cannot-lex-error)))) (def: #export space - {#;doc "Only lex white-space."} + {#.doc "Only lex white-space."} (Lexer Text) - (satisfies text;space?)) + (satisfies text.space?)) (def: #export (seq left right) (-> (Lexer Text) (Lexer Text) (Lexer Text)) - (do p;Monad<Parser> - [=left left - =right right] - (wrap ($_ text/compose =left =right)))) + (do p.Monad<Parser> + [=left left + =right right] + (wrap ($_ text/compose =left =right)))) (do-template [<name> <base> <doc>] - [(def: #export (<name> p) - {#;doc <doc>} - (-> (Lexer Text) (Lexer Text)) - (|> p <base> (:: p;Monad<Parser> map text;concat)))] + [(def: #export (<name> p) + {#.doc <doc>} + (-> (Lexer Text) (Lexer Text)) + (|> p <base> (:: p.Monad<Parser> map text.concat)))] - [some p;some "Lex some characters as a single continuous text."] - [many p;many "Lex many characters as a single continuous text."] - ) + [some p.some "Lex some characters as a single continuous text."] + [many p.many "Lex many characters as a single continuous text."] + ) (do-template [<name> <base> <doc>] - [(def: #export (<name> n p) - {#;doc <doc>} - (-> Nat (Lexer Text) (Lexer Text)) - (do p;Monad<Parser> - [] - (|> p (<base> n) (:: @ map text;concat))))] - - [exactly p;exactly "Lex exactly N characters."] - [at-most p;at-most "Lex at most N characters."] - [at-least p;at-least "Lex at least N characters."] - ) + [(def: #export (<name> n p) + {#.doc <doc>} + (-> Nat (Lexer Text) (Lexer Text)) + (do p.Monad<Parser> + [] + (|> p (<base> n) (:: @ map text.concat))))] + + [exactly p.exactly "Lex exactly N characters."] + [at-most p.at-most "Lex at most N characters."] + [at-least p.at-least "Lex at least N characters."] + ) (def: #export (between from to p) - {#;doc "Lex between N and M characters."} + {#.doc "Lex between N and M characters."} (-> Nat Nat (Lexer Text) (Lexer Text)) - (|> p (p;between from to) (:: p;Monad<Parser> map text;concat))) + (|> p (p.between from to) (:: p.Monad<Parser> map text.concat))) (def: #export (enclosed [start end] lexer) (All [a] (-> [Text Text] (Lexer a) (Lexer a))) (|> lexer - (p;before (this end)) - (p;after (this start)))) + (p.before (this end)) + (p.after (this start)))) (def: #export (local local-input lexer) - {#;doc "Run a lexer with the given input, instead of the real one."} + {#.doc "Run a lexer with the given input, instead of the real one."} (All [a] (-> Text (Lexer a) (Lexer a))) (function [real-input] - (case (run local-input lexer) - (#E;Error error) - (#E;Error error) + (case (run local-input lexer) + (#E.Error error) + (#E.Error error) - (#E;Success value) - (#E;Success [real-input value])))) + (#E.Success value) + (#E.Success [real-input value])))) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index 4dccf7855..1f1a0a3c0 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control monad ["p" parser "p/" Monad<Parser>]) @@ -16,188 +16,188 @@ ## [Utils] (def: regex-char^ - (l;Lexer Text) - (l;none-of "\\.|&()[]{}")) + (l.Lexer Text) + (l.none-of "\\.|&()[]{}")) (def: escaped-char^ - (l;Lexer Text) - (do p;Monad<Parser> - [? (l;this? "\\")] + (l.Lexer Text) + (do p.Monad<Parser> + [? (l.this? "\\")] (if ? - l;any + l.any regex-char^))) (def: #hidden (refine^ refinement^ base^) - (All [a] (-> (l;Lexer a) (l;Lexer Text) (l;Lexer Text))) - (do p;Monad<Parser> + (All [a] (-> (l.Lexer a) (l.Lexer Text) (l.Lexer Text))) + (do p.Monad<Parser> [output base^ - _ (l;local output refinement^)] + _ (l.local output refinement^)] (wrap output))) (def: #hidden word^ - (l;Lexer Text) - (p;either l;alpha-num - (l;one-of "_"))) + (l.Lexer Text) + (p.either l.alpha-num + (l.one-of "_"))) (def: #hidden (copy reference) - (-> Text (l;Lexer Text)) - (p;after (l;this reference) (p/wrap reference))) + (-> Text (l.Lexer Text)) + (p.after (l.this reference) (p/wrap reference))) (def: #hidden (join-text^ part^) - (-> (l;Lexer (List Text)) (l;Lexer Text)) - (do p;Monad<Parser> + (-> (l.Lexer (List Text)) (l.Lexer Text)) + (do p.Monad<Parser> [parts part^] - (wrap (text;join-with "" parts)))) + (wrap (text.join-with "" parts)))) (def: identifier-char^ - (l;Lexer Text) - (l;none-of "[]{}()s\"#;<>")) + (l.Lexer Text) + (l.none-of "[]{}()s\"#.<>")) (def: identifier-part^ - (l;Lexer Text) - (do p;Monad<Parser> - [head (refine^ (l;not l;decimal) + (l.Lexer Text) + (do p.Monad<Parser> + [head (refine^ (l.not l.decimal) identifier-char^) - tail (l;some identifier-char^)] + tail (l.some identifier-char^)] (wrap (format head tail)))) (def: (identifier^ current-module) - (-> Text (l;Lexer Ident)) - ($_ p;either - (p;seq (p/wrap current-module) (p;after (l;this ";;") identifier-part^)) - (p;seq identifier-part^ (p;after (l;this ";") identifier-part^)) - (p;seq (p/wrap "lux") (p;after (l;this ";") identifier-part^)) - (p;seq (p/wrap "") identifier-part^))) + (-> Text (l.Lexer Ident)) + ($_ p.either + (p.seq (p/wrap current-module) (p.after (l.this "..") identifier-part^)) + (p.seq identifier-part^ (p.after (l.this ".") identifier-part^)) + (p.seq (p/wrap "lux") (p.after (l.this ".") identifier-part^)) + (p.seq (p/wrap "") identifier-part^))) (def: (re-var^ current-module) - (-> Text (l;Lexer Code)) - (do p;Monad<Parser> - [ident (l;enclosed ["\\@<" ">"] (identifier^ current-module))] - (wrap (` (: (l;Lexer Text) (~ (code;symbol ident))))))) + (-> Text (l.Lexer Code)) + (do p.Monad<Parser> + [ident (l.enclosed ["\\@<" ">"] (identifier^ current-module))] + (wrap (` (: (l.Lexer Text) (~ (code.symbol ident))))))) (def: re-range^ - (l;Lexer Code) - (do p;Monad<Parser> - [from (|> regex-char^ (:: @ map (|>> (text;nth +0) maybe;assume))) - _ (l;this "-") - to (|> regex-char^ (:: @ map (|>> (text;nth +0) maybe;assume)))] - (wrap (` (l;range (~ (code;nat from)) (~ (code;nat to))))))) + (l.Lexer Code) + (do p.Monad<Parser> + [from (|> regex-char^ (:: @ map (|>> (text.nth +0) maybe.assume))) + _ (l.this "-") + to (|> regex-char^ (:: @ map (|>> (text.nth +0) maybe.assume)))] + (wrap (` (l.range (~ (code.nat from)) (~ (code.nat to))))))) (def: re-char^ - (l;Lexer Code) - (do p;Monad<Parser> + (l.Lexer Code) + (do p.Monad<Parser> [char escaped-char^] - (wrap (` (;;copy (~ (code;text char))))))) + (wrap (` (..copy (~ (code.text char))))))) (def: re-options^ - (l;Lexer Code) - (do p;Monad<Parser> - [options (l;many escaped-char^)] - (wrap (` (l;one-of (~ (code;text options))))))) + (l.Lexer Code) + (do p.Monad<Parser> + [options (l.many escaped-char^)] + (wrap (` (l.one-of (~ (code.text options))))))) (def: re-user-class^' - (l;Lexer Code) - (do p;Monad<Parser> - [negate? (p;maybe (l;this "^")) - parts (p;many ($_ p;either + (l.Lexer Code) + (do p.Monad<Parser> + [negate? (p.maybe (l.this "^")) + parts (p.many ($_ p.either re-range^ re-options^))] (wrap (case negate? - (#;Some _) (` (l;not ($_ p;either (~@ parts)))) - #;None (` ($_ p;either (~@ parts))))))) + (#.Some _) (` (l.not ($_ p.either (~@ parts)))) + #.None (` ($_ p.either (~@ parts))))))) (def: re-user-class^ - (l;Lexer Code) - (do p;Monad<Parser> + (l.Lexer Code) + (do p.Monad<Parser> [_ (wrap []) init re-user-class^' - rest (p;some (p;after (l;this "&&") (l;enclosed ["[" "]"] re-user-class^')))] + rest (p.some (p.after (l.this "&&") (l.enclosed ["[" "]"] re-user-class^')))] (wrap (list/fold (function [refinement base] (` (refine^ (~ refinement) (~ base)))) init rest)))) (def: #hidden blank^ - (l;Lexer Text) - (l;one-of " \t")) + (l.Lexer Text) + (l.one-of " \t")) (def: #hidden ascii^ - (l;Lexer Text) - (l;range (char "\u0000") (char "\u007F"))) + (l.Lexer Text) + (l.range (char "\u0000") (char "\u007F"))) (def: #hidden control^ - (l;Lexer Text) - (p;either (l;range (char "\u0000") (char "\u001F")) - (l;one-of "\u007F"))) + (l.Lexer Text) + (p.either (l.range (char "\u0000") (char "\u001F")) + (l.one-of "\u007F"))) (def: #hidden punct^ - (l;Lexer Text) - (l;one-of "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~")) + (l.Lexer Text) + (l.one-of "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~")) (def: #hidden graph^ - (l;Lexer Text) - (p;either punct^ l;alpha-num)) + (l.Lexer Text) + (p.either punct^ l.alpha-num)) (def: #hidden print^ - (l;Lexer Text) - (p;either graph^ - (l;one-of "\u0020"))) + (l.Lexer Text) + (p.either graph^ + (l.one-of "\u0020"))) (def: re-system-class^ - (l;Lexer Code) - (do p;Monad<Parser> + (l.Lexer Code) + (do p.Monad<Parser> [] - ($_ p;either - (p;after (l;this ".") (wrap (` l;any))) - (p;after (l;this "\\d") (wrap (` l;decimal))) - (p;after (l;this "\\D") (wrap (` (l;not l;decimal)))) - (p;after (l;this "\\s") (wrap (` l;space))) - (p;after (l;this "\\S") (wrap (` (l;not l;space)))) - (p;after (l;this "\\w") (wrap (` word^))) - (p;after (l;this "\\W") (wrap (` (l;not word^)))) - - (p;after (l;this "\\p{Lower}") (wrap (` l;lower))) - (p;after (l;this "\\p{Upper}") (wrap (` l;upper))) - (p;after (l;this "\\p{Alpha}") (wrap (` l;alpha))) - (p;after (l;this "\\p{Digit}") (wrap (` l;decimal))) - (p;after (l;this "\\p{Alnum}") (wrap (` l;alpha-num))) - (p;after (l;this "\\p{Space}") (wrap (` l;space))) - (p;after (l;this "\\p{HexDigit}") (wrap (` l;hexadecimal))) - (p;after (l;this "\\p{OctDigit}") (wrap (` l;octal))) - (p;after (l;this "\\p{Blank}") (wrap (` blank^))) - (p;after (l;this "\\p{ASCII}") (wrap (` ascii^))) - (p;after (l;this "\\p{Contrl}") (wrap (` control^))) - (p;after (l;this "\\p{Punct}") (wrap (` punct^))) - (p;after (l;this "\\p{Graph}") (wrap (` graph^))) - (p;after (l;this "\\p{Print}") (wrap (` print^))) + ($_ p.either + (p.after (l.this ".") (wrap (` l.any))) + (p.after (l.this "\\d") (wrap (` l.decimal))) + (p.after (l.this "\\D") (wrap (` (l.not l.decimal)))) + (p.after (l.this "\\s") (wrap (` l.space))) + (p.after (l.this "\\S") (wrap (` (l.not l.space)))) + (p.after (l.this "\\w") (wrap (` word^))) + (p.after (l.this "\\W") (wrap (` (l.not word^)))) + + (p.after (l.this "\\p{Lower}") (wrap (` l.lower))) + (p.after (l.this "\\p{Upper}") (wrap (` l.upper))) + (p.after (l.this "\\p{Alpha}") (wrap (` l.alpha))) + (p.after (l.this "\\p{Digit}") (wrap (` l.decimal))) + (p.after (l.this "\\p{Alnum}") (wrap (` l.alpha-num))) + (p.after (l.this "\\p{Space}") (wrap (` l.space))) + (p.after (l.this "\\p{HexDigit}") (wrap (` l.hexadecimal))) + (p.after (l.this "\\p{OctDigit}") (wrap (` l.octal))) + (p.after (l.this "\\p{Blank}") (wrap (` blank^))) + (p.after (l.this "\\p{ASCII}") (wrap (` ascii^))) + (p.after (l.this "\\p{Contrl}") (wrap (` control^))) + (p.after (l.this "\\p{Punct}") (wrap (` punct^))) + (p.after (l.this "\\p{Graph}") (wrap (` graph^))) + (p.after (l.this "\\p{Print}") (wrap (` print^))) ))) (def: re-class^ - (l;Lexer Code) - (p;either re-system-class^ - (l;enclosed ["[" "]"] re-user-class^))) + (l.Lexer Code) + (p.either re-system-class^ + (l.enclosed ["[" "]"] re-user-class^))) (def: number^ - (l;Lexer Nat) - (|> (l;many l;decimal) - (p;codec number;Codec<Text,Int>) + (l.Lexer Nat) + (|> (l.many l.decimal) + (p.codec number.Codec<Text,Int>) (p/map int-to-nat))) (def: re-back-reference^ - (l;Lexer Code) - (p;either (do p;Monad<Parser> - [_ (l;this "\\") + (l.Lexer Code) + (p.either (do p.Monad<Parser> + [_ (l.this "\\") id number^] - (wrap (` (;;copy (~ (code;symbol ["" (int/encode (nat-to-int id))])))))) - (do p;Monad<Parser> - [_ (l;this "\\k<") + (wrap (` (..copy (~ (code.symbol ["" (int/encode (nat-to-int id))])))))) + (do p.Monad<Parser> + [_ (l.this "\\k<") captured-name identifier-part^ - _ (l;this ">")] - (wrap (` (;;copy (~ (code;symbol ["" captured-name])))))))) + _ (l.this ">")] + (wrap (` (..copy (~ (code.symbol ["" captured-name])))))))) (def: (re-simple^ current-module) - (-> Text (l;Lexer Code)) - ($_ p;either + (-> Text (l.Lexer Code)) + ($_ p.either re-class^ (re-var^ current-module) re-back-reference^ @@ -205,57 +205,57 @@ )) (def: (re-simple-quantified^ current-module) - (-> Text (l;Lexer Code)) - (do p;Monad<Parser> + (-> Text (l.Lexer Code)) + (do p.Monad<Parser> [base (re-simple^ current-module) - quantifier (l;one-of "?*+")] + quantifier (l.one-of "?*+")] (case quantifier "?" - (wrap (` (p;default "" (~ base)))) + (wrap (` (p.default "" (~ base)))) "*" - (wrap (` (join-text^ (p;some (~ base))))) + (wrap (` (join-text^ (p.some (~ base))))) ## "+" _ - (wrap (` (join-text^ (p;many (~ base))))) + (wrap (` (join-text^ (p.many (~ base))))) ))) (def: (re-counted-quantified^ current-module) - (-> Text (l;Lexer Code)) - (do p;Monad<Parser> + (-> Text (l.Lexer Code)) + (do p.Monad<Parser> [base (re-simple^ current-module)] - (l;enclosed ["{" "}"] - ($_ p;either + (l.enclosed ["{" "}"] + ($_ p.either (do @ - [[from to] (p;seq number^ (p;after (l;this ",") number^))] - (wrap (` (join-text^ (p;between (~ (code;nat from)) - (~ (code;nat to)) + [[from to] (p.seq number^ (p.after (l.this ",") number^))] + (wrap (` (join-text^ (p.between (~ (code.nat from)) + (~ (code.nat to)) (~ base)))))) (do @ - [limit (p;after (l;this ",") number^)] - (wrap (` (join-text^ (p;at-most (~ (code;nat limit)) (~ base)))))) + [limit (p.after (l.this ",") number^)] + (wrap (` (join-text^ (p.at-most (~ (code.nat limit)) (~ base)))))) (do @ - [limit (p;before (l;this ",") number^)] - (wrap (` (join-text^ (p;at-least (~ (code;nat limit)) (~ base)))))) + [limit (p.before (l.this ",") number^)] + (wrap (` (join-text^ (p.at-least (~ (code.nat limit)) (~ base)))))) (do @ [limit number^] - (wrap (` (join-text^ (p;exactly (~ (code;nat limit)) (~ base)))))))))) + (wrap (` (join-text^ (p.exactly (~ (code.nat limit)) (~ base)))))))))) (def: (re-quantified^ current-module) - (-> Text (l;Lexer Code)) - (p;either (re-simple-quantified^ current-module) + (-> Text (l.Lexer Code)) + (p.either (re-simple-quantified^ current-module) (re-counted-quantified^ current-module))) (def: (re-complex^ current-module) - (-> Text (l;Lexer Code)) - ($_ p;either + (-> Text (l.Lexer Code)) + ($_ p.either (re-quantified^ current-module) (re-simple^ current-module))) (def: #hidden _text/compose_ (-> Text Text Text) - (:: text;Monoid<Text> compose)) + (:: text.Monoid<Text> compose)) (type: Re-Group #Non-Capturing @@ -263,35 +263,35 @@ (def: (re-sequential^ capturing? re-scoped^ current-module) (-> Bool - (-> Text (l;Lexer [Re-Group Code])) + (-> Text (l.Lexer [Re-Group Code])) Text - (l;Lexer [Nat Code])) - (do p;Monad<Parser> - [parts (p;many (p;alt (re-complex^ current-module) + (l.Lexer [Nat Code])) + (do p.Monad<Parser> + [parts (p.many (p.alt (re-complex^ current-module) (re-scoped^ current-module))) - #let [g!total (code;symbol ["" "0total"]) - g!temp (code;symbol ["" "0temp"]) + #let [g!total (code.symbol ["" "0total"]) + g!temp (code.symbol ["" "0temp"]) [_ names steps] (list/fold (: (-> (Either Code [Re-Group Code]) [Int (List Code) (List (List Code))] [Int (List Code) (List (List Code))]) (function [part [idx names steps]] (case part - (^or (#e;Error complex) (#e;Success [#Non-Capturing complex])) + (^or (#e.Error complex) (#e.Success [#Non-Capturing complex])) [idx names (list& (list g!temp complex (' #let) (` [(~ g!total) (_text/compose_ (~ g!total) (~ g!temp))])) steps)] - (#e;Success [(#Capturing [?name num-captures]) scoped]) + (#e.Success [(#Capturing [?name num-captures]) scoped]) (let [[idx! name!] (case ?name - (#;Some _name) - [idx (code;symbol ["" _name])] + (#.Some _name) + [idx (code.symbol ["" _name])] - #;None - [(i/inc idx) (code;symbol ["" (int/encode idx)])]) + #.None + [(i/inc idx) (code.symbol ["" (int/encode idx)])]) access (if (n/> +0 num-captures) - (` (product;left (~ name!))) + (` (product.left (~ name!))) name!)] [idx! (list& name! names) @@ -304,47 +304,47 @@ (: (List (List Code)) (list))] parts)]] (wrap [(if capturing? - (list;size names) + (list.size names) +0) - (` (do p;Monad<Parser> + (` (do p.Monad<Parser> [(~ (' #let)) [(~ g!total) ""] - (~@ (|> steps list;reverse list/join))] - ((~ (' wrap)) [(~ g!total) (~@ (list;reverse names))])))]) + (~@ (|> steps list.reverse list/join))] + ((~ (' wrap)) [(~ g!total) (~@ (list.reverse names))])))]) )) (def: #hidden (unflatten^ lexer) - (-> (l;Lexer Text) (l;Lexer [Text Unit])) - (p;seq lexer (:: p;Monad<Parser> wrap []))) + (-> (l.Lexer Text) (l.Lexer [Text Unit])) + (p.seq lexer (:: p.Monad<Parser> wrap []))) (def: #hidden (|||^ left right) - (All [l r] (-> (l;Lexer [Text l]) (l;Lexer [Text r]) (l;Lexer [Text (| l r)]))) + (All [l r] (-> (l.Lexer [Text l]) (l.Lexer [Text r]) (l.Lexer [Text (| l r)]))) (function [input] (case (left input) - (#e;Success [input' [lt lv]]) - (#e;Success [input' [lt (+0 lv)]]) + (#e.Success [input' [lt lv]]) + (#e.Success [input' [lt (+0 lv)]]) - (#e;Error _) + (#e.Error _) (case (right input) - (#e;Success [input' [rt rv]]) - (#e;Success [input' [rt (+1 rv)]]) + (#e.Success [input' [rt rv]]) + (#e.Success [input' [rt (+1 rv)]]) - (#e;Error error) - (#e;Error error))))) + (#e.Error error) + (#e.Error error))))) (def: #hidden (|||_^ left right) - (All [l r] (-> (l;Lexer [Text l]) (l;Lexer [Text r]) (l;Lexer Text))) + (All [l r] (-> (l.Lexer [Text l]) (l.Lexer [Text r]) (l.Lexer Text))) (function [input] (case (left input) - (#e;Success [input' [lt lv]]) - (#e;Success [input' lt]) + (#e.Success [input' [lt lv]]) + (#e.Success [input' lt]) - (#e;Error _) + (#e.Error _) (case (right input) - (#e;Success [input' [rt rv]]) - (#e;Success [input' rt]) + (#e.Success [input' [rt rv]]) + (#e.Success [input' rt]) - (#e;Error error) - (#e;Error error))))) + (#e.Error error) + (#e.Error error))))) (def: (prep-alternative [num-captures alt]) (-> [Nat Code] Code) @@ -354,52 +354,52 @@ (def: (re-alternative^ capturing? re-scoped^ current-module) (-> Bool - (-> Text (l;Lexer [Re-Group Code])) + (-> Text (l.Lexer [Re-Group Code])) Text - (l;Lexer [Nat Code])) - (do p;Monad<Parser> + (l.Lexer [Nat Code])) + (do p.Monad<Parser> [#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)] head sub^ - tail (p;some (p;after (l;this "|") sub^)) + tail (p.some (p.after (l.this "|") sub^)) #let [g!op (if capturing? (` |||^) (` |||_^))]] - (if (list;empty? tail) + (if (list.empty? tail) (wrap head) - (wrap [(list/fold n/max (product;left head) (list/map product;left tail)) + (wrap [(list/fold n/max (product.left head) (list/map product.left tail)) (` ($_ (~ g!op) (~ (prep-alternative head)) (~@ (list/map prep-alternative tail))))])))) (def: (re-scoped^ current-module) - (-> Text (l;Lexer [Re-Group Code])) - ($_ p;either - (do p;Monad<Parser> - [_ (l;this "(?:") + (-> Text (l.Lexer [Re-Group Code])) + ($_ p.either + (do p.Monad<Parser> + [_ (l.this "(?:") [_ scoped] (re-alternative^ false re-scoped^ current-module) - _ (l;this ")")] + _ (l.this ")")] (wrap [#Non-Capturing scoped])) - (do p;Monad<Parser> + (do p.Monad<Parser> [complex (re-complex^ current-module)] (wrap [#Non-Capturing complex])) - (do p;Monad<Parser> - [_ (l;this "(?<") + (do p.Monad<Parser> + [_ (l.this "(?<") captured-name identifier-part^ - _ (l;this ">") + _ (l.this ">") [num-captures pattern] (re-alternative^ true re-scoped^ current-module) - _ (l;this ")")] - (wrap [(#Capturing [(#;Some captured-name) num-captures]) pattern])) - (do p;Monad<Parser> - [_ (l;this "(") + _ (l.this ")")] + (wrap [(#Capturing [(#.Some captured-name) num-captures]) pattern])) + (do p.Monad<Parser> + [_ (l.this "(") [num-captures pattern] (re-alternative^ true re-scoped^ current-module) - _ (l;this ")")] - (wrap [(#Capturing [#;None num-captures]) pattern])))) + _ (l.this ")")] + (wrap [(#Capturing [#.None num-captures]) pattern])))) (def: (regex^ current-module) - (-> Text (l;Lexer Code)) - (:: p;Monad<Parser> map product;right (re-alternative^ true re-scoped^ current-module))) + (-> Text (l.Lexer Code)) + (:: p.Monad<Parser> map product.right (re-alternative^ true re-scoped^ current-module))) ## [Syntax] -(syntax: #export (regex [pattern s;text]) - {#;doc (doc "Create lexers using regular-expression syntax." +(syntax: #export (regex [pattern s.text]) + {#.doc (doc "Create lexers using regular-expression syntax." "For example:" "Literals" @@ -458,22 +458,22 @@ (regex "a(.)(.)|b(.)(.)") )} (do @ - [current-module macro;current-module-name] + [current-module macro.current-module-name] (case (|> (regex^ current-module) - (p;before l;end) - (l;run pattern)) - (#e;Error error) - (macro;fail (format "Error while parsing regular-expression:\n" + (p.before l.end) + (l.run pattern)) + (#e.Error error) + (macro.fail (format "Error while parsing regular-expression:\n" error)) - (#e;Success regex) + (#e.Success regex) (wrap (list regex)) ))) -(syntax: #export (^regex [[pattern bindings] (s;form (p;seq s;text (p;maybe s;any)))] +(syntax: #export (^regex [[pattern bindings] (s.form (p.seq s.text (p.maybe s.any)))] body - [branches (p;many s;any)]) - {#;doc (doc "Allows you to test text against regular expressions." + [branches (p.many s.any)]) + {#.doc (doc "Allows you to test text against regular expressions." (case some-text (^regex "(\\d{3})-(\\d{3})-(\\d{4})" [_ country-code area-code place-code]) @@ -485,10 +485,10 @@ _ do-something-else))} (do @ - [g!temp (macro;gensym "temp")] + [g!temp (macro.gensym "temp")] (wrap (list& (` (^multi (~ g!temp) - [(l;run (~ g!temp) (regex (~ (code;text pattern)))) - (#e;Success (~ (maybe;default g!temp + [(l.run (~ g!temp) (regex (~ (code.text pattern)))) + (#e.Success (~ (maybe.default g!temp bindings)))])) body branches)))) diff --git a/stdlib/source/lux/data/trace.lux b/stdlib/source/lux/data/trace.lux index d34ab0a0a..a0eee684d 100644 --- a/stdlib/source/lux/data/trace.lux +++ b/stdlib/source/lux/data/trace.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monoid #+ Monoid] [functor #+ Functor] @@ -18,7 +18,7 @@ (def: (unwrap wa) ((get@ #trace wa) - (get@ [#monoid #monoid;identity] wa))) + (get@ [#monoid #monoid.identity] wa))) (def: (split wa) (let [monoid (get@ #monoid wa)] |