aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/concurrency/frp.lux2
-rw-r--r--stdlib/source/lux/time/instant.lux18
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux30
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/generation.lux16
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux17
-rw-r--r--stdlib/source/test/lux/control.lux10
-rw-r--r--stdlib/source/test/lux/control/concatenative.lux87
-rw-r--r--stdlib/source/test/lux/control/concurrency/frp.lux2
-rw-r--r--stdlib/source/test/lux/control/concurrency/process.lux46
10 files changed, 202 insertions, 30 deletions
diff --git a/stdlib/source/lux/control/concurrency/frp.lux b/stdlib/source/lux/control/concurrency/frp.lux
index 3dc596a91..a9beb4a0e 100644
--- a/stdlib/source/lux/control/concurrency/frp.lux
+++ b/stdlib/source/lux/control/concurrency/frp.lux
@@ -204,7 +204,7 @@
(#.Some [head tail])
(do @
[init' (f head init)]
- (folds f init' tail)))))
+ (wrap (#.Some [init (folds f init' tail)]))))))
(def: #export (poll milli-seconds action)
(All [a]
diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux
index a8d308951..bd378016a 100644
--- a/stdlib/source/lux/time/instant.lux
+++ b/stdlib/source/lux/time/instant.lux
@@ -23,7 +23,7 @@
[type
abstract]]
[//
- ["." duration]
+ ["." duration (#+ Duration)]
["." date (#+ Date)]
["." month (#+ Month)]
["." day (#+ Day)]])
@@ -41,19 +41,19 @@
(|>> :representation))
(def: #export (span from to)
- (-> Instant Instant duration.Duration)
+ (-> Instant Instant Duration)
(duration.from-millis (i.- (:representation from) (:representation to))))
(def: #export (shift duration instant)
- (-> duration.Duration Instant Instant)
+ (-> Duration Instant Instant)
(:abstraction (i.+ (duration.to-millis duration) (:representation instant))))
(def: #export (relative instant)
- (-> Instant duration.Duration)
+ (-> Instant Duration)
(|> instant :representation duration.from-millis))
(def: #export (absolute offset)
- (-> duration.Duration Instant)
+ (-> Duration Instant)
(|> offset duration.to-millis :abstraction))
(structure: #export equivalence (Equivalence Instant)
@@ -94,7 +94,7 @@
(def: epoch-year Int +1970)
(def: (find-year now)
- (-> Instant [Int duration.Duration])
+ (-> Instant [Int Duration])
(loop [reference epoch-year
time-left (relative now)]
(let [year (if (leap-year? reference)
@@ -108,7 +108,7 @@
))))
(def: (find-month months time)
- (-> (Row Nat) duration.Duration [Nat duration.Duration])
+ (-> (Row Nat) Duration [Nat Duration])
(if (order.>= duration.order duration.empty time)
(row@fold (function (_ month-days [current-month time-left])
(let [month-duration (duration.scale-up month-days duration.day)]
@@ -132,7 +132,7 @@
(i@encode value)))
(def: (adjust-negative space duration)
- (-> duration.Duration duration.Duration duration.Duration)
+ (-> Duration Duration Duration)
(if (duration.negative? duration)
(duration.merge space duration)
duration))
@@ -149,7 +149,7 @@
(def: days-up-to-epoch Int +719468)
(def: (extract-date instant)
- (-> Instant [[Int Int Int] duration.Duration])
+ (-> Instant [[Int Int Int] Duration])
(let [offset (relative instant)
seconds (duration.query duration.second offset)
z (|> seconds (i./ seconds-per-day) (i.+ days-up-to-epoch))
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index 26a301f86..76939bb08 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -16,7 +16,7 @@
["%" format (#+ format)]]
[collection
[dictionary (#+ Dictionary)]
- ["." row]
+ ["." row ("#@." fold)]
["." set]
["." list ("#@." monoid)]]
[format
@@ -210,6 +210,28 @@
_ (..cache-module platform host target 0 extension payload)]
(wrap [state archive])))))
+ (def: module-compilation-log
+ (All [<type-vars>]
+ (-> <State+> Text))
+ (|>> (get@ [#extension.state
+ #///directive.generation
+ #///directive.state
+ #extension.state
+ #///generation.log])
+ (row@fold (function (_ right left)
+ (format left text.new-line right))
+ "")))
+
+ (def: with-reset-log
+ (All [<type-vars>]
+ (-> <State+> <State+>))
+ (set@ [#extension.state
+ #///directive.generation
+ #///directive.state
+ #extension.state
+ #///generation.log]
+ row.empty))
+
(def: #export (compile target partial-host-extension expander platform host configuration archive extension state)
(All [<type-vars>]
(-> Text Text Expander <Platform> Host Configuration Archive Text <State+> (Promise (Try [Archive <State+>]))))
@@ -274,11 +296,13 @@
(#.Right [[descriptor document] output])
(do (try.with promise.monad)
- [#let [descriptor (set@ #descriptor.references (set.from-list text.hash all-dependencies) descriptor)]
+ [#let [_ (log! (..module-compilation-log state))
+ descriptor (set@ #descriptor.references (set.from-list text.hash all-dependencies) descriptor)]
_ (..cache-module platform host target module-id extension [[descriptor document] output])]
(case (archive.add module [descriptor document] archive)
(#try.Success archive)
- (wrap [archive state])
+ (wrap [archive
+ (..with-reset-log state)])
(#try.Failure error)
(promise@wrap (#try.Failure error)))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/lux/tool/compiler/language/lux/generation.lux
index 336e4913a..41dcdd990 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/generation.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/generation.lux
@@ -1,5 +1,5 @@
(.module:
- [lux (#- Module)
+ [lux (#- Module log!)
[abstract
[monad (#+ do)]]
[control
@@ -66,7 +66,8 @@
#buffer (Maybe (Buffer directive))
#registry artifact.Registry
#counter Nat
- #context (Maybe artifact.ID)})
+ #context (Maybe artifact.ID)
+ #log (Row Text)})
(template [<special> <general>]
[(type: #export (<special> anchor expression directive)
@@ -90,7 +91,8 @@
#buffer #.None
#registry artifact.empty
#counter 0
- #context #.None})
+ #context #.None
+ #log row.empty})
(def: #export empty-buffer Buffer row.empty)
@@ -303,3 +305,11 @@
(wrap [[bundle' (set@ #context (get@ #context state) state')]
[[module-id id]
output]])))))
+
+(def: #export (log! message)
+ (All [anchor expression directive a]
+ (-> Text (Operation anchor expression directive Any)))
+ (function (_ [bundle state])
+ (#try.Success [[bundle
+ (update@ #log (row.add message) state)]
+ []])))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux
index 4db15e8e6..cb3277591 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux
@@ -44,6 +44,7 @@
[compiler
["." analysis]
["." synthesis]
+ ["." generation]
["." directive (#+ Handler Bundle)]
["." phase
[analysis
@@ -291,7 +292,8 @@
## (list@map ..field-definition fields)
## (list) ## TODO: Add methods
## (row.row))]))
- #let [_ (log! (format "Class " name))]]
+ _ (directive.lift-generation
+ (generation.log! (format "Class " name)))]
(wrap directive.no-requirements)))]))
(def: #export bundle
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
index f7099d2c4..24d059031 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
@@ -197,6 +197,12 @@
[(///analysis.bundle eval host-analysis)]))
state)])))
+(def: (announce-definition! name)
+ (All [anchor expression directive]
+ (-> Name (Operation anchor expression directive Any)))
+ (/////directive.lift-generation
+ (/////generation.log! (format "Definition " (%.name name)))))
+
(def: (lux::def expander host-analysis)
(-> Expander /////analysis.Bundle Handler)
(function (_ extension-name phase archive inputsC+)
@@ -210,8 +216,8 @@
[_ annotationsT annotations] (evaluate! archive Code annotationsC)
_ (/////directive.lift-analysis
(module.define short-name (#.Right [exported? type (:coerce Code annotations) value])))
- #let [_ (log! (format "Definition " (%.name full-name)))]
- _ (..refresh expander host-analysis)]
+ _ (..refresh expander host-analysis)
+ _ (..announce-definition! full-name)]
(wrap /////directive.no-requirements))
_
@@ -233,8 +239,8 @@
(do phase.monad
[_ (module.define short-name (#.Right [exported? type annotations value]))]
(module.declare-tags tags exported? (:coerce Type value))))
- #let [_ (log! (format "Definition " (%.name full-name)))]
- _ (..refresh expander host-analysis)]
+ _ (..refresh expander host-analysis)
+ _ (..announce-definition! full-name)]
(wrap /////directive.no-requirements)))]))
(def: imports
@@ -317,7 +323,8 @@
handler}
{<type>
(:assume handlerV)}))
- #let [_ (log! (format <description> " " (%.text (:coerce Text name))))]]
+ _ (/////directive.lift-generation
+ (/////generation.log! (format <description> " " (%.text (:coerce Text name)))))]
(wrap /////directive.no-requirements))
_
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index e90ab54f1..b393e1325 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -17,10 +17,11 @@
["#." thread]
["#." writer]
[concurrency
+ ["#." actor]
["#." atom]
- ["#." promise]
["#." frp]
- ["#." actor]
+ ["#." process]
+ ["#." promise]
["#." stm]]
["#." parser #_
["#/." text]
@@ -34,10 +35,11 @@
(def: concurrency
Test
($_ _.and
+ /actor.test
/atom.test
- /promise.test
/frp.test
- /actor.test
+ /process.test
+ /promise.test
/stm.test
))
diff --git a/stdlib/source/test/lux/control/concatenative.lux b/stdlib/source/test/lux/control/concatenative.lux
index 6701916fc..52cd5d214 100644
--- a/stdlib/source/test/lux/control/concatenative.lux
+++ b/stdlib/source/test/lux/control/concatenative.lux
@@ -146,11 +146,94 @@
|inc| (/.apply/1 inc)
|test| (/.apply/1 (|>> (n.- start) (n.< distance)))]]
($_ _.and
- (_.cover [/.call]
+ (_.cover [/.call /.apply/1]
(n.= (inc sample)
(||> (/.push sample)
(/.push (/.apply/1 inc))
/.call)))
+ (_.cover [/.apply/2]
+ (n.= (n.+ sample sample)
+ (||> (/.push sample)
+ (/.push sample)
+ (/.push (/.apply/2 n.+))
+ /.call)))
+ (_.cover [/.apply/3]
+ (n.= ($_ n.+ sample sample sample)
+ (||> (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push (/.apply/3 (function (_ i0 i1 i2)
+ ($_ n.+ i0 i1 i2))))
+ /.call)))
+ (_.cover [/.apply/4]
+ (n.= ($_ n.+ sample sample sample sample)
+ (||> (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push (/.apply/4 (function (_ i0 i1 i2 i3)
+ ($_ n.+ i0 i1 i2 i3))))
+ /.call)))
+ (_.cover [/.apply/5]
+ (n.= ($_ n.+ sample sample sample sample sample)
+ (||> (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push (/.apply/5 (function (_ i0 i1 i2 i3 i4)
+ ($_ n.+ i0 i1 i2 i3 i4))))
+ /.call)))
+ (_.cover [/.apply/6]
+ (n.= ($_ n.+ sample sample sample sample sample sample)
+ (||> (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push (/.apply/6 (function (_ i0 i1 i2 i3 i4 i5)
+ ($_ n.+ i0 i1 i2 i3 i4 i5))))
+ /.call)))
+ (_.cover [/.apply/7]
+ (n.= ($_ n.+ sample sample sample sample sample sample sample)
+ (||> (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push (/.apply/7 (function (_ i0 i1 i2 i3 i4 i5 i6)
+ ($_ n.+ i0 i1 i2 i3 i4 i5 i6))))
+ /.call)))
+ (_.cover [/.apply/8]
+ (n.= ($_ n.+ sample sample sample sample sample sample sample sample)
+ (||> (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push (/.apply/8 (function (_ i0 i1 i2 i3 i4 i5 i6 i7)
+ ($_ n.+ i0 i1 i2 i3 i4 i5 i6 i7))))
+ /.call)))
+ (_.cover [/.apply]
+ (n.= ($_ n.+ sample sample sample sample sample sample sample sample sample)
+ (||> (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push sample)
+ (/.push ((/.apply 9) (function (_ i0 i1 i2 i3 i4 i5 i6 i7 i8)
+ ($_ n.+ i0 i1 i2 i3 i4 i5 i6 i7 i8))))
+ /.call)))
(_.cover [/.if]
(n.= (if choice
(inc sample)
@@ -219,7 +302,7 @@
Test
(do random.monad
[sample random.nat]
- (_.cover [/.word:]
+ (_.cover [/.word: /.=> /.||>]
(n.= (n.* sample sample)
(||> (/.push sample)
..square)))))
diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux
index f7f7427b6..8752a195f 100644
--- a/stdlib/source/test/lux/control/concurrency/frp.lux
+++ b/stdlib/source/test/lux/control/concurrency/frp.lux
@@ -13,8 +13,6 @@
["." exception]
["." io (#+ IO io)]]
[data
- [text
- ["%" format (#+ format)]]
[number
["n" nat]]
[collection
diff --git a/stdlib/source/test/lux/control/concurrency/process.lux b/stdlib/source/test/lux/control/concurrency/process.lux
new file mode 100644
index 000000000..165fbad93
--- /dev/null
+++ b/stdlib/source/test/lux/control/concurrency/process.lux
@@ -0,0 +1,46 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." io]]
+ [data
+ [number
+ ["n" nat]
+ ["i" int]]]
+ [time
+ ["." instant (#+ Instant)]
+ ["." duration]]
+ [math
+ ["." random]]]
+ {1
+ ["." /
+ [//
+ ["." atom (#+ Atom)]
+ ["." promise]]]})
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (do random.monad
+ [dummy random.nat
+ expected random.nat
+ delay (|> random.nat (:: @ map (n.% 100)))]
+ ($_ _.and
+ (_.cover [/.parallelism]
+ (n.> 0 /.parallelism))
+ (wrap (do promise.monad
+ [reference-time (promise.future instant.now)
+ #let [box (atom.atom [reference-time dummy])]
+ _ (promise.future
+ (/.schedule delay (do io.monad
+ [execution-time instant.now]
+ (atom.write [execution-time expected] box))))
+ _ (promise.wait delay)
+ [execution-time actual] (promise.future (atom.read box))]
+ (_.claim [/.schedule]
+ (and (i.>= (.int delay)
+ (duration.to-millis (instant.span reference-time execution-time)))
+ (n.= expected actual)))))
+ ))))