From 60cf511d714adb311176be6ad375ff57a373dc7a Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 19 Aug 2017 15:14:41 -0400 Subject: - "program:" now evaluates its body within an implicit IO monad. - Fixed a bug with the types of actors and messages. - Added Functor for queues. - Small refactorings and fixes. --- stdlib/source/lux/cli.lux | 16 +++++++++------ stdlib/source/lux/concurrency/actor.lux | 35 ++++++++++++++++++++++----------- stdlib/source/lux/concurrency/atom.lux | 5 +++-- stdlib/source/lux/control/reader.lux | 8 ++++---- stdlib/source/lux/data/coll/queue.lux | 15 ++++++++------ 5 files changed, 49 insertions(+), 30 deletions(-) (limited to 'stdlib/source') 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 + [] + (~ 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 + [] + (~ 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] (data text/format - (coll [list "L/" Monoid Monad]) + (coll [list "L/" Monoid Monad Fold]) [product]) [macro #+ with-gensyms Monad] (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 [(~ g!sent?) (;;send (function [(~ g!state) (~ g!self)] (do P;Monad - [(~ g!return) (: (T;Task [((~ g!type) (~@ g!refs)) + [(~ g!return) (: (T;Task [((~ g!type) (~@ g!actor-refs)) (~ g!outputT)]) (do T;Monad [] 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) {#;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])))) + (lux (control [eq #+ Eq] + functor) + (data (coll [list "L/" Monoid Functor])))) -## [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 Eq) (All [a] (-> (Eq a) (Eq (Queue a)))) (def: (= qx qy) (:: (list;Eq Eq) = (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))})) -- cgit v1.2.3