aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/function.lux6
-rw-r--r--stdlib/source/lux/control/io.lux12
-rw-r--r--stdlib/source/lux/host.jvm.lux4
-rw-r--r--stdlib/source/lux/host.old.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux22
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/meta/cache.lux16
-rw-r--r--stdlib/source/lux/tool/compiler/meta/cache/dependency.lux33
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/archive.lux46
-rw-r--r--stdlib/source/program/compositor.lux4
-rw-r--r--stdlib/source/test/lux/abstract/monoid.lux12
-rw-r--r--stdlib/source/test/lux/control.lux6
-rw-r--r--stdlib/source/test/lux/control/function.lux58
-rw-r--r--stdlib/source/test/lux/control/io.lux10
15 files changed, 160 insertions, 80 deletions
diff --git a/stdlib/source/lux/control/function.lux b/stdlib/source/lux/control/function.lux
index ce999eb39..d9b8e36c5 100644
--- a/stdlib/source/lux/control/function.lux
+++ b/stdlib/source/lux/control/function.lux
@@ -5,7 +5,7 @@
(def: #export identity
{#.doc (doc "Identity function."
- "Does nothing to it's argument and just returns it."
+ "Does nothing to its argument and just returns it."
(let [value "foo"]
(is? (identity value)
value)))}
@@ -40,6 +40,8 @@
(-> i (-> i o) o))
(function input))
-(structure: #export monoid (All [a] (Monoid (-> a a)))
+(structure: #export monoid
+ (All [a] (Monoid (-> a a)))
+
(def: identity ..identity)
(def: compose ..compose))
diff --git a/stdlib/source/lux/control/io.lux b/stdlib/source/lux/control/io.lux
index da93918c3..533e321b9 100644
--- a/stdlib/source/lux/control/io.lux
+++ b/stdlib/source/lux/control/io.lux
@@ -17,7 +17,7 @@
{#.doc "A type that represents synchronous, effectful computations that may interact with the outside world."}
(-> Any a)
- (def: #export (label thunk)
+ (def: (label thunk)
(All [a] (-> (-> Any a) (IO a)))
(:abstraction thunk))
@@ -26,7 +26,7 @@
(function (g!func g!arg)
computation))))
- (template: (!execute io)
+ (template: (!run io)
## creatio ex nihilo
((:representation io) []))
@@ -47,22 +47,22 @@
(def: #export run
{#.doc "A way to execute IO computations and perform their side-effects."}
(All [a] (-> (IO a) a))
- (|>> !execute))
+ (|>> !run))
(structure: #export functor (Functor IO)
(def: (map f)
- (|>> !execute f !io)))
+ (|>> !run f !io)))
(structure: #export apply (Apply IO)
(def: &functor ..functor)
(def: (apply ff fa)
- (!io ((!execute ff) (!execute fa)))))
+ (!io ((!run ff) (!run fa)))))
(structure: #export monad (Monad IO)
(def: &functor ..functor)
(def: wrap (|>> !io))
- (def: join (|>> !execute !execute !io)))
+ (def: join (|>> !run !run !io)))
)
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index b34cd4242..dad69604e 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -1379,9 +1379,7 @@
(#.Left error)
(recover-from-failure error)))}
- (with-gensyms [g!_]
- (wrap (list (` ("lux try" ((~! io.label) (.function ((~ g!_) (~ g!_))
- (~ expression)))))))))
+ (wrap (list (` ("lux try" ((~! io.io) (~ expression)))))))
(syntax: #export (check {#let [imports (..context *compiler*)]}
{class (..type^ imports (list))}
diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux
index c559d3555..e5a5b3624 100644
--- a/stdlib/source/lux/host.old.lux
+++ b/stdlib/source/lux/host.old.lux
@@ -1462,9 +1462,7 @@
(#.Left error)
(recover-from-failure error)))}
- (with-gensyms [g!_]
- (wrap (list (` ("lux try" ((~! io.label) (.function ((~ g!_) (~ g!_))
- (~ expression)))))))))
+ (wrap (list (` ("lux try" ((~! io.io) (~ expression)))))))
(syntax: #export (check {#let [imports (class-imports *compiler*)]}
{class (generic-type^ imports (list))}
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index fa519d8a2..7419ddac5 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -57,17 +57,16 @@
<State+> (as-is (///directive.State+ anchor expression directive))
<Bundle> (as-is (///generation.Bundle anchor expression directive))]
- (def: (cache-module platform host target-dir module-file-name module-name output ## module
- )
+ (def: (cache-module platform host target-dir module-file-name module-id extension output)
(All <type-vars>
- (-> <Platform> Host Path Path Text Output ## Module
+ (-> <Platform> Host Path Path archive.ID Text Output
(Promise (Try Any))))
(let [system (get@ #&file-system platform)
write-artifact! (: (-> [Text Binary] (Promise (Try Any)))
(function (_ [name content])
- (ioW.write system host target-dir module-name name content)))]
+ (ioW.write system host target-dir module-id name extension content)))]
(do (try.with promise.monad)
- [_ (ioW.prepare system host target-dir module-name)
+ [_ (ioW.prepare system host target-dir module-id)
_ (|> output
row.to-list
(monad.map promise.monad
@@ -162,9 +161,9 @@
## (io.fail error))
)
- (def: #export (compile target partial-host-extension expander platform host configuration archive state)
+ (def: #export (compile target partial-host-extension expander platform host configuration archive extension state)
(All <type-vars>
- (-> Text Text Expander <Platform> Host Configuration Archive <State+> (Promise (Try [Archive <State+>]))))
+ (-> Text Text Expander <Platform> Host Configuration Archive Text <State+> (Promise (Try [Archive <State+>]))))
(let [source-module (get@ #cli.module configuration)
compiler (:share <type-vars>
{<State+>
@@ -182,7 +181,7 @@
(Promise (Try [Archive <State+>])))
recur})]
(do (try.with promise.monad)
- [[_module-id archive] (promise@wrap (archive.reserve module archive))
+ [[module-id archive] (promise@wrap (archive.reserve module archive))
input (context.read (get@ #&file-system platform)
(get@ #cli.sources configuration)
partial-host-extension
@@ -233,10 +232,9 @@
host
target
(get@ #///.file input)
- module
- output
- ## module
- )]
+ module-id
+ extension
+ output)]
(case (archive.add module descriptor+document archive)
(#try.Success archive)
(wrap [archive state])
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
index 54c2f615a..e08a6219f 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
@@ -52,6 +52,7 @@
[arity (#+ Arity)]
[reference (#+ Register)]
[meta
+ [io (#+ lux-context)]
[archive (#+ Archive)]]]]]])
(type: #export Byte-Code Binary)
@@ -76,11 +77,9 @@
(type: #export Host
(generation.Host (Bytecode Any) Definition))
-(def: prefix "lux/")
-
(def: #export (class-name [module id])
(-> generation.Context Text)
- (format ..prefix (%.nat module) "/" (%.nat id)))
+ (format lux-context "/" (%.nat module) "/" (%.nat id)))
(def: #export class (type.class "LuxRuntime" (list)))
diff --git a/stdlib/source/lux/tool/compiler/meta/cache.lux b/stdlib/source/lux/tool/compiler/meta/cache.lux
index bb4c4d8c8..fbf7fe128 100644
--- a/stdlib/source/lux/tool/compiler/meta/cache.lux
+++ b/stdlib/source/lux/tool/compiler/meta/cache.lux
@@ -6,7 +6,7 @@
["ex" exception (#+ exception:)]
pipe]
[data
- ["." bit ("#;." equivalence)]
+ ["." bit ("#@." equivalence)]
["." maybe]
["." product]
[number
@@ -16,7 +16,7 @@
["." text
[format (#- Format)]]
[collection
- ["." list ("#;." functor fold)]
+ ["." list ("#@." functor fold)]
["dict" dictionary (#+ Dictionary)]
["." set (#+ Set)]]]
[world
@@ -94,7 +94,7 @@
(do @
[_ (..delete System<m> file)]
(wrap #1))))))]
- [(list.every? (bit;= #1))
+ [(list.every? (bit@= #1))
(if> [(..delete System<m> document)]
[(wrap [])])]))))
@@ -152,7 +152,7 @@
(do> @
[(..cached System<m>)]
[(monad.map @ (load-document System<m> contexts root key binary))
- (:: @ map (list;fold (function (_ full-document archive)
+ (:: @ map (list@fold (function (_ full-document archive)
(case full-document
(#.Some [[module references] document])
(dict.put module [references document] archive)
@@ -162,17 +162,17 @@
(: (Dictionary Text [(List Module) (Ex [d] (Document d))])
(dict.new text.hash))))]))
#let [candidate-entries (dict.entries candidate)
- candidate-dependencies (list;map (product.both id product.left)
+ candidate-dependencies (list@map (product.both id product.left)
candidate-entries)
candidate-archive (|> candidate-entries
- (list;map (product.both id product.right))
+ (list@map (product.both id product.right))
(dict.from-list text.hash))
graph (|> candidate
dict.entries
- (list;map (product.both id product.left))
+ (list@map (product.both id product.left))
/dependency.graph
(/dependency.prune candidate-archive))
- archive (list;fold (function (_ module archive)
+ archive (list@fold (function (_ module archive)
(if (dict.contains? module graph)
archive
(dict.remove module archive)))
diff --git a/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux b/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux
index ec01baf45..bb3736518 100644
--- a/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux
+++ b/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux
@@ -3,29 +3,32 @@
[data
["." text]
[collection
- ["." list ("#;." functor fold)]
- ["dict" dictionary (#+ Dictionary)]]]]
+ ["." list ("#@." functor fold)]
+ ["." dictionary (#+ Dictionary)]]]]
[///io (#+ Module)]
[///archive (#+ Archive)])
-(type: #export Graph (Dictionary Module (List Module)))
+(type: #export Graph
+ (Dictionary Module (List Module)))
-(def: #export empty Graph (dict.new text.hash))
+(def: #export empty
+ Graph
+ (dictionary.new text.hash))
(def: #export (add to from)
(-> Module Module Graph Graph)
- (|>> (dict.update~ from (list) (|>> (#.Cons to)))
- (dict.update~ to (list) id)))
+ (|>> (dictionary.update~ from (list) (|>> (#.Cons to)))
+ (dictionary.update~ to (list) id)))
(def: dependents
- (-> Module Graph (Maybe (List Text)))
- dict.get)
+ (-> Module Graph (Maybe (List Module)))
+ dictionary.get)
(def: #export (remove module dependency)
(-> Module Graph Graph)
(case (dependents module dependency)
(#.Some dependents)
- (list;fold remove (dict.remove module dependency) dependents)
+ (list@fold remove (dictionary.remove module dependency) dependents)
#.None
dependency))
@@ -36,18 +39,18 @@
(def: #export (dependency [module imports])
(-> Dependency Graph)
- (list;fold (..add module) ..empty imports))
+ (list@fold (..add module) ..empty imports))
(def: #export graph
(-> (List Dependency) Graph)
- (|>> (list;map ..dependency)
- (list;fold dict.merge empty)))
+ (|>> (list@map ..dependency)
+ (list@fold dictionary.merge empty)))
(def: #export (prune archive graph)
(-> Archive Graph Graph)
- (list;fold (function (_ module graph)
- (if (dict.contains? module archive)
+ (list@fold (function (_ module graph)
+ (if (dictionary.contains? module archive)
graph
(..remove module graph)))
graph
- (dict.keys graph)))
+ (dictionary.keys graph)))
diff --git a/stdlib/source/lux/tool/compiler/meta/io.lux b/stdlib/source/lux/tool/compiler/meta/io.lux
index 579164881..271dcb79a 100644
--- a/stdlib/source/lux/tool/compiler/meta/io.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io.lux
@@ -14,3 +14,5 @@
(def: #export (sanitize system)
(All [m] (-> (System m) Text Text))
(text.replace-all "/" (:: system separator)))
+
+(def: #export lux-context "lux")
diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
index abb8b75c6..2a5713f4f 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
@@ -16,56 +16,66 @@
["%" format (#+ format)]]]
[world
["." file (#+ Path File System)]]]
- ["." // (#+ Module)])
+ ["." // (#+ Module)
+ [//
+ ["." archive]]])
(exception: #export (cannot-prepare {archive Path}
- {module Module}
+ {module-id archive.ID}
{error Text})
(exception.report
["Archive" archive]
- ["Module" module]
+ ["Module ID" (%.nat module-id)]
["Error" error]))
(def: #export (archive system host root)
(-> (System Promise) Host Path Path)
(format root (:: system separator) host))
-(def: #export (document system host root module)
- (-> (System Promise) Host Path Module Path)
+(def: #export (lux-archive system host root)
+ (-> (System Promise) Host Path Path)
(format (..archive system host root)
(:: system separator)
- (//.sanitize system module)))
+ //.lux-context))
+
+(def: #export (document system host root module-id)
+ (-> (System Promise) Host Path archive.ID Path)
+ (format (..lux-archive system host root)
+ (:: system separator)
+ (%.nat module-id)))
-(def: #export (artifact system host root module name)
- (-> (System Promise) Host Path Module Text Path)
- (format (document system host root module)
+(def: #export (artifact system host root module-id name extension)
+ (-> (System Promise) Host Path archive.ID Text Text Path)
+ (format (document system host root module-id)
(:: system separator)
- (//.sanitize system name)))
+ name
+ extension))
-(def: #export (prepare system host root module)
- (-> (System Promise) Host Path Module (Promise (Try Any)))
+(def: #export (prepare system host root module-id)
+ (-> (System Promise) Host Path archive.ID (Promise (Try Any)))
(do promise.monad
- [#let [document (..document system host root module)]
+ [#let [document (..document system host root module-id)]
document-exists? (file.exists? promise.monad system document)]
(if document-exists?
(wrap (#try.Success []))
(do @
- [outcome (!.use (:: system create-directory) document)]
+ [_ (file.get-directory @ system (..lux-archive system host root))
+ outcome (!.use (:: system create-directory) document)]
(case outcome
(#try.Success output)
(wrap (#try.Success []))
(#try.Failure error)
(wrap (exception.throw ..cannot-prepare [(..archive system host root)
- module
+ module-id
error])))))))
-(def: #export (write system host root module name content)
- (-> (System Promise) Host Path Module Text Binary (Promise (Try Any)))
+(def: #export (write system host root module-id name extension content)
+ (-> (System Promise) Host Path archive.ID Text Text Binary (Promise (Try Any)))
(do (try.with promise.monad)
[artifact (: (Promise (Try (File Promise)))
(file.get-file promise.monad system
- (..artifact system host root module name)))]
+ (..artifact system host root module-id name extension)))]
(!.use (:: artifact over-write) content)))
(def: #export (module system host root document)
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index 371dbdec7..5fb10d4ba 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -92,6 +92,7 @@
(def: #export (compiler target partial-host-extension
expander host-analysis platform host generation-bundle host-directive-bundle program extender
service
+ extension
packager,package)
(All [<parameters>]
(-> Path
@@ -105,6 +106,7 @@
(-> expression artifact)
Extender
Service
+ Text
[(-> (Row [Module (generation.Buffer artifact)]) Binary) Path]
(Promise Any)))
(do promise.monad
@@ -126,7 +128,7 @@
{(Platform <parameters>)
platform}
{(Promise (Try [Archive (directive.State+ <parameters>)]))
- (platform.compile target partial-host-extension expander platform host configuration archive.empty state)})
+ (platform.compile target partial-host-extension expander platform host configuration archive.empty extension state)})
## _ (save-artifacts! (get@ #platform.&file-system platform) state packager,package)
## _ (cache/io.clean target ...)
]
diff --git a/stdlib/source/test/lux/abstract/monoid.lux b/stdlib/source/test/lux/abstract/monoid.lux
index b0f89abc7..5353e29cd 100644
--- a/stdlib/source/test/lux/abstract/monoid.lux
+++ b/stdlib/source/test/lux/abstract/monoid.lux
@@ -4,7 +4,7 @@
["_" test (#+ Test)]
[abstract/monad (#+ do)]
[math
- ["r" random (#+ Random)]]
+ ["." random (#+ Random)]]
[control
["." function]]]
{1
@@ -14,12 +14,18 @@
(def: #export (spec (^open "/@.") (^open "/@.") gen-sample)
(All [a] (-> (Equivalence a) (Monoid a) (Random a) Test))
- (do r.monad
- [sample gen-sample]
+ (do random.monad
+ [sample gen-sample
+ left gen-sample
+ mid gen-sample
+ right gen-sample]
(<| (_.context (%.name (name-of /.Monoid)))
($_ _.and
(_.test "Left identity."
(/@= sample (/@compose /@identity sample)))
(_.test "Right identity."
(/@= sample (/@compose sample /@identity)))
+ (_.test "Associativity."
+ (/@= (/@compose left (/@compose mid right))
+ (/@compose (/@compose left mid) right)))
))))
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index 169332b30..3a6491f25 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -4,8 +4,9 @@
["." / #_
["#." concatenative]
["#." continuation]
- ["#." try]
["#." exception]
+ ["#." function]
+ ["#." try]
["#." io]
["#." parser]
["#." pipe]
@@ -63,8 +64,9 @@
($_ _.and
/concatenative.test
/continuation.test
- /try.test
/exception.test
+ /function.test
+ /try.test
/io.test
/parser.test
/pipe.test
diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux
new file mode 100644
index 000000000..f7d4d7678
--- /dev/null
+++ b/stdlib/source/test/lux/control/function.lux
@@ -0,0 +1,58 @@
+(.module:
+ [lux #*
+ [abstract
+ [equivalence (#+ Equivalence)]
+ [monad (#+ do)]]
+ [data
+ ["." name]
+ [number
+ ["n" nat]]
+ ["." text ("#@." equivalence)
+ ["%" format (#+ format)]]]
+ [math
+ ["." random (#+ Random)]]
+ ["_" test (#+ Test)]]
+ ["." /// #_
+ [abstract
+ ["#." monoid]]]
+ {1
+ ["." /]})
+
+(def: #export test
+ Test
+ (do random.monad
+ [expected random.nat
+ f0 (:: @ map n.+ random.nat)
+ f1 (:: @ map n.* random.nat)
+ dummy random.nat
+ extra (|> random.nat (random.filter (|>> (n.= expected) not)))]
+ (<| (_.context (name.module (name-of /._)))
+ ($_ _.and
+ (let [equivalence (: (Equivalence (-> Nat Nat))
+ (structure
+ (def: (= left right)
+ (n.= (left extra)
+ (right extra)))))
+ generator (: (Random (-> Nat Nat))
+ (:: @ map n.- random.nat))]
+ (///monoid.spec equivalence /.monoid generator))
+
+ (_.test (%.name (name-of /.identity))
+ (n.= expected
+ (/.identity expected)))
+ (_.test (%.name (name-of /.compose))
+ (n.= (f0 (f1 expected))
+ ((/.compose f0 f1) expected)))
+ (_.test (%.name (name-of /.constant))
+ (n.= expected
+ ((/.constant expected) dummy)))
+ (_.test (%.name (name-of /.flip))
+ (let [outcome ((/.flip n.-) expected extra)]
+ (and (n.= (n.- extra expected)
+ outcome)
+ (not (n.= (n.- expected extra)
+ outcome)))))
+ (_.test (%.name (name-of /.apply))
+ (n.= (f0 extra)
+ (/.apply extra f0)))
+ ))))
diff --git a/stdlib/source/test/lux/control/io.lux b/stdlib/source/test/lux/control/io.lux
index fb5d3e67b..a0e5f7d4b 100644
--- a/stdlib/source/test/lux/control/io.lux
+++ b/stdlib/source/test/lux/control/io.lux
@@ -11,6 +11,7 @@
["$." apply]
["$." monad]]}]
[data
+ ["." name]
[number
["n" nat]]]]
{1
@@ -29,7 +30,7 @@
(def: #export test
Test
- (<| (_.context (%.name (name-of /.IO)))
+ (<| (_.context (name.module (name-of /._)))
(do r.monad
[sample r.nat
exit-code r.int]
@@ -38,8 +39,9 @@
($apply.spec ..injection ..comparison /.apply)
($monad.spec ..injection ..comparison /.monad)
- (_.test "Can execute computations designated as I/O computations."
- (n.= sample (/.run (/.io sample))))
- (_.test "I/O operations won't execute unless they are explicitly run."
+ (_.test (%.name (name-of /.run))
+ (n.= sample
+ (/.run (/.io sample))))
+ (_.test (%.name (name-of /.exit))
(exec (/.exit exit-code)
true))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 13:03:48 +0000