aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux
diff options
context:
space:
mode:
authorEduardo Julian2020-05-29 00:19:24 -0400
committerEduardo Julian2020-05-29 00:19:24 -0400
commit6eaa3b57f3f1ea2ce13b942bdb4ef502fc1729bc (patch)
tree746eb35ad0e8d10d3a6587bf0f6b3c5d867f7899 /stdlib/source/lux
parentfcb1dcee2a4d502b41852a4c8e26b53ae7b2041e (diff)
Can now import previously exported libraries.
Diffstat (limited to 'stdlib/source/lux')
-rw-r--r--stdlib/source/lux/abstract/comonad.lux10
-rw-r--r--stdlib/source/lux/abstract/monad.lux10
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux149
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/context.lux61
4 files changed, 130 insertions, 100 deletions
diff --git a/stdlib/source/lux/abstract/comonad.lux b/stdlib/source/lux/abstract/comonad.lux
index 988d7c255..874b96913 100644
--- a/stdlib/source/lux/abstract/comonad.lux
+++ b/stdlib/source/lux/abstract/comonad.lux
@@ -6,7 +6,7 @@
[collection
["." list ("#@." fold)]]]]
[//
- ["." functor (#+ Functor)]])
+ [functor (#+ Functor)]])
(signature: #export (CoMonad w)
{#.doc (doc "CoMonads are the opposite/complement to monads."
@@ -66,17 +66,13 @@
(#.Some name)
(let [name [_cursor (#.Identifier ["" name])]]
(` ({(~ name)
- ({{#..&functor {#functor.map (~ g!map)}
- #..unwrap (~' unwrap)
- #..split (~ g!split)}
+ ({[(~ g!map) (~' unwrap) (~ g!split)]
(~ body')}
(~ name))}
(~ comonad))))
#.None
- (` ({{#..&functor {#functor.map (~ g!map)}
- #..unwrap (~' unwrap)
- #..split (~ g!split)}
+ (` ({[(~ g!map) (~' unwrap) (~ g!split)]
(~ body')}
(~ comonad)))))]))
(#.Left "'be' bindings must have an even number of parts."))
diff --git a/stdlib/source/lux/abstract/monad.lux b/stdlib/source/lux/abstract/monad.lux
index 12f75e9ac..4c03e937c 100644
--- a/stdlib/source/lux/abstract/monad.lux
+++ b/stdlib/source/lux/abstract/monad.lux
@@ -1,7 +1,7 @@
(.module:
[lux #*]
[//
- ["." functor (#+ Functor)]])
+ [functor (#+ Functor)]])
(def: (list@fold f init xs)
(All [a b]
@@ -92,17 +92,13 @@
(#.Some name)
(let [name [_cursor (#.Identifier ["" name])]]
(` ({(~ name)
- ({{#..&functor {#functor.map (~ g!map)}
- #..wrap (~' wrap)
- #..join (~ g!join)}
+ ({[(~ g!map) (~' wrap) (~ g!join)]
(~ body')}
(~ name))}
(~ monad))))
#.None
- (` ({{#..&functor {#functor.map (~ g!map)}
- #..wrap (~' wrap)
- #..join (~ g!join)}
+ (` ({[(~ g!map) (~' wrap) (~ g!join)]
(~ body')}
(~ monad)))))]))
(#.Left "'do' bindings must have an even number of parts."))
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index 5f117325c..7813ba799 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -52,8 +52,9 @@
["ioW" archive]]]]]
[program
[compositor
- ["." cli (#+ Compilation)]
- ["." static (#+ Static)]]])
+ ["." cli (#+ Compilation Library)]
+ ["." static (#+ Static)]
+ ["." import]]])
(type: #export (Platform anchor expression directive)
{#&file-system (file.System Promise)
@@ -351,85 +352,85 @@
try.assume
product.left))
- (def: #export (compile static expander platform compilation context)
+ (def: #export (compile libraries static expander platform compilation context)
(All [<type-vars>]
- (-> Static Expander <Platform> Compilation <Context> <Return>))
- (let [[compilation-sources compilation-target compilation-module] compilation
+ (-> (List Library) Static Expander <Platform> Compilation <Context> <Return>))
+ (let [[compilation-sources compilation-libraries compilation-target compilation-module] compilation
base-compiler (:share [<type-vars>]
{<Context>
context}
{(///.Compiler <State+> .Module Any)
(:assume
- ((//init.compiler expander syntax.prelude (get@ #write platform)) $.key (list)))})
- parallel-compiler (..parallel
- context
- (function (_ import! module-id [archive state] module)
- (do (try.with promise.monad)
- [#let [state (..set-current-module module state)]
- input (context.read (get@ #&file-system platform)
- compilation-sources
- (get@ #static.host-module-extension static)
- module)]
- (loop [[archive state] [archive state]
- compilation (base-compiler (:coerce ///.Input input))
- all-dependencies (: (List Module)
- (list))]
- (do {@ (try.with promise.monad)}
- [#let [new-dependencies (get@ #///.dependencies compilation)
- all-dependencies (list@compose new-dependencies all-dependencies)
- continue! (:share [<type-vars>]
- {<Platform>
- platform}
- {(-> <Context> (///.Compilation <State+> .Module Any) (List Module)
- (Action [Archive <State+>]))
- (:assume
- recur)})]
- [archive state] (case new-dependencies
- #.Nil
- (wrap [archive state])
+ ((//init.compiler expander syntax.prelude (get@ #write platform)) $.key (list)))})]
+ (do (try.with promise.monad)
+ [libraries (import.import (get@ #&file-system platform) compilation-libraries)
+ #let [parallel-compiler (..parallel
+ context
+ (function (_ import! module-id [archive state] module)
+ (do (try.with promise.monad)
+ [#let [state (..set-current-module module state)]
+ input (context.read (get@ #&file-system platform)
+ libraries
+ compilation-sources
+ (get@ #static.host-module-extension static)
+ module)]
+ (loop [[archive state] [archive state]
+ compilation (base-compiler (:coerce ///.Input input))
+ all-dependencies (: (List Module)
+ (list))]
+ (do {@ (try.with promise.monad)}
+ [#let [new-dependencies (get@ #///.dependencies compilation)
+ all-dependencies (list@compose new-dependencies all-dependencies)
+ continue! (:share [<type-vars>]
+ {<Platform>
+ platform}
+ {(-> <Context> (///.Compilation <State+> .Module Any) (List Module)
+ (Action [Archive <State+>]))
+ (:assume
+ recur)})]
+ [archive state] (case new-dependencies
+ #.Nil
+ (wrap [archive state])
- (#.Cons _)
- (do @
- [archive,document+ (|> new-dependencies
- (list@map import!)
- (monad.seq ..monad))
- #let [archive (|> archive,document+
- (list@map product.left)
- (list@fold archive.merge archive))]]
- (wrap [archive (try.assume
- (..updated-state archive state))])))]
- (case ((get@ #///.process compilation)
- ## TODO: The "///directive.set-current-module" below shouldn't be necessary. Remove it ASAP.
- ## TODO: The context shouldn't need to be re-set either.
- (|> (///directive.set-current-module module)
- (///phase.run' state)
- try.assume
- product.left)
- archive)
- (#try.Success [state more|done])
- (case more|done
- (#.Left more)
- (continue! [archive state] more all-dependencies)
+ (#.Cons _)
+ (do @
+ [archive,document+ (|> new-dependencies
+ (list@map import!)
+ (monad.seq ..monad))
+ #let [archive (|> archive,document+
+ (list@map product.left)
+ (list@fold archive.merge archive))]]
+ (wrap [archive (try.assume
+ (..updated-state archive state))])))]
+ (case ((get@ #///.process compilation)
+ ## TODO: The "///directive.set-current-module" below shouldn't be necessary. Remove it ASAP.
+ ## TODO: The context shouldn't need to be re-set either.
+ (|> (///directive.set-current-module module)
+ (///phase.run' state)
+ try.assume
+ product.left)
+ archive)
+ (#try.Success [state more|done])
+ (case more|done
+ (#.Left more)
+ (continue! [archive state] more all-dependencies)
- (#.Right [[descriptor document] output])
- (do (try.with promise.monad)
- [#let [_ (log! (..module-compilation-log state))
- descriptor (set@ #descriptor.references (set.from-list text.hash all-dependencies) descriptor)]
- _ (..cache-module static platform module-id [[descriptor document] output])]
- (case (archive.add module [descriptor document] archive)
- (#try.Success archive)
- (wrap [archive
- (..with-reset-log state)])
-
- (#try.Failure error)
- (promise@wrap (#try.Failure error)))))
+ (#.Right [[descriptor document] output])
+ (do (try.with promise.monad)
+ [#let [_ (log! (..module-compilation-log state))
+ descriptor (set@ #descriptor.references (set.from-list text.hash all-dependencies) descriptor)]
+ _ (..cache-module static platform module-id [[descriptor document] output])]
+ (case (archive.add module [descriptor document] archive)
+ (#try.Success archive)
+ (wrap [archive
+ (..with-reset-log state)])
+
+ (#try.Failure error)
+ (promise@wrap (#try.Failure error)))))
- (#try.Failure error)
- (do (try.with promise.monad)
- [_ (ioW.freeze (get@ #&file-system platform) (get@ #static.host static) (get@ #static.target static) archive)]
- (promise@wrap (#try.Failure error))))
- ))
- )))]
- (parallel-compiler compilation-module)
- ))
+ (#try.Failure error)
+ (do (try.with promise.monad)
+ [_ (ioW.freeze (get@ #&file-system platform) (get@ #static.host static) (get@ #static.target static) archive)]
+ (promise@wrap (#try.Failure error)))))))))]]
+ (parallel-compiler compilation-module))))
))
diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux
index 574b24290..1dceaaba6 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/context.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux
@@ -6,7 +6,7 @@
["." monad (#+ Monad do)]]
[control
["." try (#+ Try)]
- ["." exception (#+ Exception exception:)]
+ ["." exception (#+ exception:)]
[security
["!" capability]]
[concurrency
@@ -20,6 +20,9 @@
["." dictionary (#+ Dictionary)]]]
[world
["." file (#+ Path File)]]]
+ [program
+ [compositor
+ [import (#+ Import)]]]
["." // (#+ Context Code)
["/#" // #_
[archive
@@ -70,26 +73,60 @@
(-> Extension Extension)
(format partial-host-extension ..lux-extension))
-(def: #export (find-any-source-file system contexts partial-host-extension module)
- (-> (file.System Promise) (List Context) Extension Module
- (Promise (Try [Path (File Promise)])))
+(def: (find-local-source-file system import contexts partial-host-extension module)
+ (-> (file.System Promise) Import (List Context) Extension Module
+ (Promise (Try [Path Binary])))
+ ## Preference is explicitly being given to Lux files that have a host extension.
+ ## Normal Lux files (i.e. without a host extension) are then picked as fallback files.
+ (do {@ promise.monad}
+ [outcome (..find-source-file system contexts module (..full-host-extension partial-host-extension))]
+ (case outcome
+ (#try.Success [path file])
+ (do (try.with @)
+ [data (!.use (:: file content) [])]
+ (wrap [path data]))
+
+ (#try.Failure _)
+ (do (try.with @)
+ [[path file] (..find-source-file system contexts module ..lux-extension)
+ data (!.use (:: file content) [])]
+ (wrap [path data])))))
+
+(def: (find-library-source-file import partial-host-extension module)
+ (-> Import Extension Module (Try [Path Binary]))
+ (let [path (format module (..full-host-extension partial-host-extension))]
+ (case (dictionary.get path import)
+ (#.Some data)
+ (#try.Success [path data])
+
+ #.None
+ (let [path (format module ..lux-extension)]
+ (case (dictionary.get path import)
+ (#.Some data)
+ (#try.Success [path data])
+
+ #.None
+ (exception.throw ..cannot-find-module [module]))))))
+
+(def: (find-any-source-file system import contexts partial-host-extension module)
+ (-> (file.System Promise) Import (List Context) Extension Module
+ (Promise (Try [Path Binary])))
## Preference is explicitly being given to Lux files that have a host extension.
## Normal Lux files (i.e. without a host extension) are then picked as fallback files.
- (do promise.monad
- [outcome (find-source-file system contexts module (..full-host-extension partial-host-extension))]
+ (do {@ promise.monad}
+ [outcome (find-local-source-file system import contexts partial-host-extension module)]
(case outcome
- (#try.Success output)
+ (#try.Success [path data])
(wrap outcome)
(#try.Failure _)
- (find-source-file system contexts module ..lux-extension))))
+ (wrap (..find-library-source-file import partial-host-extension module)))))
-(def: #export (read system contexts partial-host-extension module)
- (-> (file.System Promise) (List Context) Extension Module
+(def: #export (read system import contexts partial-host-extension module)
+ (-> (file.System Promise) Import (List Context) Extension Module
(Promise (Try Input)))
(do (try.with promise.monad)
- [[path file] (..find-any-source-file system contexts partial-host-extension module)
- binary (!.use (:: file content) [])]
+ [[path binary] (..find-any-source-file system import contexts partial-host-extension module)]
(case (encoding.from-utf8 binary)
(#try.Success code)
(wrap {#////.module module