diff options
Diffstat (limited to 'stdlib/source')
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))) )))) |