aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux43
-rw-r--r--stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux26
-rw-r--r--stdlib/source/lux/compiler/default/phase/translation/scheme/runtime.jvm.lux14
-rw-r--r--stdlib/source/lux/concurrency/atom.lux68
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)))