diff options
Diffstat (limited to 'stdlib')
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]] |