From c234d5d25331d6ed3b9455ce8c93ec4d34402f91 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 15 Sep 2021 20:45:48 -0400 Subject: "Row" => "Sequence" --- .../source/library/lux/control/parser/binary.lux | 18 +- stdlib/source/library/lux/control/parser/json.lux | 4 +- stdlib/source/library/lux/data/collection/row.lux | 500 --------------------- .../library/lux/data/collection/sequence.lux | 500 +++++++++++++++++++++ stdlib/source/library/lux/data/format/binary.lux | 20 +- stdlib/source/library/lux/data/format/json.lux | 26 +- stdlib/source/library/lux/data/format/tar.lux | 14 +- stdlib/source/library/lux/data/text/buffer.lux | 22 +- stdlib/source/library/lux/math/random.lux | 12 +- stdlib/source/library/lux/target/jvm.lux | 4 +- .../library/lux/target/jvm/attribute/code.lux | 20 +- stdlib/source/library/lux/target/jvm/bytecode.lux | 21 +- stdlib/source/library/lux/target/jvm/class.lux | 34 +- stdlib/source/library/lux/target/jvm/constant.lux | 4 +- .../library/lux/target/jvm/constant/pool.lux | 22 +- stdlib/source/library/lux/target/jvm/field.lux | 10 +- stdlib/source/library/lux/target/jvm/method.lux | 14 +- stdlib/source/library/lux/time/instant.lux | 4 +- stdlib/source/library/lux/tool/compiler.lux | 4 +- .../library/lux/tool/compiler/default/init.lux | 8 +- .../library/lux/tool/compiler/default/platform.lux | 14 +- .../lux/tool/compiler/language/lux/generation.lux | 16 +- .../language/lux/phase/extension/directive/jvm.lux | 8 +- .../lux/phase/extension/generation/jvm/host.lux | 4 +- .../lux/phase/generation/common_lisp/runtime.lux | 10 +- .../language/lux/phase/generation/js/runtime.lux | 12 +- .../language/lux/phase/generation/jvm/function.lux | 4 +- .../generation/jvm/function/field/constant.lux | 4 +- .../generation/jvm/function/field/variable.lux | 4 +- .../jvm/function/field/variable/foreign.lux | 3 +- .../jvm/function/field/variable/partial.lux | 3 +- .../language/lux/phase/generation/jvm/host.lux | 6 +- .../language/lux/phase/generation/jvm/program.lux | 4 +- .../language/lux/phase/generation/jvm/runtime.lux | 8 +- .../language/lux/phase/generation/lua/runtime.lux | 12 +- .../language/lux/phase/generation/php/runtime.lux | 10 +- .../lux/phase/generation/python/runtime.lux | 12 +- .../language/lux/phase/generation/r/runtime.lux | 10 +- .../language/lux/phase/generation/ruby/runtime.lux | 12 +- .../lux/phase/generation/scheme/runtime.lux | 10 +- .../library/lux/tool/compiler/meta/archive.lux | 4 +- .../lux/tool/compiler/meta/archive/artifact.lux | 62 +-- .../library/lux/tool/compiler/meta/io/archive.lux | 24 +- .../library/lux/tool/compiler/meta/packager.lux | 4 +- .../lux/tool/compiler/meta/packager/jvm.lux | 4 +- .../lux/tool/compiler/meta/packager/scheme.lux | 6 +- .../lux/tool/compiler/meta/packager/script.lux | 4 +- stdlib/source/library/lux/type/resource.lux | 8 +- 48 files changed, 768 insertions(+), 775 deletions(-) delete mode 100644 stdlib/source/library/lux/data/collection/row.lux create mode 100644 stdlib/source/library/lux/data/collection/sequence.lux (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux/control/parser/binary.lux b/stdlib/source/library/lux/control/parser/binary.lux index c6a56de41..7e1eab4e6 100644 --- a/stdlib/source/library/lux/control/parser/binary.lux +++ b/stdlib/source/library/lux/control/parser/binary.lux @@ -16,7 +16,7 @@ ["[0]" utf8]]] [collection ["[0]" list] - ["[0]" row {"+" Row}] + ["[0]" sequence {"+" Sequence}] ["[0]" set {"+" Set}]]] [macro ["[0]" template]] @@ -189,7 +189,7 @@ (template [ ] [(def: .public ( valueP) - (All (_ v) (-> (Parser v) (Parser (Row v)))) + (All (_ v) (-> (Parser v) (Parser (Sequence v)))) (do //.monad [amount (: (Parser Nat) )] @@ -198,19 +198,19 @@ (Parser v) valueP - (Row v) - row.empty)] + (Sequence v) + sequence.empty)] (if (n.< amount index) (do //.monad [value valueP] (again (.++ index) - (row.suffix value output))) + (sequence.suffix value output))) (//#in output)))))] - [08 row/8 ..bits/8] - [16 row/16 ..bits/16] - [32 row/32 ..bits/32] - [64 row/64 ..bits/64] + [08 sequence/8 ..bits/8] + [16 sequence/16 ..bits/16] + [32 sequence/32 ..bits/32] + [64 sequence/64 ..bits/64] ) (def: .public maybe diff --git a/stdlib/source/library/lux/control/parser/json.lux b/stdlib/source/library/lux/control/parser/json.lux index ae1e82d9c..b5e10e9c1 100644 --- a/stdlib/source/library/lux/control/parser/json.lux +++ b/stdlib/source/library/lux/control/parser/json.lux @@ -11,7 +11,7 @@ ["[0]" text ("[1]#[0]" equivalence monoid)] [collection ["[0]" list ("[1]#[0]" functor)] - ["[0]" row] + ["[0]" sequence] ["[0]" dictionary {"+" Dictionary}]] [format ["/" json {"+" JSON}]]] @@ -124,7 +124,7 @@ [head ..any] (case head {/.#Array values} - (case (//.result parser (row.list values)) + (case (//.result parser (sequence.list values)) {try.#Failure error} (//.failure error) diff --git a/stdlib/source/library/lux/data/collection/row.lux b/stdlib/source/library/lux/data/collection/row.lux deleted file mode 100644 index ae8a99c37..000000000 --- a/stdlib/source/library/lux/data/collection/row.lux +++ /dev/null @@ -1,500 +0,0 @@ -... https://hypirion.com/musings/understanding-persistent-vector-pt-1 -... https://hypirion.com/musings/understanding-persistent-vector-pt-2 -... https://hypirion.com/musings/understanding-persistent-vector-pt-3 -(.module: - [library - [lux {"-" list} - ["@" target] - [abstract - [functor {"+" Functor}] - [apply {"+" Apply}] - [monad {"+" Monad do}] - [equivalence {"+" Equivalence}] - [monoid {"+" Monoid}] - [mix {"+" Mix}] - [predicate {"+" Predicate}]] - [control - ["[0]" maybe] - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}] - ["<>" parser - ["<[0]>" code {"+" Parser}]]] - [data - ["[0]" product] - [collection - ["[0]" list ("[1]#[0]" mix functor monoid)] - ["[0]" array {"+" Array} ("[1]#[0]" functor mix)]]] - [macro - [syntax {"+" syntax:}] - ["[0]" code]] - [math - [number - ["n" nat] - ["[0]" i64]]]]]) - -(type: (Node a) - (Variant - {#Base (Array a)} - {#Hierarchy (Array (Node a))})) - -(type: (Base a) - (Array a)) - -(type: (Hierarchy a) - (Array (Node a))) - -(type: Level - Nat) - -(type: Index - Nat) - -(def: branching_exponent - Nat - 5) - -(def: root_level - Level - 0) - -(template [ ] - [(def: - (-> Level Level) - ( branching_exponent))] - - [level_up n.+] - [level_down n.-] - ) - -(def: full_node_size - Nat - (i64.left_shifted branching_exponent 1)) - -(def: branch_idx_mask - Nat - (-- full_node_size)) - -(def: branch_idx - (-> Index Index) - (i64.and branch_idx_mask)) - -(def: (empty_hierarchy _) - (All (_ a) (-> Any (Hierarchy a))) - (array.empty ..full_node_size)) - -(def: (tail_off row_size) - (-> Nat Nat) - (if (n.< full_node_size row_size) - 0 - (|> (-- row_size) - (i64.right_shifted branching_exponent) - (i64.left_shifted branching_exponent)))) - -(def: (path level tail) - (All (_ a) (-> Level (Base a) (Node a))) - (if (n.= 0 level) - {#Base tail} - (|> (empty_hierarchy []) - (array.write! 0 (path (level_down level) tail)) - {#Hierarchy}))) - -(def: (tail singleton) - (All (_ a) (-> a (Base a))) - (|> (array.empty 1) - (array.write! 0 singleton))) - -(def: (with_tail size level tail parent) - (All (_ a) (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a))) - (let [sub_idx (branch_idx (i64.right_shifted level (-- 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) - ... If so, set the path to the tail - {.#None} - (..path (level_down level) tail) - ... If not, push the tail onto the sub_node. - {.#Some {#Hierarchy sub_node}} - {#Hierarchy (with_tail size (level_down level) tail sub_node)} - - _ - (undefined)) - )] - (|> (array.clone parent) - (array.write! sub_idx sub_node)))) - -(def: (expanded_tail val tail) - (All (_ a) (-> a (Base a) (Base a))) - (let [tail_size (array.size tail)] - (|> (array.empty (++ tail_size)) - (array.copy! tail_size 0 tail 0) - (array.write! tail_size val)))) - -(def: (hierarchy#has level idx val hierarchy) - (All (_ a) (-> Level Index a (Hierarchy a) (Hierarchy a))) - (let [sub_idx (branch_idx (i64.right_shifted level idx))] - (case (array.read! sub_idx hierarchy) - {.#Some {#Hierarchy sub_node}} - (|> (array.clone hierarchy) - (array.write! sub_idx {#Hierarchy (hierarchy#has (level_down level) idx val sub_node)})) - - (^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) - {#Base}))) - - _ - (undefined)))) - -(def: (without_tail size level hierarchy) - (All (_ a) (-> Nat Level (Hierarchy a) (Maybe (Hierarchy a)))) - (let [sub_idx (branch_idx (i64.right_shifted level (n.- 2 size)))] - (cond (n.= 0 sub_idx) - {.#None} - - (n.> branching_exponent level) - (do maybe.monad - [base|hierarchy (array.read! sub_idx hierarchy) - sub (case base|hierarchy - {#Hierarchy sub} - (without_tail size (level_down level) sub) - - {#Base _} - (undefined))] - (|> (array.clone hierarchy) - (array.write! sub_idx {#Hierarchy sub}) - {.#Some})) - - ... Else... - (|> (array.clone hierarchy) - (array.delete! sub_idx) - {.#Some}) - ))) - -(def: (node#list node) - (All (_ a) (-> (Node a) (List a))) - (case node - {#Base base} - (array.list {.#None} base) - - {#Hierarchy hierarchy} - (|> hierarchy - (array.list {.#None}) - list.reversed - (list#mix (function (_ sub acc) - (list#composite (node#list sub) acc)) - {.#End})))) - -(type: .public (Row a) - (Record - [#level Level - #size Nat - #root (Hierarchy a) - #tail (Base a)])) - -(def: .public empty - Row - [#level (level_up root_level) - #size 0 - #root (empty_hierarchy []) - #tail (array.empty 0)]) - -(def: .public (size row) - (All (_ a) (-> (Row a) Nat)) - (value@ #size row)) - -(def: .public (suffix val row) - (All (_ a) (-> a (Row a) (Row a))) - ... Check if there is room in the tail. - (let [row_size (value@ #size row)] - (if (|> row_size (n.- (tail_off row_size)) (n.< full_node_size)) - ... If so, append to it. - (|> row - (revised@ #size ++) - (revised@ #tail (..expanded_tail val))) - ... Otherwise, push tail into the tree - ... -------------------------------------------------------- - ... Will the root experience an overflow with this addition? - (|> (if (n.> (i64.left_shifted (value@ #level row) 1) - (i64.right_shifted branching_exponent row_size)) - ... If so, a brand-new root must be established, that is - ... 1-level taller. - (|> row - (with@ #root (|> (for [@.old - (: (Hierarchy (:parameter 0)) - (empty_hierarchy []))] - (empty_hierarchy [])) - (array.write! 0 {#Hierarchy (value@ #root row)}) - (array.write! 1 (..path (value@ #level row) (value@ #tail row))))) - (revised@ #level level_up)) - ... Otherwise, just push the current tail onto the root. - (|> row - (revised@ #root (..with_tail row_size (value@ #level row) (value@ #tail row))))) - ... Finally, update the size of the row and grow a new - ... tail with the new element as it's sole member. - (revised@ #size ++) - (with@ #tail (..tail val))) - ))) - -(exception: incorrect_row_structure) - -(exception: .public [a] (index_out_of_bounds [row (Row a) - index Nat]) - (exception.report ["Size" (# n.decimal encoded (value@ #size row))] - ["Index" (# n.decimal encoded index)])) - -(exception: base_was_not_found) - -(def: .public (within_bounds? row idx) - (All (_ a) (-> (Row a) Nat Bit)) - (n.< (value@ #size row) idx)) - -(def: (base_for idx row) - (All (_ a) (-> Index (Row a) (Try (Base a)))) - (if (within_bounds? row idx) - (if (n.< (tail_off (value@ #size row)) idx) - (loop [level (value@ #level row) - hierarchy (value@ #root row)] - (case [(n.> branching_exponent level) - (array.read! (branch_idx (i64.right_shifted level idx)) hierarchy)] - [#1 {.#Some {#Hierarchy sub}}] - (again (level_down level) sub) - - [#0 {.#Some {#Base base}}] - {try.#Success base} - - [_ {.#None}] - (exception.except ..base_was_not_found []) - - _ - (exception.except ..incorrect_row_structure []))) - {try.#Success (value@ #tail row)}) - (exception.except ..index_out_of_bounds [row idx]))) - -(def: .public (item idx row) - (All (_ a) (-> Nat (Row a) (Try a))) - (do try.monad - [base (base_for idx row)] - (case (array.read! (branch_idx idx) base) - {.#Some value} - {try.#Success value} - - {.#None} - (exception.except ..incorrect_row_structure [])))) - -(def: .public (has idx val row) - (All (_ a) (-> Nat a (Row a) (Try (Row a)))) - (let [row_size (value@ #size row)] - (if (within_bounds? row idx) - {try.#Success (if (n.< (tail_off row_size) idx) - (revised@ #root (hierarchy#has (value@ #level row) idx val) - row) - (revised@ #tail (for [@.old - (: (-> (Base (:parameter 0)) (Base (:parameter 0))) - (|>> array.clone (array.write! (branch_idx idx) val)))] - (|>> array.clone (array.write! (branch_idx idx) val))) - row))} - (exception.except ..index_out_of_bounds [row idx])))) - -(def: .public (revised idx f row) - (All (_ a) (-> Nat (-> a a) (Row a) (Try (Row a)))) - (do try.monad - [val (..item idx row)] - (..has idx (f val) row))) - -(def: .public (prefix row) - (All (_ a) (-> (Row a) (Row a))) - (case (value@ #size row) - 0 - empty - - 1 - empty - - row_size - (if (|> row_size (n.- (tail_off row_size)) (n.> 1)) - (let [old_tail (value@ #tail row) - new_tail_size (-- (array.size old_tail))] - (|> row - (revised@ #size --) - (with@ #tail (|> (array.empty new_tail_size) - (array.copy! new_tail_size 0 old_tail 0))))) - (maybe.trusted - (do maybe.monad - [new_tail (base_for (n.- 2 row_size) row) - .let [[level' root'] (let [init_level (value@ #level row)] - (loop [level init_level - root (maybe.else (empty_hierarchy []) - (without_tail row_size init_level (value@ #root row)))] - (if (n.> branching_exponent level) - (case [(array.read! 1 root) (array.read! 0 root)] - [{.#None} {.#Some {#Hierarchy sub_node}}] - (again (level_down level) sub_node) - - ... [{.#None} {.#Some {#Base _}}] - ... (undefined) - - _ - [level root]) - [level root])))]] - (in (|> row - (revised@ #size --) - (with@ #level level') - (with@ #root root') - (with@ #tail new_tail)))))) - )) - -(def: .public (list row) - (All (_ a) (-> (Row a) (List a))) - (list#composite (node#list {#Hierarchy (value@ #root row)}) - (node#list {#Base (value@ #tail row)}))) - -(def: .public of_list - (All (_ a) (-> (List a) (Row a))) - (list#mix ..suffix ..empty)) - -(def: .public (member? equivalence row val) - (All (_ a) (-> (Equivalence a) (Row a) a Bit)) - (list.member? equivalence (list row) val)) - -(def: .public empty? - (All (_ a) (-> (Row a) Bit)) - (|>> (value@ #size) (n.= 0))) - -(syntax: .public (row [elems (<>.some .any)]) - (in (.list (` (..of_list (.list (~+ elems))))))) - -(implementation: (node_equivalence Equivalence) - (All (_ a) (-> (Equivalence a) (Equivalence (Node a)))) - - (def: (= v1 v2) - (case [v1 v2] - [{#Base b1} {#Base b2}] - (# (array.equivalence Equivalence) = b1 b2) - - [{#Hierarchy h1} {#Hierarchy h2}] - (# (array.equivalence (node_equivalence Equivalence)) = h1 h2) - - _ - #0))) - -(implementation: .public (equivalence Equivalence) - (All (_ a) (-> (Equivalence a) (Equivalence (Row a)))) - - (def: (= v1 v2) - (and (n.= (value@ #size v1) (value@ #size v2)) - (let [(^open "node#[0]") (node_equivalence Equivalence)] - (and (node#= {#Base (value@ #tail v1)} - {#Base (value@ #tail v2)}) - (node#= {#Hierarchy (value@ #root v1)} - {#Hierarchy (value@ #root v2)})))))) - -(implementation: node_mix - (Mix Node) - - (def: (mix f init xs) - (case xs - {#Base base} - (array#mix f init base) - - {#Hierarchy hierarchy} - (array#mix (function (_ node init') (mix f init' node)) - init - hierarchy)))) - -(implementation: .public mix - (Mix Row) - - (def: (mix f init xs) - (let [(^open "[0]") node_mix] - (mix f - (mix f - init - {#Hierarchy (value@ #root xs)}) - {#Base (value@ #tail xs)})))) - -(implementation: .public monoid - (All (_ a) (Monoid (Row a))) - - (def: identity ..empty) - - (def: (composite xs ys) - (list#mix suffix xs (..list ys)))) - -(implementation: node_functor - (Functor Node) - - (def: (each f xs) - (case xs - {#Base base} - {#Base (array#each f base)} - - {#Hierarchy hierarchy} - {#Hierarchy (array#each (each f) hierarchy)}))) - -(implementation: .public functor - (Functor Row) - - (def: (each f xs) - [#level (value@ #level xs) - #size (value@ #size xs) - #root (|> xs (value@ #root) (array#each (# node_functor each f))) - #tail (|> xs (value@ #tail) (array#each f))])) - -(implementation: .public apply - (Apply Row) - - (def: &functor ..functor) - - (def: (on fa ff) - (let [(^open "[0]") ..functor - (^open "[0]") ..mix - (^open "[0]") ..monoid - results (each (function (_ f) (each f fa)) - ff)] - (mix composite identity results)))) - -(implementation: .public monad - (Monad Row) - - (def: &functor ..functor) - - (def: in - (|>> row)) - - (def: conjoint - (let [(^open "[0]") ..mix - (^open "[0]") ..monoid] - (mix (function (_ post pre) (composite pre post)) identity)))) - -(def: .public reversed - (All (_ a) (-> (Row a) (Row a))) - (|>> ..list - list.reversed - (list#mix suffix ..empty))) - -(template [ ] - [(def: .public - (All (_ a) - (-> (Predicate a) (Row a) Bit)) - (let [help (: (All (_ a) - (-> (Predicate a) (Node a) Bit)) - (function (help predicate node) - (case node - {#Base base} - ( predicate base) - - {#Hierarchy hierarchy} - ( (help predicate) hierarchy))))] - (function ( predicate row) - (let [(^open "_[0]") row] - ( (help predicate {#Hierarchy _#root}) - (help predicate {#Base _#tail}))))))] - - [every? array.every? #1 and] - [any? array.any? #0 or] - ) diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux new file mode 100644 index 000000000..3576d8ab2 --- /dev/null +++ b/stdlib/source/library/lux/data/collection/sequence.lux @@ -0,0 +1,500 @@ +... https://hypirion.com/musings/understanding-persistent-vector-pt-1 +... https://hypirion.com/musings/understanding-persistent-vector-pt-2 +... https://hypirion.com/musings/understanding-persistent-vector-pt-3 +(.module: + [library + [lux {"-" list} + ["@" target] + [abstract + [functor {"+" Functor}] + [apply {"+" Apply}] + [monad {"+" Monad do}] + [equivalence {"+" Equivalence}] + [monoid {"+" Monoid}] + [mix {"+" Mix}] + [predicate {"+" Predicate}]] + [control + ["[0]" maybe] + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}] + ["<>" parser + ["<[0]>" code {"+" Parser}]]] + [data + ["[0]" product] + [collection + ["[0]" list ("[1]#[0]" mix functor monoid)] + ["[0]" array {"+" Array} ("[1]#[0]" functor mix)]]] + [macro + [syntax {"+" syntax:}] + ["[0]" code]] + [math + [number + ["n" nat] + ["[0]" i64]]]]]) + +(type: (Node a) + (Variant + {#Base (Array a)} + {#Hierarchy (Array (Node a))})) + +(type: (Base a) + (Array a)) + +(type: (Hierarchy a) + (Array (Node a))) + +(type: Level + Nat) + +(type: Index + Nat) + +(def: branching_exponent + Nat + 5) + +(def: root_level + Level + 0) + +(template [ ] + [(def: + (-> Level Level) + ( branching_exponent))] + + [level_up n.+] + [level_down n.-] + ) + +(def: full_node_size + Nat + (i64.left_shifted branching_exponent 1)) + +(def: branch_idx_mask + Nat + (-- full_node_size)) + +(def: branch_idx + (-> Index Index) + (i64.and branch_idx_mask)) + +(def: (empty_hierarchy _) + (All (_ a) (-> Any (Hierarchy a))) + (array.empty ..full_node_size)) + +(def: (tail_off sequence_size) + (-> Nat Nat) + (if (n.< full_node_size sequence_size) + 0 + (|> (-- sequence_size) + (i64.right_shifted branching_exponent) + (i64.left_shifted branching_exponent)))) + +(def: (path level tail) + (All (_ a) (-> Level (Base a) (Node a))) + (if (n.= 0 level) + {#Base tail} + (|> (empty_hierarchy []) + (array.write! 0 (path (level_down level) tail)) + {#Hierarchy}))) + +(def: (tail singleton) + (All (_ a) (-> a (Base a))) + (|> (array.empty 1) + (array.write! 0 singleton))) + +(def: (with_tail size level tail parent) + (All (_ a) (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a))) + (let [sub_idx (branch_idx (i64.right_shifted level (-- 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) + ... If so, set the path to the tail + {.#None} + (..path (level_down level) tail) + ... If not, push the tail onto the sub_node. + {.#Some {#Hierarchy sub_node}} + {#Hierarchy (with_tail size (level_down level) tail sub_node)} + + _ + (undefined)) + )] + (|> (array.clone parent) + (array.write! sub_idx sub_node)))) + +(def: (expanded_tail val tail) + (All (_ a) (-> a (Base a) (Base a))) + (let [tail_size (array.size tail)] + (|> (array.empty (++ tail_size)) + (array.copy! tail_size 0 tail 0) + (array.write! tail_size val)))) + +(def: (hierarchy#has level idx val hierarchy) + (All (_ a) (-> Level Index a (Hierarchy a) (Hierarchy a))) + (let [sub_idx (branch_idx (i64.right_shifted level idx))] + (case (array.read! sub_idx hierarchy) + {.#Some {#Hierarchy sub_node}} + (|> (array.clone hierarchy) + (array.write! sub_idx {#Hierarchy (hierarchy#has (level_down level) idx val sub_node)})) + + (^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) + {#Base}))) + + _ + (undefined)))) + +(def: (without_tail size level hierarchy) + (All (_ a) (-> Nat Level (Hierarchy a) (Maybe (Hierarchy a)))) + (let [sub_idx (branch_idx (i64.right_shifted level (n.- 2 size)))] + (cond (n.= 0 sub_idx) + {.#None} + + (n.> branching_exponent level) + (do maybe.monad + [base|hierarchy (array.read! sub_idx hierarchy) + sub (case base|hierarchy + {#Hierarchy sub} + (without_tail size (level_down level) sub) + + {#Base _} + (undefined))] + (|> (array.clone hierarchy) + (array.write! sub_idx {#Hierarchy sub}) + {.#Some})) + + ... Else... + (|> (array.clone hierarchy) + (array.delete! sub_idx) + {.#Some}) + ))) + +(def: (node#list node) + (All (_ a) (-> (Node a) (List a))) + (case node + {#Base base} + (array.list {.#None} base) + + {#Hierarchy hierarchy} + (|> hierarchy + (array.list {.#None}) + list.reversed + (list#mix (function (_ sub acc) + (list#composite (node#list sub) acc)) + {.#End})))) + +(type: .public (Sequence a) + (Record + [#level Level + #size Nat + #root (Hierarchy a) + #tail (Base a)])) + +(def: .public empty + Sequence + [#level (level_up root_level) + #size 0 + #root (empty_hierarchy []) + #tail (array.empty 0)]) + +(def: .public (size sequence) + (All (_ a) (-> (Sequence a) Nat)) + (value@ #size sequence)) + +(def: .public (suffix val sequence) + (All (_ a) (-> a (Sequence a) (Sequence a))) + ... Check if there is room in the tail. + (let [sequence_size (value@ #size sequence)] + (if (|> sequence_size (n.- (tail_off sequence_size)) (n.< full_node_size)) + ... If so, append to it. + (|> sequence + (revised@ #size ++) + (revised@ #tail (..expanded_tail val))) + ... Otherwise, push tail into the tree + ... -------------------------------------------------------- + ... Will the root experience an overflow with this addition? + (|> (if (n.> (i64.left_shifted (value@ #level sequence) 1) + (i64.right_shifted branching_exponent sequence_size)) + ... If so, a brand-new root must be established, that is + ... 1-level taller. + (|> sequence + (with@ #root (|> (for [@.old + (: (Hierarchy (:parameter 0)) + (empty_hierarchy []))] + (empty_hierarchy [])) + (array.write! 0 {#Hierarchy (value@ #root sequence)}) + (array.write! 1 (..path (value@ #level sequence) (value@ #tail sequence))))) + (revised@ #level level_up)) + ... Otherwise, just push the current tail onto the root. + (|> sequence + (revised@ #root (..with_tail sequence_size (value@ #level sequence) (value@ #tail sequence))))) + ... Finally, update the size of the sequence and grow a new + ... tail with the new element as it's sole member. + (revised@ #size ++) + (with@ #tail (..tail val))) + ))) + +(exception: incorrect_sequence_structure) + +(exception: .public [a] (index_out_of_bounds [sequence (Sequence a) + index Nat]) + (exception.report ["Size" (# n.decimal encoded (value@ #size sequence))] + ["Index" (# n.decimal encoded index)])) + +(exception: base_was_not_found) + +(def: .public (within_bounds? sequence idx) + (All (_ a) (-> (Sequence a) Nat Bit)) + (n.< (value@ #size sequence) idx)) + +(def: (base_for idx sequence) + (All (_ a) (-> Index (Sequence a) (Try (Base a)))) + (if (within_bounds? sequence idx) + (if (n.< (tail_off (value@ #size sequence)) idx) + (loop [level (value@ #level sequence) + hierarchy (value@ #root sequence)] + (case [(n.> branching_exponent level) + (array.read! (branch_idx (i64.right_shifted level idx)) hierarchy)] + [#1 {.#Some {#Hierarchy sub}}] + (again (level_down level) sub) + + [#0 {.#Some {#Base base}}] + {try.#Success base} + + [_ {.#None}] + (exception.except ..base_was_not_found []) + + _ + (exception.except ..incorrect_sequence_structure []))) + {try.#Success (value@ #tail sequence)}) + (exception.except ..index_out_of_bounds [sequence idx]))) + +(def: .public (item idx sequence) + (All (_ a) (-> Nat (Sequence a) (Try a))) + (do try.monad + [base (base_for idx sequence)] + (case (array.read! (branch_idx idx) base) + {.#Some value} + {try.#Success value} + + {.#None} + (exception.except ..incorrect_sequence_structure [])))) + +(def: .public (has idx val sequence) + (All (_ a) (-> Nat a (Sequence a) (Try (Sequence a)))) + (let [sequence_size (value@ #size sequence)] + (if (within_bounds? sequence idx) + {try.#Success (if (n.< (tail_off sequence_size) idx) + (revised@ #root (hierarchy#has (value@ #level sequence) idx val) + sequence) + (revised@ #tail (for [@.old + (: (-> (Base (:parameter 0)) (Base (:parameter 0))) + (|>> array.clone (array.write! (branch_idx idx) val)))] + (|>> array.clone (array.write! (branch_idx idx) val))) + sequence))} + (exception.except ..index_out_of_bounds [sequence idx])))) + +(def: .public (revised idx f sequence) + (All (_ a) (-> Nat (-> a a) (Sequence a) (Try (Sequence a)))) + (do try.monad + [val (..item idx sequence)] + (..has idx (f val) sequence))) + +(def: .public (prefix sequence) + (All (_ a) (-> (Sequence a) (Sequence a))) + (case (value@ #size sequence) + 0 + empty + + 1 + empty + + sequence_size + (if (|> sequence_size (n.- (tail_off sequence_size)) (n.> 1)) + (let [old_tail (value@ #tail sequence) + new_tail_size (-- (array.size old_tail))] + (|> sequence + (revised@ #size --) + (with@ #tail (|> (array.empty new_tail_size) + (array.copy! new_tail_size 0 old_tail 0))))) + (maybe.trusted + (do maybe.monad + [new_tail (base_for (n.- 2 sequence_size) sequence) + .let [[level' root'] (let [init_level (value@ #level sequence)] + (loop [level init_level + root (maybe.else (empty_hierarchy []) + (without_tail sequence_size init_level (value@ #root sequence)))] + (if (n.> branching_exponent level) + (case [(array.read! 1 root) (array.read! 0 root)] + [{.#None} {.#Some {#Hierarchy sub_node}}] + (again (level_down level) sub_node) + + ... [{.#None} {.#Some {#Base _}}] + ... (undefined) + + _ + [level root]) + [level root])))]] + (in (|> sequence + (revised@ #size --) + (with@ #level level') + (with@ #root root') + (with@ #tail new_tail)))))) + )) + +(def: .public (list sequence) + (All (_ a) (-> (Sequence a) (List a))) + (list#composite (node#list {#Hierarchy (value@ #root sequence)}) + (node#list {#Base (value@ #tail sequence)}))) + +(def: .public of_list + (All (_ a) (-> (List a) (Sequence a))) + (list#mix ..suffix ..empty)) + +(def: .public (member? equivalence sequence val) + (All (_ a) (-> (Equivalence a) (Sequence a) a Bit)) + (list.member? equivalence (list sequence) val)) + +(def: .public empty? + (All (_ a) (-> (Sequence a) Bit)) + (|>> (value@ #size) (n.= 0))) + +(syntax: .public (sequence [elems (<>.some .any)]) + (in (.list (` (..of_list (.list (~+ elems))))))) + +(implementation: (node_equivalence Equivalence) + (All (_ a) (-> (Equivalence a) (Equivalence (Node a)))) + + (def: (= v1 v2) + (case [v1 v2] + [{#Base b1} {#Base b2}] + (# (array.equivalence Equivalence) = b1 b2) + + [{#Hierarchy h1} {#Hierarchy h2}] + (# (array.equivalence (node_equivalence Equivalence)) = h1 h2) + + _ + #0))) + +(implementation: .public (equivalence Equivalence) + (All (_ a) (-> (Equivalence a) (Equivalence (Sequence a)))) + + (def: (= v1 v2) + (and (n.= (value@ #size v1) (value@ #size v2)) + (let [(^open "node#[0]") (node_equivalence Equivalence)] + (and (node#= {#Base (value@ #tail v1)} + {#Base (value@ #tail v2)}) + (node#= {#Hierarchy (value@ #root v1)} + {#Hierarchy (value@ #root v2)})))))) + +(implementation: node_mix + (Mix Node) + + (def: (mix f init xs) + (case xs + {#Base base} + (array#mix f init base) + + {#Hierarchy hierarchy} + (array#mix (function (_ node init') (mix f init' node)) + init + hierarchy)))) + +(implementation: .public mix + (Mix Sequence) + + (def: (mix f init xs) + (let [(^open "[0]") node_mix] + (mix f + (mix f + init + {#Hierarchy (value@ #root xs)}) + {#Base (value@ #tail xs)})))) + +(implementation: .public monoid + (All (_ a) (Monoid (Sequence a))) + + (def: identity ..empty) + + (def: (composite xs ys) + (list#mix suffix xs (..list ys)))) + +(implementation: node_functor + (Functor Node) + + (def: (each f xs) + (case xs + {#Base base} + {#Base (array#each f base)} + + {#Hierarchy hierarchy} + {#Hierarchy (array#each (each f) hierarchy)}))) + +(implementation: .public functor + (Functor Sequence) + + (def: (each f xs) + [#level (value@ #level xs) + #size (value@ #size xs) + #root (|> xs (value@ #root) (array#each (# node_functor each f))) + #tail (|> xs (value@ #tail) (array#each f))])) + +(implementation: .public apply + (Apply Sequence) + + (def: &functor ..functor) + + (def: (on fa ff) + (let [(^open "[0]") ..functor + (^open "[0]") ..mix + (^open "[0]") ..monoid + results (each (function (_ f) (each f fa)) + ff)] + (mix composite identity results)))) + +(implementation: .public monad + (Monad Sequence) + + (def: &functor ..functor) + + (def: in + (|>> sequence)) + + (def: conjoint + (let [(^open "[0]") ..mix + (^open "[0]") ..monoid] + (mix (function (_ post pre) (composite pre post)) identity)))) + +(def: .public reversed + (All (_ a) (-> (Sequence a) (Sequence a))) + (|>> ..list + list.reversed + (list#mix suffix ..empty))) + +(template [ ] + [(def: .public + (All (_ a) + (-> (Predicate a) (Sequence a) Bit)) + (let [help (: (All (_ a) + (-> (Predicate a) (Node a) Bit)) + (function (help predicate node) + (case node + {#Base base} + ( predicate base) + + {#Hierarchy hierarchy} + ( (help predicate) hierarchy))))] + (function ( predicate sequence) + (let [(^open "_[0]") sequence] + ( (help predicate {#Hierarchy _#root}) + (help predicate {#Base _#tail}))))))] + + [every? array.every? #1 and] + [any? array.any? #0 or] + ) diff --git a/stdlib/source/library/lux/data/format/binary.lux b/stdlib/source/library/lux/data/format/binary.lux index abf28f5d0..afd908091 100644 --- a/stdlib/source/library/lux/data/format/binary.lux +++ b/stdlib/source/library/lux/data/format/binary.lux @@ -20,7 +20,7 @@ ["[0]" utf8]]] [collection ["[0]" list] - ["[0]" row {"+" Row} ("[1]#[0]" functor)] + ["[0]" sequence {"+" Sequence} ("[1]#[0]" functor)] ["[0]" set {"+" Set}]]] [math [number @@ -177,18 +177,18 @@ (template [ ] [(def: .public ( valueW) - (All (_ v) (-> (Writer v) (Writer (Row v)))) + (All (_ v) (-> (Writer v) (Writer (Sequence v)))) (function (_ value) - (let [original_count (row.size value) + (let [original_count (sequence.size value) capped_count (i64.and (..mask ) original_count) value (if (n.= original_count capped_count) value - (|> value row.list (list.first capped_count) row.of_list)) + (|> value sequence.list (list.first capped_count) sequence.of_list)) (^open "specification#[0]") ..monoid [size mutation] (|> value - (row#each valueW) - (# row.mix mix + (sequence#each valueW) + (# sequence.mix mix (function (_ post pre) (specification#composite pre post)) specification#identity))] @@ -199,10 +199,10 @@ [_ ( offset capped_count binary)] (in (mutation [(n.+ offset) binary])))))])))] - [row/8 /.size/8 binary.write/8!] - [row/16 /.size/16 binary.write/16!] - [row/32 /.size/32 binary.write/32!] - [row/64 /.size/64 binary.write/64!] + [sequence/8 /.size/8 binary.write/8!] + [sequence/16 /.size/16 binary.write/16!] + [sequence/32 /.size/32 binary.write/32!] + [sequence/64 /.size/64 binary.write/64!] ) (def: .public maybe diff --git a/stdlib/source/library/lux/data/format/json.lux b/stdlib/source/library/lux/data/format/json.lux index 56400e0ca..5bd36a123 100644 --- a/stdlib/source/library/lux/data/format/json.lux +++ b/stdlib/source/library/lux/data/format/json.lux @@ -20,7 +20,7 @@ ["[0]" text ("[1]#[0]" equivalence monoid)] [collection ["[0]" list ("[1]#[0]" mix functor)] - ["[0]" row {"+" Row row} ("[1]#[0]" monad)] + ["[0]" sequence {"+" Sequence sequence} ("[1]#[0]" monad)] ["[0]" dictionary {"+" Dictionary}]]] [macro [syntax {"+" syntax:}] @@ -47,14 +47,14 @@ {#Boolean Boolean} {#Number Number} {#String String} - {#Array (Row JSON)} + {#Array (Sequence JSON)} {#Object (Dictionary String JSON)}))) (template [ ] [(type: .public )] - [Array (Row JSON)] + [Array (Sequence JSON)] [Object (Dictionary String JSON)] ) @@ -74,7 +74,7 @@ {#Boolean' Boolean} {#Number' Number} {#String' String} - {#Array' (Row JSON')} + {#Array' (Sequence JSON')} {#Object' (Dictionary String JSON')} {#Code' Code}))) @@ -87,7 +87,7 @@ .bit .frac .text - (<>#each row.of_list + (<>#each sequence.of_list (.tuple (<>.some jsonP))) (<>#each (dictionary.of_list text.hash) (.variant (<>.some (<>.and .text jsonP)))) @@ -108,7 +108,7 @@ [code.text ..#String' ..#String]) {#Array' members} - (` {..#Array ((~! row.row) (~+ (row.list (row#each jsonF members))))}) + (` {..#Array ((~! sequence.sequence) (~+ (sequence.list (sequence#each jsonF members))))}) {#Object' pairs} (` {..#Object ((~! dictionary.of_list) @@ -192,16 +192,16 @@ [#String text.equivalence]) [{#Array xs} {#Array ys}] - (and (n.= (row.size xs) (row.size ys)) + (and (n.= (sequence.size xs) (sequence.size ys)) (list#mix (function (_ idx prev) (and prev (maybe.else #0 (do maybe.monad - [x' (row.item idx xs) - y' (row.item idx ys)] + [x' (sequence.item idx xs) + y' (sequence.item idx ys)] (in (= x' y')))))) #1 - (list.indices (row.size xs)))) + (list.indices (sequence.size xs)))) [{#Object xs} {#Object ys}] (and (n.= (dictionary.size xs) (dictionary.size ys)) @@ -264,8 +264,8 @@ (def: (array_format format) (-> (-> JSON Text) (-> Array Text)) - (|>> (row#each format) - row.list + (|>> (sequence#each format) + sequence.list (text.interposed ..value_separator) (text.enclosed [..array_start ..array_end]))) @@ -411,7 +411,7 @@ _ (.this )] (in ( elems))))] - [array_parser Array ..array_start ..array_end json_parser row.of_list] + [array_parser Array ..array_start ..array_end json_parser sequence.of_list] [object_parser Object ..object_start ..object_end (kv_parser json_parser) (dictionary.of_list text.hash)] ) diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux index dd511524b..7ab3eafd0 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -20,7 +20,7 @@ ["[1]" binary {"+" Writer} ("[1]#[0]" monoid)]] [collection ["[0]" list ("[1]#[0]" mix)] - ["[0]" row {"+" Row} ("[1]#[0]" mix)]]] + ["[0]" sequence {"+" Sequence} ("[1]#[0]" mix)]]] [math ["[0]" number ["n" nat] @@ -583,7 +583,7 @@ (try.trusted (..small 0))) (type: .public Tar - (Row Entry)) + (Sequence Entry)) (def: (blocks size) (-> Big Nat) @@ -734,10 +734,10 @@ (Writer Tar) (let [end_of_archive (binary.empty ..end_of_archive_size)] (function (_ tar) - (format#composite (row#mix (function (_ next total) - (format#composite total (..entry_writer next))) - format#identity - tar) + (format#composite (sequence#mix (function (_ next total) + (format#composite total (..entry_writer next))) + format#identity + tar) (format.segment ..end_of_archive_size end_of_archive))))) (exception: .public (wrong_checksum [expected Nat @@ -883,5 +883,5 @@ (def: .public parser (Parser Tar) (|> (<>.some entry_parser) - (# <>.monad each row.of_list) + (# <>.monad each sequence.of_list) (<>.before ..end_of_archive_parser))) diff --git a/stdlib/source/library/lux/data/text/buffer.lux b/stdlib/source/library/lux/data/text/buffer.lux index 05e22b6cd..3abad763c 100644 --- a/stdlib/source/library/lux/data/text/buffer.lux +++ b/stdlib/source/library/lux/data/text/buffer.lux @@ -11,7 +11,7 @@ ["%" format {"+" format}]] [collection ["[0]" array] - ["[0]" row {"+" Row} ("[1]#[0]" mix)]]] + ["[0]" sequence {"+" Sequence} ("[1]#[0]" mix)]]] [math [number ["n" nat]]] @@ -53,7 +53,7 @@ @.js [Nat (-> (JS_Array Text) (JS_Array Text))] @.lua [Nat (-> (array.Array Text) (array.Array Text))]] ... default - (Row Text)) + (Sequence Text)) (def: .public empty Buffer @@ -63,7 +63,7 @@ @.js [0 function.identity] @.lua [0 function.identity]] ... default - row.empty)))) + sequence.empty)))) (def: .public (then chunk buffer) (-> Text Buffer Buffer) @@ -95,7 +95,7 @@ (:abstraction [(n.+ (//.size chunk) capacity) (|>> transform then!)]))] ... default - (|> buffer :representation (row.suffix chunk) :abstraction)))) + (|> buffer :representation (sequence.suffix chunk) :abstraction)))) (def: .public size (-> Buffer Nat) @@ -106,9 +106,9 @@ @.lua ] ... default (|>> :representation - (row#mix (function (_ chunk total) - (n.+ (//.size chunk) total)) - 0))))) + (sequence#mix (function (_ chunk total) + (n.+ (//.size chunk) total)) + 0))))) (def: .public (text buffer) (-> Buffer Text) @@ -126,8 +126,8 @@ @.lua (let [[capacity transform] (:representation buffer)] (table/concat [(transform (array.empty 0)) ""]))] ... default - (row#mix (function (_ chunk total) - (format total chunk)) - "" - (:representation buffer))))) + (sequence#mix (function (_ chunk total) + (format total chunk)) + "" + (:representation buffer))))) )) diff --git a/stdlib/source/library/lux/math/random.lux b/stdlib/source/library/lux/math/random.lux index a7fffe898..9da83770e 100644 --- a/stdlib/source/library/lux/math/random.lux +++ b/stdlib/source/library/lux/math/random.lux @@ -17,7 +17,7 @@ ["[0]" queue {"+" Queue}] ["[0]" set {"+" Set}] ["[0]" stack {"+" Stack}] - ["[0]" row {"+" Row}] + ["[0]" sequence {"+" Sequence}] [tree ["[0]" finger {"+" Tree}]]]] [math @@ -245,14 +245,14 @@ (in {.#Item x xs})) (# ..monad in (.list)))) -(def: .public (row size value_gen) - (All (_ a) (-> Nat (Random a) (Random (Row a)))) +(def: .public (sequence size value_gen) + (All (_ a) (-> Nat (Random a) (Random (Sequence a)))) (if (n.> 0 size) (do ..monad [x value_gen - xs (row (-- size) value_gen)] - (in (row.suffix x xs))) - (# ..monad in row.empty))) + xs (sequence (-- size) value_gen)] + (in (sequence.suffix x xs))) + (# ..monad in sequence.empty))) (template [ ] [(def: .public ( size value_gen) diff --git a/stdlib/source/library/lux/target/jvm.lux b/stdlib/source/library/lux/target/jvm.lux index 2f5bc8173..1ac418a6e 100644 --- a/stdlib/source/library/lux/target/jvm.lux +++ b/stdlib/source/library/lux/target/jvm.lux @@ -3,7 +3,7 @@ [lux {"-" Type Primitive Label} [data [collection - [row {"+" Row}]]] + [sequence {"+" Sequence}]]] [target [jvm [type {"+" Type} @@ -310,4 +310,4 @@ {#Embedded embedded})) (type: .public (Bytecode embedded label) - (Row (Instruction embedded label))) + (Sequence (Instruction embedded label))) diff --git a/stdlib/source/library/lux/target/jvm/attribute/code.lux b/stdlib/source/library/lux/target/jvm/attribute/code.lux index 94498a51e..be5faff6f 100644 --- a/stdlib/source/library/lux/target/jvm/attribute/code.lux +++ b/stdlib/source/library/lux/target/jvm/attribute/code.lux @@ -9,7 +9,7 @@ [format ["[0]F" binary {"+" Writer} ("[1]#[0]" monoid)]] [collection - ["[0]" row {"+" Row} ("[1]#[0]" functor mix)]]] + ["[0]" sequence {"+" Sequence} ("[1]#[0]" functor mix)]]] [math [number ["n" nat]]]]] @@ -26,8 +26,8 @@ (Record [#limit Limit #code Binary - #exception_table (Row Exception) - #attributes (Row Attribute)])) + #exception_table (Sequence Exception) + #attributes (Sequence Attribute)])) (def: .public (length length code) (All (_ Attribute) (-> (-> Attribute Nat) (Code Attribute) Nat)) @@ -44,15 +44,15 @@ ... exception_table[exception_table_length]; (|> code (value@ #exception_table) - row.size + sequence.size (n.* /exception.length)) ... u2 attributes_count; ///unsigned.bytes/2 ... attribute_info attributes[attributes_count]; (|> code (value@ #attributes) - (row#each length) - (row#mix n.+ 0)))) + (sequence#each length) + (sequence#mix n.+ 0)))) (def: .public (equivalence attribute_equivalence) (All (_ attribute) @@ -60,8 +60,8 @@ ($_ product.equivalence ///limit.equivalence binary.equivalence - (row.equivalence /exception.equivalence) - (row.equivalence attribute_equivalence) + (sequence.equivalence /exception.equivalence) + (sequence.equivalence attribute_equivalence) )) ... https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.3 @@ -76,8 +76,8 @@ (binaryF.binary/32 (value@ #code code)) ... u2 exception_table_length; ... exception_table[exception_table_length]; - ((binaryF.row/16 /exception.writer) (value@ #exception_table code)) + ((binaryF.sequence/16 /exception.writer) (value@ #exception_table code)) ... u2 attributes_count; ... attribute_info attributes[attributes_count]; - ((binaryF.row/16 writer) (value@ #attributes code)) + ((binaryF.sequence/16 writer) (value@ #attributes code)) )) diff --git a/stdlib/source/library/lux/target/jvm/bytecode.lux b/stdlib/source/library/lux/target/jvm/bytecode.lux index c7fee0eed..cbcd7bf6a 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode.lux @@ -19,7 +19,7 @@ [collection ["[0]" list ("[1]#[0]" functor mix)] ["[0]" dictionary {"+" Dictionary}] - ["[0]" row {"+" Row}]]] + ["[0]" sequence {"+" Sequence}]]] [macro ["[0]" template]] [math @@ -70,11 +70,11 @@ #known (dictionary.empty n.hash)]) (type: .public Relative - (-> Resolver (Try [(Row Exception) Instruction]))) + (-> Resolver (Try [(Sequence Exception) Instruction]))) (def: no_exceptions - (Row Exception) - row.empty) + (Sequence Exception) + sequence.empty) (def: relative_identity Relative @@ -97,7 +97,7 @@ (do try.monad [[left_exceptions left_instruction] (left resolver) [right_exceptions right_instruction] (right resolver)] - (in [(# row.monoid composite left_exceptions right_exceptions) + (in [(# sequence.monoid composite left_exceptions right_exceptions) (_#composite left_instruction right_instruction)])))))) (type: .public (Bytecode a) @@ -174,7 +174,7 @@ (..failure (exception.error exception value))) (def: .public (resolve environment bytecode) - (All (_ a) (-> Environment (Bytecode a) (Resource [Environment (Row Exception) Instruction a]))) + (All (_ a) (-> Environment (Bytecode a) (Resource [Environment (Sequence Exception) Instruction a]))) (function (_ pool) (do try.monad [[[pool environment tracker] [relative output]] (bytecode [pool environment ..fresh]) @@ -1038,10 +1038,11 @@ (in []) (exception.except ..invalid_range_for_try [@start @end])) [_ @handler] (..resolve_label @handler resolver)] - (in [(row.row [//exception.#start @start - //exception.#end @end - //exception.#handler @handler - //exception.#catch @catch]) + (in [(sequence.sequence + [//exception.#start @start + //exception.#end @end + //exception.#handler @handler + //exception.#catch @catch]) _.empty]))) []]]}))) diff --git a/stdlib/source/library/lux/target/jvm/class.lux b/stdlib/source/library/lux/target/jvm/class.lux index 1658327f2..47b23c3ce 100644 --- a/stdlib/source/library/lux/target/jvm/class.lux +++ b/stdlib/source/library/lux/target/jvm/class.lux @@ -12,7 +12,7 @@ [format ["[0]F" binary {"+" Writer} ("[1]#[0]" monoid)]] [collection - ["[0]" row {"+" Row}]]]]] + ["[0]" sequence {"+" Sequence}]]]]] ["[0]" // "_" ["[1][0]" modifier {"+" Modifier modifiers:}] ["[1][0]" version {"+" Version Minor Major}] @@ -37,10 +37,10 @@ #modifier (Modifier Class) #this (Index //constant.Class) #super (Index //constant.Class) - #interfaces (Row (Index //constant.Class)) - #fields (Row Field) - #methods (Row Method) - #attributes (Row Attribute)]))) + #interfaces (Sequence (Index //constant.Class)) + #fields (Sequence Field) + #methods (Sequence Method) + #attributes (Sequence Attribute)]))) (modifiers: Class ["0001" public] @@ -63,23 +63,23 @@ //modifier.equivalence //index.equivalence //index.equivalence - (row.equivalence //index.equivalence) - (row.equivalence //field.equivalence) - (row.equivalence //method.equivalence) - (row.equivalence //attribute.equivalence))) + (sequence.equivalence //index.equivalence) + (sequence.equivalence //field.equivalence) + (sequence.equivalence //method.equivalence) + (sequence.equivalence //attribute.equivalence))) (def: (install_classes this super interfaces) (-> Internal Internal (List Internal) - (Resource [(Index //constant.Class) (Index //constant.Class) (Row (Index //constant.Class))])) + (Resource [(Index //constant.Class) (Index //constant.Class) (Sequence (Index //constant.Class))])) (do [! //constant/pool.monad] [@this (//constant/pool.class this) @super (//constant/pool.class super) - @interfaces (: (Resource (Row (Index //constant.Class))) + @interfaces (: (Resource (Sequence (Index //constant.Class))) (monad.mix ! (function (_ interface @interfaces) (do ! [@interface (//constant/pool.class interface)] - (in (row.suffix @interface @interfaces)))) - row.empty + (in (sequence.suffix @interface @interfaces)))) + sequence.empty interfaces))] (in [@this @super @interfaces]))) @@ -90,7 +90,7 @@ Internal Internal (List Internal) (List (Resource Field)) (List (Resource Method)) - (Row Attribute) + (Sequence Attribute) (Try Class)) (do try.monad [[pool [@this @super @interfaces] =fields =methods] @@ -108,8 +108,8 @@ #this @this #super @super #interfaces @interfaces - #fields (row.of_list =fields) - #methods (row.of_list =methods) + #fields (sequence.of_list =fields) + #methods (sequence.of_list =methods) #attributes attributes]))) (def: .public (writer class) @@ -126,7 +126,7 @@ [//index.writer #this] [//index.writer #super])) (~~ (template [ ] - [((binaryF.row/16 ) (value@ class))] + [((binaryF.sequence/16 ) (value@ class))] [//index.writer #interfaces] [//field.writer #fields] diff --git a/stdlib/source/library/lux/target/jvm/constant.lux b/stdlib/source/library/lux/target/jvm/constant.lux index 41a196162..92c80b94b 100644 --- a/stdlib/source/library/lux/target/jvm/constant.lux +++ b/stdlib/source/library/lux/target/jvm/constant.lux @@ -11,9 +11,7 @@ ["[0]" product] ["[0]" text] [format - ["[0]F" binary {"+" Writer} ("[1]#[0]" monoid)]] - [collection - ["[0]" row {"+" Row}]]] + ["[0]F" binary {"+" Writer} ("[1]#[0]" monoid)]]] [macro ["[0]" template]] [math diff --git a/stdlib/source/library/lux/target/jvm/constant/pool.lux b/stdlib/source/library/lux/target/jvm/constant/pool.lux index 65d5847b7..a7c488b49 100644 --- a/stdlib/source/library/lux/target/jvm/constant/pool.lux +++ b/stdlib/source/library/lux/target/jvm/constant/pool.lux @@ -14,7 +14,7 @@ ["[0]" format "_" ["[1]" binary {"+" Writer} ("specification#[0]" monoid)]] [collection - ["[0]" row {"+" Row} ("[1]#[0]" mix)]]] + ["[0]" sequence {"+" Sequence} ("[1]#[0]" mix)]]] [macro ["[0]" template]] [math @@ -36,13 +36,13 @@ ["[1][0]" descriptor {"+" Descriptor}]]]]) (type: .public Pool - [Index (Row [Index Constant])]) + [Index (Sequence [Index Constant])]) (def: .public equivalence (Equivalence Pool) (product.equivalence //index.equivalence - (row.equivalence (product.equivalence //index.equivalence - //.equivalence)))) + (sequence.equivalence (product.equivalence //index.equivalence + //.equivalence)))) (type: .public (Resource a) (+State Try Pool a)) @@ -56,7 +56,7 @@ (let [' ] (with_expansions [ (as_is (again (.++ idx)))] (loop [idx 0] - (case (row.item idx pool) + (case (sequence.item idx pool) {try.#Success entry} (case entry [index { reference}] @@ -78,7 +78,7 @@ (//unsigned.+/2 @new) (# ! each //index.index)))] (in [[next - (row.suffix [current new] pool)] + (sequence.suffix [current new] pool)] current]))))))))]) (template: (!index ) @@ -149,12 +149,12 @@ (def: .public writer (Writer Pool) (function (_ [next pool]) - (row#mix (function (_ [_index post] pre) - (specification#composite pre (//.writer post))) - (format.bits/16 (!index next)) - pool))) + (sequence#mix (function (_ [_index post] pre) + (specification#composite pre (//.writer post))) + (format.bits/16 (!index next)) + pool))) (def: .public empty Pool [(|> 1 //unsigned.u2 try.trusted //index.index) - row.empty]) + sequence.empty]) diff --git a/stdlib/source/library/lux/target/jvm/field.lux b/stdlib/source/library/lux/target/jvm/field.lux index 9d1b50706..4a1860f1a 100644 --- a/stdlib/source/library/lux/target/jvm/field.lux +++ b/stdlib/source/library/lux/target/jvm/field.lux @@ -9,7 +9,7 @@ [format ["[0]F" binary {"+" Writer} ("[1]#[0]" monoid)]] [collection - ["[0]" row {"+" Row}]]]]] + ["[0]" sequence {"+" Sequence}]]]]] ["[0]" // "_" ["[0]" modifier {"+" Modifier modifiers:}] ["[1][0]" constant {"+" UTF8} @@ -26,7 +26,7 @@ [#modifier (Modifier Field) #name (Index UTF8) #descriptor (Index (Descriptor Value)) - #attributes (Row Attribute)]))) + #attributes (Sequence Attribute)]))) (modifiers: Field ["0001" public] @@ -46,7 +46,7 @@ modifier.equivalence //index.equivalence //index.equivalence - (row.equivalence //attribute.equivalence))) + (sequence.equivalence //attribute.equivalence))) (def: .public (writer field) (Writer Field) @@ -57,11 +57,11 @@ [modifier.writer #modifier] [//index.writer #name] [//index.writer #descriptor] - [(binaryF.row/16 //attribute.writer) #attributes])) + [(binaryF.sequence/16 //attribute.writer) #attributes])) ))) (def: .public (field modifier name type attributes) - (-> (Modifier Field) UTF8 (Type Value) (Row Attribute) + (-> (Modifier Field) UTF8 (Type Value) (Sequence Attribute) (Resource Field)) (do //constant/pool.monad [@name (//constant/pool.utf8 name) diff --git a/stdlib/source/library/lux/target/jvm/method.lux b/stdlib/source/library/lux/target/jvm/method.lux index e4b70f437..c1c711379 100644 --- a/stdlib/source/library/lux/target/jvm/method.lux +++ b/stdlib/source/library/lux/target/jvm/method.lux @@ -11,7 +11,7 @@ ["[0]" format "_" ["[1]" binary {"+" Writer} ("[1]#[0]" monoid)]] [collection - ["[0]" row {"+" Row}]]]]] + ["[0]" sequence {"+" Sequence}]]]]] ["[0]" // "_" ["[1][0]" modifier {"+" Modifier modifiers:}] ["[1][0]" index {"+" Index}] @@ -32,7 +32,7 @@ [#modifier (Modifier Method) #name (Index UTF8) #descriptor (Index (Descriptor //type/category.Method)) - #attributes (Row Attribute)]))) + #attributes (Sequence Attribute)]))) (modifiers: Method ["0001" public] @@ -57,7 +57,7 @@ @descriptor (//constant/pool.descriptor (//type.descriptor type)) attributes (|> attributes (monad.all !) - (# ! each row.of_list)) + (# ! each sequence.of_list)) attributes (case code {.#Some code} (do ! @@ -74,8 +74,8 @@ @code (//attribute.code [//attribute/code.#limit (value@ //bytecode/environment.#limit environment) //attribute/code.#code bytecode //attribute/code.#exception_table exceptions - //attribute/code.#attributes (row.row)])] - (in (row.suffix @code attributes))) + //attribute/code.#attributes (sequence.sequence)])] + (in (sequence.suffix @code attributes))) {.#None} (in attributes))] @@ -90,7 +90,7 @@ //modifier.equivalence //index.equivalence //index.equivalence - (row.equivalence //attribute.equivalence) + (sequence.equivalence //attribute.equivalence) )) (def: .public (writer field) @@ -102,5 +102,5 @@ [//modifier.writer #modifier] [//index.writer #name] [//index.writer #descriptor] - [(format.row/16 //attribute.writer) #attributes])) + [(format.sequence/16 //attribute.writer) #attributes])) ))) diff --git a/stdlib/source/library/lux/time/instant.lux b/stdlib/source/library/lux/time/instant.lux index ea69493f9..a907624ab 100644 --- a/stdlib/source/library/lux/time/instant.lux +++ b/stdlib/source/library/lux/time/instant.lux @@ -16,9 +16,7 @@ ["<>" parser ["<[0]>" text {"+" Parser}]]] [data - ["[0]" text ("[1]#[0]" monoid)] - [collection - ["[0]" row]]] + ["[0]" text ("[1]#[0]" monoid)]] [math [number ["i" int] diff --git a/stdlib/source/library/lux/tool/compiler.lux b/stdlib/source/library/lux/tool/compiler.lux index 34aaa24b1..a5891d2bb 100644 --- a/stdlib/source/library/lux/tool/compiler.lux +++ b/stdlib/source/library/lux/tool/compiler.lux @@ -6,9 +6,7 @@ ["[0]" exception {"+" exception:}]] [data [binary {"+" Binary}] - ["[0]" text] - [collection - ["[0]" row {"+" Row}]]] + ["[0]" text]] [world ["[0]" file {"+" Path}]]]] [/ diff --git a/stdlib/source/library/lux/tool/compiler/default/init.lux b/stdlib/source/library/lux/tool/compiler/default/init.lux index 4fa1d7ed8..4cb35a1ea 100644 --- a/stdlib/source/library/lux/tool/compiler/default/init.lux +++ b/stdlib/source/library/lux/tool/compiler/default/init.lux @@ -16,7 +16,7 @@ ["[0]" list ("[1]#[0]" functor)] ["[0]" dictionary] ["[0]" set] - ["[0]" row ("[1]#[0]" functor)]]] + ["[0]" sequence ("[1]#[0]" functor)]]] ["[0]" meta] [world ["[0]" file]]]] @@ -259,9 +259,9 @@ (in [state {.#Right [descriptor (document.write key analysis_module) - (row#each (function (_ [artifact_id custom directive]) - [artifact_id custom (write_directive directive)]) - final_buffer)]}])) + (sequence#each (function (_ [artifact_id custom directive]) + [artifact_id custom (write_directive directive)]) + final_buffer)]}])) {.#Some [source requirements temporary_payload]} (let [[temporary_buffer temporary_registry] temporary_payload] diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index e6b1ea9bb..34e34a743 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -22,7 +22,7 @@ ["%" format {"+" format}]] [collection ["[0]" dictionary {"+" Dictionary}] - ["[0]" row {"+" Row} ("[1]#[0]" mix)] + ["[0]" sequence {"+" Sequence} ("[1]#[0]" mix)] ["[0]" set {"+" Set}] ["[0]" list ("[1]#[0]" monoid functor mix)]] [format @@ -102,12 +102,12 @@ (do [! ..monad] [_ (ioW.prepare system static module_id) _ (for [@.python (|> output - row.list + sequence.list (list.sub 128) (monad.each ! (monad.each ! write_artifact!)) (: (Action (List (List Any)))))] (|> output - row.list + sequence.list (monad.each ..monad write_artifact!) (: (Action (List Any))))) document (# async.monad in @@ -281,9 +281,9 @@ ///directive.#state extension.#state ///generation.#log]) - (row#mix (function (_ right left) - (format left ..compilation_log_separator right)) - module))) + (sequence#mix (function (_ right left) + (format left ..compilation_log_separator right)) + module))) (def: with_reset_log (All (_ ) @@ -293,7 +293,7 @@ ///directive.#state extension.#state ///generation.#log] - row.empty)) + sequence.empty)) (def: empty (Set Module) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux index 108e94a40..a938f0ea5 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux @@ -13,7 +13,7 @@ ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" format}]] [collection - ["[0]" row {"+" Row}] + ["[0]" sequence {"+" Sequence}] ["[0]" list ("[1]#[0]" functor)]]] [math [number @@ -35,7 +35,7 @@ [archive.ID artifact.ID]) (type: .public (Buffer directive) - (Row [artifact.ID (Maybe Text) directive])) + (Sequence [artifact.ID (Maybe Text) directive])) (exception: .public (cannot_interpret [error Text]) (exception.report @@ -75,7 +75,7 @@ #registry artifact.Registry #counter Nat #context (Maybe artifact.ID) - #log (Row Text)])) + #log (Sequence Text)])) (template [ ] [(type: .public ( anchor expression directive) @@ -101,11 +101,11 @@ #registry artifact.empty #counter 0 #context {.#None} - #log row.empty]) + #log sequence.empty]) (def: .public empty_buffer Buffer - row.empty) + sequence.empty) (template [ @@ -234,9 +234,9 @@ (case ?buffer {.#Some buffer} ... TODO: Optimize by no longer checking for overwrites... - (if (row.any? (|>> product.left (n.= artifact_id)) buffer) + (if (sequence.any? (|>> product.left (n.= artifact_id)) buffer) (phase.except ..cannot_overwrite_output [artifact_id]) - (extension.update (with@ #buffer {.#Some (row.suffix [artifact_id custom code] buffer)}))) + (extension.update (with@ #buffer {.#Some (sequence.suffix [artifact_id custom code] buffer)}))) {.#None} (phase.except ..no_buffer_for_saving_code [artifact_id])))) @@ -338,5 +338,5 @@ (-> Text (Operation anchor expression directive Any))) (function (_ [bundle state]) {try.#Success [[bundle - (revised@ #log (row.suffix message) state)] + (revised@ #log (sequence.suffix message) state)] []]})) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux index edf4eb749..4e03d12f5 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux @@ -16,7 +16,7 @@ [collection ["[0]" list ("[1]#[0]" functor mix)] ["[0]" dictionary] - ["[0]" row]]] + ["[0]" sequence]]] [macro ["[0]" template]] [math @@ -193,7 +193,7 @@ (do pool.monad [constant (`` (|> value (~~ (template.spliced )))) attribute (attribute.constant constant)] - (field.field ..constant::modifier name (row.row attribute)))]) + (field.field ..constant::modifier name (sequence.sequence attribute)))]) ([.#Bit type.boolean [(case> #0 +0 #1 +1) .i64 i32.i32 constant.integer pool.integer]] [.#Int type.byte [.i64 i32.i32 constant.integer pool.integer]] [.#Int type.short [.i64 i32.i32 constant.integer pool.integer]] @@ -212,7 +212,7 @@ ... TODO: Handle annotations. {#Variable [name visibility state annotations type]} (field.field (modifier#composite visibility state) - name type (row.row)))) + name type (sequence.sequence)))) (def: (method_definition [mapping selfT] [analyse synthesize generate]) (-> [Mapping .Type] @@ -293,7 +293,7 @@ ... super_class super_interfaces ... (list#each ..field_definition fields) ... (list) ... TODO: Add methods - ... (row.row))])) + ... (sequence.sequence))])) _ (directive.lifted_generation (generation.log! (format "Class " name)))] (in directive.no_requirements)))])) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux index 7058b41c6..b7e629594 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux @@ -20,7 +20,7 @@ ["[0]" list ("[1]#[0]" monad)] ["[0]" dictionary {"+" Dictionary}] ["[0]" set] - ["[0]" row]] + ["[0]" sequence]] ["[0]" format "_" ["[1]" binary]]] [target @@ -1079,7 +1079,7 @@ (foreign.variables total_environment) (list& (..with_anonymous_init class total_environment super_class inputsTI) method_definitions) - (row.row))) + (sequence.sequence))) _ (//////generation.execute! [anonymous_class_name bytecode]) _ (//////generation.save! (%.nat artifact_id) [anonymous_class_name bytecode])] (anonymous_instance generate archive class total_environment)))])) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux index acb4af284..8d4652175 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux @@ -15,7 +15,7 @@ ["[0]" encoding]] [collection ["[0]" list ("[1]#[0]" functor monoid)] - ["[0]" row]]] + ["[0]" sequence]]] ["[0]" macro [syntax {"+" syntax:}] ["[0]" code]] @@ -287,7 +287,7 @@ (in [(|> artifact.empty artifact.resource product.right) - (row.row [(%.nat ..module_id) - (|> ..runtime - _.code - (# encoding.utf8 encoded))])]))) + (sequence.sequence [(%.nat ..module_id) + (|> ..runtime + _.code + (# encoding.utf8 encoded))])]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux index c935522f2..65396d0d7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux @@ -16,7 +16,7 @@ ["[0]" utf8]]] [collection ["[0]" list ("[1]#[0]" functor)] - ["[0]" row]]] + ["[0]" sequence]]] ["[0]" macro [syntax {"+" syntax:}] ["[0]" code]] @@ -779,8 +779,8 @@ (in [(|> artifact.empty artifact.resource product.right) - (row.row [..module_id - {.#None} - (|> ..runtime - _.code - (# utf8.codec encoded))])]))) + (sequence.sequence [..module_id + {.#None} + (|> ..runtime + _.code + (# utf8.codec encoded))])]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux index 468ddd17b..89fe59585 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux @@ -9,7 +9,7 @@ ["n" nat]] [collection ["[0]" list ("[1]#[0]" monoid functor)] - ["[0]" row]] + ["[0]" sequence]] ["[0]" format "_" ["[1]" binary]]] [target @@ -110,7 +110,7 @@ (..internal /abstract.class) (list) fields methods - (row.row))) + (sequence.sequence))) .let [bytecode (format.result class.writer class)] _ (generation.execute! [function_class bytecode]) _ (generation.save! function_class {.#None} [function_class bytecode])] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux index 0bb37e3da..4cbfa7d82 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux @@ -3,7 +3,7 @@ [lux {"-" Type type} [data [collection - ["[0]" row]]] + ["[0]" sequence]]] [target [jvm ["[0]" field {"+" Field}] @@ -23,4 +23,4 @@ (def: .public (constant name type) (-> Text (Type Value) (Resource Field)) - (field.field ..modifier name type (row.row))) + (field.field ..modifier name type (sequence.sequence))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux index 9365336e8..5c2953cd9 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux @@ -4,7 +4,7 @@ [data [collection ["[0]" list ("[1]#[0]" functor)] - ["[0]" row]]] + ["[0]" sequence]]] [target [jvm ["[0]" modifier {"+" Modifier} ("[1]#[0]" monoid)] @@ -46,7 +46,7 @@ (def: .public (variable name type) (-> Text (Type Value) (Resource Field)) - (field.field ..modifier name type (row.row))) + (field.field ..modifier name type (sequence.sequence))) (def: .public (variables naming amount) (-> (-> Register Text) Nat (List (Resource Field))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/foreign.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/foreign.lux index 747d53f66..9a4aaaba5 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/foreign.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/foreign.lux @@ -3,8 +3,7 @@ [lux {"-" Type} [data [collection - ["[0]" list] - ["[0]" row]]] + ["[0]" list]]] [target [jvm ["_" bytecode {"+" Bytecode}] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux index 216c8cba8..6fedb0acf 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux @@ -7,8 +7,7 @@ [number ["n" nat]] [collection - ["[0]" list ("[1]#[0]" functor)] - ["[0]" row]]] + ["[0]" list ("[1]#[0]" functor)]]] [target [jvm ["[0]" field {"+" Field}] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux index 2684da183..4cce47a47 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux @@ -19,7 +19,7 @@ [collection ["[0]" array] ["[0]" dictionary {"+" Dictionary}] - ["[0]" row]] + ["[0]" sequence]] ["[0]" format "_" ["[1]" binary]]] [target @@ -107,7 +107,7 @@ class.public (encoding/name.internal bytecode_name) (encoding/name.internal "java.lang.Object") (list) - (list (field.field ..value::modifier ..value::field ..value::type (row.row))) + (list (field.field ..value::modifier ..value::field ..value::type (sequence.sequence))) (list (method.method ..init::modifier "" ..init::type (list) {.#Some @@ -115,7 +115,7 @@ valueG (_.putstatic (type.class bytecode_name (list)) ..value::field ..value::type) _.return)})) - (row.row))] + (sequence.sequence))] (io.run! (do [! (try.with io.monad)] [bytecode (# ! each (format.result class.writer) (io.io bytecode)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux index cfe9bace9..0c07313f1 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux @@ -7,7 +7,7 @@ ["[0]" try]] [data [collection - ["[0]" row]] + ["[0]" sequence]] ["[0]" format "_" ["[1]" binary]]] [target @@ -149,4 +149,4 @@ (list) (list) (list main) - (row.row)))])) + (sequence.sequence)))])) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux index d8d042c67..096564fa7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -10,7 +10,7 @@ [binary {"+" Binary}] [collection ["[0]" list ("[1]#[0]" functor)] - ["[0]" row]] + ["[0]" sequence]] ["[0]" format "_" ["[1]" binary]] [text @@ -536,7 +536,7 @@ right_projection::method ..try::method)) - (row.row)))] + (sequence.sequence)))] (do ////.monad [_ (generation.execute! [class bytecode])] (generation.save! ..artifact_id {.#None} [class bytecode])))) @@ -584,7 +584,7 @@ (field.field (modifier#composite field.public field.final) //function/count.field //function/count.type - (row.row))) + (sequence.sequence))) bytecode (<| (format.result class.writer) try.trusted (class.class jvm/version.v6_0 @@ -593,7 +593,7 @@ (name.internal (..reflection ^Object)) (list) (list partial_count) (list& ::method apply::method+) - (row.row)))] + (sequence.sequence)))] (do ////.monad [_ (generation.execute! [class bytecode])] (generation.save! //function.artifact_id {.#None} [class bytecode])))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux index b1f3932b2..688b80024 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux @@ -16,7 +16,7 @@ ["[0]" utf8]]] [collection ["[0]" list ("[1]#[0]" functor)] - ["[0]" row]]] + ["[0]" sequence]]] ["[0]" macro [syntax {"+" syntax:}] ["[0]" code]] @@ -426,8 +426,8 @@ (in [(|> artifact.empty artifact.resource product.right) - (row.row [..module_id - {.#None} - (|> ..runtime - _.code - (# utf8.codec encoded))])]))) + (sequence.sequence [..module_id + {.#None} + (|> ..runtime + _.code + (# utf8.codec encoded))])]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux index 1b29003d1..2abc4ecec 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux @@ -16,7 +16,7 @@ ["[0]" utf8]]] [collection ["[0]" list ("[1]#[0]" functor)] - ["[0]" row]]] + ["[0]" sequence]]] ["[0]" macro [syntax {"+" syntax:}] ["[0]" code]] @@ -604,7 +604,7 @@ (in [(|> artifact.empty artifact.resource product.right) - (row.row [..module_id - (|> ..runtime - _.code - (# utf8.codec encoded))])]))) + (sequence.sequence [..module_id + (|> ..runtime + _.code + (# utf8.codec encoded))])]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux index 3615afcb5..47368be77 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux @@ -16,7 +16,7 @@ ["[0]" utf8]]] [collection ["[0]" list ("[1]#[0]" functor)] - ["[0]" row]]] + ["[0]" sequence]]] ["[0]" macro [syntax {"+" syntax:}] ["[0]" code]] @@ -453,8 +453,8 @@ (in [(|> artifact.empty artifact.resource product.right) - (row.row [..module_id - {.#None} - (|> ..runtime - _.code - (# utf8.codec encoded))])]))) + (sequence.sequence [..module_id + {.#None} + (|> ..runtime + _.code + (# utf8.codec encoded))])]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux index e3523fe0f..2c7eb997a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux @@ -16,7 +16,7 @@ ["[0]" utf8]]] [collection ["[0]" list ("[1]#[0]" functor)] - ["[0]" row]]] + ["[0]" sequence]]] ["[0]" macro [syntax {"+" syntax:}] ["[0]" code]] @@ -839,7 +839,7 @@ (in [(|> artifact.empty artifact.resource product.right) - (row.row [(%.nat ..module_id) - (|> ..runtime - _.code - (# utf8.codec encoded))])]))) + (sequence.sequence [(%.nat ..module_id) + (|> ..runtime + _.code + (# utf8.codec encoded))])]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux index e5657407e..adb512ee1 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux @@ -16,7 +16,7 @@ ["[0]" utf8]]] [collection ["[0]" list ("[1]#[0]" functor)] - ["[0]" row]]] + ["[0]" sequence]]] ["[0]" macro [syntax {"+" syntax:}] ["[0]" code]] @@ -397,8 +397,8 @@ (in [(|> artifact.empty artifact.resource product.right) - (row.row [..module_id - {.#None} - (|> ..runtime - _.code - (# utf8.codec encoded))])]))) + (sequence.sequence [..module_id + {.#None} + (|> ..runtime + _.code + (# utf8.codec encoded))])]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux index c9cad6f31..96ad55b4a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux @@ -16,7 +16,7 @@ ["[0]" utf8]]] [collection ["[0]" list ("[1]#[0]" functor)] - ["[0]" row]]] + ["[0]" sequence]]] ["[0]" macro [syntax {"+" syntax:}] ["[0]" code]] @@ -364,7 +364,7 @@ (in [(|> artifact.empty artifact.resource product.right) - (row.row [(%.nat ..module_id) - (|> ..runtime - _.code - (# utf8.codec encoded))])]))) + (sequence.sequence [(%.nat ..module_id) + (|> ..runtime + _.code + (# utf8.codec encoded))])]))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index dae79178d..3b8b0f728 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -22,7 +22,7 @@ ["[0]" list ("[1]#[0]" functor mix)] ["[0]" dictionary {"+" Dictionary}] ["[0]" set] - ["[0]" row {"+" Row}]]] + ["[0]" sequence {"+" Sequence}]]] [math [number ["n" nat ("[1]#[0]" equivalence)]]] @@ -38,7 +38,7 @@ [version {"+" Version}]]]) (type: .public Output - (Row [artifact.ID (Maybe Text) Binary])) + (Sequence [artifact.ID (Maybe Text) Binary])) (exception: .public (unknown_document [module Module known_modules (List Module)]) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux index 178b8fa4a..1398113a2 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux @@ -14,7 +14,7 @@ ["%" format {"+" format}]] [collection ["[0]" list] - ["[0]" row {"+" Row} ("[1]#[0]" functor mix)] + ["[0]" sequence {"+" Sequence} ("[1]#[0]" functor mix)] ["[0]" dictionary {"+" Dictionary}]] [format ["[0]" binary {"+" Writer}]]] @@ -41,21 +41,21 @@ (abstract: .public Registry (Record - [#artifacts (Row Artifact) + [#artifacts (Sequence Artifact) #resolver (Dictionary Text ID)]) (def: .public empty Registry - (:abstraction [#artifacts row.empty + (:abstraction [#artifacts sequence.empty #resolver (dictionary.empty text.hash)])) (def: .public artifacts - (-> Registry (Row Artifact)) + (-> Registry (Sequence Artifact)) (|>> :representation (value@ #artifacts))) (def: next (-> Registry ID) - (|>> ..artifacts row.size)) + (|>> ..artifacts sequence.size)) (def: .public (resource registry) (-> Registry [ID Registry]) @@ -63,8 +63,8 @@ [id (|> registry :representation - (revised@ #artifacts (row.suffix [#id id - #category {#Anonymous}])) + (revised@ #artifacts (sequence.suffix [#id id + #category {#Anonymous}])) :abstraction)])) (template [ ] @@ -74,8 +74,8 @@ [id (|> registry :representation - (revised@ #artifacts (row.suffix [#id id - #category { name}])) + (revised@ #artifacts (sequence.suffix [#id id + #category { name}])) (revised@ #resolver (dictionary.has name id)) :abstraction)])) @@ -84,7 +84,7 @@ (|> registry :representation (value@ #artifacts) - row.list + sequence.list (list.all (|>> (value@ #category) (case> { name} {.#Some name} _ {.#None})))))] @@ -118,11 +118,11 @@ [4 #Generator binary.text] [5 #Directive binary.text] [6 #Custom binary.text])))) - artifacts (: (Writer (Row Category)) - (binary.row/64 category))] + artifacts (: (Writer (Sequence Category)) + (binary.sequence/64 category))] (|>> :representation (value@ #artifacts) - (row#each (value@ #category)) + (sequence#each (value@ #category)) artifacts))) (exception: .public (invalid_category [tag Nat]) @@ -147,22 +147,22 @@ [6 #Custom .text]) _ (<>.failure (exception.error ..invalid_category [tag])))))] - (|> (.row/64 category) - (# <>.monad each (row#mix (function (_ artifact registry) - (product.right - (case artifact - {#Anonymous} - (..resource registry) - - (^template [ ] - [{ name} - ( name registry)]) - ([#Definition ..definition] - [#Analyser ..analyser] - [#Synthesizer ..synthesizer] - [#Generator ..generator] - [#Directive ..directive] - [#Custom ..custom]) - ))) - ..empty))))) + (|> (.sequence/64 category) + (# <>.monad each (sequence#mix (function (_ artifact registry) + (product.right + (case artifact + {#Anonymous} + (..resource registry) + + (^template [ ] + [{ name} + ( name registry)]) + ([#Definition ..definition] + [#Analyser ..analyser] + [#Synthesizer ..synthesizer] + [#Generator ..generator] + [#Directive ..directive] + [#Custom ..custom]) + ))) + ..empty))))) ) diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux index c2b649fd1..0ddf7ae0b 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -21,7 +21,7 @@ [collection ["[0]" list ("[1]#[0]" functor mix)] ["[0]" dictionary {"+" Dictionary}] - ["[0]" row {"+" Row}] + ["[0]" sequence {"+" Sequence}] ["[0]" set]]] [math [number @@ -212,15 +212,15 @@ (def: (loaded_document extension host module_id expected actual document) (All (_ expression directive) - (-> Text (generation.Host expression directive) archive.ID (Row Artifact) (Dictionary Text Binary) (Document .Module) + (-> Text (generation.Host expression directive) archive.ID (Sequence Artifact) (Dictionary Text Binary) (Document .Module) (Try [(Document .Module) Bundles Output]))) (do [! try.monad] [[definitions bundles] (: (Try [Definitions Bundles Output]) - (loop [input (row.list expected) + (loop [input (sequence.list expected) definitions (: Definitions (dictionary.empty text.hash)) bundles ..empty_bundles - output (: Output row.empty)] + output (: Output sequence.empty)] (let [[analysers synthesizers generators directives] bundles] (case input {.#Item [[artifact_id artifact_category] input']} @@ -231,7 +231,7 @@ (case artifact_category {artifact.#Anonymous} (do ! - [.let [output (row.suffix [artifact_id {.#None} data] output)] + [.let [output (sequence.suffix [artifact_id {.#None} data] output)] _ (# host re_learn context {.#None} directive)] (in [definitions [analysers @@ -241,7 +241,7 @@ output])) {artifact.#Definition name} - (let [output (row.suffix [artifact_id {.#None} data] output)] + (let [output (sequence.suffix [artifact_id {.#None} data] output)] (if (text#= $/program.name name) (in [definitions [analysers @@ -260,7 +260,7 @@ {artifact.#Analyser extension} (do ! - [.let [output (row.suffix [artifact_id {.#None} data] output)] + [.let [output (sequence.suffix [artifact_id {.#None} data] output)] value (# host re_load context {.#None} directive)] (in [definitions [(dictionary.has extension (:as analysis.Handler value) analysers) @@ -271,7 +271,7 @@ {artifact.#Synthesizer extension} (do ! - [.let [output (row.suffix [artifact_id {.#None} data] output)] + [.let [output (sequence.suffix [artifact_id {.#None} data] output)] value (# host re_load context {.#None} directive)] (in [definitions [analysers @@ -282,7 +282,7 @@ {artifact.#Generator extension} (do ! - [.let [output (row.suffix [artifact_id {.#None} data] output)] + [.let [output (sequence.suffix [artifact_id {.#None} data] output)] value (# host re_load context {.#None} directive)] (in [definitions [analysers @@ -293,7 +293,7 @@ {artifact.#Directive extension} (do ! - [.let [output (row.suffix [artifact_id {.#None} data] output)] + [.let [output (sequence.suffix [artifact_id {.#None} data] output)] value (# host re_load context {.#None} directive)] (in [definitions [analysers @@ -304,7 +304,7 @@ {artifact.#Custom name} (do ! - [.let [output (row.suffix [artifact_id {.#Some name} data] output)] + [.let [output (sequence.suffix [artifact_id {.#Some name} data] output)] _ (# host re_learn context {.#Some name} directive)] (in [definitions [analysers @@ -435,7 +435,7 @@ (list#each product.right) (monad.mix try.monad (function (_ [module [module_id [descriptor document]]] archive) - (archive.has module [descriptor document (: Output row.empty)] archive)) + (archive.has module [descriptor document (: Output sequence.empty)] archive)) archive) (# try.monad each (dependency.load_order $.key)) (# try.monad conjoint) diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager.lux b/stdlib/source/library/lux/tool/compiler/meta/packager.lux index 1b96d7b64..ba9ae0b92 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager.lux @@ -7,7 +7,7 @@ [binary {"+" Binary}] [collection [dictionary {"+" Dictionary}] - ["[0]" row] + ["[0]" sequence] ["[0]" list ("[1]#[0]" functor)]]] [world ["[0]" file]]]] @@ -37,6 +37,6 @@ (|> descriptor (value@ descriptor.#registry) artifact.artifacts - row.list + sequence.list (list#each (|>> (value@ artifact.#id))) [module_id])))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux index 24cdea54c..14d891bd0 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux @@ -12,7 +12,7 @@ ["[0]" text ["%" format {"+" format}]] [collection - ["[0]" row] + ["[0]" sequence] ["[0]" list ("[1]#[0]" functor)] ["[0]" dictionary] ["[0]" set {"+" Set}]]] @@ -158,7 +158,7 @@ (function (_ [artifact custom content] sink) (..write_class static module artifact custom content sink)) sink - (row.list output))) + (sequence.list output))) (def: (read_jar_entry_with_unknown_size input) (-> java/util/jar/JarInputStream [Nat Binary]) diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux index d9380b3d3..9e2ab96c1 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux @@ -13,7 +13,7 @@ ["%" format {"+" format}] ["[0]" encoding]] [collection - ["[0]" row] + ["[0]" sequence] ["[0]" list ("[1]#[0]" functor mix)] ["[0]" dictionary {"+" Dictionary}] ["[0]" set]] @@ -56,7 +56,7 @@ (def: bundle_module (-> Output (Try _.Expression)) - (|>> row.list + (|>> sequence.list (list#each product.right) (monad.mix try.monad (function (_ content so_far) @@ -128,5 +128,5 @@ (: (Dictionary Module archive.ID)))] entries (monad.each ! (..write_module now mapping) order)] (in (|> entries - row.of_list + sequence.of_list (binary.result tar.writer)))))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux index 2476f3c6c..d56673f33 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux @@ -14,7 +14,7 @@ [encoding ["[0]" utf8]]] [collection - ["[0]" row] + ["[0]" sequence] ["[0]" list ("[1]#[0]" functor)]]]]] [program [compositor @@ -38,7 +38,7 @@ (-> (-> directive directive directive) [archive.ID Output] directive (Try directive))) (|> output - row.list + sequence.list (list#each (|>> product.right product.right)) (monad.mix try.monad (function (_ content so_far) diff --git a/stdlib/source/library/lux/type/resource.lux b/stdlib/source/library/lux/type/resource.lux index 9105a18f1..3ed7cc629 100644 --- a/stdlib/source/library/lux/type/resource.lux +++ b/stdlib/source/library/lux/type/resource.lux @@ -15,7 +15,7 @@ ["%" format {"+" format}]] [collection ["[0]" set] - ["[0]" row {"+" Row}] + ["[0]" sequence {"+" Sequence}] ["[0]" list ("[1]#[0]" functor mix)]]] ["[0]" macro [syntax {"+" syntax:}]] @@ -140,11 +140,11 @@ (function (_ from to) (do maybe.monad [input (list.item from g!inputs)] - (in (row.suffix input to)))) - (: (Row Code) row.empty) + (in (sequence.suffix input to)))) + (: (Sequence Code) sequence.empty) swaps) maybe.trusted - row.list) + sequence.list) g!inputsT+ (list#each (|>> (~) (..Key ..Commutative) (`)) g!inputs) g!outputsT+ (list#each (|>> (~) (..Key ..Commutative) (`)) g!outputs)]] (in (list (` (: (All ((~ g!_) (~ g!!) (~+ g!inputs) (~ g!context)) -- cgit v1.2.3