1 files changed, 107 insertions, 0 deletions
diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux
new file mode 100644
index 000000000..be72e4ccc
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux
@@ -0,0 +1,107 @@
+(.module:
+  [lux (#- Module Code)
+   [control
+    monad
+    ["ex" exception (#+ Exception exception:)]]
+   [data
+    ["." error]
+    [text
+     format
+     ["." encoding]]]
+   [world
+    ["." file (#+ File)]
+    [binary (#+ Binary)]]]
+  ["." // (#+ Context Code)
+   [//
+    [archive
+     [descriptor (#+ Module)]]
+    ["//." // (#+ Input)
+     ["." host]]]])
+
+(do-template [<name>]
+  [(exception: #export (<name> {module Module})
+     (ex.report ["Module" module]))]
+
+  [cannot-find-module]
+  [cannot-read-module]
+  )
+
+(type: #export Extension Text)
+
+(def: lux-extension
+  Extension
+  ".lux")
+
+(def: partial-host-extension
+  Extension
+  (`` (for {(~~ (static host.common-lisp)) ".cl"
+            (~~ (static host.js))          ".js"
+            (~~ (static host.jvm))         ".jvm"
+            (~~ (static host.lua))         ".lua"
+            (~~ (static host.php))         ".php"
+            (~~ (static host.python))      ".py"
+            (~~ (static host.r))           ".r"
+            (~~ (static host.ruby))        ".rb"
+            (~~ (static host.scheme))      ".scm"})))
+
+(def: full-host-extension
+  Extension
+  (format partial-host-extension lux-extension))
+
+(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-file System<m> contexts module extension)
+  (All [!]
+    (-> (file.System !) (List Context) Module Extension
+        (! (Maybe File))))
+  (case contexts
+    #.Nil
+    (:: (:: System<m> &monad) wrap #.None)
+
+    (#.Cons context contexts')
+    (do (:: System<m> &monad)
+      [#let [file (format (..file System<m> context module) extension)]
+       ? (file.exists? System<m> file)]
+      (if ?
+        (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)))
+  (case computations
+    #.Nil
+    (:: System<m> throw exception message)
+
+    (#.Cons computation computations')
+    (do (:: System<m> &monad)
+      [outcome computation]
+      (case outcome
+        (#.Some output)
+        (wrap output)
+
+        #.None
+        (try System<m> computations' exception message)))))
+
+(def: #export (read System<m> contexts module)
+  (All [!]
+    (-> (file.System !) (List Context) Module
+        (! Input)))
+  (let [find-source-file' (find-source-file System<m> contexts module)]
+    (do (:: System<m> &monad)
+      [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 {#////.module module
+               #////.file file
+               #////.code code})
+        
+        (#error.Failure _)
+        (:: System<m> throw ..cannot-read-module [module])))))