aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/cli.lux16
-rw-r--r--stdlib/source/lux/concurrency/actor.lux35
-rw-r--r--stdlib/source/lux/concurrency/atom.lux5
-rw-r--r--stdlib/source/lux/control/reader.lux8
-rw-r--r--stdlib/source/lux/data/coll/queue.lux15
5 files changed, 49 insertions, 30 deletions
diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux
index 0ea898ed8..4fa625dfd 100644
--- a/stdlib/source/lux/cli.lux
+++ b/stdlib/source/lux/cli.lux
@@ -99,8 +99,8 @@
## [Syntax]
(type: Program-Args
- (#Raw-Program-Args Text)
- (#Parsed-Program-Args (List [Code Code])))
+ (#Raw Text)
+ (#Parsed (List [Code Code])))
(def: program-args^
(Syntax Program-Args)
@@ -127,11 +127,13 @@
[data (init-program config)]
(do-something data))))}
(case args
- (#Raw-Program-Args args)
+ (#Raw args)
(wrap (list (` (;_lux_program (~ (code;symbol ["" args]))
- (~ body)))))
+ (do io;Monad<IO>
+ []
+ (~ body))))))
- (#Parsed-Program-Args args)
+ (#Parsed args)
(with-gensyms [g!args g!_ g!output g!message]
(wrap (list (` (;_lux_program (~ g!args)
(case ((: (;;CLI (io;IO Unit))
@@ -141,7 +143,9 @@
(list binding parser)))
L/join))
(~ g!_) ;;end]
- ((~' wrap) (~ body))))
+ ((~' wrap) (do io;Monad<IO>
+ []
+ (~ body)))))
(~ g!args))
(#R;Success [(~ g!_) (~ g!output)])
(~ g!output)
diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux
index 94dc81e48..04a0db61e 100644
--- a/stdlib/source/lux/concurrency/actor.lux
+++ b/stdlib/source/lux/concurrency/actor.lux
@@ -5,7 +5,7 @@
["ex" exception #+ exception:])
[io #- run "io/" Monad<IO>]
(data text/format
- (coll [list "L/" Monoid<List> Monad<List>])
+ (coll [list "L/" Monoid<List> Monad<List> Fold<List>])
[product])
[macro #+ with-gensyms Monad<Lux>]
(macro [code]
@@ -313,28 +313,39 @@
[actor-name (resolve-actor actor-name)
#let [g!type (code;symbol (product;both id state-name actor-name))
g!message (code;local-symbol (get@ #name signature))
- g!refs (: (List Code)
- (if (list;empty? actor-vars)
- (list)
- (|> actor-vars list;size n.dec
- (list;n.range +0) (L/map (|>. code;nat (~) ($) (`))))))
- g!actor (code;symbol actor-name)
- g!tvars (|> (get@ #vars signature) (L/append actor-vars) (L/map code;local-symbol))
+ g!actor-vars (L/map code;local-symbol actor-vars)
+ g!actor (` ((~ (code;symbol actor-name)) (~@ g!actor-vars)))
+ g!all-vars (|> (get@ #vars signature) (L/map code;local-symbol) (L/append g!actor-vars))
g!inputsC (|> (get@ #inputs signature) (L/map (|>. product;left code;local-symbol)))
g!inputsT (|> (get@ #inputs signature) (L/map product;right))
- g!outputT (get@ #output signature)
g!state (|> signature (get@ #state) code;local-symbol)
- g!self (|> signature (get@ #self) code;local-symbol)]]
+ g!self (|> signature (get@ #self) code;local-symbol)
+ g!actor-refs (: (List Code)
+ (if (list;empty? actor-vars)
+ (list)
+ (|> actor-vars list;size n.dec
+ (list;n.range +0) (L/map (|>. code;nat (~) ($) (`))))))
+ ref-replacements (|> (if (list;empty? actor-vars)
+ (list)
+ (|> actor-vars list;size n.dec
+ (list;n.range +0) (L/map (|>. code;nat (~) ($) (`)))))
+ (: (List Code))
+ (list;zip2 g!all-vars)
+ (: (List [Code Code])))
+ g!outputT (L/fold (function [[g!var g!ref] outputT]
+ (code;replace g!var g!ref outputT))
+ (get@ #output signature)
+ ref-replacements)]]
(wrap (list (` (def: (~@ (csw;export export)) ((~ g!message) (~@ g!inputsC) (~ g!self))
(~ (|> annotations
(with-message actor-name)
csw;annotations))
- (All [(~@ g!tvars)] (-> (~@ g!inputsT) (~ g!actor) (T;Task (~ g!outputT))))
+ (All [(~@ g!all-vars)] (-> (~@ g!inputsT) (~ g!actor) (T;Task (~ (get@ #output signature)))))
(let [(~ g!task) (T;task (~ g!outputT))]
(io;run (do io;Monad<IO>
[(~ g!sent?) (;;send (function [(~ g!state) (~ g!self)]
(do P;Monad<Promise>
- [(~ g!return) (: (T;Task [((~ g!type) (~@ g!refs))
+ [(~ g!return) (: (T;Task [((~ g!type) (~@ g!actor-refs))
(~ g!outputT)])
(do T;Monad<Task>
[]
diff --git a/stdlib/source/lux/concurrency/atom.lux b/stdlib/source/lux/concurrency/atom.lux
index 27bbe25fd..c9402ed80 100644
--- a/stdlib/source/lux/concurrency/atom.lux
+++ b/stdlib/source/lux/concurrency/atom.lux
@@ -1,6 +1,7 @@
(;module:
lux
- (lux [io #- run]))
+ (lux [function]
+ [io #- run]))
(type: #export (Atom a)
{#;doc "Atomic references that are safe to mutate concurrently."}
@@ -35,4 +36,4 @@
(def: #export (set value atom)
(All [a] (-> a (Atom a) (IO Unit)))
- (update (function [_] value) atom))
+ (update (function;const value) atom))
diff --git a/stdlib/source/lux/control/reader.lux b/stdlib/source/lux/control/reader.lux
index 21537c31b..bbc368a0c 100644
--- a/stdlib/source/lux/control/reader.lux
+++ b/stdlib/source/lux/control/reader.lux
@@ -38,14 +38,14 @@
(All [r] (Reader r r))
(function [env] env))
-(def: #export (local change reader-proc)
+(def: #export (local change proc)
{#;doc "Run computation with a locally-modified environment."}
(All [r a] (-> (-> r r) (Reader r a) (Reader r a)))
- (|>. change reader-proc))
+ (|>. change proc))
-(def: #export (run env reader-proc)
+(def: #export (run env proc)
(All [r a] (-> r (Reader r a) a))
- (reader-proc env))
+ (proc env))
(struct: #export (ReaderT Monad<M>)
{#;doc "Monad transformer for Reader."}
diff --git a/stdlib/source/lux/data/coll/queue.lux b/stdlib/source/lux/data/coll/queue.lux
index c1e7ae6a9..e5622f178 100644
--- a/stdlib/source/lux/data/coll/queue.lux
+++ b/stdlib/source/lux/data/coll/queue.lux
@@ -1,14 +1,13 @@
(;module:
lux
- (lux (control [eq #+ Eq])
- (data (coll [list "List/" Monoid<List>]))))
+ (lux (control [eq #+ Eq]
+ functor)
+ (data (coll [list "L/" Monoid<List> Functor<List>]))))
-## [Types]
(type: #export (Queue a)
{#front (List a)
#rear (List a)})
-## [Values]
(def: #export empty
Queue
{#front (list)
@@ -22,7 +21,7 @@
(def: #export (to-list queue)
(All [a] (-> (Queue a) (List a)))
(let [(^slots [#front #rear]) queue]
- (List/append front (list;reverse rear))))
+ (L/append front (list;reverse rear))))
(def: #export peek
(All [a] (-> (Queue a) (Maybe a)))
@@ -68,8 +67,12 @@
_
(update@ #rear (|>. (#;Cons val)) queue)))
-## [Structures]
(struct: #export (Eq<Queue> Eq<a>)
(All [a] (-> (Eq a) (Eq (Queue a))))
(def: (= qx qy)
(:: (list;Eq<List> Eq<a>) = (to-list qx) (to-list qy))))
+
+(struct: #export _ (Functor Queue)
+ (def: (map f fa)
+ {#front (|> fa (get@ #front) (L/map f))
+ #rear (|> fa (get@ #rear) (L/map f))}))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-10 06:15:19 +0000