- Added safe (single-threaded) mutation.

3 files changed, 96 insertions, 2 deletions

diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj
index 7031a9135..e3951da18 100644
--- a/luxc/src/lux/analyser/proc/common.clj
+++ b/luxc/src/lux/analyser/proc/common.clj
@@ -436,6 +436,41 @@
         (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]
+      (|do [:let [(&/$Cons ?init (&/$Nil)) ?values]
+            =init (&&/analyse-1 analyse $var ?init)
+            _ (&type/check exo-type (&/$UnivQ (&/|list) (&type/Box (&/$Bound 1) $var)))
+            _cursor &/cursor]
+        (return (&/|list (&&/|meta exo-type _cursor
+                                   (&&/$proc (&/T ["box" "new"]) (&/|list =init) (&/|list)))))))))
+
+(defn ^:private analyse-box-read [analyse exo-type ?values]
+  (&type/with-var
+    (fn [threadT]
+      (&type/with-var
+        (fn [valueT]
+          (|do [:let [(&/$Cons boxC (&/$Nil)) ?values]
+                boxA (&&/analyse-1 analyse (&type/Box threadT valueT) boxC)
+                _ (&type/check exo-type valueT)
+                _cursor &/cursor]
+            (return (&/|list (&&/|meta exo-type _cursor
+                                       (&&/$proc (&/T ["box" "read"]) (&/|list boxA) (&/|list)))))))))))
+
+(defn ^:private analyse-box-write [analyse exo-type ?values]
+  (&type/with-var
+    (fn [threadT]
+      (&type/with-var
+        (fn [valueT]
+          (|do [:let [(&/$Cons valueC (&/$Cons boxC (&/$Nil))) ?values]
+                boxA (&&/analyse-1 analyse (&type/Box threadT valueT) boxC)
+                valueA (&&/analyse-1 analyse valueT valueC)
+                _ (&type/check exo-type &/$Unit)
+                _cursor &/cursor]
+            (return (&/|list (&&/|meta exo-type _cursor
+                                       (&&/$proc (&/T ["box" "write"]) (&/|list valueA boxA) (&/|list)))))))))))
+
 (defn ^:private analyse-process-concurrency-level [analyse exo-type ?values]
   (|do [:let [(&/$Nil) ?values]
         _ (&type/check exo-type &type/Nat)
@@ -465,6 +500,10 @@
          "lux is"                   (analyse-lux-is analyse exo-type ?values)
          "lux try"                  (analyse-lux-try analyse exo-type ?values)
 
+         "lux box new"                 (analyse-box-new analyse exo-type ?values)
+         "lux box read"                (analyse-box-read analyse exo-type ?values)
+         "lux box write"               (analyse-box-write analyse exo-type ?values)
+         
          "lux io log"                  (analyse-io-log analyse exo-type ?values)
          "lux io error"                (analyse-io-error analyse exo-type ?values)
          "lux io exit"                 (analyse-io-exit 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 bead93256..b23a59ce1 100644
--- a/luxc/src/lux/compiler/jvm/proc/common.clj
+++ b/luxc/src/lux/compiler/jvm/proc/common.clj
@@ -759,6 +759,47 @@
                   &&/wrap-boolean)]]
     (return nil)))
 
+(defn ^:private compile-box-new [compile ?values special-args]
+  (|do [:let [(&/$Cons initS (&/$Nil)) ?values]
+        ^MethodVisitor *writer* &/get-writer
+        :let [_ (doto *writer*
+                  (.visitLdcInsn (int 1))
+                  (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object"))]
+        :let [_ (doto *writer*
+                  (.visitInsn Opcodes/DUP)
+                  (.visitLdcInsn (int 0)))]
+        _ (compile initS)
+        :let [_ (doto *writer*
+                  (.visitInsn Opcodes/AASTORE))]]
+    (return nil)))
+
+(defn ^:private compile-box-read [compile ?values special-args]
+  (|do [:let [(&/$Cons boxS (&/$Nil)) ?values
+              ;; (&/$Nil) special-args
+              ]
+        ^MethodVisitor *writer* &/get-writer
+        _ (compile boxS)
+        :let [_ (doto *writer*
+                  (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+                  (.visitLdcInsn (int 0))
+                  (.visitInsn Opcodes/AALOAD))]]
+    (return nil)))
+
+(defn ^:private compile-box-write [compile ?values special-args]
+  (|do [:let [(&/$Cons valueS (&/$Cons boxS (&/$Nil))) ?values
+              ;; (&/$Nil) special-args
+              ]
+        ^MethodVisitor *writer* &/get-writer
+        _ (compile boxS)
+        :let [_ (doto *writer*
+                  (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+                  (.visitLdcInsn (int 0)))]
+        _ (compile valueS)
+        :let [_ (doto *writer*
+                  (.visitInsn Opcodes/AASTORE)
+                  (.visitLdcInsn &/unit-tag))]]
+    (return nil)))
+
 (defn ^:private compile-process-concurrency-level [compile ?values special-args]
   (|do [:let [(&/$Nil) ?values]
         ^MethodVisitor *writer* &/get-writer
@@ -929,6 +970,13 @@
       "pow" (compile-math-pow compile ?values special-args)
       )
 
+    "box"
+    (case proc
+      "new" (compile-box-new compile ?values special-args)
+      "read" (compile-box-read compile ?values special-args)
+      "write" (compile-box-write compile ?values special-args)
+      )
+
     "atom"
     (case proc
       "new" (compile-atom-new compile ?values special-args)
diff --git a/luxc/src/lux/type.clj b/luxc/src/lux/type.clj
index d5d6b0316..84c00b978 100644
--- a/luxc/src/lux/type.clj
+++ b/luxc/src/lux/type.clj
@@ -32,13 +32,20 @@
 (def Ident (&/$Named (&/T ["lux" "Ident"]) (&/$Product Text Text)))
 
 (do-template [<name> <tag>]
-  (defn <name> [elem-type]
-    (&/$Primitive <tag> (&/|list elem-type)))
+  (defn <name> [elemT]
+    (&/$Primitive <tag> (&/|list elemT)))
 
   Array "#Array"
   Atom  "#Atom"
   )
 
+(do-template [<name> <tag>]
+  (defn <name> [threadT elemT]
+    (&/$Primitive <tag> (&/|list threadT elemT)))
+
+  Box  "#Box"
+  )
+
 (def Bottom
   (&/$Named (&/T ["lux" "Bottom"])
             (&/$UnivQ empty-env