From 91a14e9b4c6611399d33166710081982cf984a00 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 3 Jan 2018 23:55:58 -0400
Subject: - Added "Box" support to new-luxc.

---
 .../source/luxc/lang/extension/analysis/common.lux | 46 ++++++++++++++++++++++
 1 file changed, 46 insertions(+)

(limited to 'new-luxc/source/luxc/lang/extension/analysis/common.lux')

diff --git a/new-luxc/source/luxc/lang/extension/analysis/common.lux b/new-luxc/source/luxc/lang/extension/analysis/common.lux
index 079001b26..1a1c8c650 100644
--- a/new-luxc/source/luxc/lang/extension/analysis/common.lux
+++ b/new-luxc/source/luxc/lang/extension/analysis/common.lux
@@ -392,6 +392,51 @@
           (install "compare-and-swap" atom//compare-and-swap)
           )))
 
+(type: (Box ! a)
+  (#.Primitive "#Box" (#.Cons ! (#.Cons a #.Nil))))
+
+(def: (box//new proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list initC))
+      (do macro.Monad<Meta>
+        [[var-id varT] (&.with-type-env tc.var)
+         _ (&.infer (type (All [!] (Box ! varT))))
+         initA (&.with-type varT
+                 (analyse initC))]
+        (wrap (la.procedure proc (list initA))))
+      
+      _
+      (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args))))))
+
+(def: (box//read proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (do macro.Monad<Meta>
+      [[thread-id threadT] (&.with-type-env tc.var)
+       [var-id varT] (&.with-type-env tc.var)]
+      ((unary (type (Box threadT varT)) varT proc)
+       analyse eval args))))
+
+(def: (box//write proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (do macro.Monad<Meta>
+      [[thread-id threadT] (&.with-type-env tc.var)
+       [var-id varT] (&.with-type-env tc.var)]
+      ((binary varT (type (Box threadT varT)) Unit proc)
+       analyse eval args))))
+
+(def: box-procs
+  Bundle
+  (<| (prefix "box")
+      (|> (dict.new text.Hash<Text>)
+          (install "new" box//new)
+          (install "read" box//read)
+          (install "write" box//write)
+          )))
+
 (def: process-procs
   Bundle
   (<| (prefix "process")
@@ -415,5 +460,6 @@
           (dict.merge array-procs)
           (dict.merge math-procs)
           (dict.merge atom-procs)
+          (dict.merge box-procs)
           (dict.merge process-procs)
           (dict.merge io-procs))))
-- 
cgit v1.2.3