diff options
Diffstat (limited to '')
4 files changed, 50 insertions, 101 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 437a54bbc..ea5215a55 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux @@ -4,8 +4,6 @@ ["." monad (#+ do)] ["ex" exception (#+ exception:)] [thread (#+ Box)]] - [concurrency - [atom (#+ Atom)]] [data ["." text format] @@ -240,46 +238,6 @@ (bundle.install "size" (unary (type (Ex [a] (Array a))) Nat)) ))) -(def: atom::new - Handler - (function (_ extension-name analyse args) - (case args - (^ (list initC)) - (do ////.Monad<Operation> - [[var-id varT] (typeA.with-env check.var) - _ (typeA.infer (type (Atom varT))) - initA (typeA.with-type varT - (analyse initC))] - (wrap (#analysis.Extension extension-name (list initA)))) - - _ - (////.throw bundle.incorrect-arity [extension-name 1 (list.size args)])))) - -(def: atom::read - Handler - (function (_ extension-name analyse args) - (do ////.Monad<Operation> - [[var-id varT] (typeA.with-env check.var)] - ((unary (type (Atom varT)) varT extension-name) - analyse args)))) - -(def: atom::compare-and-swap - Handler - (function (_ extension-name analyse args) - (do ////.Monad<Operation> - [[var-id varT] (typeA.with-env check.var)] - ((trinary (type (Atom varT)) varT varT Bit extension-name) - analyse args)))) - -(def: bundle::atom - Bundle - (<| (bundle.prefix "atom") - (|> bundle.empty - (bundle.install "new" atom::new) - (bundle.install "read" atom::read) - (bundle.install "compare-and-swap" atom::compare-and-swap) - ))) - (def: box::new Handler (function (_ extension-name analyse args) @@ -340,7 +298,6 @@ (dict.merge bundle::frac) (dict.merge bundle::text) (dict.merge bundle::array) - (dict.merge bundle::atom) (dict.merge bundle::box) (dict.merge bundle::process) (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 a508dfabd..3aa2b453d 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 @@ -269,28 +269,15 @@ (bundle.install "exit" (unary _.exit/1)) (bundle.install "current-time" (nullary (function (_ _) (runtime.io//current-time (_.string synthesis.unit)))))))) -## [[Atoms]] -(def: atom::new +## [[Box]] +(def: box::new Unary (|>> (list) _.vector/*)) -(def: (atom::read atom) +(def: (box::read box) Unary - (_.vector-ref/2 atom (_.int +0))) - -(def: (atom::compare-and-swap [atomO oldO newO]) - Trinary - (runtime.atom//compare-and-swap atomO oldO newO)) + (_.vector-ref/2 box (_.int +0))) -(def: bundle::atom - Bundle - (<| (bundle.prefix "atom") - (|> bundle.empty - (bundle.install "new" (unary atom::new)) - (bundle.install "read" (unary atom::read)) - (bundle.install "compare-and-swap" (trinary atom::compare-and-swap))))) - -## [[Box]] (def: (box::write [valueO boxO]) Binary (runtime.box//write valueO boxO)) @@ -299,8 +286,8 @@ Bundle (<| (bundle.prefix "box") (|> bundle.empty - (bundle.install "new" (unary atom::new)) - (bundle.install "read" (unary atom::read)) + (bundle.install "new" (unary box::new)) + (bundle.install "read" (unary box::read)) (bundle.install "write" (binary box::write))))) ## [[Processes]] @@ -327,7 +314,6 @@ (dict.merge bundle::text) (dict.merge bundle::array) (dict.merge bundle::io) - (dict.merge bundle::atom) (dict.merge bundle::box) (dict.merge bundle::process) ))) diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/runtime.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/runtime.jvm.lux index 2ec83227d..0e082a5d8 100644 --- a/stdlib/source/lux/compiler/default/phase/translation/scheme/runtime.jvm.lux +++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/runtime.jvm.lux @@ -284,19 +284,6 @@ (list @@array//get @@array//put))) -(runtime: (atom//compare-and-swap atom old new) - (with-vars [@temp] - (_.let (list [@temp (_.vector-ref/2 atom (_.int +0))]) - (_.if (_.eq?/2 old @temp) - (_.begin - (list (_.vector-set!/3 atom (_.int +0) new) - (_.bool #1))) - (_.bool #0))))) - -(def: runtime//atom - Computation - @@atom//compare-and-swap) - (runtime: (box//write value box) (_.begin (list @@ -360,7 +347,6 @@ runtime//adt runtime//frac runtime//array - runtime//atom runtime//box runtime//io runtime//process diff --git a/stdlib/source/lux/concurrency/atom.lux b/stdlib/source/lux/concurrency/atom.lux index f81eafc22..b0c016a12 100644 --- a/stdlib/source/lux/concurrency/atom.lux +++ b/stdlib/source/lux/concurrency/atom.lux @@ -1,26 +1,44 @@ (.module: [lux #* + [control + [monad (#+ do)]] ["." function] - [io (#- run)]]) - -(type: #export (Atom a) - {#.doc "Atomic references that are safe to mutate concurrently."} - (#.Primitive "#Atom" (#.Cons a #.Nil))) - -(def: #export (atom value) - (All [a] (-> a (Atom a))) - ("lux atom new" value)) - -(def: #export (read atom) - (All [a] (-> (Atom a) (IO a))) - (io ("lux atom read" atom))) - -(def: #export (compare-and-swap current new atom) - {#.doc "Only mutates an atom if you can present it's current value. + ["." io (#- run)] + [type + abstract] + [compiler + ["." host]] + [host (#+ import:)]]) + +(`` (for {(~~ (static host.jvm)) + (import: (java/util/concurrent/atomic/AtomicReference a) + (new [a]) + (get [] a) + (compareAndSet [a a] boolean))})) + +(`` (abstract: #export (Atom a) + {#.doc "Atomic references that are safe to mutate concurrently."} + + (for {(~~ (static host.jvm)) + (AtomicReference a)}) + + (def: #export (atom value) + (All [a] (-> a (Atom a))) + (:abstraction (for {(~~ (static host.jvm)) + (AtomicReference::new [value])}))) + + (def: #export (read atom) + (All [a] (-> (Atom a) (IO a))) + (io (for {(~~ (static host.jvm)) + (AtomicReference::get [] (:representation atom))}))) + + (def: #export (compare-and-swap current new atom) + {#.doc "Only mutates an atom if you can present it's current value. That guarantees that atom was not updated since you last read from it."} - (All [a] (-> a a (Atom a) (IO Bit))) - (io ("lux atom compare-and-swap" atom current new))) + (All [a] (-> a a (Atom a) (IO Bit))) + (io (AtomicReference::compareAndSet [current new] (:representation atom)))) + )) (def: #export (update f atom) {#.doc "Updates an atom by applying a function to its current value. @@ -29,12 +47,14 @@ The retries will be done with the new values of the atom, as they show up."} (All [a] (-> (-> a a) (Atom a) (IO a))) - (io (loop [_ []] - (let [old ("lux atom read" atom) - new (f old)] - (if ("lux atom compare-and-swap" atom old new) - new - (recur [])))))) + (loop [_ []] + (do io.Monad<IO> + [old (read atom) + #let [new (f old)] + swapped? (compare-and-swap old new atom)] + (if swapped? + (wrap new) + (recur []))))) (def: #export (write value atom) (All [a] (-> a (Atom a) (IO Any))) |