From 4326d69ab717683449bf37bf8dd170c83455c0c0 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 30 Mar 2022 19:23:12 -0400 Subject: Lined-up names of "safe" binary/array defs with names of "unsafe" ones. --- .../library/lux/control/concurrency/thread.lux | 2 +- .../source/library/lux/control/parser/binary.lux | 8 +- stdlib/source/library/lux/control/thread.lux | 4 +- stdlib/source/library/lux/data/binary.lux | 22 +++--- .../source/library/lux/data/collection/array.lux | 15 ++-- stdlib/source/library/lux/data/collection/bits.lux | 10 +-- stdlib/source/library/lux/data/format/binary.lux | 42 +++++------ stdlib/source/library/lux/data/format/tar.lux | 2 +- stdlib/source/library/lux/debug.lux | 4 +- stdlib/source/library/lux/math/number/rev.lux | 4 +- .../lux/target/jvm/bytecode/instruction.lux | 88 +++++++++++----------- 11 files changed, 101 insertions(+), 100 deletions(-) (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux/control/concurrency/thread.lux b/stdlib/source/library/lux/control/concurrency/thread.lux index 3ba009a7c..db9c06846 100644 --- a/stdlib/source/library/lux/control/concurrency/thread.lux +++ b/stdlib/source/library/lux/control/concurrency/thread.lux @@ -170,7 +170,7 @@ (if started? (in []) (do ! - [_ (atom.write! true ..started?)] + [_ (atom.has! true ..started?)] (loop (again [_ []]) (do ! [threads (atom.read! ..runner)] diff --git a/stdlib/source/library/lux/control/parser/binary.lux b/stdlib/source/library/lux/control/parser/binary.lux index 015961926..0fc0350d2 100644 --- a/stdlib/source/library/lux/control/parser/binary.lux +++ b/stdlib/source/library/lux/control/parser/binary.lux @@ -85,10 +85,10 @@ {try.#Failure error} {try.#Failure error})))] - [bits/8 ..size/8 /.read/8!] - [bits/16 ..size/16 /.read/16!] - [bits/32 ..size/32 /.read/32!] - [bits/64 ..size/64 /.read/64!] + [bits/8 ..size/8 /.bytes/1] + [bits/16 ..size/16 /.bytes/2] + [bits/32 ..size/32 /.bytes/4] + [bits/64 ..size/64 /.bytes/8] ) (template [ ] diff --git a/stdlib/source/library/lux/control/thread.lux b/stdlib/source/library/lux/control/thread.lux index 95c7ddc69..4b5fdfc35 100644 --- a/stdlib/source/library/lux/control/thread.lux +++ b/stdlib/source/library/lux/control/thread.lux @@ -24,7 +24,7 @@ (All (_ a) (-> a (All (_ !) (Thread ! (Box ! a))))) (function (_ !) (|> (array.empty 1) - (array.write! 0 init) + (array.has! 0 init) abstraction))) (def: .public (read! box) @@ -51,7 +51,7 @@ (def: .public (write! value box) (All (_ a) (-> a (All (_ !) (-> (Box ! a) (Thread ! Any))))) (function (_ !) - (|> box representation (array.write! 0 value) abstraction))) + (|> box representation (array.has! 0 value) abstraction))) ) (def: .public (result thread) diff --git a/stdlib/source/library/lux/data/binary.lux b/stdlib/source/library/lux/data/binary.lux index 6cea2f879..c65ea01a7 100644 --- a/stdlib/source/library/lux/data/binary.lux +++ b/stdlib/source/library/lux/data/binary.lux @@ -27,9 +27,9 @@ (-> Binary Nat) (|>> /.size)) -(def: .public (empty size) +(def: .public empty (-> Nat Binary) - (/.empty size)) + (|>> /.empty)) (def: .public (aggregate $ init it) (All (_ a) (-> (-> I64 a a) a Binary a)) @@ -53,10 +53,10 @@ {try.#Success ( index it)} (exception.except ..index_out_of_bounds [(/.size it) index])))] - [read/8! /.bytes/1 (|>)] - [read/16! /.bytes/2 (n.+ 1)] - [read/32! /.bytes/4 (n.+ 3)] - [read/64! /.bytes/8 (n.+ 7)] + [bytes/1 /.bytes/1 (|>)] + [bytes/2 /.bytes/2 (n.+ 1)] + [bytes/4 /.bytes/4 (n.+ 3)] + [bytes/8 /.bytes/8 (n.+ 7)] ) (template [ ] @@ -66,10 +66,10 @@ {try.#Success ( index value it)} (exception.except ..index_out_of_bounds [(/.size it) index])))] - [write/8! /.with/1! (|>)] - [write/16! /.with/2! (n.+ 1)] - [write/32! /.with/4! (n.+ 3)] - [write/64! /.with/8! (n.+ 7)] + [has/1! /.has/1! (|>)] + [has/2! /.has/2! (n.+ 1)] + [has/4! /.has/4! (n.+ 3)] + [has/8! /.has/8! (n.+ 7)] ) (implementation: .public equivalence @@ -86,7 +86,7 @@ "Source input space" (%.nat source_input) "Target output space" (%.nat target_output))) -(def: .public (copy bytes source_offset source target_offset target) +(def: .public (copy! bytes source_offset source target_offset target) (-> Nat Nat Binary Nat Binary (Try Binary)) (let [source_input (n.- source_offset (/.size source)) target_output (n.- target_offset (/.size target))] diff --git a/stdlib/source/library/lux/data/collection/array.lux b/stdlib/source/library/lux/data/collection/array.lux index f3a0efe41..4a931cfae 100644 --- a/stdlib/source/library/lux/data/collection/array.lux +++ b/stdlib/source/library/lux/data/collection/array.lux @@ -13,6 +13,7 @@ ["!" \\unsafe]) (def: .public type_name + Text !.type) (type: .public Array @@ -26,19 +27,19 @@ (All (_ a) (-> (Array a) Nat)) (|>> !.size)) -(def: .public (read! index array) +(def: .public (item index array) (All (_ a) (-> Nat (Array a) (Maybe a))) (if (!.lacks? index array) {.#None} {.#Some (!.item index array)})) -(def: .public (write! index value array) +(def: .public (has! index value array) (All (_ a) (-> Nat a (Array a) (Array a))) (!.has! index value array)) -(def: .public (delete! index array) +(def: .public (lacks! index array) (All (_ a) (-> Nat (Array a) (Array a))) (!.lacks! index array)) @@ -48,12 +49,12 @@ (-> Nat (Array a) Bit)) (!.lacks? index array)) -(def: .public (contains? index array) +(def: .public (has? index array) (All (_ a) (-> Nat (Array a) Bit)) (!.has? index array)) -(def: .public (update! index $ array) +(def: .public (revised! index $ array) (All (_ a) (-> Nat (-> a a) (Array a) (Array a))) (!.revised! index $ array)) @@ -77,7 +78,7 @@ (All (_ a) (-> (Array a) Nat)) (|>> !.vacancy)) -(def: .public (filter! ? it) +(def: .public (only! ? it) (All (_ a) (-> (Predicate a) (Array a) (Array a))) (!.only! ? it)) @@ -87,7 +88,7 @@ (-> (Predicate a) (Array a) (Maybe a))) (!.example ? it)) -(def: .public (example+ ? it) +(def: .public (example' ? it) (All (_ a) (-> (-> Nat a Bit) (Array a) (Maybe [Nat a]))) (!.example' ? it)) diff --git a/stdlib/source/library/lux/data/collection/bits.lux b/stdlib/source/library/lux/data/collection/bits.lux index c6f692f52..45d3e154e 100644 --- a/stdlib/source/library/lux/data/collection/bits.lux +++ b/stdlib/source/library/lux/data/collection/bits.lux @@ -50,14 +50,14 @@ (-> Nat Bits Bit) (let [[chunk_index bit_index] (n./% chunk_size index)] (.and (n.< (array.size bits) chunk_index) - (|> (array.read! chunk_index bits) + (|> (array.item chunk_index bits) (maybe.else empty_chunk) (i64.one? bit_index))))) (def: (chunk idx bits) (-> Nat Bits Chunk) (if (n.< (array.size bits) idx) - (|> bits (array.read! idx) (maybe.else empty_chunk)) + (|> bits (array.item idx) (maybe.else empty_chunk)) empty_chunk)) (template [ ] @@ -85,7 +85,7 @@ (|> (if (same? ..empty output) (is Bits (array.empty size|output)) output) - (array.write! idx|output (.i64 chunk)) + (array.has! idx|output (.i64 chunk)) (again (-- size|output)))) output)))))] @@ -126,7 +126,7 @@ (|> (if (same? ..empty output) (is Bits (array.empty size|output)) output) - (array.write! idx (.i64 chunk)) + (array.has! idx (.i64 chunk)) (again (-- size|output))) output)))))) @@ -153,7 +153,7 @@ (|> (if (same? ..empty output) (is Bits (array.empty size|output)) output) - (array.write! idx (.i64 chunk)) + (array.has! idx (.i64 chunk)) (again (-- size|output)))) output)))))] diff --git a/stdlib/source/library/lux/data/format/binary.lux b/stdlib/source/library/lux/data/format/binary.lux index cc85465f6..1d99204b6 100644 --- a/stdlib/source/library/lux/data/format/binary.lux +++ b/stdlib/source/library/lux/data/format/binary.lux @@ -76,10 +76,10 @@ ( offset value) try.trusted)])]))] - [bits/8 /.size/8 binary.write/8!] - [bits/16 /.size/16 binary.write/16!] - [bits/32 /.size/32 binary.write/32!] - [bits/64 /.size/64 binary.write/64!] + [bits/8 /.size/8 binary.has/1!] + [bits/16 /.size/16 binary.has/2!] + [bits/32 /.size/32 binary.has/4!] + [bits/64 /.size/64 binary.has/8!] ) (def: .public (or left right) @@ -92,7 +92,7 @@ [(.++ caseS) (function (_ [offset binary]) (|> binary - (binary.write/8! offset ) + (binary.has/1! offset ) try.trusted [(.++ offset)] caseT))])]) @@ -137,11 +137,11 @@ (function (_ [offset binary]) [(n.+ size offset) (try.trusted - (binary.copy (n.min size (binary.size value)) - 0 - value - offset - binary))])])) + (binary.copy! (n.min size (binary.size value)) + 0 + value + offset + binary))])])) (template [ ] [(def: .public @@ -156,12 +156,12 @@ (try.trusted (do try.monad [_ ( offset size binary)] - (binary.copy size 0 value (n.+ offset) binary)))])]))))] + (binary.copy! size 0 value (n.+ offset) binary)))])]))))] - [binary/8 ..bits/8 /.size/8 binary.write/8!] - [binary/16 ..bits/16 /.size/16 binary.write/16!] - [binary/32 ..bits/32 /.size/32 binary.write/32!] - [binary/64 ..bits/64 /.size/64 binary.write/64!] + [binary/8 ..bits/8 /.size/8 binary.has/1!] + [binary/16 ..bits/16 /.size/16 binary.has/2!] + [binary/32 ..bits/32 /.size/32 binary.has/4!] + [binary/64 ..bits/64 /.size/64 binary.has/8!] ) (template [ ] @@ -201,10 +201,10 @@ [_ ( offset capped_count binary)] (in (mutation [(n.+ offset) binary])))))])))] - [sequence/8 /.size/8 binary.write/8!] - [sequence/16 /.size/16 binary.write/16!] - [sequence/32 /.size/32 binary.write/32!] - [sequence/64 /.size/64 binary.write/64!] + [sequence/8 /.size/8 binary.has/1!] + [sequence/16 /.size/16 binary.has/2!] + [sequence/32 /.size/32 binary.has/4!] + [sequence/64 /.size/64 binary.has/8!] ) (def: .public maybe @@ -240,7 +240,7 @@ [(.++ caseS) (function (_ [offset binary]) (|> binary - (binary.write/8! offset ) + (binary.has/1! offset ) try.trusted [(.++ offset)] caseT))])]) @@ -275,7 +275,7 @@ [(.++ caseS) (function (_ [offset binary]) (|> binary - (binary.write/8! offset ) + (binary.has/1! offset ) try.trusted [(.++ offset)] caseT))])]) diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux index 264acaf46..2f0a2b38a 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -237,7 +237,7 @@ (case end 0 {try.#Success (# utf8.codec encoded "")} _ (do try.monad - [last_char (binary.read/8! end string)] + [last_char (binary.bytes/1 end string)] (`` (case (.nat last_char) (pattern (char (~~ (static ..null)))) (again (-- end)) diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux index 14399ccad..d5ed1cff8 100644 --- a/stdlib/source/library/lux/debug.lux +++ b/stdlib/source/library/lux/debug.lux @@ -161,11 +161,11 @@ (case (ffi.as [java/lang/Object] object) {.#Some value} (let [value (as (array.Array java/lang/Object) value)] - (case (array.read! 0 value) + (case (array.item 0 value) (^.multi {.#Some tag} [(ffi.as java/lang/Integer tag) {.#Some tag}] - [[(array.read! 1 value) (array.read! 2 value)] + [[(array.item 1 value) (array.item 2 value)] [last? {.#Some choice}]]) (let [last? (case last? {.#Some _} #1 diff --git a/stdlib/source/library/lux/math/number/rev.lux b/stdlib/source/library/lux/math/number/rev.lux index 6fed06ede..cf07f2039 100644 --- a/stdlib/source/library/lux/math/number/rev.lux +++ b/stdlib/source/library/lux/math/number/rev.lux @@ -286,12 +286,12 @@ (def: (digit idx digits) (-> Nat Digits Nat) (|> digits - (array.read! idx) + (array.item idx) (maybe.else 0))) (def: digits#put! (-> Nat Nat Digits Digits) - array.write!) + array.has!) (def: (digits#times_5! idx output) (-> Nat Digits Digits) diff --git a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux index bbfdefdd4..d6717d8a9 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux @@ -79,7 +79,7 @@ (function (_ [offset binary]) [(n.+ (///unsigned.value ..opcode_size) offset) - (binary.with/1! offset opcode binary)])) + (binary.has/1! offset opcode binary)])) (def: nullary [Estimator (-> Opcode Instruction)] @@ -108,7 +108,7 @@ (function (_ [offset binary]) [(n.+ (///unsigned.value ) offset) (|> binary - (binary.with/1! offset opcode) + (binary.has/1! offset opcode) ( (n.+ (///unsigned.value ..opcode_size) offset) ( input0)))])) @@ -119,10 +119,10 @@ [(n.+ (///unsigned.value ) size) (|>> mutation (( opcode input0)))])]))] - [..size/1 unary/1 U1 binary.with/1! ///unsigned.value] - [..size/2 unary/2 U2 binary.with/2! ///unsigned.value] - [..size/2 jump/2 Jump binary.with/2! ///signed.value] - [..size/4 jump/4 Big_Jump binary.with/4! ///signed.value] + [..size/1 unary/1 U1 binary.has/1! ///unsigned.value] + [..size/2 unary/2 U2 binary.has/2! ///unsigned.value] + [..size/2 jump/2 Jump binary.has/2! ///signed.value] + [..size/4 jump/4 Big_Jump binary.has/4! ///signed.value] ) (template [ ] @@ -132,7 +132,7 @@ (function (_ [offset binary]) [(n.+ (///unsigned.value ) offset) (|> binary - (binary.with/1! offset opcode) + (binary.has/1! offset opcode) ( (n.+ (///unsigned.value ..opcode_size) offset) (///signed.value input0)))])) @@ -143,8 +143,8 @@ [(n.+ (///unsigned.value ) size) (|>> mutation (( opcode input0)))])]))] - [..size/1 unary/1' S1 binary.with/1!] - [..size/2 unary/2' S2 binary.with/2!] + [..size/1 unary/1' S1 binary.has/1!] + [..size/2 unary/2' S2 binary.has/2!] ) (def: size/11 @@ -158,11 +158,11 @@ (function (_ [offset binary]) [(n.+ (///unsigned.value ..size/11) offset) (|> binary - (binary.with/1! offset opcode) - (binary.with/1! (n.+ (///unsigned.value ..opcode_size) offset) - (///unsigned.value input0)) - (binary.with/1! (n.+ (///unsigned.value ..size/1) offset) - (///unsigned.value input1)))])) + (binary.has/1! offset opcode) + (binary.has/1! (n.+ (///unsigned.value ..opcode_size) offset) + (///unsigned.value input0)) + (binary.has/1! (n.+ (///unsigned.value ..size/1) offset) + (///unsigned.value input1)))])) (def: binary/11 [Estimator (-> Opcode U1 U1 Instruction)] @@ -182,11 +182,11 @@ (function (_ [offset binary]) [(n.+ (///unsigned.value ..size/21) offset) (|> binary - (binary.with/1! offset opcode) - (binary.with/2! (n.+ (///unsigned.value ..opcode_size) offset) - (///unsigned.value input0)) - (binary.with/1! (n.+ (///unsigned.value ..size/2) offset) - (///unsigned.value input1)))])) + (binary.has/1! offset opcode) + (binary.has/2! (n.+ (///unsigned.value ..opcode_size) offset) + (///unsigned.value input0)) + (binary.has/1! (n.+ (///unsigned.value ..size/2) offset) + (///unsigned.value input1)))])) (def: binary/21 [Estimator (-> Opcode U2 U1 Instruction)] @@ -207,13 +207,13 @@ (function (_ [offset binary]) [(n.+ (///unsigned.value ..size/211) offset) (|> binary - (binary.with/1! offset opcode) - (binary.with/2! (n.+ (///unsigned.value ..opcode_size) offset) - (///unsigned.value input0)) - (binary.with/1! (n.+ (///unsigned.value ..size/2) offset) - (///unsigned.value input1)) - (binary.with/1! (n.+ (///unsigned.value ..size/21) offset) - (///unsigned.value input2)))])) + (binary.has/1! offset opcode) + (binary.has/2! (n.+ (///unsigned.value ..opcode_size) offset) + (///unsigned.value input0)) + (binary.has/1! (n.+ (///unsigned.value ..size/2) offset) + (///unsigned.value input1)) + (binary.has/1! (n.+ (///unsigned.value ..size/21) offset) + (///unsigned.value input2)))])) (def: trinary/211 [Estimator (-> Opcode U2 U1 U1 Instruction)] @@ -606,21 +606,21 @@ (do [! try.monad] [amount_of_afterwards (|> amount_of_afterwards .int ///signed.s4) maximum (///signed.+/4 minimum amount_of_afterwards)] - (in (let [_ (binary.with/1! offset (hex "AA") binary) + (in (let [_ (binary.has/1! offset (hex "AA") binary) offset (n.+ (///unsigned.value ..opcode_size) offset) _ (case padding 3 (|> binary - (binary.with/1! offset 0) - (binary.with/2! (++ offset) 0)) - 2 (binary.with/2! offset 0 binary) - 1 (binary.with/1! offset 0 binary) + (binary.has/1! offset 0) + (binary.has/2! (++ offset) 0)) + 2 (binary.has/2! offset 0 binary) + 1 (binary.has/1! offset 0 binary) _ binary) offset (n.+ padding offset) - _ (binary.with/4! offset (///signed.value default) binary) + _ (binary.has/4! offset (///signed.value default) binary) offset (n.+ (///unsigned.value ..big_jump_size) offset) - _ (binary.with/4! offset (///signed.value minimum) binary) + _ (binary.has/4! offset (///signed.value minimum) binary) offset (n.+ (///unsigned.value ..integer_size) offset) - _ (binary.with/4! offset (///signed.value maximum) binary)] + _ (binary.has/4! offset (///signed.value maximum) binary)] (loop (again [offset (n.+ (///unsigned.value ..integer_size) offset) afterwards (is (List Big_Jump) {.#Item at_minimum afterwards})]) @@ -630,7 +630,7 @@ {.#Item head tail} (exec - (binary.with/4! offset (///signed.value head) binary) + (binary.has/4! offset (///signed.value head) binary) (again (n.+ (///unsigned.value ..big_jump_size) offset) tail))))))))]))] [(n.+ tableswitch_size @@ -666,19 +666,19 @@ lookupswitch_mutation (is Mutation (function (_ [offset binary]) [(n.+ lookupswitch_size offset) - (let [_ (binary.with/1! offset (hex "AB") binary) + (let [_ (binary.has/1! offset (hex "AB") binary) offset (n.+ (///unsigned.value ..opcode_size) offset) _ (case padding 3 (|> binary - (binary.with/1! offset 0) - (binary.with/2! (++ offset) 0)) - 2 (binary.with/2! offset 0 binary) - 1 (binary.with/1! offset 0 binary) + (binary.has/1! offset 0) + (binary.has/2! (++ offset) 0)) + 2 (binary.has/2! offset 0 binary) + 1 (binary.has/1! offset 0 binary) _ binary) offset (n.+ padding offset) - _ (binary.with/4! offset (///signed.value default) binary) + _ (binary.has/4! offset (///signed.value default) binary) offset (n.+ (///unsigned.value ..big_jump_size) offset) - _ (binary.with/4! offset amount_of_cases binary)] + _ (binary.has/4! offset amount_of_cases binary)] (loop (again [offset (n.+ (///unsigned.value ..integer_size) offset) cases cases]) (case cases @@ -687,8 +687,8 @@ {.#Item [value jump] tail} (exec - (binary.with/4! offset (///signed.value value) binary) - (binary.with/4! (n.+ (///unsigned.value ..integer_size) offset) (///signed.value jump) binary) + (binary.has/4! offset (///signed.value value) binary) + (binary.has/4! (n.+ (///unsigned.value ..integer_size) offset) (///signed.value jump) binary) (again (n.+ case_size offset) tail)))))]))] [(n.+ lookupswitch_size -- cgit v1.2.3