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

(limited to 'stdlib')

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 [<Platform> (as-is (Platform ! anchor expression statement))
                   <Operation> (as-is (statement.Operation anchor expression statement Any))
-                  <Compiler> (as-is (statement.State+ anchor expression statement))
+                  <State+> (as-is (statement.State+ anchor expression statement))
                   <Bundle> (as-is (Bundle anchor expression statement))]
   
   (def: (begin-module-compilation module-name source)
@@ -92,9 +85,9 @@
       (-> Text Source <Operation>))
     (statement.lift-analysis
      (do phase.Monad<Operation>
-       [_ (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]
-      (-> <Platform> Configuration <Compiler> (! <Compiler>)))
+      (-> <Platform> Configuration <State+> (! <State+>)))
     (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]
-      (-> <Platform> Configuration <Bundle> (! <Compiler>)))
+      (-> <Platform> Configuration <Bundle> (! <State+>)))
     (|> 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 [<name>]
+  [(exception: #export (<name> {module Module})
+     (ex.report ["Module" module]))]
+
+  [cannot-find-module]
+  [cannot-read-module]
+  )
+
 (type: #export Extension Text)
 
-(def: #export (file System<m> context module)
-  (All [m] (-> (file.System m) Context Module File))
-  (|> module
-      (//.sanitize System<m>)
-      (format context (:: System<m> 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 [<name>]
-  [(exception: #export (<name> {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<m> context module)
+  (All [m] (-> (file.System m) Context Module File))
+  (|> module
+      (//.sanitize System<m>)
+      (format context (:: System<m> separator))))
 
-(def: (find-source System<m> contexts module extension)
-  (All [fs]
-    (-> (file.System fs) (List Context) Module Extension
-        (fs (Maybe [Module File]))))
+(def: (find-source-file System<m> contexts module extension)
+  (All [!]
+    (-> (file.System !) (List Context) Module Extension
+        (! (Maybe File))))
   (case contexts
     #.Nil
     (:: (:: System<m> &monad) wrap #.None)
@@ -60,8 +64,8 @@
       [#let [file (format (..file System<m> context module) extension)]
        ? (file.exists? System<m> file)]
       (if ?
-        (wrap (#.Some [module file]))
-        (find-source System<m> contexts' module extension)))))
+        (wrap (#.Some file))
+        (find-source-file System<m> contexts' module extension)))))
 
 (def: (try System<m> 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<m> computations' exception message)))))
 
-(type: #export Code Text)
-
 (def: #export (read System<m> contexts module)
-  (All [fs]
-    (-> (file.System fs) (List Context) Module
-        (fs [Text Code])))
-  (let [find-source' (find-source System<m> contexts module)]
+  (All [!]
+    (-> (file.System !) (List Context) Module
+        (! Source)))
+  (let [find-source-file' (find-source-file System<m> contexts module)]
     (do (:: System<m> &monad)
-      [[path file] (try System<m>
-                        (list (find-source' ..full-host-extension)
-                              (find-source' ..lux-extension))
-                        ..module-not-found [module])
+      [file (try System<m>
+                 (list (find-source-file' ..full-host-extension)
+                       (find-source-file' ..lux-extension))
+                 ..cannot-find-module [module])
        binary (:: System<m> read file)]
       (case (encoding.from-utf8 binary)
         (#error.Success code)
-        (wrap [path code])
+        (wrap {#////.name module
+               #////.file file
+               #////.code code})
         
         (#error.Error _)
         (:: System<m> throw ..cannot-read-module [module])))))
-- 
cgit v1.2.3