diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/extension')
| -rw-r--r-- | new-luxc/source/luxc/lang/extension/analysis/common.lux | 46 |
1 files changed, 46 insertions, 0 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)))) |