Now logging to a data-structure and only printing in the end.

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)))))
+            ))))