Anonymous avatar Anonymous committed 73ba2b4

Add a proof-of-concept implementation of atom

Comments (0)

Files changed (5)

+*.so
+*.c
+*.import.*

clojurian-atom.scm

+(module clojurian-atom
+
+(atom atom-value compare-and-set! swap! reset!)
+
+(import chicken scheme)
+(use srfi-18)
+
+(define-record atom
+  mutex value)
+
+(define (atom value)
+  (make-atom (make-mutex) value))
+
+(define (compare-and-set! atom expect update)
+  (and (eq? (atom-value atom) expect)
+       (dynamic-wind
+           (lambda ()
+             (mutex-lock! (atom-mutex atom)))
+           (lambda ()
+             (and (eq? (atom-value atom) expect)
+                  (begin
+                    (atom-value-set! atom update)
+                    #t)))
+           (lambda ()
+             (mutex-unlock! (atom-mutex atom))))))
+
+(define (swap! atom proc . args)
+  (let loop ()
+    (let* ((old (atom-value atom))
+           (new (apply proc old args)))
+      (if (compare-and-set! atom old new)
+          new
+          (loop)))))
+
+(define (reset! atom val)
+  (dynamic-wind
+      (lambda ()
+        (mutex-lock! (atom-mutex atom)))
+      (lambda ()
+        (atom-value-set! atom val))
+      (lambda ()
+        (mutex-unlock! (atom-mutex atom)))))
+
+)
-(compile -s -O2 -d0 clojurian-syntax.scm -J)
-(compile -s -O2 -d0 clojurian-syntax.import.scm)
+(compile -s -O3 -d0 clojurian-syntax.scm -J)
+(compile -s -O3 -d0 clojurian-syntax.import.scm)
+
+(compile -s -O3 -d0 clojurian-atom.scm -J)
+(compile -s -O3 -d0 clojurian-atom.import.scm)
 
 (install-extension
  'clojurian
  '("clojurian-syntax.so"
-   "clojurian-syntax.import.so")
+   "clojurian-syntax.import.so"
+   "clojurian-atom.so"
+   "clojurian-atom.import.so")
  '((version "0.0.1")))
+(use clojurian-atom)
+(use test srfi-1 srfi-18)
+
+(let ((a (atom 10)))
+  (test-assert (not (compare-and-set! a 1 2))))
+
+(let ((a (atom 10)))
+  (test 10 (atom-value a))
+  (reset! a 'hey)
+  (test 'hey (atom-value a)))
+
+
+(define counter (atom 0))
+
+(for-each
+ thread-join!
+ (map (lambda _
+        (thread-start!
+         (lambda ()
+           (thread-sleep! (/ (random 100) 1000))
+           (swap! counter + 1))))
+      (iota 100)))
+
+(test 100 (atom-value counter))
+
+
+(define foo (atom (list)))
+
+(swap! foo xcons 3)
+(swap! foo xcons 2)
+(swap! foo xcons 1)
+
+(test '(1 2 3) (atom-value foo))
 
 (test-begin)
 (load-relative "syntax.scm")
+(load-relative "atom.scm")
 (test-end)
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.