diff options
Diffstat (limited to '')
25 files changed, 57 insertions, 537 deletions
diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index ee9ea33e8..38f6bc6c3 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -287,38 +287,6 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["array" "size"]) (&/|list =array) (&/|list))))))))) -(defn ^:private analyse-atom-new [analyse exo-type ?values] - (&type/with-var - (fn [$var] - (|do [:let [(&/$Cons ?init (&/$Nil)) ?values] - =init (&&/analyse-1 analyse $var ?init) - _ (&type/check exo-type (&type/Atom $var)) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["atom" "new"]) (&/|list =init) (&/|list))))))))) - -(defn ^:private analyse-atom-read [analyse exo-type ?values] - (&type/with-var - (fn [$var] - (|do [:let [(&/$Cons ?atom (&/$Nil)) ?values] - =atom (&&/analyse-1 analyse (&type/Atom $var) ?atom) - _ (&type/check exo-type $var) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["atom" "read"]) (&/|list =atom) (&/|list))))))))) - -(defn ^:private analyse-atom-compare-and-swap [analyse exo-type ?values] - (&type/with-var - (fn [$var] - (|do [:let [(&/$Cons ?atom (&/$Cons ?old (&/$Cons ?new (&/$Nil)))) ?values] - =atom (&&/analyse-1 analyse (&type/Atom $var) ?atom) - =old (&&/analyse-1 analyse $var ?old) - =new (&&/analyse-1 analyse $var ?new) - _ (&type/check exo-type &type/Bit) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["atom" "compare-and-swap"]) (&/|list =atom =old =new) (&/|list))))))))) - (defn ^:private analyse-box-new [analyse exo-type ?values] (&type/with-var (fn [$var] @@ -429,10 +397,6 @@ "lux frac max" (analyse-frac-max analyse exo-type ?values) "lux frac int" (analyse-frac-int analyse exo-type ?values) - "lux atom new" (analyse-atom-new analyse exo-type ?values) - "lux atom read" (analyse-atom-read analyse exo-type ?values) - "lux atom compare-and-swap" (analyse-atom-compare-and-swap analyse exo-type ?values) - "lux process parallelism" (analyse-process-parallelism analyse exo-type ?values) "lux process schedule" (analyse-process-schedule analyse exo-type ?values) diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index b074e37b9..6f05b3e52 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -464,40 +464,6 @@ &&/wrap-long)]] (return nil))) -(defn ^:private compile-atom-new [compile ?values special-args] - (|do [:let [(&/$Cons ?init (&/$Nil)) ?values] - ^MethodVisitor *writer* &/get-writer - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/NEW "java/util/concurrent/atomic/AtomicReference") - (.visitInsn Opcodes/DUP))] - _ (compile ?init) - :let [_ (doto *writer* - (.visitMethodInsn Opcodes/INVOKESPECIAL "java/util/concurrent/atomic/AtomicReference" "<init>" "(Ljava/lang/Object;)V"))]] - (return nil))) - -(defn ^:private compile-atom-read [compile ?values special-args] - (|do [:let [(&/$Cons ?atom (&/$Nil)) ?values] - ^MethodVisitor *writer* &/get-writer - _ (compile ?atom) - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST "java/util/concurrent/atomic/AtomicReference"))] - :let [_ (doto *writer* - (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/util/concurrent/atomic/AtomicReference" "get" "()Ljava/lang/Object;"))]] - (return nil))) - -(defn ^:private compile-atom-compare-and-swap [compile ?values special-args] - (|do [:let [(&/$Cons ?atom (&/$Cons ?old (&/$Cons ?new (&/$Nil)))) ?values] - ^MethodVisitor *writer* &/get-writer - _ (compile ?atom) - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST "java/util/concurrent/atomic/AtomicReference"))] - _ (compile ?old) - _ (compile ?new) - :let [_ (doto *writer* - (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/util/concurrent/atomic/AtomicReference" "compareAndSet" "(Ljava/lang/Object;Ljava/lang/Object;)Z") - &&/wrap-boolean)]] - (return nil))) - (defn ^:private compile-box-new [compile ?values special-args] (|do [:let [(&/$Cons initS (&/$Nil)) ?values] ^MethodVisitor *writer* &/get-writer @@ -641,13 +607,6 @@ "write" (compile-box-write compile ?values special-args) ) - "atom" - (case proc - "new" (compile-atom-new compile ?values special-args) - "read" (compile-atom-read compile ?values special-args) - "compare-and-swap" (compile-atom-compare-and-swap compile ?values special-args) - ) - "process" (case proc "parallelism" (compile-process-parallelism compile ?values special-args) diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux index 7218d9618..585292af0 100644 --- a/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux @@ -329,28 +329,15 @@ (install "exit" (unary runtimeT.io//exit)) (install "current-time" (nullary (function (_ _) (runtimeT.io//current-time runtimeT.unit))))))) -## [[Atoms]] -(def: atom//new +## [[Box]] +(def: box//new Unary (|>> (list) _.vector)) -(def: (atom//read atom) +(def: (box//read box) Unary - (_.svref atom (_.int 0))) - -(def: (atom//compare-and-swap [atomO oldO newO]) - Trinary - (runtimeT.atom//compare-and-swap atomO oldO newO)) + (_.svref box (_.int 0))) -(def: atom-procs - Bundle - (<| (prefix "atom") - (|> (dict.new text.Hash<Text>) - (install "new" (unary atom//new)) - (install "read" (unary atom//read)) - (install "compare-and-swap" (trinary atom//compare-and-swap))))) - -## [[Box]] (def: (box//write [valueO boxO]) Binary (runtimeT.box//write valueO boxO)) @@ -359,8 +346,8 @@ Bundle (<| (prefix "box") (|> (dict.new text.Hash<Text>) - (install "new" (unary atom//new)) - (install "read" (unary atom//read)) + (install "new" (unary box//new)) + (install "read" (unary box//read)) (install "write" (binary box//write))))) ## [[Processes]] @@ -390,7 +377,6 @@ (dict.merge text-procs) (dict.merge array-procs) (dict.merge io-procs) - (dict.merge atom-procs) (dict.merge box-procs) (dict.merge process-procs)) )) diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/runtime.jvm.lux index 3750bc674..c54fde7ce 100644 --- a/new-luxc/source/luxc/lang/translation/common-lisp/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/common-lisp/runtime.jvm.lux @@ -266,19 +266,6 @@ (list @@array//get @@array//put))) -(runtime: (atom//compare-and-swap atom old new) - (with-vars [temp] - (_.let (list [temp (_.svref (@@ atom) (_.int 0))]) - (_.if (_.eq (@@ old) (@@ temp)) - (_.progn - (list (_.setf! (_.svref (@@ atom) (_.int 0)) (@@ new)) - (_.bool #1))) - (_.bool #0))))) - -(def: runtime//atom - Runtime - @@atom//compare-and-swap) - (runtime: (box//write value box) (_.progn (list @@ -356,7 +343,6 @@ runtime//adt runtime//text runtime//array - runtime//atom runtime//box runtime//io runtime//process)) diff --git a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux index b40f00c73..cca49372b 100644 --- a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux @@ -307,19 +307,6 @@ Nullary (frac//to-int "(new Date()).getTime()")) -## [[Atoms]] -(def: (atom//new initJS) - Unary - (format "{" runtimeT.atom-field ":" initJS "}")) - -(def: (atom//read atomJS) - Unary - (format (self-contained atomJS) "." runtimeT.atom-field)) - -(def: (atom//compare-and-swap [atomJS oldJS newJS]) - Trinary - (format runtimeT.atom//compare-and-swap "(" atomJS "," oldJS "," newJS ")")) - ## [[Box]] (def: (box//new initJS) Unary @@ -432,14 +419,6 @@ (install "exit" (unary io//exit)) (install "current-time" (nullary io//current-time))))) -(def: atom-procs - Bundle - (<| (prefix "atom") - (|> (dict.new text.Hash<Text>) - (install "new" (unary atom//new)) - (install "read" (unary atom//read)) - (install "compare-and-swap" (trinary atom//compare-and-swap))))) - (def: box-procs Bundle (<| (prefix "box") @@ -466,7 +445,6 @@ (dict.merge text-procs) (dict.merge array-procs) (dict.merge io-procs) - (dict.merge atom-procs) (dict.merge box-procs) (dict.merge process-procs) ))) diff --git a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux index c5d85eb0d..d5abbc150 100644 --- a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux @@ -643,23 +643,6 @@ (format __io//log __io//error)) -(def: #export atom-field Text "V") - -(runtime: atom//compare-and-swap "atomCompareAndSwap" - (format "(function " @ "(atom,oldV,newV) {" - "if(atom." atom-field " === oldV) {" - "atom." atom-field " = newV;" - "return true;" - "}" - "else {" - "return false;" - "}" - "})")) - -(def: runtime//atom - Runtime - (format __atom//compare-and-swap)) - (runtime: js//get "jsGetField" (format "(function " @ "(object, field) {" "var temp = object[field];" @@ -704,7 +687,6 @@ runtime//text runtime//array runtime//io - runtime//atom runtime//js)) (def: #export artifact Text (format prefix ".js")) diff --git a/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux index a138bd79a..34e7f02c8 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux @@ -4,8 +4,6 @@ [monad (#+ do)] ["ex" exception (#+ exception:)]] ["." io] - [concurrency - [atom (#+ Atom atom)]] [data ["." error (#+ Error)] ["." text ("text/." Hash<Text>) diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux index 327a95871..a6b037947 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux @@ -408,30 +408,6 @@ (|>> (_.INVOKESTATIC "java.lang.System" "currentTimeMillis" ($t.method (list) (#.Some $t.long) (list)) #0) (_.wrap #$.Long))) -## [[Atoms]] -(def: atom-class Text "java.util.concurrent.atomic.AtomicReference") -(def: (atom//new initI) - Unary - (|>> (_.NEW atom-class) - _.DUP - initI - (_.INVOKESPECIAL atom-class "<init>" ($t.method (list $Object) #.None (list)) #0))) - -(def: (atom//read atomI) - Unary - (|>> atomI - (_.CHECKCAST atom-class) - (_.INVOKEVIRTUAL atom-class "get" ($t.method (list) (#.Some $Object) (list)) #0))) - -(def: (atom//compare-and-swap [atomI oldI newI]) - Trinary - (|>> atomI - (_.CHECKCAST atom-class) - oldI - newI - (_.INVOKEVIRTUAL atom-class "compareAndSet" ($t.method (list $Object $Object) (#.Some $t.boolean) (list)) #0) - (_.wrap #$.Boolean))) - ## [[Box]] (def: empty-boxI $.Inst @@ -559,14 +535,6 @@ (install "exit" (unary io//exit)) (install "current-time" (nullary io//current-time))))) -(def: atom-procs - Bundle - (<| (prefix "atom") - (|> (dict.new text.Hash<Text>) - (install "new" (unary atom//new)) - (install "read" (unary atom//read)) - (install "compare-and-swap" (trinary atom//compare-and-swap))))) - (def: box-procs Bundle (<| (prefix "box") @@ -593,7 +561,6 @@ (dict.merge text-procs) (dict.merge array-procs) (dict.merge io-procs) - (dict.merge atom-procs) (dict.merge box-procs) (dict.merge process-procs) ))) diff --git a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux index 372d107cb..356adb5c3 100644 --- a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux @@ -306,19 +306,6 @@ (|> (lua.apply "os.time" (list)) (lua.* (lua.int 1_000)))) -## [[Atoms]] -(def: atom//new - Unary - (|>> [runtimeT.atom//field] (list) lua.table)) - -(def: atom//read - Unary - (lua.nth (lua.string runtimeT.atom//field))) - -(def: (atom//compare-and-swap [atomO oldO newO]) - Trinary - (runtimeT.atom//compare-and-swap atomO oldO newO)) - ## [[Box]] (def: box//new Unary @@ -429,14 +416,6 @@ (install "exit" (unary io//exit)) (install "current-time" (nullary io//current-time))))) -(def: atom-procs - Bundle - (<| (prefix "atom") - (|> (dict.new text.Hash<Text>) - (install "new" (unary atom//new)) - (install "read" (unary atom//read)) - (install "compare-and-swap" (trinary atom//compare-and-swap))))) - (def: box-procs Bundle (<| (prefix "box") @@ -463,7 +442,6 @@ (dict.merge text-procs) (dict.merge array-procs) (dict.merge io-procs) - (dict.merge atom-procs) (dict.merge box-procs) (dict.merge process-procs) ))) diff --git a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux index 8121b2c9d..3a18f98e7 100644 --- a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux @@ -249,19 +249,6 @@ @@array//put )) -(def: #export atom//field Text "_lux_atom") - -(runtime: (atom//compare-and-swap atom old new) - (let [atom//field (lua.string atom//field)] - (lua.if! (lua.= old (lua.nth atom//field atom)) - (lua.block! (list (lua.set! (lua.nth atom//field atom) new) - (lua.return! (lua.bool #1)))) - (lua.return! (lua.bool #0))))) - -(def: runtime//atom - Runtime - (format @@atom//compare-and-swap)) - (runtime: (box//write value box) (lua.block! (list (lua.set! (lua.nth (lua.int 0) box) value) @@ -337,7 +324,6 @@ runtime//bit runtime//text runtime//array - runtime//atom runtime//box runtime//process runtime//lua)) diff --git a/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux index 715d8bf0b..e195130c5 100644 --- a/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux @@ -338,27 +338,6 @@ ## (install "current-time" (nullary (function (_ _) ## (runtimeT.io//current-time! runtimeT.unit))))))) -## ## [[Atoms]] -## (def: atom//new -## Unary -## (|>> [(_.string runtimeT.atom//field)] (list) _.dict)) - -## (def: atom//read -## Unary -## (_.nth (_.string runtimeT.atom//field))) - -## (def: (atom//compare-and-swap [atomO oldO newO]) -## Trinary -## (runtimeT.atom//compare-and-swap atomO oldO newO)) - -## (def: atom-procs -## Bundle -## (<| (prefix "atom") -## (|> (dict.new text.Hash<Text>) -## (install "new" (unary atom//new)) -## (install "read" (unary atom//read)) -## (install "compare-and-swap" (trinary atom//compare-and-swap))))) - ## ## [[Processes]] ## (def: (process//parallelism-level []) ## Nullary @@ -388,6 +367,5 @@ ## (dict.merge text-procs) ## (dict.merge array-procs) ## (dict.merge io-procs) - ## (dict.merge atom-procs) ## (dict.merge process-procs) ))) diff --git a/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux index d4c14b473..c57bc3d80 100644 --- a/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux @@ -299,21 +299,6 @@ ## @@array//get ## @@array//put)) -## (def: #export atom//field Text "_lux_atom") - -## (runtime: (atom//compare-and-swap atom old new) -## (let [atom//field (_.string atom//field)] -## (_.if! (_.= old (_.nth atom//field atom)) -## ($_ _.then! -## (_.set-nth! atom//field new atom) -## (_.return! (_.bool #1))) -## (_.return! (_.bool #0))))) - -## (def: runtime//atom -## Runtime -## ($_ _.then! -## @@atom//compare-and-swap)) - ## (runtime: (process//future procedure) ## ($_ _.then! ## (_.import! "threading") @@ -356,7 +341,6 @@ ## runtime//bit ## runtime//text ## runtime//array - ## runtime//atom ## runtime//io ## runtime//process )) diff --git a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux index 35ffdb1f8..9a70c8c92 100644 --- a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux @@ -358,27 +358,6 @@ (install "current-time" (nullary (function (_ _) (runtimeT.io//current-time! runtimeT.unit))))))) -## [[Atoms]] -(def: atom//new - Unary - (|>> [(python.string runtimeT.atom//field)] (list) python.dict)) - -(def: atom//read - Unary - (python.nth (python.string runtimeT.atom//field))) - -(def: (atom//compare-and-swap [atomO oldO newO]) - Trinary - (runtimeT.atom//compare-and-swap atomO oldO newO)) - -(def: atom-procs - Bundle - (<| (prefix "atom") - (|> (dict.new text.Hash<Text>) - (install "new" (unary atom//new)) - (install "read" (unary atom//read)) - (install "compare-and-swap" (trinary atom//compare-and-swap))))) - ## [[Box]] (def: box//new Unary @@ -428,7 +407,6 @@ (dict.merge text-procs) (dict.merge array-procs) (dict.merge io-procs) - (dict.merge atom-procs) (dict.merge box-procs) (dict.merge process-procs) ))) diff --git a/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux index 3dd5980e8..571835b79 100644 --- a/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux @@ -333,21 +333,6 @@ @@array//get @@array//put)) -(def: #export atom//field Text "_lux_atom") - -(runtime: (atom//compare-and-swap atom old new) - (let [atom//field (python.string atom//field)] - (python.if! (python.= old (python.nth atom//field atom)) - ($_ python.then! - (python.set-nth! atom//field new atom) - (python.return! (python.bool #1))) - (python.return! (python.bool #0))))) - -(def: runtime//atom - Runtime - ($_ python.then! - @@atom//compare-and-swap)) - (runtime: (box//write value box) ($_ python.then! (python.set-nth! (python.int 0) value box) @@ -384,7 +369,6 @@ runtime//frac runtime//text runtime//array - runtime//atom runtime//box runtime//io runtime//process diff --git a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux index c17eb6738..d8f4f4662 100644 --- a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux @@ -350,27 +350,6 @@ (install "current-time" (nullary (function (_ _) (runtimeT.io//current-time! runtimeT.unit))))))) -## [[Atoms]] -(def: atom//new - Unary - (|>> [runtimeT.atom//field] (list) r.named-list)) - -(def: atom//read - Unary - (r.nth (r.string runtimeT.atom//field))) - -(def: (atom//compare-and-swap [atomO oldO newO]) - Trinary - (runtimeT.atom//compare-and-swap atomO oldO newO)) - -(def: atom-procs - Bundle - (<| (prefix "atom") - (|> (dict.new text.Hash<Text>) - (install "new" (unary atom//new)) - (install "read" (unary atom//read)) - (install "compare-and-swap" (trinary atom//compare-and-swap))))) - ## [[Box]] (def: box//new Unary @@ -420,7 +399,6 @@ (dict.merge text-procs) (dict.merge array-procs) (dict.merge io-procs) - (dict.merge atom-procs) (dict.merge box-procs) (dict.merge process-procs) ))) diff --git a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux index fd4adfb1a..ee46836cb 100644 --- a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux @@ -764,21 +764,6 @@ @@array//get @@array//put)) -(def: #export atom//field Text "lux_atom") - -(runtime: (atom//compare-and-swap atom old new) - (let [atom//field (r.string atom//field)] - (r.if (|> (@@ atom) (r.nth atom//field) (r.= (@@ old))) - ($_ r.then - (r.set-nth! atom//field (@@ new) atom) - (r.bool #1)) - (r.bool #0)))) - -(def: runtime//atom - Runtime - ($_ r.then - @@atom//compare-and-swap)) - (runtime: (box//write value box) ($_ r.then (r.set-nth! (r.int 1) (@@ value) box) @@ -859,7 +844,6 @@ runtime//frac runtime//text runtime//array - runtime//atom runtime//box runtime//io runtime//process diff --git a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux index ba6a1241a..96d42a4a9 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux @@ -391,27 +391,6 @@ (install "exit" (unary io//exit)) (install "current-time" (nullary io//current-time))))) -## [[Atoms]] -(def: atom//new - Unary - (|>> [(ruby.string runtimeT.atom//field)] (list) ruby.dictionary)) - -(def: atom//read - Unary - (ruby.nth (ruby.string runtimeT.atom//field))) - -(def: (atom//compare-and-swap [atomO oldO newO]) - Trinary - (runtimeT.atom//compare-and-swap atomO oldO newO)) - -(def: atom-procs - Bundle - (<| (prefix "atom") - (|> (dict.new text.Hash<Text>) - (install "new" (unary atom//new)) - (install "read" (unary atom//read)) - (install "compare-and-swap" (trinary atom//compare-and-swap))))) - ## [[Box]] (def: box//new Unary @@ -461,7 +440,6 @@ (dict.merge text-procs) (dict.merge array-procs) (dict.merge io-procs) - (dict.merge atom-procs) (dict.merge box-procs) (dict.merge process-procs) ))) diff --git a/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux index 49f5d9d79..32ab5b10c 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux @@ -222,19 +222,6 @@ (format @@array//get @@array//put)) -(def: #export atom//field Text "_lux_atom") - -(runtime: (atom//compare-and-swap atom old new) - (let [atom//field (ruby.string atom//field)] - (ruby.if! (ruby.= old (ruby.nth atom//field atom)) - (ruby.block! (list (ruby.set-nth! atom//field new atom) - (ruby.return! (ruby.bool #1)))) - (ruby.return! (ruby.bool #0))))) - -(def: runtime//atom - Runtime - (format @@atom//compare-and-swap "\n")) - (runtime: (box//write value box) (ruby.block! (list (ruby.set-nth! (ruby.int 0) value box) (ruby.return! ..unit)))) @@ -263,7 +250,6 @@ runtime//bit "\n" runtime//text "\n" runtime//array "\n" - runtime//atom "\n" runtime//box "\n" runtime//process "\n" )) diff --git a/new-luxc/test/test/luxc/lang/analysis/host.jvm.lux b/new-luxc/test/test/luxc/lang/analysis/host.jvm.lux index dabef0e08..9d09216b8 100644 --- a/new-luxc/test/test/luxc/lang/analysis/host.jvm.lux +++ b/new-luxc/test/test/luxc/lang/analysis/host.jvm.lux @@ -3,8 +3,6 @@ [control [monad (#+ do)] pipe] - [concurrency - ["." atom]] [data ["e" error] ["." product] diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux index 9a2465ce3..5425be2ea 100644 --- a/new-luxc/test/test/luxc/lang/translation/common.lux +++ b/new-luxc/test/test/luxc/lang/translation/common.lux @@ -378,66 +378,6 @@ #0)))) ))) -(def: (atom-spec run) - (-> Runner Test) - (do r.Monad<Random> - [pre r.nat - post (|> r.nat (r.filter (|>> (n/= pre) not))) - #let [preS (synthesis.i64 pre) - postS (synthesis.i64 post) - atomS (#synthesis.Extension "lux atom new" (list preS))]] - ($_ seq - (test "Can read atoms." - (|> (run (#synthesis.Extension "lux atom read" (list atomS))) - (case> (#e.Success valueV) - (n/= pre (:coerce Nat valueV)) - - (#e.Error error) - (exec (log! error) - #0)))) - (test "Can compare-and-swap atoms." - (and (|> (run (synthesis.branch/let - [preS 0 - (synthesis.branch/let - [(#synthesis.Extension "lux atom new" - (list (synthesis.variable/local 0))) - 1 - (synthesis.tuple - (list (#synthesis.Extension "lux atom compare-and-swap" - (list (synthesis.variable/local 1) - (synthesis.variable/local 0) - postS)) - (#synthesis.Extension "lux atom read" (list (synthesis.variable/local 1)))))])])) - (case> (#e.Success valueV) - (let [[swapped? current-value] (:coerce [Bit Nat] valueV)] - (and swapped? - (n/= post current-value))) - - (#e.Error error) - (exec (log! error) - #0))) - (|> (run (synthesis.branch/let - [preS 0 - (synthesis.branch/let - [(#synthesis.Extension "lux atom new" - (list (synthesis.variable/local 0))) - 1 - (synthesis.tuple - (list (#synthesis.Extension "lux atom compare-and-swap" - (list (synthesis.variable/local 1) - postS - postS)) - (#synthesis.Extension "lux atom read" (list (synthesis.variable/local 1)))))])])) - (case> (#e.Success valueV) - (let [[swapped? current-value] (:coerce [Bit Nat] valueV)] - (and (not swapped?) - (n/= pre current-value))) - - (#e.Error error) - (exec (log! error) - #0))))) - ))) - (def: (box-spec run) (-> Runner Test) (do r.Monad<Random> @@ -513,7 +453,6 @@ (text-spec run) (array-spec run) (io-spec run) - (atom-spec run) (box-spec run) (process-spec run) )) 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))) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 0e09def80..350a0e913 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -1,5 +1,5 @@ (.module: - [lux + [lux #* [cli (#+ program:)] ["." test] ## TODO: Test these modules |