diff options
Diffstat (limited to 'stdlib')
26 files changed, 1037 insertions, 508 deletions
diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux index c015edb06..86558bbb1 100644 --- a/stdlib/source/library/lux/data/collection/sequence.lux +++ b/stdlib/source/library/lux/data/collection/sequence.lux @@ -3,7 +3,7 @@ ... https://hypirion.com/musings/understanding-persistent-vector-pt-3 (.require [library - [lux (.except list has revised only) + [lux (.except list has revised only all) [abstract [functor (.only Functor)] [apply (.only Apply)] @@ -63,7 +63,8 @@ (with_template [<name> <op>] [(def <name> - (-> Level Level) + (-> Level + Level) (<op> branching_exponent))] [level_up n.+] @@ -79,15 +80,19 @@ (-- full_node_size)) (def branch_idx - (-> Index Index) + (-> Index + Index) (i64.and branch_idx_mask)) (def (empty_hierarchy _) - (All (_ a) (-> Any (Hierarchy a))) + (All (_ of) + (-> Any + (Hierarchy of))) (array.empty ..full_node_size)) (def (tail_off sequence_size) - (-> Nat Nat) + (-> Nat + Nat) (if (n.< full_node_size sequence_size) 0 (|> (-- sequence_size) @@ -95,7 +100,9 @@ (i64.left_shifted branching_exponent)))) (def (path level tail) - (All (_ a) (-> Level (Base a) (Node a))) + (All (_ of) + (-> Level (Base of) + (Node of))) (if (n.= 0 level) {#Base tail} (|> (empty_hierarchy []) @@ -103,12 +110,16 @@ {#Hierarchy}))) (def (tail singleton) - (All (_ a) (-> a (Base a))) + (All (_ of) + (-> of + (Base of))) (|> (array.empty 1) (array.has! 0 singleton))) (def (with_tail size level tail parent) - (All (_ a) (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a))) + (All (_ of) + (-> Nat Level (Base of) (Hierarchy of) + (Hierarchy of))) (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) @@ -129,14 +140,18 @@ (array.has! sub_idx sub_node)))) (def (expanded_tail val tail) - (All (_ a) (-> a (Base a) (Base a))) + (All (_ of) + (-> of (Base of) + (Base of))) (let [tail_size (array.size tail)] (|> (array.empty (++ tail_size)) (array.copy! tail_size 0 tail 0) (array.has! tail_size val)))) (def (hierarchy#has level idx val hierarchy) - (All (_ a) (-> Level Index a (Hierarchy a) (Hierarchy a))) + (All (_ of) + (-> Level Index of (Hierarchy of) + (Hierarchy of))) (let [sub_idx (branch_idx (i64.right_shifted level idx))] (when (array.item sub_idx hierarchy) {#Hierarchy sub_node} @@ -154,7 +169,9 @@ (undefined)))) (def (without_tail size level hierarchy) - (All (_ a) (-> Nat Level (Hierarchy a) (Maybe (Hierarchy a)))) + (All (_ of) + (-> Nat Level (Hierarchy of) + (Maybe (Hierarchy of)))) (let [sub_idx (branch_idx (i64.right_shifted level (n.- 2 size)))] (cond (n.= 0 sub_idx) {.#None} @@ -179,7 +196,9 @@ ))) (def (node#list node) - (All (_ a) (-> (Node a) (List a))) + (All (_ of) + (-> (Node of) + (List of))) (when node {#Base base} (array.list {.#None} base) @@ -192,12 +211,12 @@ (list#composite (node#list sub) acc)) {.#End})))) -(type .public (Sequence a) +(type .public (Sequence of) (Record [#level Level #size Nat - #root (Hierarchy a) - #tail (Base a)])) + #root (Hierarchy of) + #tail (Base of)])) (def .public empty Sequence @@ -207,11 +226,15 @@ #tail (array.empty 0)]) (def .public (size sequence) - (All (_ a) (-> (Sequence a) Nat)) + (All (_ of) + (-> (Sequence of) + Nat)) (the #size sequence)) (def .public (suffix val sequence) - (All (_ a) (-> a (Sequence a) (Sequence a))) + (All (_ of) + (-> of (Sequence of) + (Sequence of))) ... Check if there is room in the tail. (let [sequence_size (the #size sequence)] (if (|> sequence_size (n.- (tail_off sequence_size)) (n.< full_node_size)) @@ -244,7 +267,8 @@ (exception.def incorrect_sequence_structure) (exception.def .public (index_out_of_bounds [sequence index]) - (All (_ a) (Exception [(Sequence a) Nat])) + (All (_ of) + (Exception [(Sequence of) Nat])) (exception.report (.list ["Size" (at n.decimal encoded (the #size sequence))] ["Index" (at n.decimal encoded index)]))) @@ -252,11 +276,15 @@ (exception.def base_was_not_found) (def .public (within_bounds? sequence idx) - (All (_ a) (-> (Sequence a) Nat Bit)) + (All (_ of) + (-> (Sequence of) Nat + Bit)) (n.< (the #size sequence) idx)) (def (base_for idx sequence) - (All (_ a) (-> Index (Sequence a) (Try (Base a)))) + (All (_ of) + (-> Index (Sequence of) + (Try (Base of)))) (if (within_bounds? sequence idx) (if (n.< (tail_off (the #size sequence)) idx) (loop (again [level (the #level sequence) @@ -278,7 +306,9 @@ (exception.except ..index_out_of_bounds [sequence idx]))) (def .public (item idx sequence) - (All (_ a) (-> Nat (Sequence a) (Try a))) + (All (_ of) + (-> Nat (Sequence of) + (Try of))) (do try.monad [base (base_for idx sequence) .let [index (branch_idx idx)]] @@ -287,7 +317,9 @@ {try.#Success (array.item index base)}))) (def .public (has idx val sequence) - (All (_ a) (-> Nat a (Sequence a) (Try (Sequence a)))) + (All (_ of) + (-> Nat of (Sequence of) + (Try (Sequence of)))) (let [sequence_size (the #size sequence)] (if (within_bounds? sequence idx) {try.#Success (if (n.< (tail_off sequence_size) idx) @@ -300,13 +332,17 @@ (exception.except ..index_out_of_bounds [sequence idx])))) (def .public (revised idx revision it) - (All (_ a) (-> Nat (-> a a) (Sequence a) (Try (Sequence a)))) + (All (_ of) + (-> Nat (-> of of) (Sequence of) + (Try (Sequence of)))) (do try.monad [val (..item idx it)] (..has idx (revision val) it))) (def .public (prefix sequence) - (All (_ a) (-> (Sequence a) (Sequence a))) + (All (_ of) + (-> (Sequence of) + (Sequence of))) (when (the #size sequence) 0 empty @@ -351,20 +387,28 @@ )) (def .public (list sequence) - (All (_ a) (-> (Sequence a) (List a))) + (All (_ of) + (-> (Sequence of) + (List of))) (list#composite (node#list {#Hierarchy (the #root sequence)}) (node#list {#Base (the #tail sequence)}))) (def .public of_list - (All (_ a) (-> (List a) (Sequence a))) + (All (_ of) + (-> (List of) + (Sequence of))) (list#mix ..suffix ..empty)) (def .public (member? equivalence sequence val) - (All (_ a) (-> (Equivalence a) (Sequence a) a Bit)) + (All (_ of) + (-> (Equivalence of) (Sequence of) of + Bit)) (list.member? equivalence (list sequence) val)) (def .public empty? - (All (_ a) (-> (Sequence a) Bit)) + (All (_ of) + (-> (Sequence of) + Bit)) (|>> (the #size) (n.= 0))) (def .public sequence @@ -372,7 +416,9 @@ (in (.list (` (..of_list (.list (,* elems)))))))) (def (node_equivalence //#=) - (All (_ a) (-> (Equivalence a) (Equivalence (Node a)))) + (All (_ of) + (-> (Equivalence of) + (Equivalence (Node of)))) (implementation (def (= v1 v2) (when [v1 v2] @@ -386,7 +432,9 @@ false)))) (def .public (equivalence //#=) - (All (_ a) (-> (Equivalence a) (Equivalence (Sequence a)))) + (All (_ of) + (-> (Equivalence of) + (Equivalence (Sequence of)))) (implementation (def (= v1 v2) (and (n.= (the #size v1) (the #size v2)) @@ -423,7 +471,8 @@ {#Base (the #tail xs)}))))) (def .public monoid - (All (_ a) (Monoid (Sequence a))) + (All (_ of) + (Monoid (Sequence of))) (implementation (def identity ..empty) @@ -479,15 +528,18 @@ (mix (function (_ post pre) (composite pre post)) identity))))) (def .public reversed - (All (_ a) (-> (Sequence a) (Sequence a))) + (All (_ of) + (-> (Sequence of) + (Sequence of))) (|>> ..list list.reversed (list#mix suffix ..empty))) (with_template [<name> <array> <init> <op>] [(def .public <name> - (All (_ a) - (-> (Predicate a) (Sequence a) Bit)) + (All (_ of) + (-> (Predicate of) (Sequence of) + Bit)) (let [help (is (All (_ a) (-> (Predicate a) (Node a) Bit)) (function (help predicate node) @@ -507,7 +559,9 @@ ) (def .public (only when items) - (All (_ a) (-> (-> a Bit) (Sequence a) (Sequence a))) + (All (_ of) + (-> (-> of Bit) (Sequence of) + (Sequence of))) (..mix (function (_ item output) (if (when item) (..suffix item output) @@ -516,8 +570,9 @@ items)) (def (one|node check items) - (All (_ a b) - (-> (-> a (Maybe b)) (Node a) (Maybe b))) + (All (_ input output) + (-> (-> input (Maybe output)) (Node input) + (Maybe output))) (when items {#Base items} (array.one check items) @@ -526,8 +581,9 @@ (array.one (one|node check) items))) (def .public (one check items) - (All (_ a b) - (-> (-> a (Maybe b)) (Sequence a) (Maybe b))) + (All (_ input output) + (-> (-> input (Maybe output)) (Sequence input) + (Maybe output))) (when (let [... TODO: This binding was established to get around a compilation error. Fix and inline! check (..one|node check)] (|> items @@ -540,3 +596,17 @@ output output)) + +(def .public (all ? it) + (All (_ input output) + (-> (-> input (Maybe output)) (Sequence input) + (Sequence output))) + (..mix (function (_ in out) + (when (? in) + {.#Some in} + (suffix in out) + + {.#None} + out)) + (sequence) + it)) diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux index c98ef6ee5..6e5293f67 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -16,7 +16,7 @@ ["[1]!" \\unsafe] ["![1]" \\format (.only Format) (.use "[1]#[0]" monoid)] ["?[1]" \\parser (.only Parser)]] - ["[0]" text (.only) + ["[0]" text (.use "[1]#[0]" equivalence) [char (.only Char)] ["%" \\format] [encoding @@ -504,8 +504,6 @@ (def maximum_mode Mode (all and - ..none - ..execute_by_other ..write_by_other ..read_by_other @@ -610,6 +608,33 @@ (type .public Tar (Sequence Entry)) +(exception.def .public (unknown_file path) + (Exception Path) + (exception.report + (list ["Path" (%.text (from_path path))]))) + +(def .public (file expected it) + (-> Path Tar + (Try Binary)) + (when (sequence.one (function (_ it) + (when it + (^.or {#Normal it} + {#Contiguous it}) + (let [[actual _ _ _ content] it] + (if (text#= (from_path expected) + (from_path actual)) + {.#Some (data content)} + {.#None})) + + _ + {.#None})) + it) + {.#Some it} + {try.#Success it} + + {.#None} + (exception.except ..unknown_file [expected]))) + (def (blocks size) (-> Big Nat) (n.+ (n./ ..block_size diff --git a/stdlib/source/library/lux/math/arithmetic.lux b/stdlib/source/library/lux/math/arithmetic.lux new file mode 100644 index 000000000..46488890a --- /dev/null +++ b/stdlib/source/library/lux/math/arithmetic.lux @@ -0,0 +1,22 @@ +(.require + [library + [lux (.except)]]) + +... https://en.wikipedia.org/wiki/Arithmetic +(type .public (Arithmetic of) + (Interface + (is (-> of of + of) + +) + (is (-> of of + of) + -) + (is (-> of of + of) + *) + (is (-> of of + of) + /) + (is (-> of of + of) + %))) diff --git a/stdlib/source/library/lux/math/number/complex.lux b/stdlib/source/library/lux/math/number/complex.lux index c862a952e..518da2518 100644 --- a/stdlib/source/library/lux/math/number/complex.lux +++ b/stdlib/source/library/lux/math/number/complex.lux @@ -17,7 +17,9 @@ ["[0]" code ["<[1]>" \\parser]] [macro - [syntax (.only syntax)]]]]]) + [syntax (.only syntax)]]]]] + [/// + [arithmetic (.only Arithmetic)]]) (type .public Complex (Record @@ -47,12 +49,14 @@ (..complex +0.0 +0.0)) (def .public (not_a_number? complex) - (-> Complex Bit) + (-> Complex + Bit) (or (f.not_a_number? (the #real complex)) (f.not_a_number? (the #imaginary complex)))) (def .public (= param input) - (-> Complex Complex Bit) + (-> Complex Complex + Bit) (and (f.= (the #real param) (the #real input)) (f.= (the #imaginary param) @@ -60,7 +64,8 @@ (with_template [<name> <op>] [(def .public (<name> param input) - (-> Complex Complex Complex) + (-> Complex Complex + Complex) [#real (<op> (the #real param) (the #real input)) #imaginary (<op> (the #imaginary param) @@ -77,7 +82,8 @@ (with_template [<name> <transform>] [(def .public <name> - (-> Complex Complex) + (-> Complex + Complex) (|>> (revised #real <transform>) (revised #imaginary <transform>)))] @@ -86,18 +92,21 @@ ) (def .public conjugate - (-> Complex Complex) + (-> Complex + Complex) (revised #imaginary f.opposite)) (def .public (*' param input) - (-> Frac Complex Complex) + (-> Frac Complex + Complex) [#real (f.* param (the #real input)) #imaginary (f.* param (the #imaginary input))]) (def .public (* param input) - (-> Complex Complex Complex) + (-> Complex Complex + Complex) [#real (f.- (f.* (the #imaginary param) (the #imaginary input)) (f.* (the #real param) @@ -108,7 +117,8 @@ (the #real input)))]) (def .public (/ param input) - (-> Complex Complex Complex) + (-> Complex Complex + Complex) (let [(open "[0]") param] (if (f.< (f.abs #imaginary) (f.abs #real)) @@ -122,13 +132,15 @@ ..#imaginary (|> (the ..#imaginary input) (f.- (f.* quot (the ..#real input))) (f./ denom))])))) (def .public (/' param subject) - (-> Frac Complex Complex) + (-> Frac Complex + Complex) (let [(open "[0]") subject] [..#real (f./ param #real) ..#imaginary (f./ param #imaginary)])) (def .public (% param input) - (-> Complex Complex Complex) + (-> Complex Complex + Complex) (let [scaled (/ param input) quotient (|> scaled (revised #real f.floor) @@ -136,8 +148,18 @@ (- (* quotient param) input))) +(def .public arithmetic + (Arithmetic Complex) + (implementation + (def + ..+) + (def - ..-) + (def * ..*) + (def / ../) + (def % ..%))) + (def .public (cos subject) - (-> Complex Complex) + (-> Complex + Complex) (let [(open "[0]") subject] [..#real (f.* (f.cosh #imaginary) (f.cos #real)) @@ -145,7 +167,8 @@ (f.sin #real)))])) (def .public (cosh subject) - (-> Complex Complex) + (-> Complex + Complex) (let [(open "[0]") subject] [..#real (f.* (f.cos #imaginary) (f.cosh #real)) @@ -153,7 +176,8 @@ (f.sinh #real))])) (def .public (sin subject) - (-> Complex Complex) + (-> Complex + Complex) (let [(open "[0]") subject] [..#real (f.* (f.cosh #imaginary) (f.sin #real)) @@ -161,7 +185,8 @@ (f.cos #real))])) (def .public (sinh subject) - (-> Complex Complex) + (-> Complex + Complex) (let [(open "[0]") subject] [..#real (f.* (f.cos #imaginary) (f.sinh #real)) @@ -169,7 +194,8 @@ (f.cosh #real))])) (def .public (tan subject) - (-> Complex Complex) + (-> Complex + Complex) (let [(open "[0]") subject r2 (f.* +2.0 #real) i2 (f.* +2.0 #imaginary) @@ -178,7 +204,8 @@ ..#imaginary (f./ d (f.sinh i2))])) (def .public (tanh subject) - (-> Complex Complex) + (-> Complex + Complex) (let [(open "[0]") subject r2 (f.* +2.0 #real) i2 (f.* +2.0 #imaginary) @@ -187,7 +214,8 @@ ..#imaginary (f./ d (f.sin i2))])) (def .public (abs subject) - (-> Complex Frac) + (-> Complex + Frac) (let [(open "[0]") subject] (if (f.< (f.abs #imaginary) (f.abs #real)) @@ -203,21 +231,24 @@ (f.abs #real))))))) (def .public (exp subject) - (-> Complex Complex) + (-> Complex + Complex) (let [(open "[0]") subject r_exp (f.exp #real)] [..#real (f.* r_exp (f.cos #imaginary)) ..#imaginary (f.* r_exp (f.sin #imaginary))])) (def .public (log subject) - (-> Complex Complex) + (-> Complex + Complex) (let [(open "[0]") subject] [..#real (|> subject ..abs f.log) ..#imaginary (f.atan_2 #real #imaginary)])) (with_template [<name> <type> <op>] [(def .public (<name> param input) - (-> <type> Complex Complex) + (-> <type> Complex + Complex) (|> input log (<op> param) exp))] [pow Complex ..*] @@ -225,11 +256,13 @@ ) (def (with_sign sign magnitude) - (-> Frac Frac Frac) + (-> Frac Frac + Frac) (f.* (f.signum sign) magnitude)) (def .public (root_2 input) - (-> Complex Complex) + (-> Complex + Complex) (let [(open "[0]") input t (|> input ..abs (f.+ (f.abs #real)) (f./ +2.0) (f.pow +0.5))] (if (f.< +0.0 #real) @@ -241,11 +274,13 @@ #imaginary)]))) (def (root_2-1z input) - (-> Complex Complex) + (-> Complex + Complex) (|> (complex +1.0) (- (* input input)) ..root_2)) (def .public (reciprocal (open "[0]")) - (-> Complex Complex) + (-> Complex + Complex) (if (f.< (f.abs #imaginary) (f.abs #real)) (let [q (f./ #imaginary #real) @@ -260,14 +295,16 @@ ..#imaginary (|> scale f.opposite (f.* q))]))) (def .public (acos input) - (-> Complex Complex) + (-> Complex + Complex) (|> input (..+ (|> input ..root_2-1z (..* ..i))) ..log (..* (..opposite ..i)))) (def .public (asin input) - (-> Complex Complex) + (-> Complex + Complex) (|> input ..root_2-1z (..+ (..* ..i input)) @@ -275,7 +312,8 @@ (..* (..opposite ..i)))) (def .public (atan input) - (-> Complex Complex) + (-> Complex + Complex) (|> input (..+ ..i) (../ (..- input ..i)) @@ -283,11 +321,13 @@ (..* (../ (..complex +2.0) ..i)))) (def .public (argument (open "[0]")) - (-> Complex Frac) + (-> Complex + Frac) (f.atan_2 #real #imaginary)) (def .public (roots nth input) - (-> Nat Complex (List Complex)) + (-> Nat Complex + (List Complex)) (when nth 0 (list) _ (let [r_nth (|> nth .int int.frac) @@ -307,7 +347,8 @@ ..#imaginary imaginary]))))))) (def .public (approximately? margin_of_error standard value) - (-> Frac Complex Complex Bit) + (-> Frac Complex Complex + Bit) (and (f.approximately? margin_of_error (the ..#real standard) (the ..#real value)) diff --git a/stdlib/source/library/lux/math/number/frac.lux b/stdlib/source/library/lux/math/number/frac.lux index afa38b160..481b37e96 100644 --- a/stdlib/source/library/lux/math/number/frac.lux +++ b/stdlib/source/library/lux/math/number/frac.lux @@ -21,7 +21,9 @@ ["[1][0]" i64] ["[1][0]" nat] ["[1][0]" int] - ["[1][0]" rev]]) + ["[1][0]" rev] + [// + [arithmetic (.only Arithmetic)]]]) (with_template [<name> <value>] [(def .public <name> @@ -37,7 +39,8 @@ (for @.old (these (with_template [<name> <method>] [(def .public (<name> it) - (-> Frac Frac) + (-> Frac + Frac) (<method> it))] [cos "jvm invokestatic:java.lang.Math:cos:double"] @@ -57,8 +60,10 @@ [root_2 "jvm invokestatic:java.lang.Math:sqrt:double"] [root_3 "jvm invokestatic:java.lang.Math:cbrt:double"] ) + (def .public (pow param subject) - (-> Frac Frac Frac) + (-> Frac Frac + Frac) ("jvm invokestatic:java.lang.Math:pow:double,double" subject param))) @.jvm @@ -77,7 +82,8 @@ (with_template [<name> <method>] [(def .public <name> - (-> Frac Frac) + (-> Frac + Frac) (|>> !double ["D"] (.jvm_member_invoke_static# [] "java.lang.Math" <method> []) @@ -102,7 +108,8 @@ ) (def .public (pow param subject) - (-> Frac Frac Frac) + (-> Frac Frac + Frac) (|> (.jvm_member_invoke_static# [] "java.lang.Math" "pow" [] ["D" (!double subject)] ["D" (!double param)]) !frac))) @@ -110,7 +117,8 @@ @.js (these (with_template [<name> <method>] [(def .public <name> - (-> Frac Frac) + (-> Frac + Frac) (|>> [] ("js apply" ("js constant" <method>)) (as Frac)))] @@ -134,13 +142,15 @@ ) (def .public (pow param subject) - (-> Frac Frac Frac) + (-> Frac Frac + Frac) (as Frac ("js apply" ("js constant" "Math.pow") [subject param])))) @.python (these (with_template [<name> <method>] [(def .public <name> - (-> Frac Frac) + (-> Frac + Frac) (|>> [] (.python_object_do# <method> (.python_import# "math")) (as Frac)))] @@ -163,11 +173,13 @@ ) (def .public (pow param subject) - (-> Frac Frac Frac) + (-> Frac Frac + Frac) (as Frac (.python_object_do# "pow" (.python_import# "math") [subject param]))) (def .public (root_3 it) - (-> Frac Frac) + (-> Frac + Frac) (if (.f64_<# +0.0 it) (|> it (.f64_*# -1.0) @@ -179,7 +191,8 @@ @.lua (these (with_template [<name> <method>] [(def .public <name> - (-> Frac Frac) + (-> Frac + Frac) (|>> [] ("lua apply" ("lua constant" <method>)) (as Frac)))] @@ -202,11 +215,13 @@ ) (def .public (pow param subject) - (-> Frac Frac Frac) + (-> Frac Frac + Frac) ("lua power" param subject)) (def .public (root_3 it) - (-> Frac Frac) + (-> Frac + Frac) (if (.f64_<# +0.0 it) (|> it (.f64_*# -1.0) @@ -218,7 +233,8 @@ @.ruby (these (with_template [<name> <method>] [(def .public <name> - (-> Frac Frac) + (-> Frac + Frac) (|>> [] ("ruby apply" ("ruby constant" <method>)) (as Frac)))] @@ -240,7 +256,8 @@ (with_template [<name> <method>] [(def .public (<name> it) - (-> Frac Frac) + (-> Frac + Frac) (|> ("ruby object do" <method> it []) (as Int) (.int_f64#)))] @@ -250,13 +267,15 @@ ) (def .public (pow param subject) - (-> Frac Frac Frac) + (-> Frac Frac + Frac) (as Frac ("ruby object do" "**" subject [param])))) @.php (these (with_template [<name> <method>] [(def .public <name> - (-> Frac Frac) + (-> Frac + Frac) (|>> ("php apply" ("php constant" <method>)) (as Frac)))] @@ -278,17 +297,20 @@ ) (def .public (pow param subject) - (-> Frac Frac Frac) + (-> Frac Frac + Frac) (as Frac ("php apply" ("php constant" "pow") subject param))) (def .public root_3 - (-> Frac Frac) + (-> Frac + Frac) (..pow (.f64_/# +3.0 +1.0)))) @.scheme (these (with_template [<name> <method>] [(def .public <name> - (-> Frac Frac) + (-> Frac + Frac) (|>> ("scheme apply" ("scheme constant" <method>)) (as Frac)))] @@ -310,16 +332,19 @@ ) (def .public (pow param subject) - (-> Frac Frac Frac) + (-> Frac Frac + Frac) (as Frac ("scheme apply" ("scheme constant" "expt") subject param))) (def .public root_3 - (-> Frac Frac) + (-> Frac + Frac) (..pow (.f64_/# +3.0 +1.0)))) ) (def .public (round it) - (-> Frac Frac) + (-> Frac + Frac) (let [floored (floor it) diff (.f64_-# floored it)] (cond (.f64_<# diff +0.5) @@ -332,7 +357,8 @@ floored))) (def .public (atan_2 x y) - (-> Frac Frac Frac) + (-> Frac Frac + Frac) (cond (.f64_<# x +0.0) (..atan (.f64_/# x y)) @@ -353,12 +379,14 @@ (.f64_/# +0.0 +0.0)))) (def .public (log_by base it) - (-> Frac Frac Frac) + (-> Frac Frac + Frac) (.f64_/# (..log base) (..log it))) (def .public (factorial it) - (-> Nat Nat) + (-> Nat + Nat) (loop (again [acc 1 it it]) (if (//nat.> 1 it) @@ -366,7 +394,8 @@ acc))) (def .public (hypotenuse catA catB) - (-> Frac Frac Frac) + (-> Frac Frac + Frac) (..pow +0.5 (.f64_+# (..pow +2.0 catA) (..pow +2.0 catB)))) @@ -374,11 +403,13 @@ ... https://en.wikipedia.org/wiki/Hyperbolic_function#Definitions (with_template [<name> <comp> <inverse>] [(def .public (<name> it) - (-> Frac Frac) + (-> Frac + Frac) (|> (..exp it) (<comp> (..exp (.f64_*# -1.0 it))) (.f64_/# +2.0))) (def .public (<inverse> it) - (-> Frac Frac) + (-> Frac + Frac) (|> +2.0 (.f64_/# (|> (..exp it) (<comp> (..exp (.f64_*# -1.0 it)))))))] [sinh .f64_-# csch] @@ -387,7 +418,8 @@ (with_template [<name> <top> <bottom>] [(def .public (<name> it) - (-> Frac Frac) + (-> Frac + Frac) (let [e+ (exp it) e- (exp (.f64_*# -1.0 it)) sinh' (|> e+ (.f64_-# e-)) @@ -401,7 +433,8 @@ ... https://en.wikipedia.org/wiki/Inverse_hyperbolic_functions#Definitions_in_terms_of_logarithms (with_template [<name> <comp>] [(def .public (<name> it) - (-> Frac Frac) + (-> Frac + Frac) (|> it (pow +2.0) (<comp> +1.0) (pow +0.5) (.f64_+# it) log))] [asinh .f64_+#] @@ -410,7 +443,8 @@ (with_template [<name> <base> <diff>] [(def .public (<name> it) - (-> Frac Frac) + (-> Frac + Frac) (let [it+ (|> <base> (.f64_+# <diff>)) it- (|> <base> (.f64_-# <diff>))] (|> it+ (.f64_/# it-) log (.f64_/# +2.0))))] @@ -421,7 +455,8 @@ (with_template [<name> <op>] [(def .public (<name> it) - (-> Frac Frac) + (-> Frac + Frac) (let [it^2 (|> it (pow +2.0))] (|> +1.0 (<op> it^2) (pow +0.5) (.f64_+# +1.0) (.f64_/# it) log)))] @@ -431,7 +466,8 @@ (with_template [<name> <op>] [(def .public (<name> param subject) - (-> Frac Frac Bit) + (-> Frac Frac + Bit) (<op> param subject))] [= .f64_=#] @@ -439,16 +475,19 @@ ) (def .public (<= reference sample) - (-> Frac Frac Bit) + (-> Frac Frac + Bit) (or (.f64_<# reference sample) (.f64_=# reference sample))) (def .public (> reference sample) - (-> Frac Frac Bit) + (-> Frac Frac + Bit) (.f64_<# sample reference)) (def .public (>= reference sample) - (-> Frac Frac Bit) + (-> Frac Frac + Bit) (or (.f64_<# sample reference) (.f64_=# sample reference))) @@ -464,7 +503,8 @@ (with_template [<name> <op>] [(def .public (<name> param subject) - (-> Frac Frac Frac) + (-> Frac Frac + Frac) (<op> param subject))] [+ .f64_+#] @@ -474,23 +514,36 @@ [% .f64_%#] ) +(def .public arithmetic + (Arithmetic Frac) + (implementation + (def + ..+) + (def - ..-) + (def * ..*) + (def / ../) + (def % ..%))) + (def .public (/% param subject) - (-> Frac Frac [Frac Frac]) + (-> Frac Frac + [Frac Frac]) [(../ param subject) (..% param subject)]) (def .public opposite - (-> Frac Frac) + (-> Frac + Frac) (..* -1.0)) (def .public (abs it) - (-> Frac Frac) + (-> Frac + Frac) (if (..< +0.0 it) (..* -1.0 it) it)) (def .public (signum it) - (-> Frac Frac) + (-> Frac + Frac) (cond (..= +0.0 it) +0.0 (..< +0.0 it) -1.0 ... else @@ -501,7 +554,8 @@ (with_template [<name> <test>] [(def .public (<name> left right) - (-> Frac Frac Frac) + (-> Frac Frac + Frac) (if (<test> right left) left right))] @@ -511,11 +565,13 @@ ) (def .public nat - (-> Frac Nat) + (-> Frac + Nat) (|>> .f64_int# .nat)) (def .public int - (-> Frac Int) + (-> Frac + Int) (|>> .f64_int#)) (def mantissa_size Nat 52) @@ -527,7 +583,8 @@ .int_f64#)) (def .public rev - (-> Frac Rev) + (-> Frac + Rev) (|>> ..abs (..% +1.0) (..* ..frac_denominator) @@ -548,11 +605,13 @@ (..* -1.0 ..positive_infinity)) (def .public (not_a_number? it) - (-> Frac Bit) + (-> Frac + Bit) (not (..= it it))) (def .public (number? it) - (-> Frac Bit) + (-> Frac + Bit) (not (or (..not_a_number? it) (..= ..positive_infinity it) (..= ..negative_infinity it)))) @@ -619,7 +678,8 @@ {try.#Failure "Could not decode Frac"})))) (def log/2 - (-> Frac Frac) + (-> Frac + Frac) (|>> ..log (../ (..log +2.0)))) @@ -649,7 +709,8 @@ (..log/2 ..smallest)) (def .public (bits it) - (-> Frac I64) + (-> Frac + I64) (.i64 (cond (..not_a_number? it) ..not_a_number_bits @@ -702,7 +763,8 @@ (with_template [<getter> <size> <offset>] [(def <getter> - (-> (I64 Any) I64) + (-> (I64 Any) + I64) (let [mask (|> 1 (//i64.left_shifted <size>) -- (//i64.left_shifted <offset>))] (|>> (//i64.and mask) (//i64.right_shifted <offset>) .i64)))] @@ -712,7 +774,8 @@ ) (def .public (of_bits it) - (-> I64 Frac) + (-> I64 + Frac) (when [(is Nat (..exponent it)) (is Nat (..mantissa it)) (is Nat (..sign it))] @@ -751,7 +814,8 @@ (..* sign))))) (`` (def (representation_exponent codec representation) - (-> (Codec Text Nat) Text (Try [Text Int])) + (-> (Codec Text Nat) Text + (Try [Text Int])) (when [(.text_index# 0 "e+" representation) (.text_index# 0 "E+" representation) (.text_index# 0 "e-" representation) @@ -836,14 +900,15 @@ (def hash ..bits))) (def .public (approximately? margin_of_error standard value) - (-> Frac Frac Frac Bit) + (-> Frac Frac Frac + Bit) (|> value (..- standard) ..abs (..< margin_of_error))) (def .public (mod divisor dividend) - (All (_ m) (-> Frac Frac Frac)) + (-> Frac Frac Frac) (let [remainder (..% divisor dividend)] (if (or (and (..< +0.0 divisor) (..> +0.0 remainder)) diff --git a/stdlib/source/library/lux/math/number/int.lux b/stdlib/source/library/lux/math/number/int.lux index 4de53bfe9..bd1c852b0 100644 --- a/stdlib/source/library/lux/math/number/int.lux +++ b/stdlib/source/library/lux/math/number/int.lux @@ -16,11 +16,14 @@ [predicate (.only Predicate)]]]]] ["[0]" // ["[1][0]" nat] - ["[1][0]" i64]]) + ["[1][0]" i64] + [// + [arithmetic (.only Arithmetic)]]]) (with_template [<name> <op>] [(def .public (<name> param subject) - (-> Int Int Bit) + (-> Int Int + Bit) (<op> param subject))] [= .i64_=#] @@ -28,17 +31,20 @@ ) (def .public (<= reference sample) - (-> Int Int Bit) + (-> Int Int + Bit) (if (.int_<# reference sample) true (.i64_=# reference sample))) (def .public (> reference sample) - (-> Int Int Bit) + (-> Int Int + Bit) (.int_<# sample reference)) (def .public (>= reference sample) - (-> Int Int Bit) + (-> Int Int + Bit) (if (.int_<# sample reference) true (.i64_=# reference sample))) @@ -55,7 +61,8 @@ (with_template [<name> <test>] [(def .public (<name> left right) - (-> Int Int Int) + (-> Int Int + Int) (if (<test> right left) left right))] @@ -66,7 +73,8 @@ (with_template [<name> <op>] [(def .public (<name> param subject) - (-> Int Int Int) + (-> Int Int + Int) (<op> param subject))] [+ .i64_+#] @@ -76,23 +84,36 @@ [% .int_%#] ) +(def .public arithmetic + (Arithmetic Int) + (implementation + (def + ..+) + (def - ..-) + (def * ..*) + (def / ../) + (def % ..%))) + (def .public (/% param subject) - (-> Int Int [Int Int]) + (-> Int Int + [Int Int]) [(../ param subject) (..% param subject)]) (def .public (opposite it) - (-> Int Int) + (-> Int + Int) (..- it +0)) (def .public (abs it) - (-> Int Int) + (-> Int + Int) (if (..< +0 it) (..* -1 it) it)) (def .public (signum it) - (-> Int Int) + (-> Int + Int) (cond (..= +0 it) +0 (..< +0 it) -1 ... else @@ -100,7 +121,8 @@ ... https://rob.conery.io/2018/08/21/mod-and-remainder-are-not-the-same/ (def .public (mod divisor dividend) - (All (_ m) (-> Int Int Int)) + (-> Int Int + Int) (let [remainder (..% divisor dividend)] (if (or (and (..< +0 divisor) (..> +0 remainder)) @@ -110,27 +132,32 @@ remainder))) (def .public even? - (-> Int Bit) + (-> Int + Bit) (|>> (..% +2) (.i64_=# +0))) (def .public odd? - (-> Int Bit) + (-> Int + Bit) (|>> ..even? not)) ... https://en.wikipedia.org/wiki/Greatest_common_divisor (def .public (gcd a b) - (-> Int Int Int) + (-> Int Int + Int) (when b +0 a _ (gcd b (..% b a)))) (def .public (co_prime? a b) - (-> Int Int Bit) + (-> Int Int + Bit) (..= +1 (..gcd a b))) ... https://en.wikipedia.org/wiki/Extended_Euclidean_algorithm (def .public (extended_gcd a b) - (-> Int Int [[Int Int] Int]) + (-> Int Int + [[Int Int] Int]) (loop (again [x +1 x1 +0 y +0 y1 +1 a1 a b1 b]) @@ -143,7 +170,8 @@ ... https://en.wikipedia.org/wiki/Least_common_multiple (`` (def .public (lcm a b) - (-> Int Int Int) + (-> Int Int + Int) (when [a b] (,, (with_template [<pattern>] [<pattern> @@ -156,7 +184,8 @@ (|> a (/ (gcd a b)) (* b))))) (def .public frac - (-> Int Frac) + (-> Int + Frac) (|>> .int_f64#)) (def .public equivalence @@ -249,7 +278,8 @@ (def hash (|>> .nat)))) (def .public (right_shifted parameter subject) - (-> Nat Int Int) + (-> Nat Int + Int) (with_expansions [<positive> (//i64.right_shifted parameter subject)] (if (< +0 subject) (|> +1 diff --git a/stdlib/source/library/lux/math/number/nat.lux b/stdlib/source/library/lux/math/number/nat.lux index 66c29f167..1464fc8e9 100644 --- a/stdlib/source/library/lux/math/number/nat.lux +++ b/stdlib/source/library/lux/math/number/nat.lux @@ -12,11 +12,14 @@ [control ["[0]" function] ["[0]" maybe] - ["[0]" try (.only Try)]]]]) + ["[0]" try (.only Try)]]]] + [/// + [arithmetic (.only Arithmetic)]]) (with_template [<extension> <output> <name>] [(def .public (<name> parameter subject) - (-> Nat Nat <output>) + (-> Nat Nat + <output>) (<extension> parameter subject))] [.i64_=# Bit =] @@ -25,16 +28,19 @@ ) (def high - (-> (I64 Any) I64) + (-> (I64 Any) + I64) (|>> (.i64_right# 32))) (def low - (-> (I64 Any) I64) + (-> (I64 Any) + I64) (let [mask (|> 1 (.i64_left# 32) (.i64_-# 1))] (|>> (.i64_and# mask)))) (def .public (< reference sample) - (-> Nat Nat Bit) + (-> Nat Nat + Bit) (let [referenceH (..high reference) sampleH (..high sample)] (if (.int_<# referenceH sampleH) @@ -46,22 +52,26 @@ false)))) (def .public (<= reference sample) - (-> Nat Nat Bit) + (-> Nat Nat + Bit) (or (..< reference sample) (.i64_=# reference sample))) (def .public (> reference sample) - (-> Nat Nat Bit) + (-> Nat Nat + Bit) (..< sample reference)) (def .public (>= reference sample) - (-> Nat Nat Bit) + (-> Nat Nat + Bit) (or (..< sample reference) (.i64_=# reference sample))) (with_template [<name> <test>] [(def .public (<name> left right) - (-> Nat Nat Nat) + (-> Nat Nat + Nat) (if (<test> right left) left right))] @@ -71,12 +81,14 @@ ) (def .public (* parameter subject) - (-> Nat Nat Nat) + (-> Nat Nat + Nat) (.nat (.int_*# (.int parameter) (.int subject)))) (def .public (/ parameter subject) - (-> Nat Nat Nat) + (-> Nat Nat + Nat) (if (.int_<# +0 (.int parameter)) (if (..< parameter subject) 0 @@ -93,30 +105,44 @@ (.i64_+# 1 quotient))))) (def .public (/% parameter subject) - (-> Nat Nat [Nat Nat]) + (-> Nat Nat + [Nat Nat]) (let [quotient (../ parameter subject) flat (.int_*# (.int parameter) (.int quotient))] [quotient (.i64_-# flat subject)])) (def .public (% parameter subject) - (-> Nat Nat Nat) + (-> Nat Nat + Nat) (let [flat (.int_*# (.int parameter) (.int (../ parameter subject)))] (.i64_-# flat subject))) +(def .public arithmetic + (Arithmetic Nat) + (implementation + (def + ..+) + (def - ..-) + (def * ..*) + (def / ../) + (def % ..%))) + (def .public (gcd a b) - (-> Nat Nat Nat) + (-> Nat Nat + Nat) (when b 0 a _ (gcd b (..% b a)))) (def .public (co_prime? a b) - (-> Nat Nat Bit) + (-> Nat Nat + Bit) (..= 1 (..gcd a b))) (`` (def .public (lcm a b) - (-> Nat Nat Nat) + (-> Nat Nat + Nat) (when [a b] (,, (with_template [<pattern>] [<pattern> @@ -129,15 +155,18 @@ (|> a (../ (..gcd a b)) (..* b))))) (def .public even? - (-> Nat Bit) + (-> Nat + Bit) (|>> (..% 2) (.i64_=# 0))) (def .public odd? - (-> Nat Bit) + (-> Nat + Bit) (|>> ..even? not)) (def .public frac - (-> Nat Frac) + (-> Nat + Frac) (|>> .int .int_f64#)) (def .public equivalence @@ -179,21 +208,24 @@ ) (def (binary_character value) - (-> Nat Text) + (-> Nat + Text) (when value 0 "0" 1 "1" _ (undefined))) (def (binary_value digit) - (-> Nat (Maybe Nat)) + (-> Nat + (Maybe Nat)) (when digit (char "0") {.#Some 0} (char "1") {.#Some 1} _ {.#None})) (def (octal_character value) - (-> Nat Text) + (-> Nat + Text) (when value 0 "0" 1 "1" @@ -206,7 +238,8 @@ _ (undefined))) (def (octal_value digit) - (-> Nat (Maybe Nat)) + (-> Nat + (Maybe Nat)) (when digit (char "0") {.#Some 0} (char "1") {.#Some 1} @@ -219,7 +252,8 @@ _ {.#None})) (def (decimal_character value) - (-> Nat Text) + (-> Nat + Text) (when value 0 "0" 1 "1" @@ -234,7 +268,8 @@ _ (undefined))) (def (decimal_value digit) - (-> Nat (Maybe Nat)) + (-> Nat + (Maybe Nat)) (when digit (char "0") {.#Some 0} (char "1") {.#Some 1} @@ -249,7 +284,8 @@ _ {.#None})) (def (hexadecimal_character value) - (-> Nat Text) + (-> Nat + Text) (when value 0 "0" 1 "1" @@ -270,7 +306,8 @@ _ (undefined))) (`` (def (hexadecimal_value digit) - (-> Nat (Maybe Nat)) + (-> Nat + (Maybe Nat)) (when digit (,, (with_template [<character> <number>] [(char <character>) diff --git a/stdlib/source/library/lux/math/number/ratio.lux b/stdlib/source/library/lux/math/number/ratio.lux index 2974eae8b..f24598300 100644 --- a/stdlib/source/library/lux/math/number/ratio.lux +++ b/stdlib/source/library/lux/math/number/ratio.lux @@ -21,7 +21,9 @@ [macro [syntax (.only syntax)]]]]] [// - ["n" nat (.use "[1]#[0]" decimal)]]) + ["n" nat (.use "[1]#[0]" decimal)] + [// + [arithmetic (.only Arithmetic)]]]) (type .public Ratio (Record @@ -29,13 +31,15 @@ #denominator Nat])) (def .public (nat value) - (-> Ratio (Maybe Nat)) + (-> Ratio + (Maybe Nat)) (when (the #denominator value) 1 {.#Some (the #numerator value)} _ {.#None})) (def .public (normal (open "_[0]")) - (-> Ratio Ratio) + (-> Ratio + Ratio) (let [common (n.gcd _#numerator _#denominator)] [..#numerator (n./ common _#numerator) ..#denominator (n./ common _#denominator)])) @@ -47,7 +51,8 @@ ..#denominator (, (maybe.else (' 1) ?denominator))])))))) (def .public (= parameter subject) - (-> Ratio Ratio Bit) + (-> Ratio Ratio + Bit) (and (n.= (the #numerator parameter) (the #numerator subject)) (n.= (the #denominator parameter) @@ -59,28 +64,33 @@ (def = ..=))) (def (equalized parameter subject) - (-> Ratio Ratio [Nat Nat]) + (-> Ratio Ratio + [Nat Nat]) [(n.* (the #denominator subject) (the #numerator parameter)) (n.* (the #denominator parameter) (the #numerator subject))]) (def .public (< parameter subject) - (-> Ratio Ratio Bit) + (-> Ratio Ratio + Bit) (let [[parameter' subject'] (..equalized parameter subject)] (n.< parameter' subject'))) (def .public (<= parameter subject) - (-> Ratio Ratio Bit) + (-> Ratio Ratio + Bit) (or (< parameter subject) (= parameter subject))) (def .public (> parameter subject) - (-> Ratio Ratio Bit) + (-> Ratio Ratio + Bit) (..< subject parameter)) (def .public (>= parameter subject) - (-> Ratio Ratio Bit) + (-> Ratio Ratio + Bit) (or (> parameter subject) (= parameter subject))) @@ -91,40 +101,55 @@ (def < ..<))) (def .public (+ parameter subject) - (-> Ratio Ratio Ratio) + (-> Ratio Ratio + Ratio) (let [[parameter' subject'] (..equalized parameter subject)] (normal [(n.+ parameter' subject') (n.* (the #denominator parameter) (the #denominator subject))]))) (def .public (- parameter subject) - (-> Ratio Ratio Ratio) + (-> Ratio Ratio + Ratio) (let [[parameter' subject'] (..equalized parameter subject)] (normal [(n.- parameter' subject') (n.* (the #denominator parameter) (the #denominator subject))]))) (def .public (* parameter subject) - (-> Ratio Ratio Ratio) + (-> Ratio Ratio + Ratio) (normal [(n.* (the #numerator parameter) (the #numerator subject)) (n.* (the #denominator parameter) (the #denominator subject))])) (def .public (/ parameter subject) - (-> Ratio Ratio Ratio) + (-> Ratio Ratio + Ratio) (let [[parameter' subject'] (..equalized parameter subject)] (normal [subject' parameter']))) (def .public (% parameter subject) - (-> Ratio Ratio Ratio) + (-> Ratio Ratio + Ratio) (let [[parameter' subject'] (..equalized parameter subject) quot (n./ parameter' subject')] (..- (revised #numerator (n.* quot) parameter) subject))) +(def .public arithmetic + (Arithmetic Ratio) + (implementation + (def + ..+) + (def - ..-) + (def * ..*) + (def / ../) + (def % ..%))) + (def .public (reciprocal (open "_[0]")) - (-> Ratio Ratio) + (-> Ratio + Ratio) [..#numerator _#denominator ..#denominator _#numerator]) diff --git a/stdlib/source/library/lux/math/number/rev.lux b/stdlib/source/library/lux/math/number/rev.lux index 47b3f52db..070c284b5 100644 --- a/stdlib/source/library/lux/math/number/rev.lux +++ b/stdlib/source/library/lux/math/number/rev.lux @@ -18,7 +18,9 @@ ["[0]" // ["[1][0]" i64] ["[1][0]" nat] - ["[1][0]" int]]) + ["[1][0]" int] + [// + [arithmetic (.only Arithmetic)]]]) (def .public /1 Rev @@ -44,30 +46,36 @@ ) (def .public (= reference sample) - (-> Rev Rev Bit) + (-> Rev Rev + Bit) (.i64_=# reference sample)) (def .public (< reference sample) - (-> Rev Rev Bit) + (-> Rev Rev + Bit) (//nat.< (.nat reference) (.nat sample))) (def .public (<= reference sample) - (-> Rev Rev Bit) + (-> Rev Rev + Bit) (or (//nat.< (.nat reference) (.nat sample)) (.i64_=# reference sample))) (def .public (> reference sample) - (-> Rev Rev Bit) + (-> Rev Rev + Bit) (..< sample reference)) (def .public (>= reference sample) - (-> Rev Rev Bit) + (-> Rev Rev + Bit) (or (..< sample reference) (.i64_=# reference sample))) (with_template [<name> <test>] [(def .public (<name> left right) - (-> Rev Rev Rev) + (-> Rev Rev + Rev) (if (<test> right left) left right))] @@ -78,7 +86,8 @@ (with_template [<name> <op>] [(def .public (<name> param subject) - (-> Rev Rev Rev) + (-> Rev Rev + Rev) (<op> param subject))] [+ .i64_+#] @@ -86,16 +95,19 @@ ) (def high - (-> (I64 Any) I64) + (-> (I64 Any) + I64) (|>> (.i64_right# 32))) (def low - (-> (I64 Any) I64) + (-> (I64 Any) + I64) (let [mask (|> 1 (.i64_left# 32) (.i64_-# 1))] (|>> (.i64_and# mask)))) (def .public (* param subject) - (-> Rev Rev Rev) + (-> Rev Rev + Rev) (let [subjectH (..high subject) subjectL (..low subject) paramH (..high param) @@ -115,23 +127,27 @@ (def odd_one (-- 0)) (def (even_reciprocal numerator) - (-> Nat Nat) + (-> Nat + Nat) (//nat./ (//i64.right_shifted 1 numerator) ..even_one)) (def (odd_reciprocal numerator) - (-> Nat Nat) + (-> Nat + Nat) (//nat./ numerator ..odd_one)) (with_expansions [<least_significant_bit> 1] (def .public (reciprocal numerator) - (-> Nat Rev) + (-> Nat + Rev) (.rev (when (is Nat (.i64_and# <least_significant_bit> numerator)) 0 (..even_reciprocal numerator) _ (..odd_reciprocal numerator)))) (def .public (/ param subject) - (-> Rev Rev Rev) + (-> Rev Rev + Rev) (if (.i64_=# +0 param) (panic! "Cannot divide Rev by zero!") (let [reciprocal (when (is Nat (.i64_and# <least_significant_bit> param)) @@ -141,16 +157,27 @@ (with_template [<operator> <name> <output> <output_type>] [(def .public (<name> param subject) - (-> Rev Rev <output_type>) + (-> Rev Rev + <output_type>) (<output> (<operator> (.nat param) (.nat subject))))] [//nat.% % .rev Rev] [//nat./ ratio |> Nat] ) +(def .public arithmetic + (Arithmetic Rev) + (implementation + (def + ..+) + (def - ..-) + (def * ..*) + (def / ../) + (def % ..%))) + (with_template [<operator> <name>] [(def .public (<name> scale subject) - (-> Nat Rev Rev) + (-> Nat Rev + Rev) (.rev (<operator> (.nat scale) (.nat subject))))] [//nat.* up] @@ -158,12 +185,14 @@ ) (def .public (/% param subject) - (-> Rev Rev [Rev Rev]) + (-> Rev Rev + [Rev Rev]) [(../ param subject) (..% param subject)]) (def mantissa - (-> (I64 Any) Frac) + (-> (I64 Any) + Frac) (|>> (.i64_right# 11) .int_f64#)) @@ -171,7 +200,8 @@ (..mantissa -1)) (def .public frac - (-> Rev Frac) + (-> Rev + Frac) (|>> ..mantissa (.f64_/# ..frac_denominator))) (def .public equivalence @@ -218,7 +248,8 @@ ) (def (decimals input) - (-> Text Text) + (-> Text + Text) (.text_clip# 1 (-- (.text_size# input)) input)) (with_template [<struct> <codec> <char_bit_size> <error>] @@ -279,21 +310,25 @@ (Array Nat)) (def (digits _) - (-> Any Digits) + (-> Any + Digits) (array.empty //i64.width)) (def (digit idx digits) - (-> Nat Digits Nat) + (-> Nat Digits + Nat) (|> digits (array.item idx) (maybe.else 0))) (def digits#put! - (-> Nat Nat Digits Digits) + (-> Nat Nat Digits + Digits) array.has!) (def (digits#times_5! idx output) - (-> Nat Digits Digits) + (-> Nat Digits + Digits) (loop (again [idx idx carry 0 output output]) @@ -307,7 +342,8 @@ (digits#put! idx (//nat.% 10 raw) output)))))) (def (power_digits power) - (-> Nat Digits) + (-> Nat + Digits) (loop (again [times power output (|> (..digits []) (digits#put! power 1))]) @@ -317,7 +353,8 @@ (digits#times_5! power output))))) (def (format digits) - (-> Digits Text) + (-> Digits + Text) (loop (again [idx (-- //i64.width) all_zeroes? true output ""]) @@ -335,7 +372,8 @@ output))))))) (def (digits#+! param subject) - (-> Digits Digits Digits) + (-> Digits Digits + Digits) (loop (again [idx (-- //i64.width) carry 0 output (..digits [])]) @@ -350,7 +388,8 @@ (digits#put! idx (//nat.% 10 raw) output)))))) (def (text_digits input) - (-> Text (Maybe Digits)) + (-> Text + (Maybe Digits)) (let [length (.text_size# input)] (if (//nat.> //i64.width length) {.#None} @@ -367,7 +406,8 @@ {.#Some output}))))) (def (digits#< param subject) - (-> Digits Digits Bit) + (-> Digits Digits + Bit) (loop (again [idx 0]) (and (//nat.< //i64.width idx) (let [pd (..digit idx param) @@ -377,7 +417,8 @@ (//nat.< pd sd)))))) (def (digits#-!' idx param subject) - (-> Nat Nat Digits Digits) + (-> Nat Nat Digits + Digits) (let [sd (..digit idx subject)] (if (//nat.< param sd) (let [diff (|> sd @@ -389,7 +430,8 @@ (digits#put! idx (//nat.- param sd) subject)))) (def (digits#-! param subject) - (-> Digits Digits Digits) + (-> Digits Digits + Digits) (loop (again [idx (-- //i64.width) output subject]) (if (//int.< +0 (.int idx)) diff --git a/stdlib/source/library/lux/meta/compiler/default/platform.lux b/stdlib/source/library/lux/meta/compiler/default/platform.lux index 4dad1b450..c245fbc26 100644 --- a/stdlib/source/library/lux/meta/compiler/default/platform.lux +++ b/stdlib/source/library/lux/meta/compiler/default/platform.lux @@ -232,7 +232,7 @@ (the #phase platform))] _ (is (Async (Try Any)) (cache.enable! async.monad (the #file_system platform) context)) - [archive analysis_state bundles] (ioW.thaw (list) compilation_configuration (the #host platform) (the #file_system platform) context import compilation_sources) + [archive analysis_state] (ioW.thaw (list) compilation_configuration (the #host platform) (the #file_system platform) context import compilation_sources) .let [with_missing_extensions (is (All (_ <type_vars>) (-> (//init.Extensions <type_vars>) <State> (Async (Try <State>)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux index 99a99baa6..3bda50cd1 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux @@ -173,54 +173,6 @@ (synthesis archive codeA))] (definition' archive translation name code//type codeS))) -(with_template [<full> <partial> <learn>] - [... TODO: Inline "<partial>" into "<full>" ASAP - (def (<partial> archive translation extension codeT codeS) - (All (_ anchor expression declaration) - (-> Archive - (/////translation.Phase anchor expression declaration) - Text - Type - Synthesis - (Operation anchor expression declaration [expression Any]))) - (do phase.monad - [current_module (/////declaration.of_analysis meta.current_module_name)] - (/////declaration.of_translation - (do phase.monad - [dependencies (cache/artifact.dependencies archive codeS) - [interim_artifacts codeG] (/////translation.with_interim_artifacts archive - (translation archive codeS)) - @module (phase.of_try (archive.id current_module archive)) - @self (<learn> extension (list#mix set.has dependencies interim_artifacts)) - [target_name value declaration] (/////translation.define! [@module @self] {.#None} [{.#None} codeG]) - _ (/////translation.save! @self {.#None} declaration)] - (in [codeG value]))))) - - (def .public (<full> archive extension codeT codeC) - (All (_ anchor expression declaration) - (-> Archive Text Type Code - (Operation anchor expression declaration [expression Any]))) - (do phase.monad - [state phase.state - .let [analysis_state (the [/////declaration.#analysis /////declaration.#state] state) - analysis (the [/////declaration.#analysis /////declaration.#phase] state) - synthesis ((the [/////declaration.#synthesis /////declaration.#phase] state) analysis_state) - translation ((the [/////declaration.#translation /////declaration.#phase] state) analysis_state)] - [_ codeA] (<| /////declaration.of_analysis - scope.with - typeA.fresh - (typeA.expecting codeT) - (analysis archive codeC)) - codeS (/////declaration.of_synthesis - (synthesis archive codeA))] - (<partial> archive translation extension codeT codeS)))] - - [analyser analyser' /////translation.learn_analyser] - [synthesizer synthesizer' /////translation.learn_synthesizer] - [translator translator' /////translation.learn_translator] - [declaration declaration' /////translation.learn_declaration] - ) - ... TODO: Get rid of this function ASAP. (def refresh (All (_ anchor expression declaration) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/translation.lux b/stdlib/source/library/lux/meta/compiler/language/lux/translation.lux index bf2e4f0f3..c69086b06 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/translation.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/translation.lux @@ -266,10 +266,6 @@ [category.Definition mandatory? [mandatory?] [Bit] learn registry.definition] [Text #1 [] [] learn_custom registry.custom] - [Text #0 [] [] learn_analyser registry.analyser] - [Text #0 [] [] learn_synthesizer registry.synthesizer] - [Text #0 [] [] learn_translator registry.translator] - [Text #0 [] [] learn_declaration registry.declaration] ) (exception.def .public (unknown_definition [name known_definitions]) diff --git a/stdlib/source/library/lux/meta/compiler/meta/archive/artifact/category.lux b/stdlib/source/library/lux/meta/compiler/meta/archive/artifact/category.lux index 7ce614c92..0b3758826 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/archive/artifact/category.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/archive/artifact/category.lux @@ -35,10 +35,6 @@ (Variant {#Anonymous} {#Definition Definition} - {#Analyser Text} - {#Synthesizer Text} - {#Translator Text} - {#Declaration Text} {#Custom Text})) (def .public equivalence @@ -52,14 +48,9 @@ [{#Definition left} {#Definition right}] (at definition_equivalence = left right) - (^.with_template [<tag>] - [[{<tag> left} {<tag> right}] - (text#= left right)]) - ([#Analyser] - [#Synthesizer] - [#Translator] - [#Declaration] - [#Custom]) + [{#Custom left} {#Custom right}] + (text#= left right) _ - false)))) + false + )))) diff --git a/stdlib/source/library/lux/meta/compiler/meta/archive/registry.lux b/stdlib/source/library/lux/meta/compiler/meta/archive/registry.lux index 3ca43494f..93e18387a 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/archive/registry.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/archive/registry.lux @@ -88,10 +88,6 @@ [//category.#Definition definition definitions //category.Definition product.left {.#Some it}] - [//category.#Analyser analyser analysers Text |> {.#None}] - [//category.#Synthesizer synthesizer synthesizers Text |> {.#None}] - [//category.#Translator translator translators Text |> {.#None}] - [//category.#Declaration declaration declarations Text |> {.#None}] [//category.#Custom custom customs Text |> {.#None}] ) @@ -125,11 +121,7 @@ ((binary.and binary.nat <format>) [<nat> value])]) ([0 //category.#Anonymous binary.any] [1 //category.#Definition definition] - [2 //category.#Analyser binary.text] - [3 //category.#Synthesizer binary.text] - [4 //category.#Translator binary.text] - [5 //category.#Declaration binary.text] - [6 //category.#Custom binary.text])))) + [2 //category.#Custom binary.text])))) mandatory? binary.bit dependency (is (Format unit.ID) (binary.and binary.nat binary.nat)) @@ -171,11 +163,7 @@ (at ! each (|>> {<tag>}) <parser>)]) ([0 //category.#Anonymous <binary>.any] [1 //category.#Definition definition] - [2 //category.#Analyser <binary>.text] - [3 //category.#Synthesizer <binary>.text] - [4 //category.#Translator <binary>.text] - [5 //category.#Declaration <binary>.text] - [6 //category.#Custom <binary>.text]) + [2 //category.#Custom <binary>.text]) _ (<>.failure (exception.error ..invalid_category [tag]))))) mandatory? <binary>.bit @@ -194,10 +182,6 @@ [{<tag> name} (<create> name mandatory? dependencies registry)]) ([//category.#Definition ..definition] - [//category.#Analyser ..analyser] - [//category.#Synthesizer ..synthesizer] - [//category.#Translator ..translator] - [//category.#Declaration ..declaration] [//category.#Custom ..custom]) ))) ..empty))))) diff --git a/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux b/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux index 02a205b27..37f0435ab 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux @@ -89,135 +89,57 @@ (archive.archived archive)))] (in (has .#modules modules (fresh_analysis_state host configuration))))) -(type Definitions (Dictionary Text Any)) -(type Analysers (Dictionary Text analysis.Handler)) -(type Synthesizers (Dictionary Text synthesis.Handler)) -(type Translators (Dictionary Text translation.Handler)) -(type Declarations (Dictionary Text declaration.Handler)) - -(type Bundles - [Analysers - Synthesizers - Translators - Declarations]) - -(def empty_bundles - Bundles - [(dictionary.empty text.hash) - (dictionary.empty text.hash) - (dictionary.empty text.hash) - (dictionary.empty text.hash)]) +(type Definitions + (Dictionary Text Any)) (def (loaded_document extension host @module expected actual document) (All (_ expression declaration) (-> Text (translation.Host expression declaration) module.ID (Sequence [Artifact (Set unit.ID)]) (Dictionary Text Binary) (Document .Module) - (Try [(Document .Module) Bundles Output]))) + (Try [(Document .Module) Output]))) (do [! try.monad] - [[definitions bundles] (is (Try [Definitions Bundles Output]) - (loop (again [input (sequence.list expected) - definitions (is Definitions - (dictionary.empty text.hash)) - bundles ..empty_bundles - output (is Output sequence.empty)]) - (let [[analysers synthesizers translators declarations] bundles] - (when input - {.#Item [[[@artifact artifact_category mandatory_artifact?] artifact_dependencies] input']} - (when (do ! - [data (try.of_maybe (dictionary.value (format (%.nat @artifact) extension) actual)) - .let [context [@module @artifact] - declaration (at host ingest context data)]] - (when artifact_category - {category.#Anonymous} - (do ! - [.let [output (sequence.suffix [@artifact {.#None} data] output)] - _ (at host re_learn context {.#None} declaration)] - (in [definitions - [analysers - synthesizers - translators - declarations] - output])) - - {category.#Definition [name function_artifact]} - (let [output (sequence.suffix [@artifact {.#None} data] output)] - (if (text#= $/program.name name) - (in [definitions - [analysers - synthesizers - translators - declarations] - output]) - (do ! - [value (at host re_load context {.#None} declaration)] - (in [(dictionary.has name value definitions) - [analysers - synthesizers - translators - declarations] - output])))) - - {category.#Analyser extension} - (do ! - [.let [output (sequence.suffix [@artifact {.#None} data] output)] - value (at host re_load context {.#None} declaration)] - (in [definitions - [(dictionary.has extension (as analysis.Handler value) analysers) - synthesizers - translators - declarations] - output])) - - {category.#Synthesizer extension} - (do ! - [.let [output (sequence.suffix [@artifact {.#None} data] output)] - value (at host re_load context {.#None} declaration)] - (in [definitions - [analysers - (dictionary.has extension (as synthesis.Handler value) synthesizers) - translators - declarations] - output])) - - {category.#Translator extension} - (do ! - [.let [output (sequence.suffix [@artifact {.#None} data] output)] - value (at host re_load context {.#None} declaration)] - (in [definitions - [analysers - synthesizers - (dictionary.has extension (as translation.Handler value) translators) - declarations] - output])) - - {category.#Declaration extension} - (do ! - [.let [output (sequence.suffix [@artifact {.#None} data] output)] - value (at host re_load context {.#None} declaration)] - (in [definitions - [analysers - synthesizers - translators - (dictionary.has extension (as declaration.Handler value) declarations)] - output])) + [[definitions output] (is (Try [Definitions Output]) + (loop (again [input (sequence.list expected) + definitions (is Definitions + (dictionary.empty text.hash)) + output (is Output sequence.empty)]) + (when input + {.#Item [[[@artifact artifact_category mandatory_artifact?] artifact_dependencies] input']} + (when (do ! + [data (try.of_maybe (dictionary.value (format (%.nat @artifact) extension) actual)) + .let [context [@module @artifact] + declaration (at host ingest context data)]] + (when artifact_category + {category.#Anonymous} + (do ! + [.let [output (sequence.suffix [@artifact {.#None} data] output)] + _ (at host re_learn context {.#None} declaration)] + (in [definitions + output])) + + {category.#Definition [name function_artifact]} + (let [output (sequence.suffix [@artifact {.#None} data] output)] + (if (text#= $/program.name name) + (in [definitions + output]) + (do ! + [value (at host re_load context {.#None} declaration)] + (in [(dictionary.has name value definitions) + output])))) - {category.#Custom name} - (do ! - [.let [output (sequence.suffix [@artifact {.#Some name} data] output)] - _ (at host re_learn context {.#Some name} declaration)] - (in [definitions - [analysers - synthesizers - translators - declarations] - output])))) - {try.#Success [definitions' bundles' output']} - (again input' definitions' bundles' output') + {category.#Custom name} + (do ! + [.let [output (sequence.suffix [@artifact {.#Some name} data] output)] + _ (at host re_learn context {.#Some name} declaration)] + (in [definitions + output])))) + {try.#Success [definitions' output']} + (again input' definitions' output') - failure - failure) - - {.#End} - {try.#Success [definitions bundles output]})))) + failure + failure) + + {.#End} + {try.#Success [definitions output]}))) content (document.content $.key document) definitions (monad.each ! (function (_ [def_name [exported? def_global]]) (when def_global @@ -238,24 +160,23 @@ (in (list)))) (the .#definitions content))] (in [(document.document $.key (has .#definitions (list#conjoint definitions) content)) - bundles]))) + output]))) (def (load_definitions fs context @module host_environment entry) (All (_ expression declaration) (-> (file.System Async) Context module.ID (translation.Host expression declaration) (archive.Entry .Module) - (Async (Try [(archive.Entry .Module) Bundles])))) + (Async (Try (archive.Entry .Module))))) (do (try.with async.monad) [actual (is (Async (Try (Dictionary Text Binary))) (cache/module.artifacts async.monad fs context @module)) .let [expected (registry.artifacts (the archive.#registry entry))] - [document bundles output] (|> (the [archive.#module module.#document] entry) - (loaded_document (the context.#artifact_extension context) host_environment @module expected actual) - async#in)] - (in [(|> entry - (has [archive.#module module.#document] document) - (has archive.#output output)) - bundles]))) + [document output] (|> (the [archive.#module module.#document] entry) + (loaded_document (the context.#artifact_extension context) host_environment @module expected actual) + async#in)] + (in (|> entry + (has [archive.#module module.#document] document) + (has archive.#output output))))) (def pseudo_module Text @@ -319,20 +240,19 @@ (All (_ expression declaration) (-> (translation.Host expression declaration) (file.System Async) Context Purge (dependency.Order .Module) - (Async (Try (List [[descriptor.Module (archive.Entry .Module)] Bundles]))))) + (Async (Try (List [descriptor.Module (archive.Entry .Module)]))))) (do [! (try.with async.monad)] [... TODO: Stop needing to wrap this expression in an unnecessary "do" expression. it (|> load_order (list.only (|>> product.left (dictionary.key? purge) not)) (monad.each ! (function (_ [module_name [@module entry]]) (do ! - [[entry bundles] (with_expansions [<it> (..load_definitions fs context @module host_environment entry)] - (for @.old (as (Async (Try [(archive.Entry .Module) Bundles])) - <it>) - <it>))] - (in (with_expansions [<it> [[module_name entry] - bundles]] - (for @.old (as [[descriptor.Module (archive.Entry .Module)] Bundles] + [entry (with_expansions [<it> (..load_definitions fs context @module host_environment entry)] + (for @.old (as (Async (Try (archive.Entry .Module))) + <it>) + <it>))] + (in (with_expansions [<it> [module_name entry]] + (for @.old (as [descriptor.Module (archive.Entry .Module)] <it>) <it>)))))))] (in it))) @@ -340,7 +260,7 @@ (def (load_every_reserved_module customs configuration host_environment fs context import contexts archive) (All (_ expression declaration) (-> (List Custom) Configuration (translation.Host expression declaration) (file.System Async) Context Import (List //.Context) Archive - (Async (Try [Archive .Lux Bundles])))) + (Async (Try [Archive .Lux])))) (do [! (try.with async.monad)] [pre_loaded_caches (..pre_loaded_caches customs fs context import contexts archive) load_order (async#in (load_order archive pre_loaded_caches)) @@ -352,26 +272,17 @@ (async#in (do [! try.monad] [archive (monad.mix ! - (function (_ [[module entry] _bundle] archive) + (function (_ [module entry] archive) (archive.has module entry archive)) archive loaded_caches) analysis_state (..analysis_state (the context.#host context) configuration archive)] - (in [archive - analysis_state - (list#mix (function (_ [_ [+analysers +synthesizers +translators +declarations]] - [analysers synthesizers translators declarations]) - [(dictionary.composite +analysers analysers) - (dictionary.composite +synthesizers synthesizers) - (dictionary.composite +translators translators) - (dictionary.composite +declarations declarations)]) - ..empty_bundles - loaded_caches)]))))) + (in [archive analysis_state]))))) (def .public (thaw customs configuration host_environment fs context import contexts) (All (_ expression declaration) (-> (List Custom) Configuration (translation.Host expression declaration) (file.System Async) Context Import (List //.Context) - (Async (Try [Archive .Lux Bundles])))) + (Async (Try [Archive .Lux])))) (do async.monad [binary (at fs read (cache/archive.descriptor fs context))] (when binary @@ -382,5 +293,4 @@ {try.#Failure error} (in {try.#Success [archive.empty - (fresh_analysis_state (the context.#host context) configuration) - ..empty_bundles]})))) + (fresh_analysis_state (the context.#host context) configuration)]})))) diff --git a/stdlib/source/library/lux/world/file/extension.lux b/stdlib/source/library/lux/world/file/extension.lux new file mode 100644 index 000000000..12b6700be --- /dev/null +++ b/stdlib/source/library/lux/world/file/extension.lux @@ -0,0 +1,108 @@ +... https://en.wikipedia.org/wiki/List_of_filename_extensions +(.require + [library + [lux (.except) + [data + [text + ["%" \\format]]] + [meta + [macro + ["[0]" template]]]]]) + +(def .public Extension + Text) + +(with_template [<ext> <name> <aliases>] + [(def .public <name> + Extension + (%.format "." <ext>)) + + (`` (with_template [<alias>] + [(def .public <alias> <name>)] + + (,, (template.spliced <aliases>)) + )) + ] + + ... https://en.wikipedia.org/wiki/List_of_filename_extensions_(0%E2%80%939) + ["7z" compressed_7z_archive []] + + ... https://en.wikipedia.org/wiki/List_of_filename_extensions_(A%E2%80%93E) + ["a" archive []] + ["aac" advanced_audio_coding []] + ["agda" agda_source_code []] + ["apk" android_application_package []] + ["asm" assembler_source_code []] + + ["bin" binary []] + ["bz2" bzip2_archive []] + ["blend" blender_project []] + + ["c" c_source_code [[c]]] + ["cpp" c++_source_code [[c++]]] + ["class" java_class []] + ["com" dos_program []] + ["cs" c#_source_code []] + ["css" css []] + ["csv" comma_separated_values [[csv]]] + + ["d" d_source_code []] + ["dart" dart_source_code []] + + ["el" emacs_lisp_source_code [[emacs_lisp]]] + ["elc" compiled_emacs_lisp_code []] + ["elf" executable_and_linkable_file []] + ["epub" electronic_publication []] + ["erl" erlang_source_code [[erlang]]] + ["exe" executable_program []] + + ... https://en.wikipedia.org/wiki/List_of_filename_extensions_(F%E2%80%93L) + ["flame" apophysis_fractal []] + + ["gpx" gps_exchange_format []] + ["gz" gzip_compressed_data []] + + ["har" http_archive_format []] + ["h" c_header []] + ["html" html []] + + ["iso" optical_disc_file_system []] + + ["jar" java_archive [[jar]]] + ["java" java_source_code [[java]]] + ["js" javascript_source_code [[javascript] [js]]] + ["json" javascript_object_notation [[json]]] + + ["ll" llvm_assembly []] + ["lua" lua_source_code [[lua]]] + ["lz" lzip_archive []] + + ... https://en.wikipedia.org/wiki/List_of_filename_extensions_(M%E2%80%93R) + ["md" markdown []] + ["mid" musical_instrument_digital_interface [[midi]]] + + ["o" object_code []] + ["ogg" vorbis_audio [[ogg]]] + + ["pdf" portable_document_format [[pdf]]] + ["php" php_source_code [[php]]] + ["pom" maven_build_configuration []] + ["ps" postscript_source_code []] + ["py" python_source_code [[python]]] + + ["rb" ruby_source_code [[ruby]]] + + ... https://en.wikipedia.org/wiki/List_of_filename_extensions_(S%E2%80%93Z) + ["scm" scheme_source_code [[scheme]]] + ["sh" unix_shell_script []] + ["sql" structured_query_language [[sql]]] + ["svg" scalable_vector_graphics [[svg]]] + + ["tar" tape_archive [[tar]]] + ["tmp" temporary_file []] + ["tsv" tab_separated_values []] + + ["yaml" yaml [[yet_another_markup_language] [yaml_ain't_markup_language]]] + + ["zip" zip_archive [[zip]]] + ) diff --git a/stdlib/source/specification/lux/abstract/order.lux b/stdlib/source/specification/lux/abstract/order.lux index ae7dc3355..1bf62b3cc 100644 --- a/stdlib/source/specification/lux/abstract/order.lux +++ b/stdlib/source/specification/lux/abstract/order.lux @@ -3,57 +3,68 @@ [lux (.except) [abstract [monad (.only do)]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)]] [math ["[0]" random (.only Random)]] [test ["_" property (.only Test)]]]] [\\library - ["[0]" /]]) + ["[0]" /]] + [// + ["[0]S" equivalence]]) -(def .public (spec (open "@//[0]") generator) - (All (_ a) (-> (/.Order a) (Random a) Test)) +(def .public (spec (open "/#[0]") random) + (All (_ of) + (-> (/.Order of) (Random of) + Test)) (<| (_.for [/.Order]) (all _.and + (_.for [/.equivalence] + (equivalenceS.spec /#equivalence random)) + (do random.monad - [parameter generator - subject generator] - (_.test "Values are either ordered, or they are equal. All options(_ are mutually exclusive." - (cond (@//< parameter subject) - (not (or (@//< subject parameter) - (@//= parameter subject))) + [parameter random + subject random + .let [equal_or_ordered! + (let [equal! + (/#= parameter subject) - (@//< subject parameter) - (not (@//= parameter subject)) + ordered! + (or (and (/#< parameter subject) + (not (/#< subject parameter))) + (and (/#< subject parameter) + (not (/#< parameter subject))))] + (bit#= equal! (not ordered!)))] - ... else - (@//= parameter subject)))) - (do random.monad - [parameter generator - subject (random.only (|>> (@//= parameter) not) - generator) + subject (random.only (|>> (/#= parameter) not) + random) extra (random.only (function (_ value) - (not (or (@//= parameter value) - (@//= subject value)))) - generator)] - (_.test "Transitive property." - (if (@//< parameter subject) - (let [greater? (and (@//< subject extra) - (@//< parameter extra)) - lesser? (and (@//< extra parameter) - (@//< extra subject)) - in_between? (and (@//< parameter extra) - (@//< extra subject))] - (or greater? - lesser? - in_between?)) - ... (@//< subject parameter) - (let [greater? (and (@//< extra subject) - (@//< extra parameter)) - lesser? (and (@//< parameter extra) - (@//< subject extra)) - in_between? (and (@//< subject extra) - (@//< extra parameter))] - (or greater? - lesser? - in_between?))))) + (not (or (/#= parameter value) + (/#= subject value)))) + random) + .let [transitive_property! + (if (/#< parameter subject) + (let [greater? (and (/#< subject extra) + (/#< parameter extra)) + lesser? (and (/#< extra parameter) + (/#< extra subject)) + in_between? (and (/#< parameter extra) + (/#< extra subject))] + (or greater? + lesser? + in_between?)) + ... (/#< subject parameter) + (let [greater? (and (/#< extra subject) + (/#< extra parameter)) + lesser? (and (/#< parameter extra) + (/#< subject extra)) + in_between? (and (/#< subject extra) + (/#< extra parameter))] + (or greater? + lesser? + in_between?)))]] + (_.coverage [/.<] + (and equal_or_ordered! + transitive_property!))) ))) diff --git a/stdlib/source/specification/lux/math/arithmetic.lux b/stdlib/source/specification/lux/math/arithmetic.lux new file mode 100644 index 000000000..7ae9f3f06 --- /dev/null +++ b/stdlib/source/specification/lux/math/arithmetic.lux @@ -0,0 +1,46 @@ +(.require + [library + [lux (.except) + [abstract + [equivalence (.only Equivalence)] + [monad (.only do)]] + [math + ["[0]" random (.only Random)]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(def .public (spec (open "[0]") (open "[0]") random) + (All (_ of) + (-> (Equivalence of) (/.Arithmetic of) (Random of) + Test)) + (do random.monad + [any random + .let [zero (- any any) + non_zero (random.only (|>> (= zero) not) + random)] + left non_zero + right non_zero + .let [one (/ right right)]] + (<| (_.covering /._) + (_.for [/.Arithmetic]) + (all _.and + (_.coverage [/.+ /.-] + (and (|> left (+ right) (- right) (= left)) + (|> left (- right) (+ right) (= left)) + (|> left (+ zero) (= left)) + (|> left (- zero) (= left)) + (|> left (- left) (= zero)))) + (_.coverage [/.* /./] + (and (|> left (* right) (/ right) (= left)) + (|> left (* one) (= left)) + (|> left (/ one) (= left)) + (|> left (/ left) (= one)) + (|> left (* zero) (= zero)))) + (_.coverage [/.%] + (let [rem (% left right) + div (|> right (- rem) (/ left))] + (= right + (|> div (* left) (+ rem))))) + )))) diff --git a/stdlib/source/test/lux/math/number/complex.lux b/stdlib/source/test/lux/math/number/complex.lux index 2b8eada59..18fbdd28e 100644 --- a/stdlib/source/test/lux/math/number/complex.lux +++ b/stdlib/source/test/lux/math/number/complex.lux @@ -9,7 +9,9 @@ [collection ["[0]" list (.use "[1]#[0]" functor)]]] [math - ["[0]" random (.only Random)]] + ["[0]" random (.only Random)] + ["[0]" arithmetic + ["[1]S" \\specification]]] [test ["_" property (.only Test)]]]] [\\library @@ -272,6 +274,8 @@ (all _.and (_.for [/.= /.equivalence] ($equivalence.spec /.equivalence ..random)) + (_.for [/.arithmetic] + (arithmeticS.spec /.equivalence /.arithmetic ..random)) ..construction ..constant diff --git a/stdlib/source/test/lux/math/number/frac.lux b/stdlib/source/test/lux/math/number/frac.lux index 9d6844441..673b04276 100644 --- a/stdlib/source/test/lux/math/number/frac.lux +++ b/stdlib/source/test/lux/math/number/frac.lux @@ -13,7 +13,9 @@ [data ["[0]" bit (.use "[1]#[0]" equivalence)]] [math - ["[0]" random (.only Random)]] + ["[0]" random (.only Random)] + ["[0]" arithmetic + ["[1]S" \\specification]]] [meta ["@" target] [macro @@ -120,6 +122,8 @@ [/.binary] [/.octal] [/.decimal] [/.hex] )) + (_.for [/.arithmetic] + (arithmeticS.spec /.equivalence /.arithmetic random.safe_frac)) ))) (with_expansions [<jvm> (these (ffi.import java/lang/Double diff --git a/stdlib/source/test/lux/math/number/int.lux b/stdlib/source/test/lux/math/number/int.lux index afb733787..46c2739e3 100644 --- a/stdlib/source/test/lux/math/number/int.lux +++ b/stdlib/source/test/lux/math/number/int.lux @@ -14,7 +14,9 @@ [data ["[0]" bit (.use "[1]#[0]" equivalence)]] [math - ["[0]" random (.only Random)]] + ["[0]" random (.only Random)] + ["[0]" arithmetic + ["[1]S" \\specification]]] [test ["_" property (.only Test)]]]] [\\library @@ -53,6 +55,8 @@ [/.binary] [/.octal] [/.decimal] [/.hex] )) + (_.for [/.arithmetic] + (arithmeticS.spec /.equivalence /.arithmetic random.int)) ))) (def predicate diff --git a/stdlib/source/test/lux/math/number/nat.lux b/stdlib/source/test/lux/math/number/nat.lux index 9ab7e63fb..aecbccf81 100644 --- a/stdlib/source/test/lux/math/number/nat.lux +++ b/stdlib/source/test/lux/math/number/nat.lux @@ -14,7 +14,9 @@ [data ["[0]" bit (.use "[1]#[0]" equivalence)]] [math - ["[0]" random]] + ["[0]" random] + ["[0]" arithmetic + ["[1]S" \\specification]]] [test ["_" property (.only Test)]]]] [\\library @@ -51,6 +53,8 @@ [/.binary] [/.octal] [/.decimal] [/.hex] )) + (_.for [/.arithmetic] + (arithmeticS.spec /.equivalence /.arithmetic random.nat)) ))) (def predicate diff --git a/stdlib/source/test/lux/math/number/ratio.lux b/stdlib/source/test/lux/math/number/ratio.lux index 74c9a9ca7..d5062806c 100644 --- a/stdlib/source/test/lux/math/number/ratio.lux +++ b/stdlib/source/test/lux/math/number/ratio.lux @@ -13,7 +13,9 @@ [data ["[0]" bit (.use "[1]#[0]" equivalence)]] [math - ["[0]" random (.only Random)]] + ["[0]" random (.only Random)] + ["[0]" arithmetic + ["[1]S" \\specification]]] [test ["_" property (.only Test)]]]] [\\library @@ -53,6 +55,8 @@ )) (_.for [/.codec] ($codec.spec /.equivalence /.codec ..random)) + (_.for [/.arithmetic] + (arithmeticS.spec /.equivalence /.arithmetic ..random)) (do random.monad [.let [(open "#[0]") /.equivalence] diff --git a/stdlib/source/test/lux/math/number/rev.lux b/stdlib/source/test/lux/math/number/rev.lux index 6f5d6a4eb..724d0112a 100644 --- a/stdlib/source/test/lux/math/number/rev.lux +++ b/stdlib/source/test/lux/math/number/rev.lux @@ -14,7 +14,9 @@ [data ["[0]" bit (.use "[1]#[0]" equivalence)]] [math - ["[0]" random]] + ["[0]" random] + ["[0]" arithmetic + ["[1]S" \\specification]]] [test ["_" property (.only Test)]]]] [\\library @@ -52,6 +54,8 @@ [/.binary] [/.octal] [/.decimal] [/.hex] )) + (_.for [/.arithmetic] + (arithmeticS.spec /.equivalence /.arithmetic random.rev)) ))) (def .public test diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index 35402d81a..d2f3cde55 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -28,7 +28,8 @@ ["[0]" unit] ["_" property (.only Test)]]]] ["[0]" / - ["[1][0]" watch]] + ["[1][0]" watch] + ["[1][0]" extension]] [\\library ["[0]" /]] [\\specification @@ -288,4 +289,5 @@ false)))) /watch.test + /extension.test )))) diff --git a/stdlib/source/test/lux/world/file/extension.lux b/stdlib/source/test/lux/world/file/extension.lux new file mode 100644 index 000000000..428933939 --- /dev/null +++ b/stdlib/source/test/lux/world/file/extension.lux @@ -0,0 +1,148 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [data + ["[0]" text] + [collection + ["[0]" list] + ["[0]" set]]] + [math + ["[0]" random (.only Random)] + [number + ["n" nat]]] + [meta + [macro + ["[0]" template]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(with_expansions [<extensions> (these [/.compressed_7z_archive] + + [/.archive] + [/.advanced_audio_coding] + [/.agda_source_code] + [/.android_application_package] + [/.assembler_source_code] + + [/.binary] + [/.bzip2_archive] + [/.blender_project] + + [/.c_source_code] + [/.c++_source_code] + [/.java_class] + [/.dos_program] + [/.c#_source_code] + [/.css] + [/.comma_separated_values] + + [/.d_source_code] + [/.dart_source_code] + + [/.emacs_lisp_source_code] + [/.compiled_emacs_lisp_code] + [/.executable_and_linkable_file] + [/.electronic_publication] + [/.erlang_source_code] + [/.executable_program] + + [/.apophysis_fractal] + + [/.gps_exchange_format] + [/.gzip_compressed_data] + + [/.http_archive_format] + [/.c_header] + [/.html] + + [/.optical_disc_file_system] + + [/.java_archive] + [/.java_source_code] + [/.javascript_source_code] + [/.javascript_object_notation] + + [/.llvm_assembly] + [/.lua_source_code] + [/.lzip_archive] + + [/.markdown] + [/.musical_instrument_digital_interface] + + [/.object_code] + [/.vorbis_audio] + + [/.portable_document_format] + [/.php_source_code] + [/.maven_build_configuration] + [/.postscript_source_code] + [/.python_source_code] + + [/.ruby_source_code] + + [/.scheme_source_code] + [/.unix_shell_script] + [/.structured_query_language] + [/.scalable_vector_graphics] + + [/.tape_archive] + [/.temporary_file] + [/.tab_separated_values] + + [/.yaml] + + [/.zip_archive])] + (def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + []) + (_.for [/.Extension]) + (`` (all _.and + (_.coverage [(,, (with_template [<extension>] + [<extension>] + + <extensions>))] + (let [options (list <extensions>) + uniques (set.of_list text.hash options)] + (n.= (list.size options) + (set.size uniques)))) + (,, (with_template [<original> <aliases>] + [(with_expansions [<aliases>' (template.spliced <aliases>)] + (`` (_.coverage [(,, (with_template [<extension>] + [<extension>] + + <aliases>'))] + (and (,, (with_template [<extension>] + [(same? <original> <extension>)] + + <aliases>'))))))] + + [/.c_source_code [[/.c]]] + [/.c++_source_code [[/.c++]]] + [/.comma_separated_values [[/.csv]]] + [/.emacs_lisp_source_code [[/.emacs_lisp]]] + [/.erlang_source_code [[/.erlang]]] + [/.java_archive [[/.jar]]] + [/.java_source_code [[/.java]]] + [/.javascript_source_code [[/.javascript] [/.js]]] + [/.javascript_object_notation [[/.json]]] + [/.lua_source_code [[/.lua]]] + [/.musical_instrument_digital_interface [[/.midi]]] + [/.vorbis_audio [[/.ogg]]] + [/.portable_document_format [[/.pdf]]] + [/.php_source_code [[/.php]]] + [/.python_source_code [[/.python]]] + [/.ruby_source_code [[/.ruby]]] + [/.scheme_source_code [[/.scheme]]] + [/.structured_query_language [[/.sql]]] + [/.scalable_vector_graphics [[/.svg]]] + [/.tape_archive [[/.tar]]] + [/.yaml [[/.yet_another_markup_language] [/.yaml_ain't_markup_language]]] + [/.zip_archive [[/.zip]]] + )) + ))))) |