diff options
author | Eduardo Julian | 2018-07-31 22:54:35 -0400 |
---|---|---|
committer | Eduardo Julian | 2018-07-31 22:54:35 -0400 |
commit | 428965131e17d101a16e3ca60b3412101e216cd1 (patch) | |
tree | 2b74c5241ee117aa581f4ee7301fc1e5f1bfa6a8 /stdlib | |
parent | 97ab1f076ac08992d6b64cd77bc0bef97b3fc50a (diff) |
Now implementing box functionality in stdlib instead of the compiler.
Diffstat (limited to '')
3 files changed, 30 insertions, 84 deletions
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] |