aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/concurrency/frp.lux14
-rw-r--r--stdlib/source/lux/concurrency/process.lux10
-rw-r--r--stdlib/source/lux/concurrency/promise.lux6
-rw-r--r--stdlib/source/lux/data/format/context.lux25
-rw-r--r--stdlib/source/lux/data/text/encoding.lux5
-rw-r--r--stdlib/source/lux/time/duration.lux36
-rw-r--r--stdlib/source/lux/time/instant.lux126
-rw-r--r--stdlib/source/lux/type.lux1
8 files changed, 122 insertions, 101 deletions
diff --git a/stdlib/source/lux/concurrency/frp.lux b/stdlib/source/lux/concurrency/frp.lux
index d188a90da..8db54f28f 100644
--- a/stdlib/source/lux/concurrency/frp.lux
+++ b/stdlib/source/lux/concurrency/frp.lux
@@ -8,13 +8,12 @@
[data
[collection
[list ("list/." Monoid<List>)]]]
- [type
+ [type (#+ :share)
abstract]]
[//
["." atom (#+ Atom atom)]
["." promise (#+ Promise)]])
-## [Types]
(abstract: #export (Channel a)
{#.doc "An asynchronous channel to distribute values."}
(Atom (List (-> a (IO Any))))
@@ -23,22 +22,22 @@
(All [a] (-> Any (Channel a)))
(:abstraction (atom (list))))
- (def: #export (listen listener (^:representation channel))
+ (def: #export (listen listener channel)
(All [a] (-> (-> a (IO Any)) (Channel a) (IO Any)))
## TODO: Simplify when possible.
(do io.Monad<IO>
- [_ (atom.update (|>> (#.Cons listener)) channel)]
+ [_ (atom.update (|>> (#.Cons listener))
+ (:representation channel))]
(wrap [])))
- (def: #export (publish (^:representation channel) value)
+ (def: #export (publish channel value)
{#.doc "Publish to a channel."}
(All [a] (-> (Channel a) a (IO Any)))
(do io.Monad<IO>
- [listeners (atom.read channel)]
+ [listeners (atom.read (:representation channel))]
(monad.map @ (function (_ listener) (listener value)) listeners)))
)
-## [Values]
(def: #export (filter predicate input)
(All [a] (-> (-> a Bit) (Channel a) (Channel a)))
(let [output (channel [])]
@@ -100,7 +99,6 @@
(wrap (promise.await recur (f zero))))))
output)))
-## [Structures]
(structure: #export _ (Functor Channel)
(def: (map f input)
(let [output (channel [])]
diff --git a/stdlib/source/lux/concurrency/process.lux b/stdlib/source/lux/concurrency/process.lux
index c2b519fb4..a67734747 100644
--- a/stdlib/source/lux/concurrency/process.lux
+++ b/stdlib/source/lux/concurrency/process.lux
@@ -34,7 +34,8 @@
(import: java/util/concurrent/ScheduledThreadPoolExecutor
(new [int])
(schedule [Runnable long TimeUnit] #io (ScheduledFuture Object))))}
-
+
+ ## Default
(type: Process
{#creation Nat
#delay Nat
@@ -47,12 +48,15 @@
(|> (Runtime::getRuntime)
(Runtime::availableProcessors)
.nat)}
+
+ ## Default
1)))
(def: runner
(`` (for {(~~ (static host.jvm))
(ScheduledThreadPoolExecutor::new (.int ..parallelism))}
+ ## Default
(: (Atom (List Process))
(atom.atom (list))))))
@@ -67,6 +71,8 @@
0 (Executor::execute runnable runner)
_ (ScheduledThreadPoolExecutor::schedule runnable (.int milli-seconds) TimeUnit::MILLISECONDS
runner)))}
+
+ ## Default
(atom.update (|>> (#.Cons {#creation ("lux io current-time")
#delay milli-seconds
#action action}))
@@ -74,6 +80,8 @@
(`` (for {(~~ (static host.jvm))
(as-is)}
+
+ ## Default
(as-is (exception: #export (cannot-continue-running-processes) "")
(def: #export run!
diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux
index 24f26a24c..1a471022f 100644
--- a/stdlib/source/lux/concurrency/promise.lux
+++ b/stdlib/source/lux/concurrency/promise.lux
@@ -141,7 +141,8 @@
left||right))))
(def: #export (schedule millis-delay computation)
- {#.doc "Runs an I/O computation on its own process (after a specified delay) and returns a Promise that will eventually host its result."}
+ {#.doc (doc "Runs an I/O computation on its own process (after a specified delay)."
+ "Returns a Promise that will eventually host its result.")}
(All [a] (-> Nat (IO a) (Promise a)))
(let [!out (promise #.None)]
(exec (|> (do io.Monad<IO>
@@ -152,7 +153,8 @@
!out)))
(def: #export future
- {#.doc "Runs an I/O computation on its own process and returns a Promise that will eventually host its result."}
+ {#.doc (doc "Runs an I/O computation on its own process."
+ "Returns a Promise that will eventually host its result.")}
(All [a] (-> (IO a) (Promise a)))
(schedule 0))
diff --git a/stdlib/source/lux/data/format/context.lux b/stdlib/source/lux/data/format/context.lux
index 0cc7d0da8..b5d86139a 100644
--- a/stdlib/source/lux/data/format/context.lux
+++ b/stdlib/source/lux/data/format/context.lux
@@ -1,26 +1,29 @@
(.module:
[lux #*
[control
- ["p" parser]
+ [parser (#+ Parser)]
["ex" exception (#+ exception:)]
[monad (#+ do)]]
[data
- ["E" error]
- [collection ["dict" dictionary (#+ Dictionary)]]]])
+ ["." error (#+ Error)]
+ [text
+ format]
+ [collection
+ ["." dictionary (#+ Dictionary)]]]])
(exception: #export (unknown-property {property Text})
- property)
+ (ex.report ["Property" (%t property)]))
(type: #export Context
(Dictionary Text Text))
(type: #export (Property a)
- (p.Parser Context a))
+ (Parser Context a))
(def: #export (property name)
(-> Text (Property Text))
(function (_ context)
- (case (dict.get name context)
+ (case (dictionary.get name context)
(#.Some value)
(ex.return [context value])
@@ -28,10 +31,10 @@
(ex.throw unknown-property name))))
(def: #export (run context property)
- (All [a] (-> Context (Property a) (E.Error a)))
+ (All [a] (-> Context (Property a) (Error a)))
(case (property context)
- (#E.Success [_ output])
- (#E.Success output)
+ (#error.Success [_ output])
+ (#error.Success output)
- (#E.Error error)
- (#E.Error error)))
+ (#error.Error error)
+ (#error.Error error)))
diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux
index de4bdf310..bd1a255ec 100644
--- a/stdlib/source/lux/data/text/encoding.lux
+++ b/stdlib/source/lux/data/text/encoding.lux
@@ -4,8 +4,9 @@
["." error (#+ Error)]]
[world
[binary (#+ Binary)]]
- [compiler
- ["_" host]]
+ [platform
+ [compiler
+ ["_" host]]]
[host (#+ import:)]])
(`` (for {(~~ (static _.jvm))
diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux
index 35401497a..699abe31d 100644
--- a/stdlib/source/lux/time/duration.lux
+++ b/stdlib/source/lux/time/duration.lux
@@ -37,15 +37,17 @@
)
(do-template [<name> <op>]
- [(def: #export (<name> scalar duration)
- (-> Int Duration Duration)
- (:abstraction (<op> scalar (:representation duration))))]
+ [(def: #export (<name> scalar)
+ (-> Nat Duration Duration)
+ (|>> :representation (<op> (.int scalar)) :abstraction))]
[scale-up i/*]
[scale-down i//]
)
- (def: #export inverse (scale-up -1))
+ (def: #export inverse
+ (-> Duration Duration)
+ (|>> :representation (i/* -1) :abstraction))
(def: #export (difference from to)
(-> Duration Duration Duration)
@@ -95,15 +97,21 @@
)
)
-(def: #export empty Duration (from-millis +0))
-(def: #export milli Duration (from-millis +1))
-(def: #export second Duration (scale-up +1_000 milli))
-(def: #export minute Duration (scale-up +60 second))
-(def: #export hour Duration (scale-up +60 minute))
-(def: #export day Duration (scale-up +24 hour))
-(def: #export week Duration (scale-up +7 day))
-(def: #export normal-year Duration (scale-up +365 day))
-(def: #export leap-year Duration (merge day normal-year))
+(def: #export empty (from-millis +0))
+(def: #export milli-second (from-millis +1))
+
+(do-template [<name> <scale> <base>]
+ [(def: #export <name> (scale-up <scale> <base>))]
+
+ [second 1_000 milli-second]
+ [minute 60 second]
+ [hour 60 minute]
+ [day 24 hour]
+ [week 7 day]
+ [normal-year 365 day]
+ )
+
+(def: #export leap-year (merge day normal-year))
(structure: #export _ (Monoid Duration)
(def: identity empty)
@@ -119,7 +127,7 @@
(int/abs days)
days)
time-left (if signed?
- (scale-up -1 time-left)
+ (..inverse time-left)
time-left)
[hours time-left] [(query hour time-left) (frame hour time-left)]
[minutes time-left] [(query minute time-left) (frame minute time-left)]
diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux
index 70890ce4b..08029405a 100644
--- a/stdlib/source/lux/time/instant.lux
+++ b/stdlib/source/lux/time/instant.lux
@@ -102,7 +102,7 @@
(if (i/= +0 (duration.query year time-left))
[reference time-left]
(if (duration/>= duration.empty time-left)
- (recur (inc reference) (duration.merge (duration.scale-up -1 year) time-left))
+ (recur (inc reference) (duration.merge (duration.inverse year) time-left))
(recur (dec reference) (duration.merge year time-left)))
))))
@@ -121,14 +121,14 @@
(-> (Row Nat) duration.Duration [Nat duration.Duration])
(if (duration/>= duration.empty time)
(row/fold (function (_ month-days [current-month time-left])
- (let [month-duration (duration.scale-up (.int month-days) duration.day)]
+ (let [month-duration (duration.scale-up month-days duration.day)]
(if (i/= +0 (duration.query month-duration time-left))
[current-month time-left]
- [(inc current-month) (duration.merge (duration.scale-up -1 month-duration) time-left)])))
+ [(inc current-month) (duration.merge (duration.inverse month-duration) time-left)])))
[0 time]
months)
(row/fold (function (_ month-days [current-month time-left])
- (let [month-duration (duration.scale-up (.int month-days) duration.day)]
+ (let [month-duration (duration.scale-up month-days duration.day)]
(if (i/= +0 (duration.query month-duration time-left))
[current-month time-left]
[(dec current-month) (duration.merge month-duration time-left)])))
@@ -243,65 +243,65 @@
(i/+ (i// +400 year))))
## Based on: https://stackoverflow.com/a/3309340/6823464
-(def: lex-instant
- (l.Lexer Instant)
- (do p.Monad<Parser>
- [utc-year lex-year
- _ (l.this "-")
- utc-month lex-section
- _ (p.assert "Invalid month."
- (and (i/>= +1 utc-month)
- (i/<= +12 utc-month)))
- #let [months (if (leap-year? utc-year)
- leap-year-months
- normal-months)
- month-days (|> months
- (row.nth (.nat (dec utc-month)))
- maybe.assume)]
- _ (l.this "-")
- utc-day lex-section
- _ (p.assert "Invalid day."
- (and (i/>= +1 utc-day)
- (i/<= (.int month-days) utc-day)))
- _ (l.this "T")
- utc-hour lex-section
- _ (p.assert "Invalid hour."
- (and (i/>= +0 utc-hour)
- (i/<= +23 utc-hour)))
- _ (l.this ":")
- utc-minute lex-section
- _ (p.assert "Invalid minute."
- (and (i/>= +0 utc-minute)
- (i/<= +59 utc-minute)))
- _ (l.this ":")
- utc-second lex-section
- _ (p.assert "Invalid second."
- (and (i/>= +0 utc-second)
- (i/<= +59 utc-second)))
- utc-millis lex-millis
- _ (l.this "Z")
- #let [years-since-epoch (i/- epoch-year utc-year)
- previous-leap-days (i/- (leap-years epoch-year)
- (leap-years (dec utc-year)))
- year-days-so-far (|> (i/* +365 years-since-epoch)
- (i/+ previous-leap-days))
- month-days-so-far (|> months
- row.to-list
- (list.take (.nat (dec utc-month)))
- (list/fold n/+ 0))
- total-days (|> year-days-so-far
- (i/+ (.int month-days-so-far))
- (i/+ (dec utc-day)))]]
- (wrap (|> epoch
- (shift (duration.scale-up total-days duration.day))
- (shift (duration.scale-up utc-hour duration.hour))
- (shift (duration.scale-up utc-minute duration.minute))
- (shift (duration.scale-up utc-second duration.second))
- (shift (duration.scale-up utc-millis duration.milli))))))
-
-(def: (decode input)
- (-> Text (e.Error Instant))
- (l.run input lex-instant))
+## (def: lex-instant
+## (l.Lexer Instant)
+## (do p.Monad<Parser>
+## [utc-year lex-year
+## _ (l.this "-")
+## utc-month lex-section
+## _ (p.assert "Invalid month."
+## (and (i/>= +1 utc-month)
+## (i/<= +12 utc-month)))
+## #let [months (if (leap-year? utc-year)
+## leap-year-months
+## normal-months)
+## month-days (|> months
+## (row.nth (.nat (dec utc-month)))
+## maybe.assume)]
+## _ (l.this "-")
+## utc-day lex-section
+## _ (p.assert "Invalid day."
+## (and (i/>= +1 utc-day)
+## (i/<= (.int month-days) utc-day)))
+## _ (l.this "T")
+## utc-hour lex-section
+## _ (p.assert "Invalid hour."
+## (and (i/>= +0 utc-hour)
+## (i/<= +23 utc-hour)))
+## _ (l.this ":")
+## utc-minute lex-section
+## _ (p.assert "Invalid minute."
+## (and (i/>= +0 utc-minute)
+## (i/<= +59 utc-minute)))
+## _ (l.this ":")
+## utc-second lex-section
+## _ (p.assert "Invalid second."
+## (and (i/>= +0 utc-second)
+## (i/<= +59 utc-second)))
+## utc-millis lex-millis
+## _ (l.this "Z")
+## #let [years-since-epoch (i/- epoch-year utc-year)
+## previous-leap-days (i/- (leap-years epoch-year)
+## (leap-years (dec utc-year)))
+## year-days-so-far (|> (i/* +365 years-since-epoch)
+## (i/+ previous-leap-days))
+## month-days-so-far (|> months
+## row.to-list
+## (list.take (.nat (dec utc-month)))
+## (list/fold n/+ 0))
+## total-days (|> year-days-so-far
+## (i/+ (.int month-days-so-far))
+## (i/+ (dec utc-day)))]]
+## (wrap (|> epoch
+## (shift (duration.scale-up total-days duration.day))
+## (shift (duration.scale-up utc-hour duration.hour))
+## (shift (duration.scale-up utc-minute duration.minute))
+## (shift (duration.scale-up utc-second duration.second))
+## (shift (duration.scale-up utc-millis duration.milli))))))
+
+## (def: (decode input)
+## (-> Text (e.Error Instant))
+## (l.run input lex-instant))
## (structure: #export _
## {#.doc (doc "Based on ISO 8601."
diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux
index e010c2a98..6dcc8981d 100644
--- a/stdlib/source/lux/type.lux
+++ b/stdlib/source/lux/type.lux
@@ -388,5 +388,6 @@
(-> (~ (get@ #type exemplar))
(~ (get@ #type computation))))
(.function ((~ g!_) (~ g!_))
+ ## TODO: this should use : instead of :assume
(:assume (~ (get@ #expression computation))))))]
(wrap (list (` ((~ shareC) (~ (get@ #expression exemplar)))))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 08:41:35 +0000