aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux4
-rw-r--r--stdlib/source/lux/control/concurrency/thread.lux12
-rw-r--r--stdlib/source/lux/data/binary.lux127
-rw-r--r--stdlib/source/lux/data/collection/dictionary.lux2
-rw-r--r--stdlib/source/lux/data/collection/row.lux12
-rw-r--r--stdlib/source/lux/data/format/tar.lux2
-rw-r--r--stdlib/source/lux/host.js.lux15
-rw-r--r--stdlib/source/lux/host.py.lux38
-rw-r--r--stdlib/source/lux/math/number/frac.lux6
-rw-r--r--stdlib/source/lux/math/number/i64.lux49
-rw-r--r--stdlib/source/lux/math/number/int.lux6
-rw-r--r--stdlib/source/lux/math/number/nat.lux4
-rw-r--r--stdlib/source/lux/math/number/rev.lux8
-rw-r--r--stdlib/source/lux/math/random.lux8
-rw-r--r--stdlib/source/lux/target/jvm/encoding/signed.lux4
-rw-r--r--stdlib/source/lux/target/python.lux44
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux15
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux3
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux12
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux9
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux29
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux24
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/syntax.lux52
-rw-r--r--stdlib/source/lux/type/dynamic.lux4
-rw-r--r--stdlib/source/lux/type/implicit.lux16
-rw-r--r--stdlib/source/lux/world/file.lux59
-rw-r--r--stdlib/source/poly/lux/data/format/json.lux2
-rw-r--r--stdlib/source/program/aedifex/artifact/snapshot/version.lux71
-rw-r--r--stdlib/source/spec/lux/abstract/equivalence.lux6
-rw-r--r--stdlib/source/spec/lux/abstract/hash.lux6
-rw-r--r--stdlib/source/test/aedifex/artifact/snapshot.lux4
-rw-r--r--stdlib/source/test/aedifex/artifact/snapshot/version.lux46
-rw-r--r--stdlib/source/test/aedifex/artifact/time.lux10
-rw-r--r--stdlib/source/test/lux/data/collection/set/multi.lux348
-rw-r--r--stdlib/source/test/lux/data/format/tar.lux13
-rw-r--r--stdlib/source/test/lux/data/name.lux9
-rw-r--r--stdlib/source/test/lux/math/number/i64.lux29
-rw-r--r--stdlib/source/test/lux/math/number/int.lux28
-rw-r--r--stdlib/source/test/lux/type/dynamic.lux4
-rw-r--r--stdlib/source/test/lux/type/implicit.lux52
45 files changed, 714 insertions, 509 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index bd492b4aa..2b9d0b27e 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -2091,7 +2091,7 @@
(def:''' (high_bits value)
(list)
(-> ($' I64 Any) I64)
- ("lux i64 logical-right-shift" 32 value))
+ ("lux i64 right-shift" 32 value))
(def:''' low_mask
(list)
@@ -2167,7 +2167,7 @@
0
1)
(let' [quotient (|> subject
- ("lux i64 logical-right-shift" 1)
+ ("lux i64 right-shift" 1)
("lux i64 /" ("lux coerce" Int param))
("lux i64 left-shift" 1))
flat ("lux i64 *"
diff --git a/stdlib/source/lux/control/concurrency/thread.lux b/stdlib/source/lux/control/concurrency/thread.lux
index 9c77fc85f..2ae0afec9 100644
--- a/stdlib/source/lux/control/concurrency/thread.lux
+++ b/stdlib/source/lux/control/concurrency/thread.lux
@@ -49,7 +49,7 @@
@.python
(host.import: threading/Timer
(new [host.Float host.Function])
- (start [] #io Any))}
+ (start [] #io #? Any))}
## Default
(type: Thread
@@ -108,10 +108,12 @@
(n.frac milli_seconds)])
@.python
- (|> (host.lambda [] (io.run action))
- [(|> milli_seconds n.frac (f./ +1,000.0))]
- threading/Timer::new
- (threading/Timer::start []))}
+ (do io.monad
+ [_ (|> (host.lambda [] (io.run action))
+ [(|> milli_seconds n.frac (f./ +1,000.0))]
+ threading/Timer::new
+ (threading/Timer::start []))]
+ (wrap []))}
## Default
(do io.monad
diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux
index eb8405fc5..e74517756 100644
--- a/stdlib/source/lux/data/binary.lux
+++ b/stdlib/source/lux/data/binary.lux
@@ -1,7 +1,7 @@
(.module:
[lux (#- i64)
- ["." host]
["@" target]
+ ["." host]
[abstract
[monad (#+ do)]
[equivalence (#+ Equivalence)]
@@ -16,7 +16,7 @@
[collection
["." array]]]
[math
- [number
+ [number (#+ hex)
["n" nat]
["f" frac]
["." i64]]]])
@@ -65,11 +65,8 @@
@.jvm
(|>> .int (:coerce (primitive "java.lang.Long")) host.long_to_byte)})))]
- (for {@.old
- (as_is <jvm>)
-
- @.jvm
- (as_is <jvm>)
+ (for {@.old (as_is <jvm>)
+ @.jvm (as_is <jvm>)
@.js
(as_is (host.import: ArrayBuffer
@@ -87,11 +84,8 @@
(primitive "bytearray"))}))
(template: (!size binary)
- (for {@.old
- (host.array_length binary)
-
- @.jvm
- (host.array_length binary)
+ (for {@.old (host.array_length binary)
+ @.jvm (host.array_length binary)
@.js
(f.nat (Uint8Array::length binary))
@@ -102,11 +96,8 @@
"python array length")}))
(template: (!read idx binary)
- (for {@.old
- (..i64 (host.array_read idx binary))
-
- @.jvm
- (..i64 (host.array_read idx binary))
+ (for {@.old (..i64 (host.array_read idx binary))
+ @.jvm (..i64 (host.array_read idx binary))
@.js
(|> binary
@@ -122,11 +113,8 @@
("python array read" idx))}))
(template: (!write idx value binary)
- (for {@.old
- (host.array_write idx (..byte value) binary)
-
- @.jvm
- (host.array_write idx (..byte value) binary)
+ (for {@.old (host.array_write idx (..byte value) binary)
+ @.jvm (host.array_write idx (..byte value) binary)
@.js
(|> binary
@@ -138,7 +126,7 @@
@.python
(|> binary
(:coerce (array.Array (I64 Any)))
- ("python array write" idx (:coerce (I64 Any) value))
+ ("python array write" idx (:coerce (I64 Any) (i64.and (hex "FF") value)))
(:coerce ..Binary))}))
(def: #export size
@@ -147,17 +135,14 @@
(def: #export create
(-> Nat Binary)
- (for {@.old
- (|>> (host.array byte))
-
- @.jvm
- (|>> (host.array byte))
+ (for {@.old (|>> (host.array byte))
+ @.jvm (|>> (host.array byte))
@.js
- (|>> n.frac [] ArrayBuffer::new Uint8Array::new)
+ (|>> n.frac ArrayBuffer::new Uint8Array::new)
@.python
- (|>> ("python apply" ("python constant" "bytearray"))
+ (|>> ("python apply" (:coerce host.Function ("python constant" "bytearray")))
(:coerce Binary))}))
(def: #export (fold f init binary)
@@ -210,64 +195,58 @@
(def: #export (write/8 idx value binary)
(-> Nat (I64 Any) Binary (Try Binary))
(if (n.< (..!size binary) idx)
- (exec (|> binary
- (!write idx value))
- (#try.Success binary))
+ (#try.Success (|> binary
+ (!write idx value)))
(exception.throw ..index_out_of_bounds [(..!size binary) idx])))
(def: #export (write/16 idx value binary)
(-> Nat (I64 Any) Binary (Try Binary))
(if (n.< (..!size binary) (n.+ 1 idx))
- (exec (|> binary
- (!write idx (i64.logic_right_shift 8 value))
- (!write (n.+ 1 idx) value))
- (#try.Success binary))
+ (#try.Success (|> binary
+ (!write idx (i64.right_shift 8 value))
+ (!write (n.+ 1 idx) value)))
(exception.throw ..index_out_of_bounds [(..!size binary) idx])))
(def: #export (write/32 idx value binary)
(-> Nat (I64 Any) Binary (Try Binary))
(if (n.< (..!size binary) (n.+ 3 idx))
- (exec (|> binary
- (!write idx (i64.logic_right_shift 24 value))
- (!write (n.+ 1 idx) (i64.logic_right_shift 16 value))
- (!write (n.+ 2 idx) (i64.logic_right_shift 8 value))
- (!write (n.+ 3 idx) value))
- (#try.Success binary))
+ (#try.Success (|> binary
+ (!write idx (i64.right_shift 24 value))
+ (!write (n.+ 1 idx) (i64.right_shift 16 value))
+ (!write (n.+ 2 idx) (i64.right_shift 8 value))
+ (!write (n.+ 3 idx) value)))
(exception.throw ..index_out_of_bounds [(..!size binary) idx])))
(def: #export (write/64 idx value binary)
(-> Nat (I64 Any) Binary (Try Binary))
(if (n.< (..!size binary) (n.+ 7 idx))
- (exec (|> binary
- (!write idx (i64.logic_right_shift 56 value))
- (!write (n.+ 1 idx) (i64.logic_right_shift 48 value))
- (!write (n.+ 2 idx) (i64.logic_right_shift 40 value))
- (!write (n.+ 3 idx) (i64.logic_right_shift 32 value))
- (!write (n.+ 4 idx) (i64.logic_right_shift 24 value))
- (!write (n.+ 5 idx) (i64.logic_right_shift 16 value))
- (!write (n.+ 6 idx) (i64.logic_right_shift 8 value))
- (!write (n.+ 7 idx) value))
- (#try.Success binary))
+ (#try.Success (|> binary
+ (!write idx (i64.right_shift 56 value))
+ (!write (n.+ 1 idx) (i64.right_shift 48 value))
+ (!write (n.+ 2 idx) (i64.right_shift 40 value))
+ (!write (n.+ 3 idx) (i64.right_shift 32 value))
+ (!write (n.+ 4 idx) (i64.right_shift 24 value))
+ (!write (n.+ 5 idx) (i64.right_shift 16 value))
+ (!write (n.+ 6 idx) (i64.right_shift 8 value))
+ (!write (n.+ 7 idx) value)))
(exception.throw ..index_out_of_bounds [(..!size binary) idx])))
(structure: #export equivalence
(Equivalence Binary)
(def: (= reference sample)
- (for {@.old
- (java/util/Arrays::equals reference sample)
-
- @.jvm
- (java/util/Arrays::equals reference sample)}
- (let [limit (!size reference)]
- (and (n.= limit
- (!size sample))
- (loop [idx 0]
- (if (n.< limit idx)
- (and (n.= (!read idx reference)
- (!read idx sample))
- (recur (inc idx)))
- true)))))))
+ (with_expansions [<jvm> (java/util/Arrays::equals reference sample)]
+ (for {@.old <jvm>
+ @.jvm <jvm>}
+ (let [limit (!size reference)]
+ (and (n.= limit
+ (!size sample))
+ (loop [idx 0]
+ (if (n.< limit idx)
+ (and (n.= (!read idx reference)
+ (!read idx sample))
+ (recur (inc idx)))
+ true))))))))
(for {@.old (as_is)
@.jvm (as_is)}
@@ -286,11 +265,8 @@
(with_expansions [<jvm> (as_is (do try.monad
[_ (java/lang/System::arraycopy source (.int source_offset) target (.int target_offset) (.int bytes))]
(wrap target)))]
- (for {@.old
- <jvm>
-
- @.jvm
- <jvm>}
+ (for {@.old <jvm>
+ @.jvm <jvm>}
## Default
(let [source_input (n.- source_offset (!size source))
@@ -312,11 +288,8 @@
(if (and (n.< size from)
(n.< size to))
(with_expansions [<jvm> (as_is (#try.Success (java/util/Arrays::copyOfRange binary (.int from) (.int (inc to)))))]
- (for {@.old
- <jvm>
-
- @.jvm
- <jvm>}
+ (for {@.old <jvm>
+ @.jvm <jvm>}
## Default
(let [how_many (n.- from to)]
diff --git a/stdlib/source/lux/data/collection/dictionary.lux b/stdlib/source/lux/data/collection/dictionary.lux
index 9691c87cd..8e07a4ab4 100644
--- a/stdlib/source/lux/data/collection/dictionary.lux
+++ b/stdlib/source/lux/data/collection/dictionary.lux
@@ -168,7 +168,7 @@
(def: (level_index level hash)
(-> Level Hash_Code Index)
(i64.and hierarchy_mask
- (i64.logic_right_shift level hash)))
+ (i64.right_shift level hash)))
## A mechanism to go from indices to bit-positions.
(def: (->bit_position index)
diff --git a/stdlib/source/lux/data/collection/row.lux b/stdlib/source/lux/data/collection/row.lux
index e7780b6f9..560f7618a 100644
--- a/stdlib/source/lux/data/collection/row.lux
+++ b/stdlib/source/lux/data/collection/row.lux
@@ -77,7 +77,7 @@
(if (n.< full_node_size row_size)
0
(|> (dec row_size)
- (i64.logic_right_shift branching_exponent)
+ (i64.right_shift branching_exponent)
(i64.left_shift branching_exponent))))
(def: (new_path level tail)
@@ -95,7 +95,7 @@
(def: (push_tail size level tail parent)
(All [a] (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a)))
- (let [sub_idx (branch_idx (i64.logic_right_shift level (dec size)))
+ (let [sub_idx (branch_idx (i64.right_shift level (dec size)))
## If we're currently on a bottom node
sub_node (if (n.= branching_exponent level)
## Just add the tail to it
@@ -124,7 +124,7 @@
(def: (put' level idx val hierarchy)
(All [a] (-> Level Index a (Hierarchy a) (Hierarchy a)))
- (let [sub_idx (branch_idx (i64.logic_right_shift level idx))]
+ (let [sub_idx (branch_idx (i64.right_shift level idx))]
(case (array.read sub_idx hierarchy)
(#.Some (#Hierarchy sub_node))
(|> (array.clone hierarchy)
@@ -142,7 +142,7 @@
(def: (pop_tail size level hierarchy)
(All [a] (-> Nat Level (Hierarchy a) (Maybe (Hierarchy a))))
- (let [sub_idx (branch_idx (i64.logic_right_shift level (n.- 2 size)))]
+ (let [sub_idx (branch_idx (i64.right_shift level (n.- 2 size)))]
(cond (n.= 0 sub_idx)
#.None
@@ -208,7 +208,7 @@
## --------------------------------------------------------
## Will the root experience an overflow with this addition?
(|> (if (n.> (i64.left_shift (get@ #level row) 1)
- (i64.logic_right_shift branching_exponent row_size))
+ (i64.right_shift branching_exponent row_size))
## If so, a brand-new root must be established, that is
## 1-level taller.
(|> row
@@ -248,7 +248,7 @@
(loop [level (get@ #level row)
hierarchy (get@ #root row)]
(case [(n.> branching_exponent level)
- (array.read (branch_idx (i64.logic_right_shift level idx)) hierarchy)]
+ (array.read (branch_idx (i64.right_shift level idx)) hierarchy)]
[#1 (#.Some (#Hierarchy sub))]
(recur (level_down level) sub)
diff --git a/stdlib/source/lux/data/format/tar.lux b/stdlib/source/lux/data/format/tar.lux
index 052f35f77..598b52be6 100644
--- a/stdlib/source/lux/data/format/tar.lux
+++ b/stdlib/source/lux/data/format/tar.lux
@@ -562,7 +562,7 @@
(#Directory ..Directory)
(#Contiguous ..Contiguous))
-(type: #export Device
+(type: Device
Small)
(def: no_device
diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux
index 9b990ae07..2935f9e16 100644
--- a/stdlib/source/lux/host.js.lux
+++ b/stdlib/source/lux/host.js.lux
@@ -148,11 +148,16 @@
(def: (without_null g!temp [nullable? outputT] output)
(-> Code Nullable Code Code)
(if nullable?
- (` (let [(~ g!temp) (~ output)]
- (if ("js object null?" (~ g!temp))
- #.None
- (#.Some (~ g!temp)))))
- output))
+ (` (: (Maybe (~ outputT))
+ (let [(~ g!temp) (~ output)]
+ (if ("js object null?" (~ g!temp))
+ #.None
+ (#.Some (~ g!temp))))))
+ (` (: (~ outputT)
+ (let [(~ g!temp) (~ output)]
+ (if ("js object null?" (~ g!temp))
+ (.error "Null is an invalid value.")
+ (~ g!temp)))))))
(type: Import
(#Class [Text (List Member)])
diff --git a/stdlib/source/lux/host.py.lux b/stdlib/source/lux/host.py.lux
index ed3497df8..5405d65a5 100644
--- a/stdlib/source/lux/host.py.lux
+++ b/stdlib/source/lux/host.py.lux
@@ -32,6 +32,7 @@
[None]
[Function]
+ [Dict]
)
(template [<name> <type>]
@@ -148,11 +149,16 @@
(def: (without_none g!temp [noneable? outputT] output)
(-> Code Noneable Code Code)
(if noneable?
- (` (let [(~ g!temp) (~ output)]
- (if ("python object none?" (~ g!temp))
- #.None
- (#.Some (~ g!temp)))))
- output))
+ (` (: (Maybe (~ outputT))
+ (let [(~ g!temp) (~ output)]
+ (if ("python object none?" (~ g!temp))
+ #.None
+ (#.Some (~ g!temp))))))
+ (` (: (~ outputT)
+ (let [(~ g!temp) (~ output)]
+ (if ("python object none?" (~ g!temp))
+ (.error! "None is an invalid value!")
+ (~ g!temp)))))))
(type: Import
(#Class [Text (List Member)])
@@ -213,7 +219,7 @@
(with_try try?)
(without_none g!temp outputT)
(` ("python apply"
- (~ source)
+ (:coerce ..Function (~ source))
(~+ (list\map (with_none g!temp) g!inputs)))))))))))
(syntax: #export (import: {import ..import})
@@ -228,7 +234,8 @@
imported (case (text.split_all_with "/" class)
(#.Cons head tail)
(list\fold (function (_ sub super)
- (` ("python object get" (~ (code.text sub)) (~ super))))
+ (` ("python object get" (~ (code.text sub))
+ (:coerce (..Object .Any) (~ super)))))
(` ("python import" (~ (code.text head))))
tail)
@@ -247,27 +254,30 @@
(:assume
("python apply"
(:coerce ..Function (~ imported))
- [(~+ (list\map (with_none g!temp) g!inputs))])))))
+ (~+ (list\map (with_none g!temp) g!inputs)))))))
(#Field [static? field fieldT])
(if static?
(` ((~! syntax:) ((~ (qualify field)))
(\ (~! meta.monad) (~' wrap)
(list (` (.:coerce (~ (noneable_type fieldT))
- ("python object get" (~ (code.text field)) (~ imported))))))))
+ ("python object get" (~ (code.text field))
+ (:coerce (..Object .Any) (~ imported)))))))))
(` (def: ((~ (qualify field))
(~ g!object))
(-> (~ g!type)
(~ (noneable_type fieldT)))
(:assume
- (~ (without_none g!temp fieldT (` ("python object get" (~ (code.text field)) (~ g!object)))))))))
+ (~ (without_none g!temp fieldT (` ("python object get" (~ (code.text field))
+ (:coerce (..Object .Any) (~ g!object))))))))))
(#Method method)
(case method
(#Static [method alias inputsT io? try? outputT])
(..make_function (qualify (maybe.default method alias))
g!temp
- (` ("python object get" (~ (code.text method)) (~ imported)))
+ (` ("python object get" (~ (code.text method))
+ (:coerce (..Object .Any) (~ imported))))
inputsT
io?
try?
@@ -290,7 +300,7 @@
(` ("python object do"
(~ (code.text method))
(~ g!object)
- [(~+ (list\map (with_none g!temp) g!inputs))])))))))))))
+ (~+ (list\map (with_none g!temp) g!inputs)))))))))))))
members)))))
(#Function [name alias inputsT io? try? outputT])
@@ -303,10 +313,6 @@
outputT)))
)))
-(def: #export none
- (<| (:coerce None)
- ("python object none")))
-
(template: #export (lambda <inputs> <output>)
(.:coerce ..Function
(`` ("python function"
diff --git a/stdlib/source/lux/math/number/frac.lux b/stdlib/source/lux/math/number/frac.lux
index 599c5cbbb..ccc6bd544 100644
--- a/stdlib/source/lux/math/number/frac.lux
+++ b/stdlib/source/lux/math/number/frac.lux
@@ -121,7 +121,7 @@
(def: frac_denominator
(|> -1
- ("lux i64 logical-right-shift" ..exponent_size)
+ ("lux i64 right-shift" ..exponent_size)
"lux i64 f64"))
(def: #export rev
@@ -174,7 +174,7 @@
[(def: #export <name>
{#.doc <doc>}
(|> <constant>
- ("python apply" (:assume ("python constant" "float")))
+ ("python apply" (:coerce Nothing ("python constant" "float")))
(:coerce Frac)))]
[not_a_number "NaN" "Not a number."]
@@ -310,7 +310,7 @@
[(def: <getter>
(-> (I64 Any) I64)
(let [mask (|> 1 (//i64.left_shift <size>) dec (//i64.left_shift <offset>))]
- (|>> (//i64.and mask) (//i64.logic_right_shift <offset>) .i64)))]
+ (|>> (//i64.and mask) (//i64.right_shift <offset>) .i64)))]
[mantissa ..mantissa_size 0]
[exponent ..exponent_size ..mantissa_size]
diff --git a/stdlib/source/lux/math/number/i64.lux b/stdlib/source/lux/math/number/i64.lux
index d04a9c13a..e8dde83e0 100644
--- a/stdlib/source/lux/math/number/i64.lux
+++ b/stdlib/source/lux/math/number/i64.lux
@@ -26,22 +26,29 @@
(All [s] (-> <parameter_type> (I64 s) (I64 s)))
(<op> parameter subject))]
- [(I64 Any) or "lux i64 or" "Bitwise or."]
- [(I64 Any) xor "lux i64 xor" "Bitwise xor."]
- [(I64 Any) and "lux i64 and" "Bitwise and."]
+ [(I64 Any) or "lux i64 or" "Bitwise or."]
+ [(I64 Any) xor "lux i64 xor" "Bitwise xor."]
+ [(I64 Any) and "lux i64 and" "Bitwise and."]
- [Nat left_shift "lux i64 left-shift" "Bitwise left-shift."]
- [Nat logic_right_shift "lux i64 logical-right-shift" "Unsigned bitwise logic-right-shift."]
- [Nat arithmetic_right_shift "lux i64 arithmetic-right-shift" "Signed bitwise arithmetic-right-shift."]
+ [Nat left_shift "lux i64 left-shift" "Bitwise left-shift."]
+ [Nat right_shift "lux i64 right-shift" "Unsigned/logic bitwise right-shift."]
)
+(type: #export Mask
+ I64)
+
+(def: #export (bit position)
+ (-> Nat Mask)
+ (|> 1 .i64 (..left_shift (n.% ..width position))))
+
+(def: #export sign
+ Mask
+ (..bit (dec ..width)))
+
(def: #export not
{#.doc "Bitwise negation."}
(All [s] (-> (I64 s) (I64 s)))
- (xor (.i64 (dec 0))))
-
-(type: #export Mask
- I64)
+ (..xor (.i64 (dec 0))))
(def: #export false
Mask
@@ -59,25 +66,17 @@
0 ..true
bits (|> 1 .i64 (..left_shift (n.% ..width bits)) .dec))))
-(def: #export (bit position)
- (-> Nat Mask)
- (|> 1 .i64 (..left_shift (n.% ..width position))))
-
-(def: #export sign
- Mask
- (..bit (dec ..width)))
-
(def: (add_shift shift value)
(-> Nat Nat Nat)
- (|> value (logic_right_shift shift) (n.+ value)))
+ (|> value (right_shift shift) (n.+ value)))
(def: #export (count subject)
{#.doc "Count the number of 1s in a bit-map."}
(-> (I64 Any) Nat)
- (let [count' (n.- (|> subject (logic_right_shift 1) (..and 6148914691236517205) i64)
+ (let [count' (n.- (|> subject (right_shift 1) (..and 6148914691236517205) i64)
(i64 subject))]
(|> count'
- (logic_right_shift 2) (..and 3689348814741910323) (n.+ (..and 3689348814741910323 count'))
+ (right_shift 2) (..and 3689348814741910323) (n.+ (..and 3689348814741910323 count'))
(add_shift 4) (..and 1085102592571150095)
(add_shift 8)
(add_shift 16)
@@ -113,8 +112,8 @@
(..or (<forward> distance input)
(<backward> (n.- (n.% ..width distance) ..width) input)))]
- [rotate_left ..left_shift ..logic_right_shift]
- [rotate_right ..logic_right_shift ..left_shift]
+ [rotate_left ..left_shift ..right_shift]
+ [rotate_right ..right_shift ..left_shift]
)
(def: #export (region size offset)
@@ -166,7 +165,7 @@
high (try.assume (\ n.binary decode pattern))
low (..rotate_right size high)]
(function (_ value)
- (..or (..logic_right_shift size (..and high value))
+ (..or (..right_shift size (..and high value))
(..left_shift size (..and low value)))))))
swap/01 (swapper 0)
@@ -205,7 +204,7 @@
(def: &equivalence ..equivalence)
(def: width width)
(def: (narrow value)
- (..or (|> value (..and ..sign) (..logic_right_shift sign_shift))
+ (..or (|> value (..and ..sign) (..right_shift sign_shift))
(|> value (..and mantissa))))
(def: (widen value)
(.i64 (case (.nat (..and sign value))
diff --git a/stdlib/source/lux/math/number/int.lux b/stdlib/source/lux/math/number/int.lux
index ec4df8389..e43c5eb89 100644
--- a/stdlib/source/lux/math/number/int.lux
+++ b/stdlib/source/lux/math/number/int.lux
@@ -251,3 +251,9 @@
(def: &equivalence ..equivalence)
(def: hash .nat))
+
+(def: #export (right_shift parameter subject)
+ {#.doc "Signed/arithmetic bitwise right-shift."}
+ (-> Nat Int Int)
+ (//i64.or (//i64.and //i64.sign subject)
+ (//i64.right_shift parameter subject)))
diff --git a/stdlib/source/lux/math/number/nat.lux b/stdlib/source/lux/math/number/nat.lux
index 5d1f7a101..a9583ea8a 100644
--- a/stdlib/source/lux/math/number/nat.lux
+++ b/stdlib/source/lux/math/number/nat.lux
@@ -27,7 +27,7 @@
(def: high
(-> (I64 Any) I64)
- (|>> ("lux i64 logical-right-shift" 32)))
+ (|>> ("lux i64 right-shift" 32)))
(def: low
(-> (I64 Any) I64)
@@ -94,7 +94,7 @@
0
1)
(let [quotient (|> subject
- ("lux i64 logical-right-shift" 1)
+ ("lux i64 right-shift" 1)
("lux i64 /" ("lux coerce" Int parameter))
("lux i64 left-shift" 1))
flat ("lux i64 *"
diff --git a/stdlib/source/lux/math/number/rev.lux b/stdlib/source/lux/math/number/rev.lux
index 36436bf99..2e7975f1d 100644
--- a/stdlib/source/lux/math/number/rev.lux
+++ b/stdlib/source/lux/math/number/rev.lux
@@ -91,7 +91,7 @@
(def: high
(-> (I64 Any) I64)
- (|>> ("lux i64 logical-right-shift" 32)))
+ (|>> ("lux i64 right-shift" 32)))
(def: low
(-> (I64 Any) I64)
@@ -107,7 +107,7 @@
paramL (..low param)
bottom (|> subjectL
("lux i64 *" paramL)
- ("lux i64 logical-right-shift" 32))
+ ("lux i64 right-shift" 32))
middle ("lux i64 +"
("lux i64 *" paramL subjectH)
("lux i64 *" paramH subjectL))
@@ -122,7 +122,7 @@
(def: (even_reciprocal numerator)
(-> Nat Nat)
- (//nat./ (//i64.logic_right_shift 1 numerator)
+ (//nat./ (//i64.right_shift 1 numerator)
..even_one))
(def: (odd_reciprocal numerator)
@@ -173,7 +173,7 @@
(def: mantissa
(-> (I64 Any) Frac)
- (|>> ("lux i64 logical-right-shift" 11)
+ (|>> ("lux i64 right-shift" 11)
"lux i64 f64"))
(def: frac_denominator
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
index c4767d27f..68c33e91c 100644
--- a/stdlib/source/lux/math/random.lux
+++ b/stdlib/source/lux/math/random.lux
@@ -358,11 +358,11 @@
(let [magic 6364136223846793005]
(function (_ _)
[(|> seed .nat (n.* magic) ("lux i64 +" increase) [increase] pcg32)
- (let [rot (|> seed .i64 (i64.logic_right_shift 59))]
+ (let [rot (|> seed .i64 (i64.right_shift 59))]
(|> seed
- (i64.logic_right_shift 18)
+ (i64.right_shift 18)
(i64.xor seed)
- (i64.logic_right_shift 27)
+ (i64.right_shift 27)
(i64.rotate_right rot)
.i64))])))
@@ -386,7 +386,7 @@
(-> Nat PRNG)
(let [twist (: (-> Nat Nat Nat)
(function (_ shift value)
- (i64.xor (i64.logic_right_shift shift value)
+ (i64.xor (i64.right_shift shift value)
value)))
mix n.*]
(..prng (n.+ (hex "9E,37,79,B9,7F,4A,7C,15"))
diff --git a/stdlib/source/lux/target/jvm/encoding/signed.lux b/stdlib/source/lux/target/jvm/encoding/signed.lux
index 671cbb17d..7ce06ac28 100644
--- a/stdlib/source/lux/target/jvm/encoding/signed.lux
+++ b/stdlib/source/lux/target/jvm/encoding/signed.lux
@@ -59,8 +59,8 @@
(def: #export <constructor>
(-> Int (Try <name>))
- (let [positive (|> <bytes> (n.* i64.bits_per_byte) i64.mask .nat)
- negative (|> positive (i64.arithmetic_right_shift 1) i64.not)]
+ (let [positive (|> <bytes> (n.* i64.bits_per_byte) i64.mask)
+ negative (|> positive .int (i.right_shift 1) i64.not)]
(function (_ value)
(if (i.= (if (i.< +0 value)
(i64.or negative value)
diff --git a/stdlib/source/lux/target/python.lux b/stdlib/source/lux/target/python.lux
index 7510eac7d..700dff481 100644
--- a/stdlib/source/lux/target/python.lux
+++ b/stdlib/source/lux/target/python.lux
@@ -172,7 +172,7 @@
(-> (List a) Literal)))
(function (_ entries)
(<| :abstraction
- ..expression
+ ## ..expression
(format left_delimiter
(|> entries
(list\map entry_serializer)
@@ -191,13 +191,13 @@
(def: #export (slice from to list)
(-> (Expression Any) (Expression Any) (Expression Any) Access)
(<| :abstraction
- ..expression
+ ## ..expression
(format (:representation list) "[" (:representation from) ":" (:representation to) "]")))
(def: #export (slice_from from list)
(-> (Expression Any) (Expression Any) Access)
(<| :abstraction
- ..expression
+ ## ..expression
(format (:representation list) "[" (:representation from) ":]")))
(def: #export dict
@@ -207,7 +207,7 @@
(def: #export (apply/* func args)
(-> (Expression Any) (List (Expression Any)) (Computation Any))
(<| :abstraction
- ..expression
+ ## ..expression
(format (:representation func) "(" (text.join_with ", " (list\map ..code args)) ")")))
(template [<name> <brand> <prefix>]
@@ -223,7 +223,7 @@
[(def: #export (<name> args extra func)
(-> (List (Expression Any)) (Expression Any) (Expression Any) (Computation Any))
(<| :abstraction
- ..expression
+ ## ..expression
(format (:representation func)
(format "(" (|> args
(list\map (function (_ arg) (format (:representation arg) ", ")))
@@ -295,7 +295,7 @@
(def: #export (not subject)
(-> (Expression Any) (Computation Any))
(<| :abstraction
- ..expression
+ ## ..expression
(format "not " (:representation subject))))
(def: #export (lambda arguments body)
@@ -362,12 +362,6 @@
(-> (Expression Any) (Statement Any))
(|>> :transmutation))
- (def: #export (exec code then)
- (-> (Expression Any) (Statement Any) (Statement Any))
- (:abstraction
- (format "exec" (..expression (:representation code)) text.new_line
- (:representation then))))
-
(def: #export pass
(Statement Any)
(:abstraction "pass"))
@@ -389,17 +383,28 @@
(..nest (:representation catch!)))))
(text.join_with "")))))
- (template [<name> <keyword>]
- [(def: #export (<name> message)
+ (template [<name> <keyword> <pre>]
+ [(def: #export (<name> value)
(-> (Expression Any) (Statement Any))
(:abstraction
- (format <keyword> " " (:representation message))))]
+ (format <keyword> (<pre> (:representation value)))))]
- [raise "raise"]
- [return "return"]
- [print "print"]
+ [raise "raise " |>]
+ [return "return " |>]
+ [print "print" ..expression]
)
-
+
+ (def: #export (exec code globals)
+ (-> (Expression Any) (Maybe (Expression Any)) (Statement Any))
+ (let [extra (case globals
+ (#.Some globals)
+ (.list globals)
+
+ #.None
+ (.list))]
+ (:abstraction
+ (format "exec" (:representation (..tuple (list& code extra)))))))
+
(def: #export (def name args body)
(-> SVar (List (Ex [k] (Var k))) (Statement Any) (Statement Any))
(:abstraction
@@ -457,6 +462,7 @@
["len"]
["chr"]
["repr"]
+ ["__import__"]
["Exception"]]]
[2
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index 21fc0b343..72642db8d 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -95,12 +95,17 @@
write_artifact! (: (-> [Text Binary] (Action Any))
(function (_ [name content])
(ioW.write system static module_id name content)))]
- (do ..monad
+ (do {! ..monad}
[_ (ioW.prepare system static module_id)
- _ (|> output
- row.to_list
- (monad.map ..monad write_artifact!)
- (: (Action (List Any))))
+ _ (for {@.python (|> output
+ row.to_list
+ (list.chunk 128)
+ (monad.map ! (monad.map ! write_artifact!))
+ (: (Action (List (List Any)))))}
+ (|> output
+ row.to_list
+ (monad.map ..monad write_artifact!)
+ (: (Action (List Any)))))
document (\ promise.monad wrap
(document.check $.key document))]
(ioW.cache system static module_id
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux
index 0d18884cb..4e6a9f7ff 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux
@@ -251,8 +251,7 @@
(///bundle.install "or" (binary I64* I64* I64))
(///bundle.install "xor" (binary I64* I64* I64))
(///bundle.install "left-shift" (binary Nat I64* I64))
- (///bundle.install "logical-right-shift" (binary Nat I64* I64))
- (///bundle.install "arithmetic-right-shift" (binary Nat I64* I64))
+ (///bundle.install "right-shift" (binary Nat I64* I64))
(///bundle.install "=" (binary I64* I64* Bit))
(///bundle.install "<" (binary Int Int Bit))
(///bundle.install "+" (binary I64* I64* I64))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux
index 5c10bbc0f..78e1a4f5a 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux
@@ -119,6 +119,10 @@
(for {@.python host.Function}
Any))
+(def: Dict
+ (for {@.python host.Dict}
+ Any))
+
(def: object::get
Handler
(custom
@@ -201,13 +205,15 @@
(def: python::exec
Handler
(custom
- [<c>.any
- (function (_ extension phase archive codeC)
+ [($_ <>.and <c>.any <c>.any)
+ (function (_ extension phase archive [codeC globalsC])
(do phase.monad
[codeA (analysis/type.with_type Text
(phase archive codeC))
+ globalsA (analysis/type.with_type ..Dict
+ (phase archive globalsC))
_ (analysis/type.infer .Any)]
- (wrap (#analysis.Extension extension (list codeA)))))]))
+ (wrap (#analysis.Extension extension (list codeA globalsA)))))]))
(def: #export bundle
Bundle
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux
index 4c1ab473f..ca0e8daa9 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux
@@ -51,9 +51,8 @@
(Binary Expression)
(<op> subjectG (//runtime.i64//to_number paramG)))]
- [i64//left_shift //runtime.i64//left_shift]
- [i64//arithmetic_right_shift //runtime.i64//arithmetic_right_shift]
- [i64//logical_right_shift //runtime.i64//logic_right_shift]
+ [i64//left_shift //runtime.i64//left_shift]
+ [i64//right_shift //runtime.i64//right_shift]
)
## [[Numbers]]
@@ -139,8 +138,7 @@
(/.install "or" (binary (product.uncurry //runtime.i64//or)))
(/.install "xor" (binary (product.uncurry //runtime.i64//xor)))
(/.install "left-shift" (binary i64//left_shift))
- (/.install "logical-right-shift" (binary i64//logical_right_shift))
- (/.install "arithmetic-right-shift" (binary i64//arithmetic_right_shift))
+ (/.install "right-shift" (binary i64//right_shift))
(/.install "=" (binary (product.uncurry //runtime.i64//=)))
(/.install "<" (binary (product.uncurry //runtime.i64//<)))
(/.install "+" (binary (product.uncurry //runtime.i64//+)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux
index 630e212c3..a9251f4d6 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux
@@ -181,9 +181,8 @@
shiftG ..jvm-int
<op> (///value.wrap type.long)))]
- [i64::left-shift _.lshl]
- [i64::arithmetic-right-shift _.lshr]
- [i64::logical-right-shift _.lushr]
+ [i64::left-shift _.lshl]
+ [i64::right-shift _.lushr]
)
(template [<name> <type> <op>]
@@ -273,8 +272,7 @@
(/////bundle.install "or" (binary ..i64::or))
(/////bundle.install "xor" (binary ..i64::xor))
(/////bundle.install "left-shift" (binary ..i64::left-shift))
- (/////bundle.install "logical-right-shift" (binary ..i64::logical-right-shift))
- (/////bundle.install "arithmetic-right-shift" (binary ..i64::arithmetic-right-shift))
+ (/////bundle.install "right-shift" (binary ..i64::right-shift))
(/////bundle.install "=" (binary ..i64::=))
(/////bundle.install "<" (binary ..i64::<))
(/////bundle.install "+" (binary ..i64::+))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux
index 9657fcb66..285499f13 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux
@@ -9,7 +9,7 @@
["<s>" synthesis (#+ Parser)]]]
[data
["." product]
- [text
+ ["." text
["%" format (#+ format)]]
[collection
["." dictionary]
@@ -101,8 +101,7 @@
(/.install "or" (binary (product.uncurry //runtime.i64//or)))
(/.install "xor" (binary (product.uncurry //runtime.i64//xor)))
(/.install "left-shift" (binary (product.uncurry //runtime.i64//left_shift)))
- (/.install "logical-right-shift" (binary (product.uncurry //runtime.i64//logic_right_shift)))
- (/.install "arithmetic-right-shift" (binary (product.uncurry _.bit_shr)))
+ (/.install "right-shift" (binary (product.uncurry //runtime.i64//right_shift)))
(/.install "<" (binary (product.uncurry _.<)))
(/.install "=" (binary (product.uncurry _.=)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux
index fcf35aa99..0c1478eea 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux
@@ -142,11 +142,12 @@
(def: python::exec
(custom
- [<s>.any
- (function (_ extension phase archive codeS)
+ [($_ <>.and <s>.any <s>.any)
+ (function (_ extension phase archive [codeS globalsS])
(do {! ////////phase.monad}
- [codeG (phase archive codeS)]
- (wrap (//runtime.lux//exec codeG))))]))
+ [codeG (phase archive codeS)
+ globalsG (phase archive globalsS)]
+ (wrap (//runtime.lux//exec codeG globalsG))))]))
(def: #export bundle
Bundle
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
index c0f697584..5487cc628 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
@@ -66,7 +66,7 @@
(def: #export high
(-> (I64 Any) (I64 Any))
- (i64.logic_right_shift 32))
+ (i64.right_shift 32))
(def: #export low
(-> (I64 Any) (I64 Any))
@@ -453,7 +453,7 @@
low (|> input (_.the ..i64_high_field) (_.arithmetic_right_shift (_.- (_.i32 +32) shift)))]
(_.return (..i64 high low))))))
-(runtime: (i64//logic_right_shift input shift)
+(runtime: (i64//right_shift input shift)
($_ _.then
(..cap_shift! shift)
(_.cond (list (..no_shift! shift input)
@@ -476,7 +476,7 @@
@i64//not
@i64//left_shift
@i64//arithmetic_right_shift
- @i64//logic_right_shift
+ @i64//right_shift
))
(runtime: (i64//- parameter subject)
@@ -576,7 +576,7 @@
[(i64//= i64//min parameter)
(_.return i64//one)])
(with_vars [approximation]
- (let [subject/2 (i64//arithmetic_right_shift subject (_.i32 +1))]
+ (let [subject/2 (..i64//arithmetic_right_shift subject (_.i32 +1))]
($_ _.then
(_.define approximation (i64//left_shift (i64/// parameter
subject/2)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux
index ddaf1fe5b..a1ae27d5e 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux
@@ -93,7 +93,7 @@
[#.Right //runtime.tuple//right]))]
(method source)))
valueO
- pathP))))
+ (list.reverse pathP)))))
(def: @savepoint (_.var "lux_pm_savepoint"))
(def: @cursor (_.var "lux_pm_cursor"))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
index ef213fb2c..f32712fc2 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
@@ -155,24 +155,23 @@
(~ code)))))))))))))
(runtime: (lux//try op)
- (with_vars [error value]
- (_.try ($_ _.then
- (_.set (list value) (_.apply/* op (list unit)))
- (_.return (right value)))
- (list [(list (_.var "Exception")) error
- (_.return (left (_.str/1 error)))]))))
+ (with_vars [exception]
+ (_.try (_.return (..right (_.apply/* op (list ..unit))))
+ (list [(list (_.var "Exception")) exception
+ (_.return (..left (_.str/1 exception)))]))))
(runtime: (lux//program_args program_args)
(with_vars [inputs value]
($_ _.then
(_.set (list inputs) ..none)
- (<| (_.for_in value program_args)
+ (<| (_.for_in value (_.apply/* (_.var "reversed") (list program_args)))
(_.set (list inputs)
- (..some (_.tuple (list value inputs)))))
+ (..some (_.list (list value inputs)))))
(_.return inputs))))
-(runtime: (lux//exec code)
- (<| (_.exec code)
+(runtime: (lux//exec code globals)
+ ($_ _.then
+ (_.exec code (#.Some globals))
(_.return ..unit)))
(def: runtime//lux
@@ -304,7 +303,7 @@
..as_nat
..i64//64)))
-(runtime: (i64//logic_right_shift param subject)
+(runtime: (i64//right_shift param subject)
(_.return (|> subject
..as_nat
(_.bit_shr param))))
@@ -328,13 +327,13 @@
@i64//top
@i64//bottom
@i64//64
- @i64//left_shift
- @i64//logic_right_shift
@i64//nat_top
+ @i64//left_shift
+ @i64//right_shift
+ @i64//remainder
@i64//and
@i64//or
@i64//xor
- @i64//remainder
))
(runtime: (f64//decode input)
@@ -397,11 +396,11 @@
(Statement Any)
($_ _.then
runtime//lux
+ runtime//io
runtime//adt
runtime//i64
runtime//f64
runtime//text
- runtime//io
runtime//array
))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux
index b303a258d..6bc35147b 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux
@@ -386,13 +386,17 @@
(list\fold for_synthesis synthesis_storage environment)
(^ (/.branch/case [inputS pathS]))
- (|> synthesis_storage (for_synthesis inputS) (for_path pathS))
+ (update@ #dependencies
+ (set.union (get@ #dependencies (for_path pathS synthesis_storage)))
+ (for_synthesis inputS synthesis_storage))
(^ (/.branch/let [inputS register exprS]))
- (list\fold for_synthesis
- (update@ #bindings (set.add (#///reference/variable.Local register))
- synthesis_storage)
- (list inputS exprS))
+ (update@ #dependencies
+ (set.union (|> synthesis_storage
+ (update@ #bindings (set.add (#///reference/variable.Local register)))
+ (for_synthesis exprS)
+ (get@ #dependencies)))
+ (for_synthesis inputS synthesis_storage))
(^ (/.branch/if [testS thenS elseS]))
(list\fold for_synthesis synthesis_storage (list testS thenS elseS))
@@ -401,7 +405,15 @@
(for_synthesis whole synthesis_storage)
(^ (/.loop/scope [start initsS+ iterationS]))
- (list\fold for_synthesis synthesis_storage (#.Cons iterationS initsS+))
+ (update@ #dependencies
+ (set.union (|> synthesis_storage
+ (update@ #bindings (set.union (|> initsS+
+ list.enumeration
+ (list\map (|>> product.left (n.+ start) #///reference/variable.Local))
+ (set.from_list ///reference/variable.hash))))
+ (for_synthesis iterationS)
+ (get@ #dependencies)))
+ (list\fold for_synthesis synthesis_storage initsS+))
(^ (/.loop/recur replacementsS+))
(list\fold for_synthesis synthesis_storage replacementsS+)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux
index 4bd39b8a9..8362c7054 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux
@@ -26,6 +26,7 @@
## location, which is helpful for documentation and debugging.
(.module:
[lux #*
+ ["@" target]
[abstract
monad]
[control
@@ -48,6 +49,10 @@
["." rev]
["." frac]]]])
+(template: (inline: <declaration> <type> <body>)
+ (for {@.python (def: <declaration> <type> <body>)}
+ (template: <declaration> <body>)))
+
## TODO: Implement "lux syntax char case!" as a custom extension.
## That way, it should be possible to obtain the char without wrapping
## it into a java.lang.Long, thereby improving performance.
@@ -61,7 +66,8 @@
## producing the locations only involved building them, without any need
## for pattern-matching and de-structuring.
-(type: Char Nat)
+(type: Char
+ Nat)
(template [<name> <extension> <diff>]
[(template: (<name> value)
@@ -142,8 +148,8 @@
(def: amount_of_input_shown 64)
-(template: (input_at start input)
- ## (-> Offset Text Text)
+(inline: (input_at start input)
+ (-> Offset Text Text)
(let [end (|> start (!n/+ amount_of_input_shown) (n.min ("lux text size" input)))]
(!clip start end input)))
@@ -194,13 +200,13 @@
(!inc offset)
source_code])
-(template: (!new_line where)
- ## (-> Location Location)
+(inline: (!new_line where)
+ (-> Location Location)
(let [[where::file where::line where::column] where]
[where::file (!inc where::line) 0]))
-(template: (!forward length where)
- ## (-> Nat Location Location)
+(inline: (!forward length where)
+ (-> Nat Location Location)
(let [[where::file where::line where::column] where]
[where::file where::line (!n/+ length where::column)]))
@@ -210,8 +216,9 @@
source_code])
(template [<name> <close> <tag>]
- [(template: (<name> parse where offset source_code)
- ## (-> (Parser Code) (Parser Code))
+ [(inline: (<name> parse where offset source_code)
+ (-> (Parser Code) Location Offset Text
+ (Either [Source Text] [Source Code]))
(loop [source (: Source [(!forward 1 where) offset source_code])
stack (: (List Code) #.Nil)]
(case (parse source)
@@ -231,8 +238,9 @@
[parse_tuple ..close_tuple #.Tuple]
)
-(template: (parse_record parse where offset source_code)
- ## (-> (Parser Code) (Parser Code))
+(inline: (parse_record parse where offset source_code)
+ (-> (Parser Code) Location Offset Text
+ (Either [Source Text] [Source Code]))
(loop [source (: Source [(!forward 1 where) offset source_code])
stack (: (List [Code Code]) #.Nil)]
(case (parse source)
@@ -256,7 +264,7 @@
(exception.construct ..text_cannot_contain_new_lines content)])))
(def: (parse_text where offset source_code)
- (-> Location Nat Text (Either [Source Text] [Source Code]))
+ (-> Location Offset Text (Either [Source Text] [Source Code]))
(case ("lux text index" offset (static ..text_delimiter) source_code)
(#.Some g!end)
(<| (let [g!content (!clip offset g!end source_code)])
@@ -346,8 +354,9 @@
[..positive_sign]
[..negative_sign])]
- (template: (parse_frac source_code//size start where offset source_code)
- ## (-> Nat Offset (Parser Code))
+ (inline: (parse_frac source_code//size start where offset source_code)
+ (-> Nat Nat Location Offset Text
+ (Either [Source Text] [Source Code]))
(loop [end offset
exponent (static ..no_exponent)]
(<| (!with_char+ source_code//size source_code end char/0 <frac_output>)
@@ -370,8 +379,9 @@
<frac_output>))))
- (template: (parse_signed source_code//size start where offset source_code)
- ## (-> Nat Offset (Parser Code))
+ (inline: (parse_signed source_code//size start where offset source_code)
+ (-> Nat Nat Location Offset Text
+ (Either [Source Text] [Source Code]))
(loop [end offset]
(<| (!with_char+ source_code//size source_code end char <int_output>)
(!if_digit?+ char
@@ -384,8 +394,9 @@
)
(template [<parser> <codec> <tag>]
- [(template: (<parser> source_code//size start where offset source_code)
- ## (-> Nat Nat Location Nat Text (Either [Source Text] [Source Code]))
+ [(inline: (<parser> source_code//size start where offset source_code)
+ (-> Nat Nat Location Offset Text
+ (Either [Source Text] [Source Code]))
(loop [g!end offset]
(<| (!with_char+ source_code//size source_code g!end g!char (!number_output source_code start g!end <codec> <tag>))
(!if_digit?+ g!char
@@ -408,8 +419,9 @@
end
source_code]
(!clip start end source_code)])]
- (template: (parse_name_part start where offset source_code)
- ## (-> Offset (Parser Text))
+ (inline: (parse_name_part start where offset source_code)
+ (-> Nat Location Offset Text
+ (Either [Source Text] [Source Text]))
(let [source_code//size ("lux text size" source_code)]
(loop [end offset]
(<| (!with_char+ source_code//size source_code end char <output>)
diff --git a/stdlib/source/lux/type/dynamic.lux b/stdlib/source/lux/type/dynamic.lux
index d8b3cd3f6..d50fefc27 100644
--- a/stdlib/source/lux/type/dynamic.lux
+++ b/stdlib/source/lux/type/dynamic.lux
@@ -6,7 +6,7 @@
["." exception (#+ exception:)]]
[data
[text
- ["%" format (#+ format)]]]
+ ["%" format]]]
[macro (#+ with_gensyms)
["." syntax (#+ syntax:)]]
["." type
@@ -43,7 +43,7 @@
(#try.Success (:coerce (~ type) (~ g!value)))
((~! exception.throw) ..wrong_type [(.type (~ type)) (~ g!type)])))))))))
- (def: #export (print value)
+ (def: #export (format value)
(-> Dynamic (Try Text))
(let [[type value] (:representation value)]
(debug.represent type value)))
diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux
index d8c4fbe1f..9a6c1a832 100644
--- a/stdlib/source/lux/type/implicit.lux
+++ b/stdlib/source/lux/type/implicit.lux
@@ -146,7 +146,7 @@
(\ ! map (prepare_definitions this_module_name this_module_name)
(meta.definitions this_module_name))))
-(def: import_structs
+(def: imported_structs
(Meta (List [Name Type]))
(do {! meta.monad}
[this_module_name meta.current_module_name
@@ -238,7 +238,7 @@
($_ meta.either
(do meta.monad [alts ..local_env] (..test_provision provision context dep alts))
(do meta.monad [alts ..local_structs] (..test_provision provision context dep alts))
- (do meta.monad [alts ..import_structs] (..test_provision provision context dep alts))))
+ (do meta.monad [alts ..imported_structs] (..test_provision provision context dep alts))))
(#.Left error)
(check.fail error)
@@ -287,9 +287,9 @@
(-> Type Nat (List Type) Type (Meta (List Instance)))
(let [test (test_alternatives sig_type member_idx input_types output_type)]
($_ meta.either
- (do meta.monad [alts local_env] (test alts))
- (do meta.monad [alts local_structs] (test alts))
- (do meta.monad [alts import_structs] (test alts)))))
+ (do meta.monad [alts ..local_env] (test alts))
+ (do meta.monad [alts ..local_structs] (test alts))
+ (do meta.monad [alts ..imported_structs] (test alts)))))
(def: (var? input)
(-> Code Bit)
@@ -380,7 +380,7 @@
(Parser (List Code))
(s.tuple (p.many s.any)))
-(syntax: #export (implicit {structures ..implicits} body)
+(syntax: #export (with {structures ..implicits} body)
(do meta.monad
[g!implicit+ (implicit_bindings (list.size structures))]
(wrap (list (` (let [(~+ (|> (list.zip/2 g!implicit+ structures)
@@ -394,4 +394,6 @@
[g!implicit+ (implicit_bindings (list.size structures))]
(wrap (|> (list.zip/2 g!implicit+ structures)
(list\map (function (_ [g!implicit structure])
- (` (def: (~ g!implicit) (~ structure)))))))))
+ (` (def: (~ g!implicit)
+ {#.struct? #1}
+ (~ structure)))))))))
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index e8ebb7aac..b24f6fda4 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -680,7 +680,12 @@
(as_is (type: (Tuple/2 left right)
(primitive "python_tuple[2]" [left right]))
- (host.import: (open [host.String host.String] #io #try Any))
+ (host.import: PyFile
+ (read [] #io #try Binary)
+ (write [Binary] #io #try #? Any)
+ (close [] #io #try #? Any))
+
+ (host.import: (open [host.String host.String] #io #try PyFile))
(host.import: (tuple [[host.Integer host.Integer]] (Tuple/2 host.Integer host.Integer)))
(host.import: os
@@ -689,17 +694,17 @@
(#static W_OK host.Integer)
(#static X_OK host.Integer)
- (#static mkdir [host.String] #io #try Any)
+ (#static mkdir [host.String] #io #try #? Any)
(#static access [host.String host.Integer] #io #try host.Boolean)
- (#static remove [host.String] #io #try Any)
- (#static rmdir [host.String] #io #try Any)
- (#static rename [host.String host.String] #io #try Any)
- (#static utime [host.String (Tuple/2 host.Integer host.Integer)] #io #try Any)
+ (#static remove [host.String] #io #try #? Any)
+ (#static rmdir [host.String] #io #try #? Any)
+ (#static rename [host.String host.String] #io #try #? Any)
+ (#static utime [host.String (Tuple/2 host.Integer host.Integer)] #io #try #? Any)
(#static listdir [host.String] #io #try (Array host.String)))
(host.import: os/path
- (#static isfile [] #io #try host.Boolean)
- (#static isdir [] #io #try host.Boolean)
+ (#static isfile [host.String] #io #try host.Boolean)
+ (#static isdir [host.String] #io #try host.Boolean)
(#static sep host.String)
(#static basename [host.String] host.String)
(#static getsize [host.String] #io #try host.Integer)
@@ -713,10 +718,10 @@
(..can_modify
(function (<name> data)
(do (try.with io.monad)
- [file (..open [path <mode>])]
- (io.io (do try.monad
- [_ (host.try ("python object do" "write" (:assume file) data))]
- (host.try ("python object do" "close" (:assume file)))))))))]
+ [file (..open [path <mode>])
+ _ (PyFile::write [data] file)
+ _ (PyFile::close [] file)]
+ (wrap [])))))]
[over_write "wb"]
[append "ab"]
@@ -726,12 +731,10 @@
(..can_query
(function (_ _)
(do (try.with io.monad)
- [file (..open [path "rb"])]
- (io.io (do try.monad
- [data (:coerce (Try Binary)
- (host.try ("python object do" "read" (:assume file))))
- _ (host.try ("python object do" "close" (:assume file)))]
- (wrap data)))))))
+ [file (..open [path "rb"])
+ data (PyFile::read [] file)
+ _ (PyFile::close [] file)]
+ (wrap data)))))
(def: name
(..can_see
@@ -844,16 +847,16 @@
(def: create_file
(..can_open
(function (create_file path)
- (do io.monad
- [outcome (..open [path "x"])]
- (wrap (case outcome
- (#try.Success _)
- (do try.monad
- [_ (host.try ("python object do" "close" (:assume outcome)))]
- (wrap (..file path)))
-
- (#try.Failure error)
- (exception.throw ..cannot_create_file [path])))))))
+ (do {! io.monad}
+ [file (..open [path "x"])]
+ (case file
+ (#try.Success file)
+ (do (try.with !)
+ [_ (PyFile::close [] file)]
+ (wrap (..file path)))
+
+ (#try.Failure error)
+ (wrap (exception.throw ..cannot_create_file [path])))))))
(def: create_directory
(..can_open
diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux
index b6c14eb14..947e3666a 100644
--- a/stdlib/source/poly/lux/data/format/json.lux
+++ b/stdlib/source/poly/lux/data/format/json.lux
@@ -59,7 +59,7 @@
(codec.Codec JSON Nat)
(def: (encode input)
- (let [high (|> input (i64.and high_mask) (i64.logic_right_shift 32))
+ (let [high (|> input (i64.and high_mask) (i64.right_shift 32))
low (i64.and low_mask input)]
(#/.Array (row (|> high .int int.frac #/.Number)
(|> low .int int.frac #/.Number)))))
diff --git a/stdlib/source/program/aedifex/artifact/snapshot/version.lux b/stdlib/source/program/aedifex/artifact/snapshot/version.lux
new file mode 100644
index 000000000..905523bd0
--- /dev/null
+++ b/stdlib/source/program/aedifex/artifact/snapshot/version.lux
@@ -0,0 +1,71 @@
+(.module:
+ [lux (#- Type)
+ [abstract
+ [equivalence (#+ Equivalence)]
+ [monad (#+ do)]]
+ [control
+ ["<>" parser
+ ["<.>" xml (#+ Parser)]
+ ["<.>" text]]]
+ [data
+ ["." product]
+ ["." text]
+ [format
+ ["." xml (#+ XML)]]]]
+ ["." /// #_
+ ["#." type (#+ Type)]
+ ["#." time (#+ Time)]])
+
+(type: #export Version
+ {#extension Type
+ #value Text
+ #updated Time})
+
+(def: #export equivalence
+ (Equivalence Version)
+ ($_ product.equivalence
+ text.equivalence
+ text.equivalence
+ ///time.equivalence
+ ))
+
+(template [<definition> <tag>]
+ [(def: <definition> xml.Tag ["" <tag>])]
+
+ [<extension> "extension"]
+ [<value> "value"]
+ [<updated> "updated"]
+
+ [<snapshot_version> "snapshotVersion"]
+ )
+
+(def: (format_text tag value)
+ (-> xml.Tag Text XML)
+ (|> value #xml.Text list (#xml.Node tag xml.attributes)))
+
+(def: #export (format (^slots [#extension #value #updated]))
+ (-> Version XML)
+ (<| (#xml.Node ..<snapshot_version> xml.attributes)
+ (list (..format_text ..<extension> extension)
+ (..format_text ..<value> value)
+ (..format_text ..<updated> (///time.format updated)))))
+
+(def: (sub tag parser)
+ (All [a] (-> xml.Tag (Parser a) (Parser a)))
+ (do <>.monad
+ [_ (<xml>.node tag)]
+ (<xml>.children parser)))
+
+(def: (text tag)
+ (-> xml.Tag (Parser Text))
+ (..sub tag <xml>.text))
+
+(def: #export parser
+ (Parser Version)
+ (<| (..sub ..<snapshot_version>)
+ ($_ <>.and
+ (<xml>.somewhere (..text ..<extension>))
+ (<xml>.somewhere (..text ..<value>))
+ (<xml>.somewhere (<text>.embed ///time.parser
+ (..text ..<updated>)))
+ )))
diff --git a/stdlib/source/spec/lux/abstract/equivalence.lux b/stdlib/source/spec/lux/abstract/equivalence.lux
index 5c5114f4d..f3d97e5b6 100644
--- a/stdlib/source/spec/lux/abstract/equivalence.lux
+++ b/stdlib/source/spec/lux/abstract/equivalence.lux
@@ -8,11 +8,11 @@
{1
["." / (#+ Equivalence)]})
-(def: #export (spec (^open "_//.") generator)
+(def: #export (spec (^open "_//.") random)
(All [a] (-> (Equivalence a) (Random a) Test))
(do random.monad
- [left generator
- right generator]
+ [left random
+ right random]
(<| (_.for [/.Equivalence])
($_ _.and
(_.test "Reflexivity."
diff --git a/stdlib/source/spec/lux/abstract/hash.lux b/stdlib/source/spec/lux/abstract/hash.lux
index 17f8d12f2..543ea2a85 100644
--- a/stdlib/source/spec/lux/abstract/hash.lux
+++ b/stdlib/source/spec/lux/abstract/hash.lux
@@ -12,11 +12,11 @@
{1
["." /]})
-(def: #export (spec (^open "\.") generator)
+(def: #export (spec (^open "\.") random)
(All [a] (-> (/.Hash a) (Random a) Test))
(do random.monad
- [parameter generator
- subject generator]
+ [parameter random
+ subject random]
(_.cover [/.Hash]
(bit\= (\= parameter subject)
(n.= (\hash parameter) (\hash subject))))))
diff --git a/stdlib/source/test/aedifex/artifact/snapshot.lux b/stdlib/source/test/aedifex/artifact/snapshot.lux
index 1bdb9ca2d..371fde55e 100644
--- a/stdlib/source/test/aedifex/artifact/snapshot.lux
+++ b/stdlib/source/test/aedifex/artifact/snapshot.lux
@@ -15,7 +15,8 @@
["$." / #_
["#." build]
["#." time]
- ["#." stamp]]
+ ["#." stamp]
+ ["#." version]]
{#program
["." /]})
@@ -45,4 +46,5 @@
$/build.test
$/time.test
$/stamp.test
+ $/version.test
))))
diff --git a/stdlib/source/test/aedifex/artifact/snapshot/version.lux b/stdlib/source/test/aedifex/artifact/snapshot/version.lux
new file mode 100644
index 000000000..e08691c3c
--- /dev/null
+++ b/stdlib/source/test/aedifex/artifact/snapshot/version.lux
@@ -0,0 +1,46 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]
+ {[0 #spec]
+ [/
+ ["$." equivalence]]}]
+ [control
+ ["." try ("#\." functor)]
+ [parser
+ ["<.>" xml]]]
+ [math
+ ["." random (#+ Random)]]]
+ {#program
+ ["." /]}
+ ["$." /// #_
+ ["#." type]
+ ["#." time]])
+
+(def: #export random
+ (Random /.Version)
+ ($_ random.and
+ $///type.random
+ (random.ascii/alpha 1)
+ $///time.random
+ ))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.Version])
+ ($_ _.and
+ (_.for [/.equivalence]
+ ($equivalence.spec /.equivalence ..random))
+
+ (do random.monad
+ [expected ..random]
+ (_.cover [/.format /.parser]
+ (|> expected
+ /.format
+ list
+ (<xml>.run /.parser)
+ (try\map (\ /.equivalence = expected))
+ (try.default false))))
+ )))
diff --git a/stdlib/source/test/aedifex/artifact/time.lux b/stdlib/source/test/aedifex/artifact/time.lux
index 880bc1f83..4bf63018c 100644
--- a/stdlib/source/test/aedifex/artifact/time.lux
+++ b/stdlib/source/test/aedifex/artifact/time.lux
@@ -11,7 +11,7 @@
[parser
["<.>" text]]]
[math
- ["." random]]
+ ["." random (#+ Random)]]
[time
["." instant]]]
{#program
@@ -20,16 +20,20 @@
["#." date]
["#." time]])
+(def: #export random
+ (Random /.Time)
+ random.instant)
+
(def: #export test
Test
(<| (_.covering /._)
(_.for [/.Time])
($_ _.and
(_.for [/.equivalence]
- ($equivalence.spec /.equivalence random.instant))
+ ($equivalence.spec /.equivalence ..random))
(do random.monad
- [expected random.instant]
+ [expected ..random]
(_.cover [/.format /.parser]
(|> expected
/.format
diff --git a/stdlib/source/test/lux/data/collection/set/multi.lux b/stdlib/source/test/lux/data/collection/set/multi.lux
index 718c971c3..feea35e2f 100644
--- a/stdlib/source/test/lux/data/collection/set/multi.lux
+++ b/stdlib/source/test/lux/data/collection/set/multi.lux
@@ -36,6 +36,78 @@
(list.zip/2 element_counts
(set.to_list elements))))))
+(def: signature
+ Test
+ (do {! random.monad}
+ [diversity (\ ! map (n.% 10) random.nat)]
+ ($_ _.and
+ (_.for [/.equivalence]
+ ($equivalence.spec /.equivalence (..random diversity n.hash ..count random.nat)))
+ (_.for [/.hash]
+ (|> random.nat
+ (\ random.monad map (function (_ single)
+ (/.add 1 single (/.new n.hash))))
+ ($hash.spec /.hash)))
+ )))
+
+(def: composition
+ Test
+ (do {! random.monad}
+ [diversity (\ ! map (n.% 10) random.nat)
+ sample (..random diversity n.hash ..count random.nat)
+ another (..random diversity n.hash ..count random.nat)]
+ (`` ($_ _.and
+ (~~ (template [<name> <composition>]
+ [(_.cover [<name>]
+ (let [|sample| (/.support sample)
+ |another| (/.support another)
+ sample_only (set.difference |another| |sample|)
+ another_only (set.difference |sample| |another|)
+ common (set.intersection |sample| |another|)
+ composed (<name> sample another)
+
+ no_left_changes! (list.every? (function (_ member)
+ (n.= (/.multiplicity sample member)
+ (/.multiplicity composed member)))
+ (set.to_list sample_only))
+ no_right_changes! (list.every? (function (_ member)
+ (n.= (/.multiplicity another member)
+ (/.multiplicity composed member)))
+ (set.to_list another_only))
+ common_changes! (list.every? (function (_ member)
+ (n.= (<composition> (/.multiplicity sample member)
+ (/.multiplicity another member))
+ (/.multiplicity composed member)))
+ (set.to_list common))]
+ (and no_left_changes!
+ no_right_changes!
+ common_changes!)))]
+
+ [/.sum n.+]
+ [/.union n.max]
+ ))
+ (_.cover [/.intersection]
+ (let [|sample| (/.support sample)
+ |another| (/.support another)
+ sample_only (set.difference |another| |sample|)
+ another_only (set.difference |sample| |another|)
+ common (set.intersection |sample| |another|)
+ composed (/.intersection sample another)
+
+ left_removals! (list.every? (|>> (/.member? composed) not)
+ (set.to_list sample_only))
+ right_removals! (list.every? (|>> (/.member? composed) not)
+ (set.to_list another_only))
+ common_changes! (list.every? (function (_ member)
+ (n.= (n.min (/.multiplicity sample member)
+ (/.multiplicity another member))
+ (/.multiplicity composed member)))
+ (set.to_list common))]
+ (and left_removals!
+ right_removals!
+ common_changes!)))
+ ))))
+
(def: #export test
Test
(<| (_.covering /._)
@@ -48,175 +120,121 @@
addition_count ..count
partial_removal_count (\ ! map (n.% addition_count) random.nat)
another (..random diversity n.hash ..count random.nat)]
- (`` ($_ _.and
- (_.for [/.equivalence]
- ($equivalence.spec /.equivalence (..random diversity n.hash ..count random.nat)))
- (_.for [/.hash]
- (|> random.nat
- (\ random.monad map (function (_ single)
- (/.add 1 single (/.new n.hash))))
- ($hash.spec /.hash)))
-
- (_.cover [/.to_list /.from_list]
- (|> sample
- /.to_list
- (/.from_list n.hash)
- (\ /.equivalence = sample)))
- (_.cover [/.size]
- (n.= (list.size (/.to_list sample))
- (/.size sample)))
- (_.cover [/.empty?]
- (bit\= (/.empty? sample)
- (n.= 0 (/.size sample))))
- (_.cover [/.new]
- (/.empty? (/.new n.hash)))
- (_.cover [/.support]
- (list.every? (set.member? (/.support sample))
- (/.to_list sample)))
- (_.cover [/.member?]
- (let [non_member_is_not_identified!
- (not (/.member? sample non_member))
-
- all_members_are_identified!
- (list.every? (/.member? sample)
- (/.to_list sample))]
- (and non_member_is_not_identified!
- all_members_are_identified!)))
- (_.cover [/.multiplicity]
- (let [non_members_have_0_multiplicity!
- (n.= 0 (/.multiplicity sample non_member))
-
- every_member_has_positive_multiplicity!
- (list.every? (|>> (/.multiplicity sample) (n.> 0))
- (/.to_list sample))]
- (and non_members_have_0_multiplicity!
- every_member_has_positive_multiplicity!)))
- (_.cover [/.add]
- (let [null_scenario!
- (|> sample
- (/.add 0 non_member)
- (\ /.equivalence = sample))
+ ($_ _.and
+ (_.cover [/.to_list /.from_list]
+ (|> sample
+ /.to_list
+ (/.from_list n.hash)
+ (\ /.equivalence = sample)))
+ (_.cover [/.size]
+ (n.= (list.size (/.to_list sample))
+ (/.size sample)))
+ (_.cover [/.empty?]
+ (bit\= (/.empty? sample)
+ (n.= 0 (/.size sample))))
+ (_.cover [/.new]
+ (/.empty? (/.new n.hash)))
+ (_.cover [/.support]
+ (list.every? (set.member? (/.support sample))
+ (/.to_list sample)))
+ (_.cover [/.member?]
+ (let [non_member_is_not_identified!
+ (not (/.member? sample non_member))
- normal_scenario!
- (let [sample+ (/.add addition_count non_member sample)]
- (and (not (/.member? sample non_member))
- (/.member? sample+ non_member)
- (n.= addition_count (/.multiplicity sample+ non_member))))]
- (and null_scenario!
- normal_scenario!)))
- (_.cover [/.remove]
- (let [null_scenario!
- (\ /.equivalence =
- (|> sample
- (/.add addition_count non_member))
- (|> sample
- (/.add addition_count non_member)
- (/.remove 0 non_member)))
+ all_members_are_identified!
+ (list.every? (/.member? sample)
+ (/.to_list sample))]
+ (and non_member_is_not_identified!
+ all_members_are_identified!)))
+ (_.cover [/.multiplicity]
+ (let [non_members_have_0_multiplicity!
+ (n.= 0 (/.multiplicity sample non_member))
- partial_scenario!
- (let [sample* (|> sample
- (/.add addition_count non_member)
- (/.remove partial_removal_count non_member))]
- (and (/.member? sample* non_member)
- (n.= (n.- partial_removal_count
- addition_count)
- (/.multiplicity sample* non_member))))
+ every_member_has_positive_multiplicity!
+ (list.every? (|>> (/.multiplicity sample) (n.> 0))
+ (/.to_list sample))]
+ (and non_members_have_0_multiplicity!
+ every_member_has_positive_multiplicity!)))
+ (_.cover [/.add]
+ (let [null_scenario!
+ (|> sample
+ (/.add 0 non_member)
+ (\ /.equivalence = sample))
- total_scenario!
- (|> sample
- (/.add addition_count non_member)
- (/.remove addition_count non_member)
- (\ /.equivalence = sample))]
- (and null_scenario!
- partial_scenario!
- total_scenario!)))
- (_.cover [/.from_set]
- (let [unary (|> sample /.support /.from_set)]
- (list.every? (|>> (/.multiplicity unary) (n.= 1))
- (/.to_list unary))))
- (_.cover [/.sub?]
- (let [unary (|> sample /.support /.from_set)]
- (and (/.sub? sample unary)
- (or (not (/.sub? unary sample))
- (\ /.equivalence = sample unary)))))
- (_.cover [/.super?]
- (let [unary (|> sample /.support /.from_set)]
- (and (/.super? unary sample)
- (or (not (/.super? sample unary))
- (\ /.equivalence = sample unary)))))
- (~~ (template [<name> <composition>]
- [(_.cover [<name>]
- (let [|sample| (/.support sample)
- |another| (/.support another)
- sample_only (set.difference |another| |sample|)
- another_only (set.difference |sample| |another|)
- common (set.intersection |sample| |another|)
- composed (<name> sample another)
+ normal_scenario!
+ (let [sample+ (/.add addition_count non_member sample)]
+ (and (not (/.member? sample non_member))
+ (/.member? sample+ non_member)
+ (n.= addition_count (/.multiplicity sample+ non_member))))]
+ (and null_scenario!
+ normal_scenario!)))
+ (_.cover [/.remove]
+ (let [null_scenario!
+ (\ /.equivalence =
+ (|> sample
+ (/.add addition_count non_member))
+ (|> sample
+ (/.add addition_count non_member)
+ (/.remove 0 non_member)))
- no_left_changes! (list.every? (function (_ member)
- (n.= (/.multiplicity sample member)
- (/.multiplicity composed member)))
- (set.to_list sample_only))
- no_right_changes! (list.every? (function (_ member)
- (n.= (/.multiplicity another member)
- (/.multiplicity composed member)))
- (set.to_list another_only))
- common_changes! (list.every? (function (_ member)
- (n.= (<composition> (/.multiplicity sample member)
- (/.multiplicity another member))
- (/.multiplicity composed member)))
- (set.to_list common))]
- (and no_left_changes!
- no_right_changes!
- common_changes!)))]
+ partial_scenario!
+ (let [sample* (|> sample
+ (/.add addition_count non_member)
+ (/.remove partial_removal_count non_member))]
+ (and (/.member? sample* non_member)
+ (n.= (n.- partial_removal_count
+ addition_count)
+ (/.multiplicity sample* non_member))))
- [/.sum n.+]
- [/.union n.max]
- ))
- (_.cover [/.intersection]
- (let [|sample| (/.support sample)
- |another| (/.support another)
- sample_only (set.difference |another| |sample|)
- another_only (set.difference |sample| |another|)
- common (set.intersection |sample| |another|)
- composed (/.intersection sample another)
+ total_scenario!
+ (|> sample
+ (/.add addition_count non_member)
+ (/.remove addition_count non_member)
+ (\ /.equivalence = sample))]
+ (and null_scenario!
+ partial_scenario!
+ total_scenario!)))
+ (_.cover [/.from_set]
+ (let [unary (|> sample /.support /.from_set)]
+ (list.every? (|>> (/.multiplicity unary) (n.= 1))
+ (/.to_list unary))))
+ (_.cover [/.sub?]
+ (let [unary (|> sample /.support /.from_set)]
+ (and (/.sub? sample unary)
+ (or (not (/.sub? unary sample))
+ (\ /.equivalence = sample unary)))))
+ (_.cover [/.super?]
+ (let [unary (|> sample /.support /.from_set)]
+ (and (/.super? unary sample)
+ (or (not (/.super? sample unary))
+ (\ /.equivalence = sample unary)))))
+ (_.cover [/.difference]
+ (let [|sample| (/.support sample)
+ |another| (/.support another)
+ sample_only (set.difference |another| |sample|)
+ another_only (set.difference |sample| |another|)
+ common (set.intersection |sample| |another|)
+ composed (/.difference sample another)
- left_removals! (list.every? (|>> (/.member? composed) not)
- (set.to_list sample_only))
- right_removals! (list.every? (|>> (/.member? composed) not)
- (set.to_list another_only))
- common_changes! (list.every? (function (_ member)
- (n.= (n.min (/.multiplicity sample member)
- (/.multiplicity another member))
- (/.multiplicity composed member)))
- (set.to_list common))]
- (and left_removals!
- right_removals!
- common_changes!)))
- (_.cover [/.difference]
- (let [|sample| (/.support sample)
- |another| (/.support another)
- sample_only (set.difference |another| |sample|)
- another_only (set.difference |sample| |another|)
- common (set.intersection |sample| |another|)
- composed (/.difference sample another)
+ ommissions! (list.every? (|>> (/.member? composed) not)
+ (set.to_list sample_only))
+ intact! (list.every? (function (_ member)
+ (n.= (/.multiplicity another member)
+ (/.multiplicity composed member)))
+ (set.to_list another_only))
+ subtractions! (list.every? (function (_ member)
+ (let [sample_multiplicity (/.multiplicity sample member)
+ another_multiplicity (/.multiplicity another member)]
+ (n.= (if (n.> another_multiplicity sample_multiplicity)
+ 0
+ (n.- sample_multiplicity
+ another_multiplicity))
+ (/.multiplicity composed member))))
+ (set.to_list common))]
+ (and ommissions!
+ intact!
+ subtractions!)))
- ommissions! (list.every? (|>> (/.member? composed) not)
- (set.to_list sample_only))
- intact! (list.every? (function (_ member)
- (n.= (/.multiplicity another member)
- (/.multiplicity composed member)))
- (set.to_list another_only))
- subtractions! (list.every? (function (_ member)
- (let [sample_multiplicity (/.multiplicity sample member)
- another_multiplicity (/.multiplicity another member)]
- (n.= (if (n.> another_multiplicity sample_multiplicity)
- 0
- (n.- sample_multiplicity
- another_multiplicity))
- (/.multiplicity composed member))))
- (set.to_list common))]
- (and ommissions!
- intact!
- subtractions!)))
- )))))
+ ..signature
+ ..composition
+ ))))
diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux
index 1300012dd..10000ff52 100644
--- a/stdlib/source/test/lux/data/format/tar.lux
+++ b/stdlib/source/test/lux/data/format/tar.lux
@@ -11,7 +11,7 @@
[data
["." product]
["." maybe]
- ["." binary ("#\." equivalence)]
+ ["." binary ("#\." equivalence monoid)]
["." text ("#\." equivalence)
["%" format (#+ format)]
["." encoding]
@@ -51,6 +51,8 @@
(#try.Failure error)
false))
+ (_.cover [/.no_path]
+ (text\= "" (/.from_path /.no_path)))
(_.cover [/.path_size /.path_is_too_long]
(case (/.path invalid)
(#try.Success _)
@@ -398,6 +400,15 @@
(<b>.run /.parser)
(\ try.monad map row.empty?)
(try.default false)))
+ (_.cover [/.invalid_end_of_archive]
+ (let [dump (format.run /.writer row.empty)]
+ (case (<b>.run /.parser (binary\compose dump dump))
+ (#try.Success _)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.invalid_end_of_archive error))))
+
..path
..name
..small
diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux
index f68a58d9a..62c576d27 100644
--- a/stdlib/source/test/lux/data/name.lux
+++ b/stdlib/source/test/lux/data/name.lux
@@ -20,15 +20,10 @@
{1
["." /]})
-(def: (part size)
- (-> Nat (Random Text))
- (random.filter (|>> (text.contains? ".") not)
- (random.unicode size)))
-
(def: #export (random module_size short_size)
(-> Nat Nat (Random Name))
- (random.and (..part module_size)
- (..part short_size)))
+ (random.and (random.ascii/alpha module_size)
+ (random.ascii/alpha short_size)))
(def: #export test
Test
diff --git a/stdlib/source/test/lux/math/number/i64.lux b/stdlib/source/test/lux/math/number/i64.lux
index 43e240675..9384e08c4 100644
--- a/stdlib/source/test/lux/math/number/i64.lux
+++ b/stdlib/source/test/lux/math/number/i64.lux
@@ -48,39 +48,22 @@
[pattern random.nat]
($_ _.and
(do !
- [idx (\ ! map (n.% /.width) random.nat)]
- (_.cover [/.arithmetic_right_shift]
- (let [value (.int pattern)
-
- nullity!
- (\= pattern (/.arithmetic_right_shift 0 pattern))
-
- idempotency!
- (\= value (/.arithmetic_right_shift /.width value))
-
- sign_preservation!
- (bit\= (i.negative? value)
- (i.negative? (/.arithmetic_right_shift idx value)))]
- (and nullity!
- idempotency!
- sign_preservation!))))
- (do !
[idx (\ ! map (|>> (n.% (dec /.width)) inc) random.nat)]
- (_.cover [/.left_shift /.logic_right_shift]
+ (_.cover [/.left_shift /.right_shift]
(let [nullity!
(and (\= pattern (/.left_shift 0 pattern))
- (\= pattern (/.logic_right_shift 0 pattern)))
+ (\= pattern (/.right_shift 0 pattern)))
idempotency!
(and (\= pattern (/.left_shift /.width pattern))
- (\= pattern (/.logic_right_shift /.width pattern)))
+ (\= pattern (/.right_shift /.width pattern)))
movement!
(let [shift (n.- idx /.width)]
(\= (/.and (/.mask idx) pattern)
(|> pattern
(/.left_shift shift)
- (/.logic_right_shift shift))))]
+ (/.right_shift shift))))]
(and nullity!
idempotency!
movement!))))
@@ -123,11 +106,11 @@
0 (\= /.false (/.region size offset))
_ (\= (|> pattern
## NNNNYYYYNNNN
- (/.logic_right_shift offset)
+ (/.right_shift offset)
## ____NNNNYYYY
(/.left_shift spare)
## YYYY________
- (/.logic_right_shift spare)
+ (/.right_shift spare)
## ________YYYY
(/.left_shift offset)
## ____YYYY____
diff --git a/stdlib/source/test/lux/math/number/int.lux b/stdlib/source/test/lux/math/number/int.lux
index 3d9931ad1..c75ffb6bd 100644
--- a/stdlib/source/test/lux/math/number/int.lux
+++ b/stdlib/source/test/lux/math/number/int.lux
@@ -19,7 +19,9 @@
{1
["." /
[//
- ["f" frac]]]})
+ ["n" nat]
+ ["f" frac]
+ ["." i64]]]})
(def: signature
Test
@@ -178,6 +180,30 @@
[expected (\ ! map (/.% +1,000,000) random.int)]
(_.cover [/.frac]
(|> expected /.frac f.int (/.= expected))))
+ (do {! random.monad}
+ [pattern random.int
+ idx (\ ! map (n.% i64.width) random.nat)]
+ (_.cover [/.right_shift]
+ (let [nullity!
+ (/.= pattern (/.right_shift 0 pattern))
+
+ idempotency!
+ (/.= pattern (/.right_shift i64.width pattern))
+
+ sign_mask (i64.left_shift (dec i64.width) 1)
+ mantissa_mask (i64.not sign_mask)
+
+ sign_preservation!
+ (/.= (i64.and sign_mask pattern)
+ (i64.and sign_mask (/.right_shift idx pattern)))
+
+ mantissa_parity!
+ (/.= (i64.and mantissa_mask (i64.right_shift idx pattern))
+ (i64.and mantissa_mask (/.right_shift idx pattern)))]
+ (and nullity!
+ idempotency!
+ sign_preservation!
+ mantissa_parity!))))
..predicate
..signature
diff --git a/stdlib/source/test/lux/type/dynamic.lux b/stdlib/source/test/lux/type/dynamic.lux
index 533b7fad0..e95f68146 100644
--- a/stdlib/source/test/lux/type/dynamic.lux
+++ b/stdlib/source/test/lux/type/dynamic.lux
@@ -37,8 +37,8 @@
(#try.Failure error)
(exception.match? /.wrong_type error)))
- (_.cover [/.print]
- (case (/.print (/.:dynamic expected))
+ (_.cover [/.format]
+ (case (/.format (/.:dynamic expected))
(#try.Success actual)
(text\= (%.nat expected) actual)
diff --git a/stdlib/source/test/lux/type/implicit.lux b/stdlib/source/test/lux/type/implicit.lux
index 4978a9b3a..9ef12d3a0 100644
--- a/stdlib/source/test/lux/type/implicit.lux
+++ b/stdlib/source/test/lux/type/implicit.lux
@@ -1,10 +1,10 @@
(.module:
[lux #*
- ["%" data/text/format]
["_" test (#+ Test)]
[abstract
[equivalence (#+)]
[functor (#+)]
+ [monoid (#+)]
[monad (#+ do)]
["." enum]]
[data
@@ -18,28 +18,46 @@
{1
["." /]})
+(/.implicit: [n.multiplication])
+
(def: #export test
Test
- (<| (_.context (%.name (name_of /._)))
+ (<| (_.covering /._)
(do {! random.monad}
[#let [digit (\ ! map (n.% 10) random.nat)]
left digit
right digit
#let [start (n.min left right)
- end (n.max left right)]]
+ end (n.max left right)]
+
+ left random.nat
+ right random.nat]
($_ _.and
- (_.test "Can automatically select first-order structures."
- (let [(^open "list\.") (list.equivalence n.equivalence)]
- (and (bit\= (\ n.equivalence = left right)
- (/.\\ = left right))
- (list\= (\ list.functor map inc (enum.range n.enum start end))
- (/.\\ map inc (enum.range n.enum start end))))))
- (_.test "Can automatically select second-order structures."
- (/.\\ =
- (enum.range n.enum start end)
- (enum.range n.enum start end)))
- (_.test "Can automatically select third-order structures."
- (let [lln (/.\\ map (enum.range n.enum start)
- (enum.range n.enum start end))]
- (/.\\ = lln lln)))
+ (_.cover [/.\\]
+ (let [first_order!
+ (let [(^open "list\.") (list.equivalence n.equivalence)]
+ (and (bit\= (\ n.equivalence = left right)
+ (/.\\ = left right))
+ (list\= (\ list.functor map inc (enum.range n.enum start end))
+ (/.\\ map inc (enum.range n.enum start end)))))
+
+ second_order!
+ (/.\\ =
+ (enum.range n.enum start end)
+ (enum.range n.enum start end))
+
+ third_order!
+ (let [lln (/.\\ map (enum.range n.enum start)
+ (enum.range n.enum start end))]
+ (/.\\ = lln lln))]
+ (and first_order!
+ second_order!
+ third_order!)))
+ (_.cover [/.with]
+ (/.with [n.addition]
+ (n.= (\ n.addition compose left right)
+ (/.\\ compose left right))))
+ (_.cover [/.implicit:]
+ (n.= (\ n.multiplication compose left right)
+ (/.\\ compose left right)))
))))