diff options
Diffstat (limited to 'stdlib')
5 files changed, 28 insertions, 153 deletions
diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux index 3272f8a29..24f22df3c 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux @@ -9,7 +9,6 @@ format] [collection ["." list ("list/." Functor<List>)] - ["." array] ["dict" dictionary (#+ Dictionary)]]] [type ["." check]] @@ -203,41 +202,6 @@ (bundle.install "clip" (trinary Text Nat Nat (type (Maybe Text)))) ))) -(def: array::get - Handler - (function (_ extension-name analyse args) - (do ////.Monad<Operation> - [[var-id varT] (typeA.with-env check.var)] - ((binary (type (Array varT)) Nat (type (Maybe varT)) extension-name) - analyse args)))) - -(def: array::put - Handler - (function (_ extension-name analyse args) - (do ////.Monad<Operation> - [[var-id varT] (typeA.with-env check.var)] - ((trinary (type (Array varT)) Nat varT (type (Array varT)) extension-name) - analyse args)))) - -(def: array::remove - Handler - (function (_ extension-name analyse args) - (do ////.Monad<Operation> - [[var-id varT] (typeA.with-env check.var)] - ((binary (type (Array varT)) Nat (type (Array varT)) extension-name) - analyse args)))) - -(def: bundle::array - Bundle - (<| (bundle.prefix "array") - (|> bundle.empty - (bundle.install "new" (unary Nat Array)) - (bundle.install "get" array::get) - (bundle.install "put" array::put) - (bundle.install "remove" array::remove) - (bundle.install "size" (unary (type (Ex [a] (Array a))) Nat)) - ))) - (def: box::new Handler (function (_ extension-name analyse args) @@ -289,7 +253,6 @@ (dict.merge bundle::int) (dict.merge bundle::frac) (dict.merge bundle::text) - (dict.merge bundle::array) (dict.merge bundle::box) (dict.merge bundle::io) ))) diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux index d1576248d..c46a5e82e 100644 --- a/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux +++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux @@ -115,34 +115,6 @@ (bundle.install "arithmetic-right-shift" (binary bit::arithmetic-right-shift)) ))) -## [[Arrays]] -(def: (array::new size0) - Unary - (_.make-vector/2 size0 _.nil)) - -(def: (array::get [arrayO idxO]) - Binary - (runtime.array//get arrayO idxO)) - -(def: (array::put [arrayO idxO elemO]) - Trinary - (runtime.array//put arrayO idxO elemO)) - -(def: (array::remove [arrayO idxO]) - Binary - (runtime.array//put arrayO idxO _.nil)) - -(def: bundle::array - Bundle - (<| (bundle.prefix "array") - (|> bundle.empty - (bundle.install "new" (unary array::new)) - (bundle.install "get" (binary array::get)) - (bundle.install "put" (trinary array::put)) - (bundle.install "remove" (binary array::remove)) - (bundle.install "size" (unary _.vector-length/1)) - ))) - ## [[Numbers]] (import: java/lang/Double (#static MIN_VALUE Double) @@ -299,7 +271,6 @@ (dict.merge bundle::int) (dict.merge bundle::frac) (dict.merge bundle::text) - (dict.merge bundle::array) (dict.merge bundle::io) (dict.merge bundle::box) ))) diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux index 1d64511a9..09fe50412 100644 --- a/stdlib/source/lux/data/collection/array.lux +++ b/stdlib/source/lux/data/collection/array.lux @@ -7,32 +7,46 @@ fold [predicate (#+ Predicate)]] [data + ["." product] [collection - ["." list ("list/." Fold<List>)]] - ["." product]]]) + ["." list ("list/." Fold<List>)]]] + [compiler + ["." host]]]) (def: #export (new size) (All [a] (-> Nat (Array a))) - ("lux array new" size)) + (`` (for {(~~ (static host.jvm)) + (:assume ("jvm anewarray" "(java.lang.Object )" size))}))) (def: #export (size xs) (All [a] (-> (Array a) Nat)) - ("lux array size" xs)) + (`` (for {(~~ (static host.jvm)) + ("jvm arraylength" xs)}))) (def: #export (read i xs) (All [a] (-> Nat (Array a) (Maybe a))) - ("lux array get" xs i)) + (if (n/< (size xs) i) + (`` (for {(~~ (static host.jvm)) + (let [value ("jvm aaload" xs i)] + (if ("jvm object null?" value) + #.None + (#.Some value)))})) + #.None)) (def: #export (write i x xs) (All [a] (-> Nat a (Array a) (Array a))) - ("lux array put" xs i x)) + (`` (for {(~~ (static host.jvm)) + ("jvm aastore" xs i x)}))) (def: #export (delete i xs) (All [a] (-> Nat (Array a) (Array a))) - ("lux array remove" xs i)) + (if (n/< (size xs) i) + (`` (for {(~~ (static host.jvm)) + (write i (:assume ("jvm object null")) xs)})) + xs)) (def: #export (copy length src-start src-array dest-start dest-array) (All [a] diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index 583a03b1f..2fc52ae41 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -12,7 +12,9 @@ [data ["." error (#+ Error)] ["." maybe] - ["." text]] + ["." text] + [collection + ["." array]]] ["." math]] [/ ["." i64]]) @@ -750,15 +752,15 @@ (def: (make-digits _) (-> Any Digits) - ("lux array new" i64.width)) + (array.new i64.width)) (def: (digits-get idx digits) (-> Nat Digits Nat) - (maybe.default 0 ("lux array get" digits idx))) + (|> digits (array.read idx) (maybe.default 0))) -(def: (digits-put idx digit digits) +(def: digits-put (-> Nat Nat Digits Digits) - ("lux array put" digits idx digit)) + array.write) (def: (prepend left right) (-> Text Text Text) diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux index 9d733912e..20eeaf2eb 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux @@ -170,81 +170,6 @@ (check-success+ "lux text clip" (list subjectC fromC toC) (type (Maybe Text)))) )))) -(context: "Array procedures" - (<| (times 100) - (do @ - [[elemT elemC] _primitive.primitive - sizeC (|> r.nat (:: @ map code.nat)) - idxC (|> r.nat (:: @ map code.nat)) - var-name (r.unicode 5) - #let [arrayT (type (Array elemT)) - g!array (code.local-identifier var-name) - array-operation (function (_ output-type code) - (|> (scope.with-scope "" - (scope.with-local [var-name arrayT] - (typeA.with-type output-type - (_primitive.analyse code)))) - (phase.run [analysisE.bundle (init.compiler [])]) - (case> (#e.Success _) - #1 - - (#e.Error error) - #0)))]] - ($_ seq - (test "Can create arrays." - (check-success+ "lux array new" (list sizeC) arrayT)) - (test "Can get a value inside an array." - (array-operation (type (Maybe elemT)) - (` ("lux array get" (~ g!array) (~ idxC))))) - (test "Can put a value inside an array." - (array-operation arrayT - (` ("lux array put" (~ g!array) (~ idxC) (~ elemC))))) - (test "Can remove a value from an array." - (array-operation arrayT - (` ("lux array remove" (~ g!array) (~ idxC))))) - (test "Can query the size of an array." - (array-operation Nat - (` ("lux array size" (~ g!array))))) - )))) - -(context: "Atom procedures" - (<| (times 100) - (do @ - [[elemT elemC] _primitive.primitive - sizeC (|> r.nat (:: @ map code.nat)) - idxC (|> r.nat (:: @ map code.nat)) - var-name (r.unicode 5) - #let [atomT (type (atom.Atom elemT))]] - ($_ seq - (test "Can create atomic reference." - (check-success+ "lux atom new" (list elemC) atomT)) - (test "Can read the value of an atomic reference." - (|> (scope.with-scope "" - (scope.with-local [var-name atomT] - (typeA.with-type elemT - (_primitive.analyse (` ("lux atom read" (~ (code.identifier ["" var-name])))))))) - (phase.run [analysisE.bundle (init.compiler [])]) - (case> (#e.Success _) - #1 - - (#e.Error _) - #0))) - (test "Can swap the value of an atomic reference." - (|> (scope.with-scope "" - (scope.with-local [var-name atomT] - (typeA.with-type Bit - (_primitive.analyse (` ("lux atom compare-and-swap" - (~ (code.identifier ["" var-name])) - (~ elemC) - (~ elemC))))))) - (phase.run [analysisE.bundle (init.compiler [])]) - (case> (#e.Success _) - #1 - - (#e.Error _) - #0))) - )))) - (context: "IO procedures" (<| (times 100) (do @ |