From 428965131e17d101a16e3ca60b3412101e216cd1 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 31 Jul 2018 22:54:35 -0400
Subject: Now implementing box functionality in stdlib instead of the compiler.

---
 .../default/phase/extension/analysis/common.lux    | 46 +---------------------
 .../translation/scheme/extension/common.jvm.lux    | 22 -----------
 stdlib/source/lux/control/thread.lux               | 46 ++++++++++++++--------
 3 files changed, 30 insertions(+), 84 deletions(-)

(limited to 'stdlib')

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 24f22df3c..bf8e73b86 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux
@@ -2,8 +2,7 @@
   [lux #*
    [control
     ["." monad (#+ do)]
-    ["ex" exception (#+ exception:)]
-    [thread (#+ Box)]]
+    ["ex" exception (#+ exception:)]]
    [data
     ["." text
      format]
@@ -202,48 +201,6 @@
           (bundle.install "clip" (trinary Text Nat Nat (type (Maybe Text))))
           )))
 
-(def: box::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 (All [!] (Box ! 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: box::read
-  Handler
-  (function (_ extension-name analyse args)
-    (do ////.Monad<Operation>
-      [[thread-id threadT] (typeA.with-env check.var)
-       [var-id varT] (typeA.with-env check.var)]
-      ((unary (type (Box threadT varT)) varT extension-name)
-       analyse args))))
-
-(def: box::write
-  Handler
-  (function (_ extension-name analyse args)
-    (do ////.Monad<Operation>
-      [[thread-id threadT] (typeA.with-env check.var)
-       [var-id varT] (typeA.with-env check.var)]
-      ((binary varT (type (Box threadT varT)) Any extension-name)
-       analyse args))))
-
-(def: bundle::box
-  Bundle
-  (<| (bundle.prefix "box")
-      (|> bundle.empty
-          (bundle.install "new" box::new)
-          (bundle.install "read" box::read)
-          (bundle.install "write" box::write)
-          )))
-
 (def: #export bundle
   Bundle
   (<| (bundle.prefix "lux")
@@ -253,6 +210,5 @@
           (dict.merge bundle::int)
           (dict.merge bundle::frac)
           (dict.merge bundle::text)
-          (dict.merge bundle::box)
           (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 c46a5e82e..65184a7ea 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
@@ -241,27 +241,6 @@
           (bundle.install "exit" (unary _.exit/1))
           (bundle.install "current-time" (nullary (function (_ _) (runtime.io//current-time (_.string synthesis.unit))))))))
 
-## [[Box]]
-(def: box::new
-  Unary
-  (|>> (list) _.vector/*))
-
-(def: (box::read box)
-  Unary
-  (_.vector-ref/2 box (_.int +0)))
-
-(def: (box::write [valueO boxO])
-  Binary
-  (runtime.box//write valueO boxO))
-
-(def: bundle::box
-  Bundle
-  (<| (bundle.prefix "box")
-      (|> bundle.empty
-          (bundle.install "new" (unary box::new))
-          (bundle.install "read" (unary box::read))
-          (bundle.install "write" (binary box::write)))))
-
 ## [Bundles]
 (def: #export bundle
   Bundle
@@ -272,5 +251,4 @@
           (dict.merge bundle::frac)
           (dict.merge bundle::text)
           (dict.merge bundle::io)
-          (dict.merge bundle::box)
           )))
diff --git a/stdlib/source/lux/control/thread.lux b/stdlib/source/lux/control/thread.lux
index b7aac24d7..2e7942355 100644
--- a/stdlib/source/lux/control/thread.lux
+++ b/stdlib/source/lux/control/thread.lux
@@ -4,29 +4,41 @@
     [functor (#+ Functor)]
     [apply (#+ Apply)]
     [monad (#+ Monad do)]]
+   [data
+    [collection
+     ["." array]]]
+   [type (#+ :share)
+    abstract]
+   [compiler
+    ["." host]]
    [io (#+ IO)]])
 
 (type: #export (Thread ! a)
   (-> ! a))
 
-(type: #export (Box t v)
+(abstract: #export (Box t v)
   {#.doc "A mutable box holding a value."}
-  (#.Primitive "#Box" (#.Cons t (#.Cons v #.Nil))))
-
-(def: #export (box init)
-  (All [a] (-> a (All [!] (Thread ! (Box ! a)))))
-  (function (_ !)
-    ("lux box new" init)))
-
-(def: #export (read box)
-  (All [! a] (-> (Box ! a) (Thread ! a)))
-  (function (_ !)
-    ("lux box read" box)))
-
-(def: #export (write value box)
-  (All [a] (-> a (All [!] (-> (Box ! a) (Thread ! Any)))))
-  (function (_ !)
-    ("lux box write" value box)))
+
+  (Array v)
+
+  (def: #export (box init)
+    (All [a] (-> a (All [!] (Thread ! (Box ! a)))))
+    (function (_ !)
+      (|> (array.new 1)
+          (array.write 0 init)
+          :abstraction)))
+
+  (def: #export (read box)
+    (All [! a] (-> (Box ! a) (Thread ! a)))
+    (function (_ !)
+      (`` (for {(~~ (static host.jvm))
+                ("jvm aaload" (:representation box) 0)}))))
+
+  (def: #export (write value box)
+    (All [a] (-> a (All [!] (-> (Box ! a) (Thread ! Any)))))
+    (function (_ !)
+      (|> box :representation (array.write 0 value) :abstraction)))
+  )
 
 (def: #export (run thread)
   (All [a]
-- 
cgit v1.2.3