From 07426c47503a84666a9a7824d76e8d5730492d75 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 15 Dec 2018 09:22:46 -0400 Subject: Small improvements. --- stdlib/source/lux/concurrency/frp.lux | 14 ++-- stdlib/source/lux/concurrency/process.lux | 10 ++- stdlib/source/lux/concurrency/promise.lux | 6 +- stdlib/source/lux/data/format/context.lux | 25 +++--- stdlib/source/lux/data/text/encoding.lux | 5 +- stdlib/source/lux/time/duration.lux | 36 +++++---- stdlib/source/lux/time/instant.lux | 126 +++++++++++++++--------------- stdlib/source/lux/type.lux | 1 + 8 files changed, 122 insertions(+), 101 deletions(-) (limited to 'stdlib/source') 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)]]] - [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 - [_ (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 - [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 @@ -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 [ ] - [(def: #export ( scalar duration) - (-> Int Duration Duration) - (:abstraction ( scalar (:representation duration))))] + [(def: #export ( scalar) + (-> Nat Duration Duration) + (|>> :representation ( (.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 [ ] + [(def: #export (scale-up ))] + + [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 - [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 +## [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))))))))) -- cgit v1.2.3