aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/extension/analysis/common.lux46
-rw-r--r--new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux38
2 files changed, 83 insertions, 1 deletions
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))))
diff --git a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
index 336293dc4..84c42244e 100644
--- a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
@@ -141,6 +141,8 @@
($i.label @end)
)))
+(def: unitI $.Inst ($i.string hostL.unit))
+
## [Procedures]
## [[Lux]]
(def: (lux//is [leftI rightI])
@@ -513,7 +515,7 @@
messageI
($i.CHECKCAST "java.lang.String")
($i.INVOKEVIRTUAL "java.io.PrintStream" "println" string-method false)
- ($i.string hostL.unit)))
+ unitI))
(def: (io//error messageI)
Unary
@@ -559,6 +561,31 @@
($i.INVOKEVIRTUAL atom-class "compareAndSet" ($t.method (list $Object $Object) (#.Some $t.boolean) (list)) false)
($i.wrap #$.Boolean)))
+## [[Box]]
+(def: empty-boxI
+ $.Inst
+ (|>> ($i.int 1) ($i.ANEWARRAY ($t.binary-name "java.lang.Object"))))
+
+(def: check-boxI
+ $.Inst
+ ($i.CHECKCAST ($t.descriptor $Object-Array)))
+
+(def: (box//new initI)
+ Unary
+ (|>> empty-boxI
+ $i.DUP ($i.int 0) initI $i.AASTORE))
+
+(def: (box//read boxI)
+ Unary
+ (|>> boxI check-boxI
+ ($i.int 0) $i.AALOAD))
+
+(def: (box//write [valueI boxI])
+ Binary
+ (|>> boxI check-boxI
+ ($i.int 0) valueI $i.AASTORE
+ unitI))
+
## [[Processes]]
(def: (process//concurrency-level [])
Nullary
@@ -745,6 +772,14 @@
(install "read" (unary atom//read))
(install "compare-and-swap" (trinary atom//compare-and-swap)))))
+(def: box-procs
+ Bundle
+ (<| (prefix "box")
+ (|> (dict.new text.Hash<Text>)
+ (install "new" (unary box//new))
+ (install "read" (unary box//read))
+ (install "write" (binary box//write)))))
+
(def: process-procs
Bundle
(<| (prefix "process")
@@ -769,5 +804,6 @@
(dict.merge math-procs)
(dict.merge io-procs)
(dict.merge atom-procs)
+ (dict.merge box-procs)
(dict.merge process-procs)
)))