aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--stdlib/source/lux/compiler/default.lux67
-rw-r--r--stdlib/source/lux/compiler/default/phase.lux19
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension/statement.lux63
-rw-r--r--stdlib/source/lux/time/duration.lux4
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)))