aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/library/lux/data/collection/sequence.lux148
-rw-r--r--stdlib/source/library/lux/data/format/tar.lux31
-rw-r--r--stdlib/source/library/lux/math/arithmetic.lux22
-rw-r--r--stdlib/source/library/lux/math/number/complex.lux103
-rw-r--r--stdlib/source/library/lux/math/number/frac.lux175
-rw-r--r--stdlib/source/library/lux/math/number/int.lux70
-rw-r--r--stdlib/source/library/lux/math/number/nat.lux91
-rw-r--r--stdlib/source/library/lux/math/number/ratio.lux55
-rw-r--r--stdlib/source/library/lux/math/number/rev.lux106
-rw-r--r--stdlib/source/library/lux/meta/compiler/default/platform.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux48
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/translation.lux4
-rw-r--r--stdlib/source/library/lux/meta/compiler/meta/archive/artifact/category.lux17
-rw-r--r--stdlib/source/library/lux/meta/compiler/meta/archive/registry.lux20
-rw-r--r--stdlib/source/library/lux/meta/compiler/meta/io/archive.lux218
-rw-r--r--stdlib/source/library/lux/world/file/extension.lux108
16 files changed, 758 insertions, 460 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]]]
+ )