- Added timing functionality to measure performance.

- Measuring performance of different parts of the compilation process.

4 files changed, 93 insertions, 60 deletions

diff --git a/stdlib/source/lux/compiler/default.lux b/stdlib/source/lux/compiler/default.lux
index 5b4a1a153..16c1a2b0e 100644
--- a/stdlib/source/lux/compiler/default.lux
+++ b/stdlib/source/lux/compiler/default.lux
@@ -29,20 +29,13 @@
      [".A" expression]]
     ["." translation (#+ Host Bundle)]
     ["." statement
-     [".S" total]]]]
+     [".S" total]]
+    ["." extension]]]
   ## (luxc [cache]
   ##       [cache/description]
   ##       [cache/io])
   )
 
-(def: (forgive-eof operation)
-  (All [s o]
-    (-> (phase.Operation s o) (phase.Operation s Any)))
-  (function (_ compiler)
-    (ex.catch syntax.end-of-file
-              (|>> [compiler])
-              (operation compiler))))
-
 (def: #export prelude Text "lux")
 
 (def: (read current-module aliases)
@@ -65,17 +58,17 @@
 ## ##                (format module-name "/" cache.descriptor-name)
 ## ##                (encoding.to-utf8 (%code (cache/description.write file-name module))))))
 
-(type: #export (Platform fs anchor expression statement)
+(type: #export (Platform ! anchor expression statement)
   {#host (Host expression statement)
    #phase (translation.Phase anchor expression statement)
    #runtime (translation.Operation anchor expression statement Any)
-   #file-system (file.System fs)})
+   #file-system (file.System !)})
 
 (type: #export Source
   {#name Text
    #code Text})
 
-(with-expansions [<Platform> (as-is (Platform fs anchor expression statement))
+(with-expansions [<Platform> (as-is (Platform ! anchor expression statement))
                   <Operation> (as-is (statement.Operation anchor expression statement Any))
                   <Compiler> (as-is (statement.State+ anchor expression statement))
                   <Bundle> (as-is (Bundle anchor expression statement))]
@@ -98,18 +91,30 @@
   (def: (loop-module-compilation module-name)
     (All [anchor expression statement]
       (-> Text <Operation>))
-    (forgive-eof
-     (loop [_ []]
-       (do phase.Monad<Operation>
-         [code (statement.lift-analysis
-                (do @
-                  [code (..read module-name syntax.no-aliases)
-                   #let [[cursor _] code]
-                   _ (analysis.set-cursor cursor)]
-                  (wrap code)))
-          _ (totalS.phase code)
-          _ init.refresh]
-         (forgive-eof (recur []))))))
+    (let [iteration (: (All [anchor expression statement]
+                         <Operation>)
+                       (<| (phase.timed (name-of ..loop-module-compilation) "ITERATION")
+                           (do phase.Monad<Operation>
+                             [code (statement.lift-analysis
+                                    (do @
+                                      [code (<| (phase.timed (name-of ..loop-module-compilation) "syntax")
+                                                (..read module-name syntax.no-aliases))
+                                       #let [[cursor _] code]
+                                       _ (analysis.set-cursor cursor)]
+                                      (wrap code)))
+                              _ (<| (phase.timed (name-of ..loop-module-compilation) "PHASE")
+                                    (totalS.phase code))]
+                             init.refresh)))]
+      (function (_ state)
+        (loop [state state]
+          (case (iteration state)
+            (#error.Success [state' output])
+            (recur state')
+            
+            (#error.Error error)
+            (if (ex.match? syntax.end-of-file error)
+              (#error.Success [state []])
+              (#error.Error error)))))))
 
   (def: (perform-module-compilation module-name source)
     (All [anchor expression statement]
@@ -120,8 +125,8 @@
       (end-module-compilation module-name)))
 
   (def: #export (compile-module platform configuration compiler)
-    (All [fs anchor expression statement]
-      (-> <Platform> Configuration <Compiler> (fs <Compiler>)))
+    (All [! anchor expression statement]
+      (-> <Platform> Configuration <Compiler> (! <Compiler>)))
     (do (:: (get@ #file-system platform) &monad)
       [source (context.read (get@ #file-system platform)
                             (get@ #cli.sources configuration)
@@ -132,15 +137,15 @@
       (<| (:: @ map product.left)
           (:: (get@ #file-system platform) lift)
           (phase.run' compiler)
-          (:share [fs anchor expression statement]
+          (:share [! anchor expression statement]
                   {<Platform>
                    platform}
                   {<Operation>
                    (perform-module-compilation (get@ #cli.module configuration) source)}))))
 
   (def: #export (initialize platform configuration translation-bundle)
-    (All [fs anchor expression statement]
-      (-> <Platform> Configuration <Bundle> (fs <Compiler>)))
+    (All [! anchor expression statement]
+      (-> <Platform> Configuration <Bundle> (! <Compiler>)))
     (|> platform
         (get@ #runtime)
         statement.lift-translation
@@ -177,8 +182,8 @@
     )
 
   (def: #export (compile platform configuration translation-bundle)
-    (All [fs anchor expression statement]
-      (-> <Platform> Configuration <Bundle> (fs Any)))
+    (All [! anchor expression statement]
+      (-> <Platform> Configuration <Bundle> (! Any)))
     (do (:: (get@ #file-system platform) &monad)
       [compiler (initialize platform configuration translation-bundle)
        _ (compile-module platform (set@ #cli.module ..prelude configuration) compiler)
diff --git a/stdlib/source/lux/compiler/default/phase.lux b/stdlib/source/lux/compiler/default/phase.lux
index 25ceea746..a81d5dfa7 100644
--- a/stdlib/source/lux/compiler/default/phase.lux
+++ b/stdlib/source/lux/compiler/default/phase.lux
@@ -9,6 +9,10 @@
     ["." error (#+ Error) ("error/." Functor<Error>)]
     ["." text
      format]]
+   [time
+    ["." instant]
+    ["." duration]]
+   ["." io]
    [macro
     ["s" syntax (#+ syntax:)]]])
 
@@ -94,3 +98,18 @@
       [[pre/state' temp] (pre input pre/state)
        [post/state' output] (post temp post/state)]
       (wrap [[pre/state' post/state'] output]))))
+
+(def: #export (timed definition description operation)
+  (All [s a]
+    (-> Name Text (Operation s a) (Operation s a)))
+  (do Monad<Operation>
+    [_ (wrap [])
+     #let [pre (io.run instant.now)]
+     output operation
+     #let [_ (log! (|> instant.now
+                       io.run
+                       instant.relative
+                       (duration.difference (instant.relative pre))
+                       %duration
+                       (format (%name definition) " [" description "]: ")))]]
+    (wrap output)))
diff --git a/stdlib/source/lux/compiler/default/phase/extension/statement.lux b/stdlib/source/lux/compiler/default/phase/extension/statement.lux
index 6d2fbaa4e..051d264c2 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/statement.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/statement.lux
@@ -51,35 +51,40 @@
   (All [anchor expression statement]
     (-> Name (Maybe Type) Code
         (Operation anchor expression statement [Type expression Text Any])))
-  (do ///.Monad<Operation>
-    [state (//.lift ///.get-state)
-     #let [analyse (get@ [#statement.analysis #statement.phase] state)
-           synthesize (get@ [#statement.synthesis #statement.phase] state)
-           translate (get@ [#statement.translation #statement.phase] state)]
-     [_ code//type codeA] (statement.lift-analysis
-                           (analysis.with-scope
-                             (type.with-fresh-env
-                               (case ?type
-                                 (#.Some type)
-                                 (type.with-type type
-                                   (do @
-                                     [codeA (analyse codeC)]
-                                     (wrap [type codeA])))
-
-                                 #.None
-                                 (do @
-                                   [[code//type codeA] (type.with-inference (analyse codeC))
-                                    code//type (type.with-env
-                                                 (check.clean code//type))]
-                                   (wrap [code//type codeA]))))))
-     codeS (statement.lift-synthesis
-            (synthesize codeA))]
-    (statement.lift-translation
-     (translation.with-buffer
-       (do @
-         [codeT (translate codeS)
-          codeN+V (translation.define! name codeT)]
-         (wrap [code//type codeT codeN+V]))))))
+  (<| (///.timed name "DEFINE")
+      (do ///.Monad<Operation>
+        [state (//.lift ///.get-state)
+         #let [analyse (get@ [#statement.analysis #statement.phase] state)
+               synthesize (get@ [#statement.synthesis #statement.phase] state)
+               translate (get@ [#statement.translation #statement.phase] state)]
+         [_ code//type codeA] (<| (///.timed name "analysis")
+                                  (statement.lift-analysis
+                                   (analysis.with-scope
+                                     (type.with-fresh-env
+                                       (case ?type
+                                         (#.Some type)
+                                         (type.with-type type
+                                           (do @
+                                             [codeA (analyse codeC)]
+                                             (wrap [type codeA])))
+
+                                         #.None
+                                         (do @
+                                           [[code//type codeA] (type.with-inference (analyse codeC))
+                                            code//type (type.with-env
+                                                         (check.clean code//type))]
+                                           (wrap [code//type codeA])))))))
+         codeS (<| (///.timed name "synthesis")
+                   (statement.lift-synthesis
+                    (synthesize codeA)))]
+        (statement.lift-translation
+         (translation.with-buffer
+           (do @
+             [codeT (<| (///.timed name "translation")
+                        (translate codeS))
+              codeN+V (<| (///.timed name "evaluation")
+                          (translation.define! name codeT))]
+             (wrap [code//type codeT codeN+V])))))))
 
 (def: lux::def
   Handler
diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux
index d14ce451e..91f262fe4 100644
--- a/stdlib/source/lux/time/duration.lux
+++ b/stdlib/source/lux/time/duration.lux
@@ -47,6 +47,10 @@
 
   (def: #export inverse (scale-up -1))
 
+  (def: #export (difference from to)
+    (-> Duration Duration Duration)
+    (|> from inverse (merge to)))
+
   (def: #export (query param subject)
     (-> Duration Duration Int)
     (i// (:representation param) (:representation subject)))