diff options
| -rw-r--r-- | stdlib/source/lux/compiler/default.lux | 67 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/default/phase.lux | 19 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/default/phase/extension/statement.lux | 63 | ||||
| -rw-r--r-- | stdlib/source/lux/time/duration.lux | 4 |
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))) |