From 9ff129bfc295354289d072df102277e458d34208 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 13 Oct 2018 13:41:03 -0400 Subject: Introduced an explicit "Compiler" abstraction. --- stdlib/source/lux/compiler.lux | 20 +++++++ stdlib/source/lux/compiler/default.lux | 21 +++----- stdlib/source/lux/compiler/meta/io.lux | 4 +- stdlib/source/lux/compiler/meta/io/context.lux | 74 ++++++++++++++------------ 4 files changed, 69 insertions(+), 50 deletions(-) create mode 100644 stdlib/source/lux/compiler.lux diff --git a/stdlib/source/lux/compiler.lux b/stdlib/source/lux/compiler.lux new file mode 100644 index 000000000..cdbc598bb --- /dev/null +++ b/stdlib/source/lux/compiler.lux @@ -0,0 +1,20 @@ +(.module: + [lux (#- Source) + [control + ["ex" exception (#+ exception:)]] + [world + ["." file (#+ File)]]] + [/ + [meta + ["." archive (#+ Document Archive)]]]) + +(type: #export Source + {#name Text + #file File + #code Text}) + +(type: #export (Compiler d !) + (-> (file.System !) Archive Source (! (Document d)))) + +(exception: #export (cannot-compile {name Text}) + (ex.report ["Module" name])) diff --git a/stdlib/source/lux/compiler/default.lux b/stdlib/source/lux/compiler/default.lux index 2b8aeb0a8..e799f0496 100644 --- a/stdlib/source/lux/compiler/default.lux +++ b/stdlib/source/lux/compiler/default.lux @@ -15,7 +15,7 @@ ["." macro] [world ["." file (#+ File)]]] - [// + ["." // (#+ Source) ["." cli (#+ Configuration)] [meta [io @@ -36,9 +36,6 @@ ## [cache/io]) ) -(exception: #export (cannot-compile-module {name Text}) - (ex.report ["Module" name])) - (type: Reader (-> .Source (Error [.Source Code]))) @@ -78,13 +75,9 @@ #runtime (translation.Operation anchor expression statement Any) #file-system (file.System !)}) -(type: #export Source - {#name Text - #code Text}) - (with-expansions [ (as-is (Platform ! anchor expression statement)) (as-is (statement.Operation anchor expression statement Any)) - (as-is (statement.State+ anchor expression statement)) + (as-is (statement.State+ anchor expression statement)) (as-is (Bundle anchor expression statement))] (def: (begin-module-compilation module-name source) @@ -92,9 +85,9 @@ (-> Text Source )) (statement.lift-analysis (do phase.Monad - [_ (module.create (text/hash (get@ #code source)) module-name) + [_ (module.create (text/hash (get@ #//.code source)) module-name) _ (analysis.set-current-module module-name)] - (analysis.set-source-code (init.source (get@ #name source) (get@ #code source)))))) + (analysis.set-source-code (init.source (get@ #//.name source) (get@ #//.code source)))))) (def: end-module-compilation (All [anchor expression statement] @@ -125,7 +118,7 @@ (#error.Error error) (if (ex.match? syntax.end-of-file error) (#error.Success [state []]) - (ex.with-stack ..cannot-compile-module module-name (#error.Error error)))))))) + (ex.with-stack //.cannot-compile module-name (#error.Error error)))))))) (def: (perform-module-compilation module-name source) (All [anchor expression statement] @@ -137,7 +130,7 @@ (def: #export (compile-module platform configuration compiler) (All [! anchor expression statement] - (-> Configuration (! ))) + (-> Configuration (! ))) (do (:: (get@ #file-system platform) &monad) [source (context.read (get@ #file-system platform) (get@ #cli.sources configuration) @@ -156,7 +149,7 @@ (def: #export (initialize platform configuration translation-bundle) (All [! anchor expression statement] - (-> Configuration (! ))) + (-> Configuration (! ))) (|> platform (get@ #runtime) statement.lift-translation diff --git a/stdlib/source/lux/compiler/meta/io.lux b/stdlib/source/lux/compiler/meta/io.lux index a46f78d5a..dd261a539 100644 --- a/stdlib/source/lux/compiler/meta/io.lux +++ b/stdlib/source/lux/compiler/meta/io.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Module) + [lux (#- Module Code) [data ["." text]] [world @@ -9,6 +9,8 @@ (type: #export Module Text) +(type: #export Code Text) + (def: #export (sanitize system) (All [m] (-> (System m) Text Text)) (text.replace-all "/" (:: system separator))) diff --git a/stdlib/source/lux/compiler/meta/io/context.lux b/stdlib/source/lux/compiler/meta/io/context.lux index 643640698..96a8d4835 100644 --- a/stdlib/source/lux/compiler/meta/io/context.lux +++ b/stdlib/source/lux/compiler/meta/io/context.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Module Code) + [lux (#- Module Source Code) [control monad ["ex" exception (#+ Exception exception:)]] @@ -11,17 +11,23 @@ [world ["." file (#+ File)] [binary (#+ Binary)]]] - ["." // (#+ Context Module) - [/// + ["." // (#+ Context Module Code) + ["/." /// (#+ Source) ["." host]]]) +(do-template [] + [(exception: #export ( {module Module}) + (ex.report ["Module" module]))] + + [cannot-find-module] + [cannot-read-module] + ) + (type: #export Extension Text) -(def: #export (file System context module) - (All [m] (-> (file.System m) Context Module File)) - (|> module - (//.sanitize System) - (format context (:: System separator)))) +(def: lux-extension + Extension + ".lux") (def: partial-host-extension Extension @@ -35,22 +41,20 @@ (~~ (static host.ruby)) ".rb" (~~ (static host.scheme)) ".scm"}))) -(def: lux-extension Extension ".lux") - -(def: full-host-extension Extension (format partial-host-extension lux-extension)) - -(do-template [] - [(exception: #export ( {module Module}) - (ex.report ["Module" module]))] +(def: full-host-extension + Extension + (format partial-host-extension lux-extension)) - [module-not-found] - [cannot-read-module] - ) +(def: #export (file System context module) + (All [m] (-> (file.System m) Context Module File)) + (|> module + (//.sanitize System) + (format context (:: System separator)))) -(def: (find-source System contexts module extension) - (All [fs] - (-> (file.System fs) (List Context) Module Extension - (fs (Maybe [Module File])))) +(def: (find-source-file System contexts module extension) + (All [!] + (-> (file.System !) (List Context) Module Extension + (! (Maybe File)))) (case contexts #.Nil (:: (:: System &monad) wrap #.None) @@ -60,8 +64,8 @@ [#let [file (format (..file System context module) extension)] ? (file.exists? System file)] (if ? - (wrap (#.Some [module file])) - (find-source System contexts' module extension))))) + (wrap (#.Some file)) + (find-source-file System contexts' module extension))))) (def: (try System computations exception message) (All [m a e] (-> (file.System m) (List (m (Maybe a))) (Exception e) e (m a))) @@ -79,22 +83,22 @@ #.None (try System computations' exception message))))) -(type: #export Code Text) - (def: #export (read System contexts module) - (All [fs] - (-> (file.System fs) (List Context) Module - (fs [Text Code]))) - (let [find-source' (find-source System contexts module)] + (All [!] + (-> (file.System !) (List Context) Module + (! Source))) + (let [find-source-file' (find-source-file System contexts module)] (do (:: System &monad) - [[path file] (try System - (list (find-source' ..full-host-extension) - (find-source' ..lux-extension)) - ..module-not-found [module]) + [file (try System + (list (find-source-file' ..full-host-extension) + (find-source-file' ..lux-extension)) + ..cannot-find-module [module]) binary (:: System read file)] (case (encoding.from-utf8 binary) (#error.Success code) - (wrap [path code]) + (wrap {#////.name module + #////.file file + #////.code code}) (#error.Error _) (:: System throw ..cannot-read-module [module]))))) -- cgit v1.2.3