Now implementing atom functionality in stdlib instead of the compiler.

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)))