aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/control/concurrency/process.lux51
-rw-r--r--stdlib/source/lux/control/parser/cli.lux48
-rw-r--r--stdlib/source/lux/target/js.lux53
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux25
-rw-r--r--stdlib/source/lux/tool/compiler/meta/cache/dependency.lux103
-rw-r--r--stdlib/source/lux/tool/compiler/meta/packager/script.lux28
-rw-r--r--stdlib/source/program/compositor.lux2
8 files changed, 144 insertions, 170 deletions
diff --git a/stdlib/source/lux/control/concurrency/process.lux b/stdlib/source/lux/control/concurrency/process.lux
index 3b273753a..dd38e3041 100644
--- a/stdlib/source/lux/control/concurrency/process.lux
+++ b/stdlib/source/lux/control/concurrency/process.lux
@@ -117,7 +117,7 @@
[_ (atom.update (|>> (#.Cons {#creation (.nat ("lux io current-time"))
#delay milli-seconds
#action action}))
- runner)]
+ ..runner)]
(wrap []))))
(for {@.old
@@ -129,29 +129,28 @@
## Default
(as-is (exception: #export cannot-continue-running-processes)
- (def: #export run!
- (IO Any)
- (loop [_ []]
- (do {@ io.monad}
- [processes (atom.read runner)]
- (case processes
- ## And... we're done!
- #.Nil
- (wrap [])
-
- _
- (do @
- [#let [now (.nat ("lux io current-time"))
- [ready pending] (list.partition (function (_ process)
- (|> (get@ #creation process)
- (n.+ (get@ #delay process))
- (n.<= now)))
- processes)]
- swapped? (atom.compare-and-swap processes pending runner)]
- (if swapped?
- (do @
- [_ (monad.map @ (get@ #action) ready)]
- (wrap []))
- (error! (ex.construct ..cannot-continue-running-processes []))))
- ))))
+ (def: #export (run! _)
+ (-> Any (IO Any))
+ (do {@ io.monad}
+ [processes (atom.read ..runner)]
+ (case processes
+ ## And... we're done!
+ #.Nil
+ (wrap [])
+
+ _
+ (do @
+ [#let [now (.nat ("lux io current-time"))
+ [ready pending] (list.partition (function (_ process)
+ (|> (get@ #creation process)
+ (n.+ (get@ #delay process))
+ (n.<= now)))
+ processes)]
+ swapped? (atom.compare-and-swap processes pending ..runner)]
+ (if swapped?
+ (do @
+ [_ (monad.map @ (get@ #action) ready)]
+ (run! []))
+ (error! (ex.construct ..cannot-continue-running-processes []))))
+ )))
))
diff --git a/stdlib/source/lux/control/parser/cli.lux b/stdlib/source/lux/control/parser/cli.lux
index f58d78d13..39786b94f 100644
--- a/stdlib/source/lux/control/parser/cli.lux
+++ b/stdlib/source/lux/control/parser/cli.lux
@@ -138,17 +138,25 @@
(do io.monad
[data (init-program config)]
(do-something data))))}
- (with-gensyms [g!program]
- (case args
- (#Raw args)
- (wrap (list (` ("lux def program"
- (.function ((~ g!program) (~ (code.identifier ["" args])))
- ((~! do) (~! io.monad)
- []
- (~ body)))))))
-
- (#Parsed args)
- (with-gensyms [g!args g!_ g!output g!message]
+ (with-gensyms [g!program g!args g!_ g!output g!message]
+ (let [initialization+event-loop
+ (` ((~! do) (~! io.monad)
+ [(~ g!output) (~ body)
+ (~+ (for {@.old
+ (list)
+
+ @.jvm
+ (list)}
+ (list g!_
+ (` ((~! process.run!) [])))))]
+ ((~' wrap) (~ g!output))))]
+ (case args
+ (#Raw args)
+ (wrap (list (` ("lux def program"
+ (.function ((~ g!program) (~ (code.identifier ["" args])))
+ (~ initialization+event-loop))))))
+
+ (#Parsed args)
(wrap (list (` ("lux def program"
(.function ((~ g!program) (~ g!args))
(case ((: (~! (..Parser (io.IO .Any)))
@@ -157,22 +165,12 @@
(list@map (function (_ [binding parser])
(list binding parser)))
list@join))]
- ((~' wrap) ((~! do) (~! io.monad)
- [(~ g!output) (~ body)
- (~+ (for {@.old
- (list)
-
- @.jvm
- (list)}
- (list g!_
- (` process.run!))))]
- ((~' wrap) (~ g!output))))))
+ ((~' wrap) (~ initialization+event-loop))))
(~ g!args))
(#.Right [(~ g!_) (~ g!output)])
(~ g!output)
(#.Left (~ g!message))
- (.error! (~ g!message))
- ))))
- )))
- )))
+ (.error! (~ g!message))))))
+ ))
+ ))))
diff --git a/stdlib/source/lux/target/js.lux b/stdlib/source/lux/target/js.lux
index 429579655..7ba1c6851 100644
--- a/stdlib/source/lux/target/js.lux
+++ b/stdlib/source/lux/target/js.lux
@@ -15,9 +15,14 @@
[type
abstract]])
-(def: argument (text.enclose ["(" ")"]))
+(def: expression (text.enclose ["(" ")"]))
(def: element (text.enclose ["[" "]"]))
+(def: nest
+ (-> Text Text)
+ (|>> (format text.new-line)
+ (text.replace-all text.new-line (format text.new-line text.tab))))
+
(abstract: #export (Code brand)
{}
@@ -75,7 +80,7 @@
"-Infinity"
## else
- (|> value %.frac ..argument))))
+ (|> value %.frac ..expression))))
(def: sanitize
(-> Text Text)
@@ -129,7 +134,7 @@
(|> inputs
(list@map ..code)
(text.join-with ..argument-separator)
- ..argument
+ ..expression
(format (:representation function))
:abstraction))
@@ -143,13 +148,13 @@
(format (:representation (..string key)) ..field-separator (:representation val))))
(text.join-with ..argument-separator)
(text.enclose ["{" "}"])
- ..argument
+ ..expression
:abstraction))
(def: #export (, pre post)
(-> Expression Expression Computation)
(|> (format (:representation pre) ..argument-separator (:representation post))
- ..argument
+ ..expression
:abstraction))
(def: #export (then pre post)
@@ -158,16 +163,11 @@
text.new-line
(:representation post))))
- ## (def: indent
- ## (-> Text Text)
- ## (text.replace-all text.new-line (format text.new-line text.tab)))
-
(def: block
(-> Statement Text)
(let [close (format text.new-line "}")]
(|>> :representation
- (format text.new-line)
- ## ..indent
+ ..nest
(text.enclose ["{"
close]))))
@@ -179,7 +179,7 @@
(|> inputs
(list@map ..code)
(text.join-with ..argument-separator)
- ..argument)
+ ..expression)
" ")
:abstraction))
@@ -187,7 +187,7 @@
(-> Var (List Var) Statement Computation)
(|> (..function! name inputs body)
:representation
- ..argument
+ ..expression
:abstraction))
(def: #export (closure inputs body)
@@ -198,16 +198,16 @@
(|> inputs
(list@map ..code)
(text.join-with ..argument-separator)
- ..argument)
+ ..expression)
" ")
- ..argument
+ ..expression
:abstraction))
(template [<name> <op>]
[(def: #export (<name> param subject)
(-> Expression Expression Computation)
(|> (format (:representation subject) " " <op> " " (:representation param))
- ..argument
+ ..expression
:abstraction))]
[= "==="]
@@ -236,7 +236,7 @@
(template [<name> <prefix>]
[(def: #export <name>
(-> Expression Computation)
- (|>> :representation (text.prefix <prefix>) ..argument :abstraction))]
+ (|>> :representation (text.prefix <prefix>) ..expression :abstraction))]
[not "!"]
[bit-not "~"]
@@ -247,7 +247,7 @@
[(def: #export (<name> value)
{#.doc "A 32-bit integer expression."}
(-> <input> Computation)
- (:abstraction (..argument (format (<format> value) "|0"))))]
+ (:abstraction (..expression (format (<format> value) "|0"))))]
[to-i32 Expression :representation]
[i32 Int %.int]
@@ -264,14 +264,14 @@
(|> (format (:representation test)
" ? " (:representation then)
" : " (:representation else))
- ..argument
+ ..expression
:abstraction))
(def: #export type-of
(-> Expression Computation)
(|>> :representation
(format "typeof ")
- ..argument
+ ..expression
:abstraction))
(def: #export (new constructor inputs)
@@ -280,8 +280,8 @@
(|> inputs
(list@map ..code)
(text.join-with ..argument-separator)
- ..argument))
- ..argument
+ ..expression))
+ ..expression
:abstraction))
(def: #export statement
@@ -302,7 +302,7 @@
(def: #export (set' name value)
(-> Location Expression Expression)
- (:abstraction (..argument (format (:representation name) " = " (:representation value)))))
+ (:abstraction (..expression (format (:representation name) " = " (:representation value)))))
(def: #export (set name value)
(-> Location Expression Statement)
@@ -405,14 +405,13 @@
(format (|> when
(list@map (|>> :representation (text.enclose ["case " ":"])))
(text.join-with text.new-line))
- text.new-line
- (:representation then))))
+ (..nest (:representation then)))))
(text.join-with text.new-line))
text.new-line
(case default
(#.Some default)
- (format "default:" text.new-line
- (:representation default))
+ (format "default:"
+ (..nest (:representation default)))
#.None ""))
:abstraction
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
index 6f3d288ef..59557b6de 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
@@ -367,8 +367,8 @@
Synthesis
(/////generation.Operation anchor expression directive Any)))
(do phase.monad
- [artifact-id (/////generation.learn /////program.name)
- programG (generate archive programS)]
+ [programG (generate archive programS)
+ artifact-id (/////generation.learn /////program.name)]
(/////generation.save! false [(%.nat module-id) (%.nat artifact-id)] (program [module-id artifact-id] programG))))
(def: (def::program program)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux
index 6ef13f3a3..fa9307f90 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux
@@ -107,16 +107,21 @@
(def: (io//exit codeG)
(Unary Expression)
- (let [@@process (_.var "process")
- @@window (_.var "window")
- @@location (_.var "location")]
- ($_ _.or
- ($_ _.and
- (_.not (_.= _.undefined (_.type-of @@process)))
- (_.the "exit" @@process)
- (_.do "exit" (list (//runtime.i64//to-number codeG)) @@process))
- (_.do "close" (list) @@window)
- (_.do "reload" (list) @@location))))
+ (let [exit-node-js! (let [@@process (_.var "process")]
+ (|> (_.not (_.= _.undefined (_.type-of @@process)))
+ (_.and (_.the "exit" @@process))
+ (_.and (_.do "exit" (list (//runtime.i64//to-number codeG)) @@process))))
+ close-browser-window! (let [@@window (_.var "window")]
+ (|> (_.not (_.= _.undefined (_.type-of @@window)))
+ (_.and (_.the "close" @@window))
+ (_.and (_.do "close" (list) @@window))))
+ reload-page! (let [@@location (_.var "location")]
+ (|> (_.not (_.= _.undefined (_.type-of @@location)))
+ (_.and (_.the "reload" @@location))
+ (_.and (_.do "reload" (list) @@location))))]
+ (|> exit-node-js!
+ (_.or close-browser-window!)
+ (_.or reload-page!))))
(def: (io//current-time _)
(Nullary Expression)
diff --git a/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux b/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux
index 25c7065ca..0105d0ccd 100644
--- a/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux
+++ b/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux
@@ -4,7 +4,9 @@
["." monad (#+ do)]]
[control
["." try (#+ Try)]
- ["." function]]
+ ["." state]
+ ["." function
+ ["." memo (#+ Memo)]]]
[data
["." maybe ("#@." functor)]
["." text
@@ -37,17 +39,6 @@
(-> Graph (List Module))
dictionary.keys)
-## (def: (remove module dependency)
-## (-> Module Graph Graph)
-## (case (..descendants module dependency)
-## (#.Some [ancestors descendants])
-## (list@fold remove
-## (dictionary.remove module dependency)
-## (set.to-list descendants))
-
-## #.None
-## dependency))
-
(type: Dependency
{#module Module
#imports Ancestry})
@@ -58,62 +49,48 @@
(dictionary.put module imports graph))
..empty))
-## (def: #export (prune archive graph)
-## (-> Archive Graph Graph)
-## (list@fold (function (_ module graph)
-## (if (archive.archived? archive module)
-## graph
-## (..remove module graph)))
-## graph
-## (dictionary.keys graph)))
+(def: (ancestry archive)
+ (-> Archive Graph)
+ (let [memo (: (Memo Module Ancestry)
+ (function (_ recur module)
+ (do {! state.monad}
+ [#let [parents (case (archive.find module archive)
+ (#try.Success [descriptor document])
+ (get@ #descriptor.references descriptor)
+
+ (#try.Failure error)
+ ..fresh)]
+ ancestors (monad.map ! recur (set.to-list parents))]
+ (wrap (list@fold set.union parents ancestors)))))
+ ancestry (memo.open memo)]
+ (list@fold (function (_ module memory)
+ (if (dictionary.contains? module memory)
+ memory
+ (let [[memory _] (ancestry [memory module])]
+ memory)))
+ ..empty
+ (archive.archived archive))))
-(def: (dependency? context target source)
+(def: (dependency? ancestry target source)
(-> Graph Module Module Bit)
- (let [ancestry (: (-> Module Ancestry)
- (function (_ module)
- (|> context
- (dictionary.get module)
- (maybe.default ..fresh))))]
- (loop [rejected ..fresh
- candidates (ancestry target)]
- (if (set.empty? candidates)
- false
- (or (set.member? candidates source)
- (let [rejected (set.union rejected candidates)]
- (recur rejected
- (|> candidates
- set.to-list
- (list@fold (function (_ candidate new-batch)
- (|> candidate
- ancestry
- (set.difference rejected)
- (set.union new-batch)))
- ..fresh)))))))))
+ (let [target-ancestry (|> ancestry
+ (dictionary.get target)
+ (maybe.default ..fresh))]
+ (set.member? target-ancestry source)))
(type: #export Order
(List [Module [archive.ID [Descriptor (Document .Module)]]]))
(def: #export (load-order key archive)
(-> (Key .Module) Archive (Try Order))
- (|> archive
- archive.archived
- (monad.map try.monad
- (function (_ module)
- (do try.monad
- [[descriptor document] (archive.find module archive)]
- (wrap {#module module
- #imports (get@ #descriptor.references descriptor)}))))
- (:: try.monad map
- (function (_ dependencies)
- (let [context (..graph dependencies)]
- (|> context
- ..modules
- (list.sort (..dependency? context))
- (monad.map try.monad
- (function (_ module)
- (do try.monad
- [module-id (archive.id module archive)
- [descriptor document] (archive.find module archive)
- document (document.check key document)]
- (wrap [module [module-id [descriptor document]]]))))))))
- (:: try.monad join)))
+ (let [ancestry (..ancestry archive)]
+ (|> ancestry
+ dictionary.keys
+ (list.sort (..dependency? ancestry))
+ (monad.map try.monad
+ (function (_ module)
+ (do try.monad
+ [module-id (archive.id module archive)
+ [descriptor document] (archive.find module archive)
+ document (document.check key document)]
+ (wrap [module [module-id [descriptor document]]])))))))
diff --git a/stdlib/source/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/lux/tool/compiler/meta/packager/script.lux
index 20756c0cf..88a7ddef0 100644
--- a/stdlib/source/lux/tool/compiler/meta/packager/script.lux
+++ b/stdlib/source/lux/tool/compiler/meta/packager/script.lux
@@ -34,6 +34,8 @@
["." archive
["." descriptor (#+ Module)]
["." artifact]]
+ [cache
+ ["." dependency]]
["." io #_
["#" archive]]
[//
@@ -89,18 +91,14 @@
monad}
{(! (Try (Directory !)))
(:assume (!.use (:: file-system directory) [(get@ #static.target static)]))})
- order (|> archive
- archive.archived
- (monad.map try.monad (function (_ module)
- (do try.monad
- [[descriptor document] (archive.find module archive)
- module-id (archive.id module archive)]
- (wrap (|> descriptor
- (get@ #descriptor.registry)
- artifact.artifacts
- row.to-list
- (list@map (|>> (get@ #artifact.id)))
- [module-id])))))
- (:: monad wrap))]
- (:: @ map (|>> to-code encoding.to-utf8)
- (monad.fold @ (..write-module monad file-system static sequence) header order)))))
+ order (:: monad wrap (dependency.load-order $.key archive))]
+ (|> order
+ (list@map (function (_ [module [module-id [descriptor document]]])
+ [module-id
+ (|> descriptor
+ (get@ #descriptor.registry)
+ artifact.artifacts
+ row.to-list
+ (list@map (|>> (get@ #artifact.id))))]))
+ (monad.fold @ (..write-module monad file-system static sequence) header)
+ (:: @ map (|>> to-code encoding.to-utf8))))))
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index 4dbd5efcd..f208fb73e 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -22,8 +22,6 @@
["." dictionary]
["." row (#+ Row)]
["." list ("#@." functor fold)]]]
- [time
- ["." instant (#+ Instant)]]
[world
["." file (#+ File Path)]
["." console]]