aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/library')
-rw-r--r--stdlib/source/library/lux/control/concurrency/event.lux107
-rw-r--r--stdlib/source/library/lux/control/concurrency/thread.lux79
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/loop.lux4
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux92
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/when.lux6
-rw-r--r--stdlib/source/library/lux/world/environment.lux4
-rw-r--r--stdlib/source/library/lux/world/file.lux2
7 files changed, 184 insertions, 110 deletions
diff --git a/stdlib/source/library/lux/control/concurrency/event.lux b/stdlib/source/library/lux/control/concurrency/event.lux
new file mode 100644
index 000000000..680bf50dd
--- /dev/null
+++ b/stdlib/source/library/lux/control/concurrency/event.lux
@@ -0,0 +1,107 @@
+... https://en.wikipedia.org/wiki/Event_loop
+(.require
+ [library
+ [lux (.except loop)
+ [abstract
+ ["[0]" monad (.only do)]]
+ [control
+ ["[0]" io (.only IO)]
+ ["[0]" try (.only Try)]
+ ["[0]" exception (.only Exception)]]
+ [data
+ [text
+ ["%" \\format]]
+ [collection
+ ["[0]" list]]]
+ [math
+ [number
+ ["n" nat]]]
+ [world
+ [time
+ ["[0]" instant (.only Instant) (.use "[1]#[0]" order)]
+ ["[0]" duration]]]]]
+ [//
+ ["[0]" atom (.only Atom)]])
+
+(def Action
+ (type_literal (IO Any)))
+
+(type Event
+ (Record
+ [#when Instant
+ #what Action]))
+
+(def Scheduler
+ (type_literal (-> Nat Action (IO Any))))
+
+(def Loop
+ (type_literal (IO (Try Nat))))
+
+(exception.def .public (error_during_execution [loop error])
+ (Exception [Text Text])
+ (exception.report
+ (list ["Loop" (%.text loop)]
+ ["Error" error])))
+
+(def (execute! loop action)
+ (-> Text Action (Try Any))
+ (when (try (io.run! action))
+ {try.#Failure error}
+ (exception.except ..error_during_execution [loop error])
+
+ success
+ success))
+
+(exception.def .public (already_started loop)
+ (Exception Text)
+ (exception.report
+ (list ["Loop" (%.text loop)])))
+
+(def .public (loop name)
+ (-> Text [Scheduler Loop])
+ (let [state (is (Atom [Bit (List Event)])
+ (atom.atom [false (list)]))]
+ [(is Scheduler
+ (function (schedule! milli_seconds action)
+ (do io.monad
+ [now instant.now
+ _ (atom.update! (function (_ [stated? events])
+ [stated?
+ (list.partial [#when (instant.after (duration.of_millis (.int milli_seconds))
+ now)
+ #what action]
+ events)])
+ state)]
+ (in []))))
+ (is Loop
+ (.loop (retry! [_ []])
+ (do [! io.monad]
+ [started?,events (atom.read! state)
+ .let [[started? events] started?,events]]
+ (if started?
+ (in (exception.except ..already_started [name]))
+ (do !
+ [swapped? (atom.compare_and_swap! started?,events [true events] state)]
+ (if swapped?
+ (.loop (again [events_processed 0])
+ (do !
+ [started?,events (atom.read! state)
+ .let [[started? events] started?,events]]
+ (when events
+ ... And... we're done!
+ {.#End}
+ (in {try.#Success events_processed})
+
+ _
+ (do !
+ [now instant.now
+ .let [[pending ready] (list.partition (function (_ thread)
+ (instant#< (the #when thread) now))
+ events)]
+ swapped? (atom.compare_and_swap! started?,events [started? pending] state)]
+ (if swapped?
+ (do [! (try.with !)]
+ [_ (monad.each ! (|>> (the #what) (..execute! name) io.io) ready)]
+ (again (n.+ (list.size ready) events_processed)))
+ (again events_processed))))))
+ (retry! [])))))))]))
diff --git a/stdlib/source/library/lux/control/concurrency/thread.lux b/stdlib/source/library/lux/control/concurrency/thread.lux
index def0f230d..5b260b4ea 100644
--- a/stdlib/source/library/lux/control/concurrency/thread.lux
+++ b/stdlib/source/library/lux/control/concurrency/thread.lux
@@ -7,7 +7,6 @@
["[0]" monad (.only do)]]
[control
["[0]" try]
- ["[0]" exception]
["[0]" io (.only IO io)]]
[data
["[0]" text]
@@ -22,9 +21,11 @@
["[0]" configuration]]
[world
[time
- ["[0]" instant]]]]]
+ ["[0]" instant (.only Instant) (.use "[1]#[0]" order)]
+ ["[0]" duration]]]]]
[//
- ["[0]" atom (.only Atom)]])
+ ["[0]" atom (.only Atom)]
+ ["[0]" event]])
(with_expansions [<jvm> (these (ffi.import java/lang/Object
"[1]::[0]")
@@ -68,11 +69,7 @@
(start [] "io" "?" Any))
... Default
- (type Thread
- (Record
- [#creation Nat
- #delay Nat
- #action (IO Any)]))
+ (these)
))
(def .public parallelism
@@ -102,12 +99,9 @@
@.python (these)
... Default
- (these (def started?
- (Atom Bit)
- (atom.atom false))
- (def runner
- (Atom (List Thread))
- (atom.atom (list))))))
+ (these (def schedule!,run!
+ (let [[module _] (symbol .._)]
+ (event.loop module))))))
(def (execute! action)
(-> (IO Any) Any)
@@ -147,13 +141,8 @@
(in []))
... Default
- (do [! io.monad]
- [now (at ! each (|>> instant.millis .nat) instant.now)
- _ (atom.update! (|>> {.#Item [#creation now
- #delay milli_seconds
- #action action]})
- ..runner)]
- (in [])))))
+ (let [[schedule! run!] ..schedule!,run!]
+ (schedule! milli_seconds action)))))
(for @.old (these)
@.jvm (these)
@@ -161,39 +150,15 @@
@.python (these)
... Default
- (these (exception.def .public cannot_continue_running_threads)
-
- ... https://en.wikipedia.org/wiki/Event_loop
- ... Starts the event-loop.
- (def .public run!
- (IO Any)
- (do [! io.monad]
- [started? (atom.read! ..started?)]
- (if started?
- (in [])
- (do !
- [_ (atom.write! true ..started?)]
- (loop (again [_ []])
- (do !
- [threads (atom.read! ..runner)]
- (when threads
- ... And... we're done!
- {.#End}
- (in [])
-
- _
- (do !
- [now (at ! each (|>> instant.millis .nat) instant.now)
- .let [[ready pending] (list.partition (function (_ thread)
- (|> (the #creation thread)
- (n.+ (the #delay thread))
- (n.<= now)))
- threads)]
- swapped? (atom.compare_and_swap! threads pending ..runner)]
- (if swapped?
- (do !
- [_ (monad.each ! (|>> (the #action) ..execute! io.io) ready)]
- (again []))
- (panic! (exception.error ..cannot_continue_running_threads []))))
- )))))))
- ))
+ (def .public run!
+ (IO Any)
+ (let [[schedule! run!] ..schedule!,run!]
+ (do io.monad
+ [outcome run!]
+ (when outcome
+ {try.#Success _}
+ (in [])
+
+ {try.#Failure error}
+ (in (debug.log! error))))))
+ )
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/loop.lux
index c475281e4..92811921c 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/loop.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/loop.lux
@@ -45,7 +45,7 @@
(all _.then
(if initial?
(_.define $binding binding)
- (_.set $binding binding))
+ (_.statement (_.set $binding binding)))
body
))
@@ -56,7 +56,7 @@
(let [variable (//when.register (n.+ offset register))]
(if initial?
(_.define variable (_.at (_.i32 (.int register)) $iteration))
- (_.set variable (_.at (_.i32 (.int register)) $iteration))))))
+ (_.statement (_.set variable (_.at (_.i32 (.int register)) $iteration)))))))
list.reversed
(list#mix _.then body)
(_.then (_.define $iteration (_.array bindings))))))
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux
index 8848c781d..506287a9c 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux
@@ -143,8 +143,8 @@
tuple))
(with_expansions [<recur> (these (all _.then
- (_.set lefts (_.- last_index_right lefts))
- (_.set tuple (_.at last_index_right tuple))))]
+ (_.statement (_.set lefts (_.- last_index_right lefts)))
+ (_.statement (_.set tuple (_.at last_index_right tuple)))))]
(runtime
(tuple//left lefts tuple)
(with_vars [last_index_right]
@@ -182,9 +182,9 @@
(with_vars [tag is_last value]
(_.closure (list tag is_last value)
(all _.then
- (_.set (_.the ..variant_tag_field @this) tag)
- (_.set (_.the ..variant_flag_field @this) is_last)
- (_.set (_.the ..variant_value_field @this) value)
+ (_.statement (_.set (_.the ..variant_tag_field @this) tag))
+ (_.statement (_.set (_.the ..variant_flag_field @this) is_last))
+ (_.statement (_.set (_.the ..variant_value_field @this) value))
)))))
(def .public (variant tag last? value)
@@ -199,10 +199,10 @@
actual::value (|> sum (_.the ..variant_value_field))
is_last? (_.= ..unit actual::right?)
recur! (all _.then
- (_.set expected::lefts (|> expected::lefts
- (_.- actual::lefts)
- (_.- (_.i32 +1))))
- (_.set sum actual::value))]
+ (_.statement (_.set expected::lefts (|> expected::lefts
+ (_.- actual::lefts)
+ (_.- (_.i32 +1)))))
+ (_.statement (_.set sum actual::value)))]
(<| (_.while (_.boolean true))
(_.if (_.= expected::lefts actual::lefts)
(_.if (_.= expected::right? actual::right?)
@@ -260,8 +260,8 @@
(..last_index inputs)
(_.>= (_.i32 +0) idx)
(_.-- idx)
- (_.set output (..some (_.array (list (_.at idx inputs)
- output)))))
+ (_.statement (_.set output (..some (_.array (list (_.at idx inputs)
+ output))))))
(_.return output))))
(def runtime//lux
@@ -280,8 +280,8 @@
(with_vars [high low]
(_.closure (list high low)
(all _.then
- (_.set (_.the ..i64_high_field @this) high)
- (_.set (_.the ..i64_low_field @this) low)
+ (_.statement (_.set (_.the ..i64_high_field @this) high))
+ (_.statement (_.set (_.the ..i64_low_field @this) low))
)))))
(def .public (i64 high low)
@@ -308,7 +308,7 @@
(def (cap_shift! shift)
(-> Var Statement)
- (_.set shift (|> shift (_.bit_and (_.i32 +63)))))
+ (_.statement (_.set shift (|> shift (_.bit_and (_.i32 +63))))))
(def (no_shift! shift input)
(-> Var Var (-> Expression Expression))
@@ -458,18 +458,18 @@
(_.define x16 (|> (high_16 x00)
(_.+ l16)
(_.+ r16)))
- (_.set x00 (low_16 x00))
+ (_.statement (_.set x00 (low_16 x00)))
(_.define x32 (|> (high_16 x16)
(_.+ l32)
(_.+ r32)))
- (_.set x16 (low_16 x16))
+ (_.statement (_.set x16 (low_16 x16)))
(_.define x48 (|> (high_16 x32)
(_.+ l48)
(_.+ r48)
low_16))
- (_.set x32 (low_16 x32))
+ (_.statement (_.set x32 (low_16 x32)))
(_.return (..i64 (_.bit_or (up_16 x48) x32)
(_.bit_or (up_16 x16) x00)))
@@ -527,26 +527,28 @@
(_.define x00 (_.* l00 r00))
(_.define x16 (high_16 x00))
- (_.set x00 (low_16 x00))
+ (_.statement (_.set x00 (low_16 x00)))
- (_.set x16 (|> x16 (_.+ (_.* l16 r00))))
- (_.define x32 (high_16 x16)) (_.set x16 (low_16 x16))
- (_.set x16 (|> x16 (_.+ (_.* l00 r16))))
- (_.set x32 (|> x32 (_.+ (high_16 x16)))) (_.set x16 (low_16 x16))
-
- (_.set x32 (|> x32 (_.+ (_.* l32 r00))))
- (_.define x48 (high_16 x32)) (_.set x32 (low_16 x32))
- (_.set x32 (|> x32 (_.+ (_.* l16 r16))))
- (_.set x48 (|> x48 (_.+ (high_16 x32)))) (_.set x32 (low_16 x32))
- (_.set x32 (|> x32 (_.+ (_.* l00 r32))))
- (_.set x48 (|> x48 (_.+ (high_16 x32)))) (_.set x32 (low_16 x32))
+ (_.statement (_.set x16 (|> x16 (_.+ (_.* l16 r00)))))
+ (_.define x32 (high_16 x16))
+ (_.statement (_.set x16 (|> x16 low_16 (_.+ (_.* l00 r16)))))
+ (_.statement (_.set x32 (|> x32 (_.+ (high_16 x16)))))
+ (_.statement (_.set x16 (low_16 x16)))
+
+ (_.statement (_.set x32 (|> x32 (_.+ (_.* l32 r00)))))
+ (_.define x48 (high_16 x32))
+ (_.statement (_.set x32 (|> x32 low_16 (_.+ (_.* l16 r16)))))
+ (_.statement (_.set x48 (|> x48 (_.+ (high_16 x32)))))
+ (_.statement (_.set x32 (|> x32 low_16 (_.+ (_.* l00 r32)))))
+ (_.statement (_.set x48 (|> x48 (_.+ (high_16 x32)))))
+ (_.statement (_.set x32 (low_16 x32)))
- (_.set x48 (|> x48
- (_.+ (_.* l48 r00))
- (_.+ (_.* l32 r16))
- (_.+ (_.* l16 r32))
- (_.+ (_.* l00 r48))
- low_16))
+ (_.statement (_.set x48 (|> x48
+ (_.+ (_.* l48 r00))
+ (_.+ (_.* l32 r16))
+ (_.+ (_.* l16 r32))
+ (_.+ (_.* l00 r48))
+ low_16)))
(_.return (..i64 (_.bit_or (up_16 x48) x32)
(_.bit_or (up_16 x16) x00)))
@@ -641,14 +643,14 @@
(i64::< approximate_remainder
remainder))
(all _.then
- (_.set approximate (_.- delta approximate))
- (_.set approximate_result approximate_result')
- (_.set approximate_remainder approx_remainder)))
- (_.set result (i64::+ (_.? (i64::= i64::zero approximate_result)
- i64::one
- approximate_result)
- result))
- (_.set remainder (i64::- approximate_remainder remainder))))))
+ (_.statement (_.set approximate (_.- delta approximate)))
+ (_.statement (_.set approximate_result approximate_result'))
+ (_.statement (_.set approximate_remainder approx_remainder))))
+ (_.statement (_.set result (i64::+ (_.? (i64::= i64::zero approximate_result)
+ i64::one
+ approximate_result)
+ result)))
+ (_.statement (_.set remainder (i64::- approximate_remainder remainder)))))))
(_.return result)))))
(runtime
@@ -761,7 +763,7 @@
(runtime
(js//set object field input)
(all _.then
- (_.set (_.at field object) input)
+ (_.statement (_.set (_.at field object) input))
(_.return object)))
(runtime
@@ -781,7 +783,7 @@
(runtime
(array//write idx value array)
(all _.then
- (_.set (_.at (_.the ..i64_low_field idx) array) value)
+ (_.statement (_.set (_.at (_.the ..i64_low_field idx) array) value))
(_.return array)))
(runtime
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/when.lux
index 7487beb55..c7790d6d1 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/when.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/when.lux
@@ -140,7 +140,7 @@
(def restore_cursor!
Statement
- (_.set @cursor (|> @savepoint (_.do "pop" (list)))))
+ (_.statement (_.set @cursor (|> @savepoint (_.do "pop" (list))))))
(def fail_pm! _.break)
@@ -154,8 +154,8 @@
[(def (<name> simple? idx)
(-> Bit Nat Statement)
(all _.then
- (_.set @temp (//runtime.sum//get ..peek_cursor <flag>
- (|> idx .int _.i32)))
+ (_.statement (_.set @temp (//runtime.sum//get ..peek_cursor <flag>
+ (|> idx .int _.i32))))
(.if simple?
(_.when (_.= _.null @temp)
..fail_pm!)
diff --git a/stdlib/source/library/lux/world/environment.lux b/stdlib/source/library/lux/world/environment.lux
index 69d8dce95..31dafca6d 100644
--- a/stdlib/source/library/lux/world/environment.lux
+++ b/stdlib/source/library/lux/world/environment.lux
@@ -375,7 +375,7 @@
<default>)
@.python (os/path::expanduser "~")
@.lua (..run_command "~" "echo ~")
- @.ruby (io.io (Dir::home))
+ @.ruby (Dir::home)
... @.php (do io.monad
... [output (..getenv/1 ["HOME"])]
... (in (if (bit#= false (as Bit output))
@@ -409,7 +409,7 @@
(if (same? default on_windows)
(..run_command default "pwd")
(in on_windows)))
- @.ruby (io.io (FileUtils::pwd))
+ @.ruby (FileUtils::pwd)
... @.php (do io.monad
... [output (..getcwd [])]
... (in (if (bit#= false (as Bit output))
diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux
index 16e205fe7..554d8c4f6 100644
--- a/stdlib/source/library/lux/world/file.lux
+++ b/stdlib/source/library/lux/world/file.lux
@@ -672,7 +672,7 @@
(def ruby_separator
Text
- (..RubyFile::SEPARATOR))
+ (io.run! (..RubyFile::SEPARATOR)))
(`` (def .public default
(System IO)