aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/concurrency/actor.lux527
-rw-r--r--stdlib/source/lux/data/collection/tree.lux9
-rw-r--r--stdlib/source/lux/math/random.lux12
-rw-r--r--stdlib/source/lux/type/abstract.lux14
-rw-r--r--stdlib/source/program/aedifex/artifact/extension.lux2
-rw-r--r--stdlib/source/program/aedifex/artifact/type.lux2
-rw-r--r--stdlib/source/program/aedifex/command/deploy.lux2
-rw-r--r--stdlib/source/program/aedifex/dependency/resolution.lux31
-rw-r--r--stdlib/source/program/aedifex/hash.lux10
-rw-r--r--stdlib/source/program/aedifex/local.lux58
-rw-r--r--stdlib/source/program/aedifex/package.lux36
-rw-r--r--stdlib/source/test/aedifex.lux2
-rw-r--r--stdlib/source/test/aedifex/artifact/extension.lux4
-rw-r--r--stdlib/source/test/aedifex/artifact/type.lux4
-rw-r--r--stdlib/source/test/aedifex/hash.lux8
-rw-r--r--stdlib/source/test/aedifex/package.lux64
-rw-r--r--stdlib/source/test/lux/control/concurrency/actor.lux232
-rw-r--r--stdlib/source/test/lux/control/parser/binary.lux68
-rw-r--r--stdlib/source/test/lux/control/parser/cli.lux4
-rw-r--r--stdlib/source/test/lux/control/parser/json.lux30
-rw-r--r--stdlib/source/test/lux/control/parser/text.lux110
-rw-r--r--stdlib/source/test/lux/control/parser/type.lux18
-rw-r--r--stdlib/source/test/lux/control/parser/xml.lux20
-rw-r--r--stdlib/source/test/lux/data.lux26
-rw-r--r--stdlib/source/test/lux/data/collection/list.lux3
-rw-r--r--stdlib/source/test/lux/data/collection/tree.lux112
-rw-r--r--stdlib/source/test/lux/data/collection/tree/zipper.lux3
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux44
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux8
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux4
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux32
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux40
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux40
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux8
34 files changed, 840 insertions, 747 deletions
diff --git a/stdlib/source/lux/control/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux
index 3c423692a..320dc4207 100644
--- a/stdlib/source/lux/control/concurrency/actor.lux
+++ b/stdlib/source/lux/control/concurrency/actor.lux
@@ -26,26 +26,21 @@
["csw" writer]]]]
["." meta (#+ with-gensyms monad)
["." annotation]]
- [type
- abstract]]
+ [type (#+ :share)
+ ["." abstract (#+ abstract: :representation :abstraction)]]]
[//
["." atom (#+ Atom atom)]
["." promise (#+ Promise Resolver) ("#@." monad)]])
(exception: #export poisoned)
-
-(exception: #export (dead {actor-name Text}
- {message-name Text})
- (exception.report
- ["Actor" actor-name]
- ["Message" message-name]))
+(exception: #export dead)
(with-expansions
- [<Message> (as-is (-> s (Actor s) (Promise (Try s))))
- <Obituary> (as-is [Text s (List <Message>)])
+ [<Mail> (as-is (-> s (Actor s) (Promise (Try s))))
+ <Obituary> (as-is [Text s (List <Mail>)])
<Mailbox> (as-is (Rec Mailbox
- [(Promise [<Message> Mailbox])
- (Resolver [<Message> Mailbox])]))]
+ [(Promise [<Mail> Mailbox])
+ (Resolver [<Mail> Mailbox])]))]
(def: (pending [read write])
(All [a]
@@ -68,44 +63,37 @@
(Resolver <Obituary>)]
#mailbox (Atom <Mailbox>)}
- {#.doc "An actor, defined as all the necessities it requires."}
-
- ## TODO: Delete after new-luxc becomes the new standard compiler.
- (def: (actor mailbox obituary)
- (All [s]
- (-> (Atom <Mailbox>)
- [(Promise <Obituary>)
- (Resolver <Obituary>)]
- (Actor s)))
- (:abstraction {#obituary obituary
- #mailbox mailbox}))
-
- (type: #export (Message s)
- <Message>)
+ (type: #export (Mail s)
+ <Mail>)
(type: #export (Obituary s)
<Obituary>)
- (type: #export (Behavior s)
- {#.doc "An actor's behavior when messages are received."}
- {#handle (-> (Message s) s (Actor s) (Promise (Try s)))
- #end (-> Text s (Promise Any))})
+ (type: #export (Behavior o s)
+ {#.doc "An actor's behavior when mail is received and when a fatal error occurs."}
+ {#on-init (-> o s)
+ #on-mail (-> (Mail s) s (Actor s) (Promise (Try s)))
+ #on-stop (-> Text s (Promise Any))})
- (def: #export (spawn behavior init)
+ (def: #export (spawn! behavior init)
{#.doc "Given a behavior and initial state, spawns an actor and returns it."}
- (All [s] (-> (Behavior s) s (IO (Actor s))))
- (io (let [[handle end] behavior
- self (actor (atom (promise.promise []))
- (promise.promise []))
- process (loop [state init
+ (All [o s] (-> (Behavior o s) o (IO (Actor s))))
+ (io (let [[on-init on-mail on-stop] behavior
+ self (:share [o s]
+ {(Behavior o s)
+ behavior}
+ {(Actor s)
+ (:abstraction {#obituary (promise.promise [])
+ #mailbox (atom (promise.promise []))})})
+ process (loop [state (on-init init)
[|mailbox| _] (io.run (atom.read (get@ #mailbox (:representation self))))]
(do {! promise.monad}
[[head tail] |mailbox|
- ?state' (handle head state self)]
+ ?state' (on-mail head state self)]
(case ?state'
(#try.Failure error)
(do !
- [_ (end error state)]
+ [_ (on-stop error state)]
(let [[_ resolve] (get@ #obituary (:representation self))]
(exec (io.run
(do io.monad
@@ -134,13 +122,13 @@
(let [[obituary _] (get@ #obituary (:representation actor))]
(promise.poll obituary)))
- (def: #export (send message actor)
- {#.doc "Communicate with an actor through message passing."}
- (All [s] (-> (Message s) (Actor s) (IO Bit)))
+ (def: #export (mail! mail actor)
+ {#.doc "Send mail to an actor.."}
+ (All [s] (-> (Mail s) (Actor s) (IO (Try Any))))
(do {! io.monad}
[alive? (..alive? actor)]
(if alive?
- (let [entry [message (promise.promise [])]]
+ (let [entry [mail (promise.promise [])]]
(do !
[|mailbox|&resolve (atom.read (get@ #mailbox (:representation actor)))]
(loop [[|mailbox| resolve] |mailbox|&resolve]
@@ -153,272 +141,239 @@
(if resolved?
(do !
[_ (atom.write (product.right entry) (get@ #mailbox (:representation actor)))]
- (wrap true))
+ (wrap (exception.return [])))
(recur |mailbox|&resolve)))
(#.Some [_ |mailbox|'])
(recur |mailbox|'))))))
- (wrap false))))
+ (wrap (exception.throw ..dead [])))))
+
+ (type: #export (Message s o)
+ (-> s (Actor s) (Promise (Try [s o]))))
+
+ (def: (mail message)
+ (All [s o] (-> (Message s o) [(Promise (Try o)) (Mail s)]))
+ (let [[promise resolve] (:share [s o]
+ {(Message s o)
+ message}
+ {[(Promise (Try o))
+ (Resolver (Try o))]
+ (promise.promise [])})]
+ [promise
+ (function (_ state self)
+ (do {! promise.monad}
+ [outcome (message state self)]
+ (case outcome
+ (#try.Success [state' return])
+ (exec (io.run (resolve (#try.Success return)))
+ (promise.resolved (#try.Success state')))
+
+ (#try.Failure error)
+ (exec (io.run (resolve (#try.Failure error)))
+ (promise.resolved (#try.Failure error))))))]))
+
+ (def: #export (tell! message actor)
+ {#.doc "Communicate with an actor through message passing."}
+ (All [s o] (-> (Message s o) (Actor s) (Promise (Try o))))
+ (let [[promise mail] (..mail message)]
+ (do promise.monad
+ [outcome (promise.future (..mail! mail actor))]
+ (case outcome
+ (#try.Success)
+ promise
+
+ (#try.Failure error)
+ (wrap (#try.Failure error))))))
)
)
-(def: (default-handle message state self)
- (All [s] (-> (Message s) s (Actor s) (Promise (Try s))))
- (message state self))
+(def: (default-on-mail mail state self)
+ (All [s] (-> (Mail s) s (Actor s) (Promise (Try s))))
+ (mail state self))
-(def: (default-end cause state)
+(def: (default-on-stop cause state)
(All [s] (-> Text s (Promise Any)))
(promise@wrap []))
-(def: #export default-behavior
- (All [s] (Behavior s))
- {#handle default-handle
- #end default-end})
-
-(def: #export (poison actor)
- {#.doc (doc "Kills the actor by sending a message that will kill it upon processing,"
- "but allows the actor to handle previous messages.")}
- (All [s] (-> (Actor s) (IO Bit)))
- (send (function (_ state self)
- (promise.resolved (exception.throw ..poisoned [])))
- actor))
-
-(template [<with> <resolve> <tag> <desc>]
- [(def: (<with> name)
- (-> Name cs.Annotations cs.Annotations)
- (|>> (#.Cons [(name-of <tag>)
- (code.tag name)])))
-
- (def: (<resolve> name)
- (-> Name (Meta Name))
- (do meta.monad
- [constant (meta.find-def name)]
- (case constant
- (#.Left de-aliased)
- (<resolve> de-aliased)
-
- (#.Right [_ _ annotations _])
- (case (annotation.tag (name-of <tag>) annotations)
- (#.Some actor-name)
- (wrap actor-name)
-
- _
- (meta.fail (format "Definition is not " <desc> "."))))))]
-
- [with-actor resolve-actor #..actor "an actor"]
- [with-message resolve-message #..message "a message"]
- )
+(def: #export default
+ (All [s] (Behavior s s))
+ {#on-init function.identity
+ #on-mail ..default-on-mail
+ #on-stop ..default-on-stop})
+
+(def: #export (poison! actor)
+ {#.doc (doc "Kills the actor by sending mail that will kill it upon processing,"
+ "but allows the actor to handle previous mail.")}
+ (All [s] (-> (Actor s) (IO (Try Any))))
+ (..mail! (function (_ state self)
+ (promise.resolved (exception.throw ..poisoned [])))
+ actor))
(def: actor-decl^
(Parser [Text (List Text)])
(<>.either (<c>.form (<>.and <c>.local-identifier (<>.some <c>.local-identifier)))
(<>.and <c>.local-identifier (:: <>.monad wrap (list)))))
-(template [<name> <desc>]
- [(def: <name>
- (-> Text Text)
- (|>> (format <desc> "@")))]
-
- [state-name "State"]
- [behavior-name "Behavior"]
- [new-name "new"]
- )
-
-(type: HandleC
+(type: On-MailC
[[Text Text Text] Code])
-(type: StopC
+(type: On-StopC
[[Text Text] Code])
(type: BehaviorC
- [(Maybe HandleC) (Maybe StopC)])
+ [(Maybe On-MailC) (Maybe On-StopC) (List Code)])
+
+(def: argument
+ (Parser Text)
+ <c>.local-identifier)
(def: behavior^
(Parser BehaviorC)
- (let [handle-args (<c>.tuple ($_ <>.and <c>.local-identifier <c>.local-identifier <c>.local-identifier))
- stop-args (<c>.tuple ($_ <>.and <c>.local-identifier <c>.local-identifier))]
- (<>.and (<>.maybe (<c>.form (<>.and (<c>.form (<>.after (<c>.this! (' handle)) handle-args))
- <c>.any)))
- (<>.maybe (<c>.form (<>.and (<c>.form (<>.after (<c>.this! (' stop)) stop-args))
- <c>.any))))))
-
-(syntax: #export (actor:
- {export csr.export}
- {[_name _vars] actor-decl^}
- {annotations (<>.default cs.empty-annotations csr.annotations)}
- state-type
- {[?handle ?stop] behavior^})
- {#.doc (doc "Defines an actor, with its behavior and internal state."
- (actor: #export Counter
- Nat
-
- ((stop cause state)
- (:: promise.monad wrap
- (log! (if (exception.match? ..poisoned cause)
- (format "Counter was poisoned: " (%.nat state))
- cause)))))
-
- (actor: #export (Stack a)
- (List a)
-
- ((handle message state self)
- (do (try.with promise.monad)
- [#let [_ (log! "BEFORE")]
- output (message state self)
- #let [_ (log! "AFTER")]]
- (wrap output)))))}
- (with-gensyms [g!_ g!init]
- (do meta.monad
- [module meta.current-module-name
- #let [g!type (code.local-identifier (state-name _name))
- g!behavior (code.local-identifier (behavior-name _name))
- g!actor (code.local-identifier _name)
- g!new (code.local-identifier (new-name _name))
- g!vars (list@map code.local-identifier _vars)]]
- (wrap (list (` (type: (~+ (csw.export export)) ((~ g!type) (~+ g!vars))
- (~ state-type)))
- (` (type: (~+ (csw.export export)) ((~ g!actor) (~+ g!vars))
- (~ (|> annotations
- (with-actor [module _name])
- csw.annotations))
- (..Actor ((~ g!type) (~+ g!vars)))))
- (` (def: (~+ (csw.export export)) (~ g!behavior)
- (All [(~+ g!vars)]
- (..Behavior ((~ g!type) (~+ g!vars))))
- {#..handle (~ (case ?handle
- #.None
- (` (~! ..default-handle))
-
- (#.Some [[messageN stateN selfN] bodyC])
- (` (function ((~ g!_)
- (~ (code.local-identifier messageN))
- (~ (code.local-identifier stateN))
- (~ (code.local-identifier selfN)))
- ((~! do) ((~! try.with) (~! promise.monad))
- []
- (~ bodyC))))))
- #..end (~ (case ?stop
- #.None
- (` (~! ..default-end))
-
- (#.Some [[causeN stateN] bodyC])
- (` (function ((~ g!_)
- (~ (code.local-identifier causeN))
- (~ (code.local-identifier stateN)))
- ((~! do) (~! promise.monad)
- []
- (~ bodyC))))))}))
- (` (def: (~+ (csw.export export)) ((~ g!new) (~ g!init))
- (All [(~+ g!vars)]
- (-> ((~ g!type) (~+ g!vars)) (io.IO ((~ g!actor) (~+ g!vars)))))
- (..spawn (~ g!behavior) (~ g!init))))))
- )))
-
-(type: Signature
- {#vars (List Text)
- #name Text
- #inputs (List cs.Typed-Input)
- #state Text
- #self Text
- #output Code})
-
-(def: signature^
- (Parser Signature)
- (<c>.form ($_ <>.and
- (<>.default (list) (<c>.tuple (<>.some <c>.local-identifier)))
- <c>.local-identifier
- (<>.some csr.typed-input)
- <c>.local-identifier
- <c>.local-identifier
- <c>.any)))
-
-(def: reference^
- (Parser [Name (List Text)])
- (<>.either (<c>.form (<>.and <c>.identifier (<>.some <c>.local-identifier)))
- (<>.and <c>.identifier (:: <>.monad wrap (list)))))
-
-(syntax: #export (message:
- {export csr.export}
- {[actor-name actor-vars] reference^}
- {signature signature^}
- {annotations (<>.default cs.empty-annotations csr.annotations)}
- body)
- {#.doc (doc "A message can access the actor's state through the state parameter."
- "A message can also access the actor itself through the self parameter."
- "A message's output must be a task containing a 2-tuple with the updated state and a return value."
- "A message may succeed or fail (in case of failure, the actor dies)."
-
- (message: #export Counter
- (count! [increment Nat] state self Nat)
- (let [state' (n.+ increment state)]
- (promise.resolved (#try.Success [state' state']))))
-
- (message: #export (Stack a)
- (push [value a] state self (List a))
- (let [state' (#.Cons value state)]
- (promise.resolved (#try.Success [state' state'])))))}
- (with-gensyms [g!_ g!return g!error g!task g!sent? g!resolve]
- (do meta.monad
- [current-module meta.current-module-name
- actor-name (resolve-actor actor-name)
- #let [message-name [current-module (get@ #name signature)]
- g!type (code.identifier (product.both function.identity state-name actor-name))
- g!message (code.local-identifier (get@ #name signature))
- g!actor-vars (list@map code.local-identifier actor-vars)
- actorC (` ((~ (code.identifier actor-name)) (~+ g!actor-vars)))
- g!all-vars (|> (get@ #vars signature) (list@map code.local-identifier) (list@compose g!actor-vars))
- g!inputsC (|> (get@ #inputs signature) (list@map product.left))
- g!inputsT (|> (get@ #inputs signature) (list@map product.right))
- g!state (|> signature (get@ #state) code.local-identifier)
- g!self (|> signature (get@ #self) code.local-identifier)
- g!actor-refs (: (List Code)
- (if (list.empty? actor-vars)
- (list)
- (|> actor-vars list.size list.indices (list@map (|>> code.nat (~) ($) (`))))))
- ref-replacements (|> (if (list.empty? actor-vars)
- (list)
- (|> actor-vars list.size list.indices (list@map (|>> code.nat (~) ($) (`)))))
- (: (List Code))
- (list.zip/2 g!all-vars)
- (: (List [Code Code])))
- g!outputT (list@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!all-vars)]
- (-> (~+ g!inputsT)
- (~ actorC)
- ((~! promise.Promise) ((~! try.Try) (~ (get@ #output signature))))))
- (let [[(~ g!task) (~ g!resolve)] (: [((~! promise.Promise) ((~! try.Try) (~ g!outputT)))
- ((~! promise.Resolver) ((~! try.Try) (~ g!outputT)))]
- (promise.promise []))]
- ((~! io.run) ((~! do) (~! io.monad)
- [(~ g!sent?) (..send (function ((~ g!_) (~ g!state) (~ g!self))
- ((~! do) (~! promise.monad)
- [(~ g!return) (: ((~! promise.Promise)
- ((~! try.Try)
- [((~ g!type) (~+ g!actor-refs))
- (~ g!outputT)]))
- ((~! do) ((~! try.with) (~! promise.monad))
- []
- (~ body)))]
- (case (~ g!return)
- (#try.Success [(~ g!state) (~ g!return)])
- (exec ((~! io.run) ((~ g!resolve) (#try.Success (~ g!return))))
- ((~! promise.resolved) (#try.Success (~ g!state))))
-
- (#try.Failure (~ g!error))
- (exec ((~! io.run) ((~ g!resolve) (#try.Failure (~ g!error))))
- ((~! promise.resolved) (#try.Failure (~ g!error)))))
- ))
- (~ g!self))]
- (if (~ g!sent?)
- ((~' wrap) (~ g!task))
- ((~' wrap) ((~! promise.resolved)
- ((~! exception.throw) ..dead [(~ (code.text (%.name actor-name)))
- (~ (code.text (%.name message-name)))])))))))))
- )))))
+ (let [on-mail-args ($_ <>.and ..argument ..argument ..argument)
+ on-stop-args ($_ <>.and ..argument ..argument)]
+ ($_ <>.and
+ (<>.maybe (<c>.form (<>.and (<c>.form (<>.after (<c>.this! (' on-mail)) on-mail-args))
+ <c>.any)))
+ (<>.maybe (<c>.form (<>.and (<c>.form (<>.after (<c>.this! (' on-stop)) on-stop-args))
+ <c>.any)))
+ (<>.some <c>.any))))
+
+(def: (on-mail g!_ ?on-mail)
+ (-> Code (Maybe On-MailC) Code)
+ (case ?on-mail
+ #.None
+ (` (~! ..default-on-mail))
+
+ (#.Some [[mailN stateN selfN] bodyC])
+ (` (function ((~ g!_)
+ (~ (code.local-identifier mailN))
+ (~ (code.local-identifier stateN))
+ (~ (code.local-identifier selfN)))
+ (~ bodyC)))))
+
+(def: (on-stop g!_ ?on-stop)
+ (-> Code (Maybe On-StopC) Code)
+ (case ?on-stop
+ #.None
+ (` (~! ..default-on-stop))
+
+ (#.Some [[causeN stateN] bodyC])
+ (` (function ((~ g!_)
+ (~ (code.local-identifier causeN))
+ (~ (code.local-identifier stateN)))
+ (~ bodyC)))))
+
+(with-expansions [<examples> (as-is (actor: #export (Stack a)
+ (List a)
+
+ ((on-mail mail state self)
+ (do (try.with promise.monad)
+ [#let [_ (log! "BEFORE")]
+ output (mail state self)
+ #let [_ (log! "AFTER")]]
+ (wrap output)))
+
+ (message: #export (push {value a} state self (List a))
+ (let [state' (#.Cons value state)]
+ (promise.resolved (#try.Success [state' state'])))))
+
+ (actor: #export Counter
+ Nat
+
+ ((on-stop cause state)
+ (:: promise.monad wrap
+ (log! (if (exception.match? ..poisoned cause)
+ (format "Counter was poisoned: " (%.nat state))
+ cause))))
+
+ (message: #export (count! {increment Nat} state self Any)
+ (let [state' (n.+ increment state)]
+ (promise.resolved (#try.Success [state' state']))))
+
+ (message: #export (read! state self Nat)
+ (promise.resolved (#try.Success [state state])))))]
+ (syntax: #export (actor:
+ {export csr.export}
+ {[name vars] actor-decl^}
+ {annotations (<>.default cs.empty-annotations csr.annotations)}
+ state-type
+ {[?on-mail ?on-stop messages] behavior^})
+ {#.doc (doc "Defines an actor, with its behavior and internal state."
+ "Messages for the actor must be defined after the on-mail and on-stop handlers."
+ <examples>)}
+ (with-gensyms [g!_ g!init]
+ (do meta.monad
+ [g!type (meta.gensym (format name "-abstract-type"))
+ #let [g!actor (code.local-identifier name)
+ g!vars (list@map code.local-identifier vars)]]
+ (wrap (list (` ((~! abstract:) (~+ (csw.export export)) ((~ g!type) (~+ g!vars))
+ (~ state-type)
+
+ (def: (~+ (csw.export export)) (~ g!actor)
+ (All [(~+ g!vars)]
+ (..Behavior (~ state-type) ((~ g!type) (~+ g!vars))))
+ {#..on-init (|>> ((~! abstract.:abstraction) (~ g!type)))
+ #..on-mail (~ (on-mail g!_ ?on-mail))
+ #..on-stop (~ (on-stop g!_ ?on-stop))})
+
+ (~+ messages))))))))
+
+ (type: Signature
+ {#vars (List Text)
+ #name Text
+ #inputs (List cs.Typed-Input)
+ #state Text
+ #self Text
+ #output Code})
+
+ (def: signature^
+ (Parser Signature)
+ (<c>.form ($_ <>.and
+ (<>.default (list) (<c>.tuple (<>.some <c>.local-identifier)))
+ <c>.local-identifier
+ (<>.some csr.typed-input)
+ <c>.local-identifier
+ <c>.local-identifier
+ <c>.any)))
+
+ (def: reference^
+ (Parser [Name (List Text)])
+ (<>.either (<c>.form (<>.and <c>.identifier (<>.some <c>.local-identifier)))
+ (<>.and <c>.identifier (:: <>.monad wrap (list)))))
+
+ (syntax: #export (message:
+ {export csr.export}
+ {signature signature^}
+ {annotations (<>.default cs.empty-annotations csr.annotations)}
+ body)
+ {#.doc (doc "A message can access the actor's state through the state parameter."
+ "A message can also access the actor itself through the self parameter."
+ "A message's output must be a promise containing a 2-tuple with the updated state and a return value."
+ "A message may succeed or fail (in case of failure, the actor dies)."
+
+ <examples>)}
+ (with-gensyms [g!_ g!return]
+ (do meta.monad
+ [[actor-name actor-vars] abstract.current
+ #let [g!type (code.local-identifier actor-name)
+ g!message (code.local-identifier (get@ #name signature))
+ g!actor-vars (list@map code.local-identifier actor-vars)
+ g!all-vars (|> (get@ #vars signature) (list@map code.local-identifier) (list@compose g!actor-vars))
+ g!inputsC (|> (get@ #inputs signature) (list@map product.left))
+ g!inputsT (|> (get@ #inputs signature) (list@map product.right))
+ g!state (|> signature (get@ #state) code.local-identifier)
+ g!self (|> signature (get@ #self) code.local-identifier)]]
+ (wrap (list (` (def: (~+ (csw.export export)) ((~ g!message) (~+ g!inputsC))
+ (~ (csw.annotations annotations))
+ (All [(~+ g!all-vars)]
+ (-> (~+ g!inputsT)
+ (..Message ((~ g!type) (~+ g!actor-vars)) (~ (get@ #output signature)))))
+ (function ((~ g!_) (~ g!state) (~ g!self))
+ (let [(~ g!state) ((~! abstract.:representation) (~ g!type) (~ g!state))]
+ ((~! do) (~! promise.monad)
+ [(~ g!return) (~ body)]
+ ((~' wrap) ((~! do) (~! try.monad)
+ [[(~ g!state) (~ g!return)] (~ g!return)]
+ ((~' wrap) [((~! abstract.:abstraction) (~ g!type) (~ g!state))
+ (~ g!return)]))))))))
+ ))))))
diff --git a/stdlib/source/lux/data/collection/tree.lux b/stdlib/source/lux/data/collection/tree.lux
index aab50c4f3..375732b1b 100644
--- a/stdlib/source/lux/data/collection/tree.lux
+++ b/stdlib/source/lux/data/collection/tree.lux
@@ -2,9 +2,9 @@
[lux #*
[abstract
[functor (#+ Functor)]
- [monad (#+ Monad do)]
[equivalence (#+ Equivalence)]
- [fold (#+ Fold)]]
+ [fold (#+ Fold)]
+ [monad (#+ do)]]
[control
["<>" parser
["<c>" code (#+ Parser)]]]
@@ -39,10 +39,13 @@
(def: tree^
(Parser Tree-Code)
- (|> (|>> <>.some <c>.record (<>.and <c>.any))
+ (|> (|>> <>.some
+ <c>.record
+ (<>.and <c>.any))
<>.rec
<>.some
<c>.record
+ (<>.default (list))
(<>.and <c>.any)))
(syntax: #export (tree {root tree^})
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
index f38a0c571..8f2ef6006 100644
--- a/stdlib/source/lux/math/random.lux
+++ b/stdlib/source/lux/math/random.lux
@@ -86,6 +86,18 @@
(wrap sample)
(filter pred gen))))
+(def: #export (one check random)
+ (All [a b]
+ (-> (-> a (Maybe b)) (Random a) (Random b)))
+ (do ..monad
+ [sample random]
+ (case (check sample)
+ (#.Some output)
+ (wrap output)
+
+ #.None
+ (one check random))))
+
(def: #export (refine refiner gen)
{#.doc "Retries the generator until the output can be refined."}
(All [t r] (-> (Refiner t r) (Random t) (Random (Refined t r))))
diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux
index 639f58137..22a21cc9c 100644
--- a/stdlib/source/lux/type/abstract.lux
+++ b/stdlib/source/lux/type/abstract.lux
@@ -91,6 +91,18 @@
#.None
(exception.throw ..no-active-scopes [])))))
+(def: #export current
+ (Meta [Text (List Text)])
+ (do meta.monad
+ [[name type-vars abstraction representation] (..peek! #.None)]
+ (wrap [name (list@map code.format type-vars)])))
+
+(def: #export (specific name)
+ (-> Text (Meta (List Text)))
+ (do meta.monad
+ [[name type-vars abstraction representation] (..peek! (#.Some name))]
+ (wrap (list@map code.format type-vars))))
+
(template: (!push <source> <reference> <then>)
(loop [entries <source>]
(case entries
@@ -167,7 +179,7 @@
(<>.and (<>@wrap #.None) <c>.any)))
(template [<name> <from> <to>]
- [(syntax: #export (<name> {[scope value] cast})
+ [(syntax: #export (<name> {[scope value] ..cast})
(do meta.monad
[[name type-vars abstraction representation] (peek! scope)]
(wrap (list (` ((~! :cast) [(~+ type-vars)] (~ <from>) (~ <to>)
diff --git a/stdlib/source/program/aedifex/artifact/extension.lux b/stdlib/source/program/aedifex/artifact/extension.lux
index 412bf699a..78939260a 100644
--- a/stdlib/source/program/aedifex/artifact/extension.lux
+++ b/stdlib/source/program/aedifex/artifact/extension.lux
@@ -26,6 +26,6 @@
[lux-library]
[jvm-library]
[pom]
- [sha1]
+ [sha-1]
[md5]
)
diff --git a/stdlib/source/program/aedifex/artifact/type.lux b/stdlib/source/program/aedifex/artifact/type.lux
index 35035ebc4..5e5772ea2 100644
--- a/stdlib/source/program/aedifex/artifact/type.lux
+++ b/stdlib/source/program/aedifex/artifact/type.lux
@@ -13,6 +13,6 @@
["tar" lux-library]
["jar" jvm-library]
["pom" pom]
- ["sha1" sha1]
+ ["sha1" sha-1]
["md5" md5]
)
diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux
index 25b1a15aa..3041c53f1 100644
--- a/stdlib/source/program/aedifex/command/deploy.lux
+++ b/stdlib/source/program/aedifex/command/deploy.lux
@@ -70,6 +70,6 @@
pom (promise@wrap (///pom.write profile))
_ (deploy! ///artifact/type.pom (|> pom (:: xml.codec encode) encoding.to-utf8))
_ (deploy! ///artifact/type.lux-library library)
- _ (deploy! ///artifact/type.sha1 (///hash.data (///hash.sha1 library)))
+ _ (deploy! ///artifact/type.sha-1 (///hash.data (///hash.sha-1 library)))
_ (deploy! ///artifact/type.md5 (///hash.data (///hash.md5 library)))]
(wrap [])))))
diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux
index 46d32a4f7..7e48610e3 100644
--- a/stdlib/source/program/aedifex/dependency/resolution.lux
+++ b/stdlib/source/program/aedifex/dependency/resolution.lux
@@ -33,6 +33,7 @@
["/" profile]
["#." hash]
["#." pom]
+ ["#." package (#+ Package)]
["#." artifact
["#/." extension]]]])
@@ -85,23 +86,16 @@
["Type" (%.text type)]
["Hash" (%.text hash)])))]
- [sha1-does-not-match]
+ [sha-1-does-not-match]
[md5-does-not-match]
)
-(type: #export Package
- {#library Binary
- #pom XML
- #dependencies (List Dependency)
- #sha1 Text
- #md5 Text})
-
(def: (verified-hash dependency library url hash codec exception)
(All [h]
(-> Dependency Binary URL
(-> Binary (///hash.Hash h)) (Codec Text (///hash.Hash h))
(Exception [Dependency Text])
- (IO (Try Text))))
+ (IO (Try (///hash.Hash h)))))
(do (try.with io.monad)
[#let [expected (hash library)]
actual (..download url)]
@@ -111,7 +105,7 @@
actual (:: codec decode output)
_ (exception.assert exception [dependency output]
(:: ///hash.equivalence = expected actual))]
- (wrap output)))))
+ (wrap actual)))))
(def: #export (resolve repository dependency)
(-> Repository Dependency (IO (Try Package)))
@@ -119,7 +113,7 @@
prefix (format repository uri.separator (///artifact.uri artifact))]
(do (try.with io.monad)
[library (..download (format prefix (///artifact/extension.extension type)))
- sha1 (..verified-hash dependency library (format prefix ///artifact/extension.sha1) ///hash.sha1 ///hash.sha1-codec ..sha1-does-not-match)
+ sha-1 (..verified-hash dependency library (format prefix ///artifact/extension.sha-1) ///hash.sha-1 ///hash.sha-1-codec ..sha-1-does-not-match)
md5 (..verified-hash dependency library (format prefix ///artifact/extension.md5) ///hash.md5 ///hash.md5-codec ..md5-does-not-match)
pom (..download (format prefix ///artifact/extension.pom))]
(:: io.monad wrap
@@ -127,11 +121,10 @@
[pom (encoding.from-utf8 pom)
pom (:: xml.codec decode pom)
profile (<xml>.run ///pom.parser pom)]
- (wrap {#library library
- #pom pom
- #dependencies (set.to-list (get@ #/.dependencies profile))
- #sha1 sha1
- #md5 md5}))))))
+ (wrap {#///package.library library
+ #///package.pom pom
+ #///package.sha-1 sha-1
+ #///package.md5 md5}))))))
(type: #export Resolution
(Dictionary Dependency Package))
@@ -179,6 +172,8 @@
#.None
(..resolve-any repositories head))
- #let [resolution (dictionary.put head package resolution)]
- resolution (resolve-all repositories (get@ #dependencies package) resolution)]
+ sub-dependencies (:: io.monad wrap (///package.dependencies package))
+ resolution (|> resolution
+ (dictionary.put head package)
+ (resolve-all repositories (set.to-list sub-dependencies)))]
(resolve-all repositories tail resolution))))
diff --git a/stdlib/source/program/aedifex/hash.lux b/stdlib/source/program/aedifex/hash.lux
index 2f63d0edd..e5e4e020f 100644
--- a/stdlib/source/program/aedifex/hash.lux
+++ b/stdlib/source/program/aedifex/hash.lux
@@ -45,7 +45,7 @@
(java/security/MessageDigest::digest [value])
:abstraction))]
- [sha1 ..SHA-1 "SHA-1"]
+ [sha-1 ..SHA-1 "SHA-1"]
[md5 ..MD5 "MD5"]
)
@@ -64,7 +64,7 @@
Nat
<factor>)]
- [20 sha1::size]
+ [20 sha-1::size]
[16 md5::size]
)
@@ -87,7 +87,7 @@
["Expected size" (%.nat <size>)]
["Actual size" (%.nat (binary.size data))]))]
- [not-a-sha1 ..sha1::size]
+ [not-a-sha-1 ..sha-1::size]
[not-a-md5 ..md5::size]
)
@@ -98,7 +98,7 @@
(#try.Success (:abstraction data))
(exception.throw <exception> [data])))]
- [as-sha1 SHA-1 ..sha1::size ..not-a-sha1]
+ [as-sha-1 SHA-1 ..sha-1::size ..not-a-sha-1]
[as-md5 MD5 ..md5::size ..not-a-md5]
)
@@ -149,7 +149,7 @@
(def: encode (|>> :representation ..encode))
(def: decode (..decode <nat> <constructor>)))]
- [sha1-codec SHA-1 ..sha1::size ..as-sha1]
+ [sha-1-codec SHA-1 ..sha-1::size ..as-sha-1]
[md5-codec MD5 ..md5::size ..as-md5]
)
diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux
index 3c06f0222..dc769bcc1 100644
--- a/stdlib/source/program/aedifex/local.lux
+++ b/stdlib/source/program/aedifex/local.lux
@@ -34,11 +34,12 @@
["/" profile (#+ Profile)]
["#." pom]
["#." hash]
+ ["#." package (#+ Package)]
["#." artifact (#+ Artifact)
["#/." type]
["#/." extension]]
["#." dependency (#+ Dependency)
- ["#/." resolution (#+ Package Resolution)]]])
+ ["#/." resolution (#+ Resolution)]]])
(def: #export (repository system)
(All [a] (-> (file.System a) Path))
@@ -67,16 +68,22 @@
directory (: (Promise (Try (Directory Promise)))
(file.get-directory promise.monad system directory))
_ (..save! system
- (get@ #//dependency/resolution.library package)
+ (get@ #//package.library package)
(format prefix (//artifact/extension.extension type)))
_ (..save! system
- (encoding.to-utf8 (get@ #//dependency/resolution.sha1 package))
- (format prefix //artifact/extension.sha1))
+ (|> package
+ (get@ #//package.sha-1)
+ (:: //hash.sha-1-codec encode)
+ encoding.to-utf8)
+ (format prefix //artifact/extension.sha-1))
_ (..save! system
- (encoding.to-utf8 (get@ #//dependency/resolution.md5 package))
+ (|> package
+ (get@ #//package.md5)
+ (:: //hash.md5-codec encode)
+ encoding.to-utf8)
(format prefix //artifact/extension.md5))
_ (..save! system
- (|> package (get@ #//dependency/resolution.pom) (:: xml.codec encode) encoding.to-utf8)
+ (|> package (get@ #//package.pom) (:: xml.codec encode) encoding.to-utf8)
(format prefix //artifact/extension.pom))]
(wrap [])))
@@ -102,24 +109,19 @@
(file.make-directories promise.monad system (..path system artifact)))
#let [prefix (format directory (:: system separator) (//artifact.identity artifact))]
pom (..read! system (format prefix //artifact/extension.pom))
- [pom dependencies] (:: promise.monad wrap
- (do try.monad
- [pom (encoding.from-utf8 pom)
- pom (:: xml.codec decode pom)
- profile (<xml>.run //pom.parser pom)]
- (wrap [pom (get@ #/.dependencies profile)])))
library (..read! system (format prefix (//artifact/extension.extension type)))
- sha1 (..read! system (format prefix //artifact/extension.sha1))
+ sha-1 (..read! system (format prefix //artifact/extension.sha-1))
md5 (..read! system (format prefix //artifact/extension.md5))]
- (wrap {#//dependency/resolution.library library
- #//dependency/resolution.pom pom
- #//dependency/resolution.dependencies (set.to-list dependencies)
- #//dependency/resolution.sha1 (|> sha1
- (:coerce (//hash.Hash //hash.SHA-1))
- (:: //hash.sha1-codec encode))
- #//dependency/resolution.md5 (|> md5
- (:coerce (//hash.Hash //hash.MD5))
- (:: //hash.md5-codec encode))})))
+ (:: promise.monad wrap
+ (do try.monad
+ [pom (encoding.from-utf8 pom)
+ pom (:: xml.codec decode pom)
+ sha-1 (//hash.as-sha-1 sha-1)
+ md5 (//hash.as-md5 md5)]
+ (wrap {#//package.library library
+ #//package.pom pom
+ #//package.sha-1 sha-1
+ #//package.md5 md5})))))
(def: #export (all-cached system dependencies resolution)
(-> (file.System Promise) (List Dependency) Resolution (Promise (Try Resolution)))
@@ -138,10 +140,14 @@
(with-expansions [<next> (as-is (all-cached system tail resolution))]
(case package
(#try.Success package)
- (let [resolution (dictionary.put head package resolution)]
- (do (try.with promise.monad)
- [resolution (all-cached system (get@ #//dependency/resolution.dependencies package) resolution)]
- <next>))
+ (do (try.with promise.monad)
+ [sub-dependencies (|> package
+ //package.dependencies
+ (:: promise.monad wrap))
+ resolution (|> resolution
+ (dictionary.put head package)
+ (all-cached system (set.to-list sub-dependencies)))]
+ <next>)
(#try.Failure error)
<next>)))))
diff --git a/stdlib/source/program/aedifex/package.lux b/stdlib/source/program/aedifex/package.lux
new file mode 100644
index 000000000..757f116e6
--- /dev/null
+++ b/stdlib/source/program/aedifex/package.lux
@@ -0,0 +1,36 @@
+(.module:
+ [lux #*
+ [control
+ ["." try (#+ Try) ("#@." functor)]
+ [parser
+ ["<.>" xml]]]
+ [data
+ [binary (#+ Binary)]
+ [format
+ [xml (#+ XML)]]
+ [collection
+ [set (#+ Set)]]]]
+ ["." // #_
+ [dependency (#+ Dependency)]
+ ["/" profile]
+ ["#." hash (#+ Hash SHA-1 MD5)]
+ ["#." pom]])
+
+(type: #export Package
+ {#library Binary
+ #pom XML
+ #sha-1 (Hash SHA-1)
+ #md5 (Hash MD5)})
+
+(def: #export (local pom library)
+ (-> XML Binary Package)
+ {#library library
+ #pom pom
+ #sha-1 (//hash.sha-1 library)
+ #md5 (//hash.md5 library)})
+
+(def: #export dependencies
+ (-> Package (Try (Set Dependency)))
+ (|>> (get@ #pom)
+ (<xml>.run //pom.parser)
+ (try@map (get@ #/.dependencies))))
diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux
index dec078509..c1aa9ae9b 100644
--- a/stdlib/source/test/aedifex.lux
+++ b/stdlib/source/test/aedifex.lux
@@ -13,6 +13,7 @@
["#/." install]]
["#." local]
["#." dependency]
+ ["#." package]
["#." profile]
["#." project]
["#." cli]
@@ -29,6 +30,7 @@
/command/install.test
/local.test
/dependency.test
+ /package.test
/profile.test
/project.test
/cli.test
diff --git a/stdlib/source/test/aedifex/artifact/extension.lux b/stdlib/source/test/aedifex/artifact/extension.lux
index e65dd567a..c3da8465c 100644
--- a/stdlib/source/test/aedifex/artifact/extension.lux
+++ b/stdlib/source/test/aedifex/artifact/extension.lux
@@ -23,8 +23,8 @@
(_.with-cover [/.Extension]
($_ _.and
(_.cover [/.lux-library /.jvm-library /.pom
- /.sha1 /.md5]
- (let [options (list /.lux-library /.jvm-library /.pom /.sha1 /.md5)
+ /.sha-1 /.md5]
+ (let [options (list /.lux-library /.jvm-library /.pom /.sha-1 /.md5)
uniques (set.from-list text.hash options)]
(n.= (list.size options)
(set.size uniques))))
diff --git a/stdlib/source/test/aedifex/artifact/type.lux b/stdlib/source/test/aedifex/artifact/type.lux
index cbc6f681b..0d8284d7c 100644
--- a/stdlib/source/test/aedifex/artifact/type.lux
+++ b/stdlib/source/test/aedifex/artifact/type.lux
@@ -21,9 +21,9 @@
(_.with-cover [/.Type]
($_ _.and
(_.cover [/.lux-library /.jvm-library
- /.pom /.md5 /.sha1]
+ /.pom /.md5 /.sha-1]
(let [options (list /.lux-library /.jvm-library
- /.pom /.md5 /.sha1)
+ /.pom /.md5 /.sha-1)
uniques (set.from-list text.hash options)]
(n.= (list.size options)
(set.size uniques))))
diff --git a/stdlib/source/test/aedifex/hash.lux b/stdlib/source/test/aedifex/hash.lux
index 21e318be6..bc6bb1b4b 100644
--- a/stdlib/source/test/aedifex/hash.lux
+++ b/stdlib/source/test/aedifex/hash.lux
@@ -40,7 +40,7 @@
(`` ($_ _.and
(_.with-cover [/.equivalence]
($_ _.and
- ($equivalence.spec /.equivalence (..random /.sha1))
+ ($equivalence.spec /.equivalence (..random /.sha-1))
($equivalence.spec /.equivalence (..random /.md5))
))
(_.with-cover [/.data]
@@ -64,14 +64,14 @@
(#try.Failure error)
(exception.match? <exception> error)))))]
- [/.sha1 /.as-sha1 /.not-a-sha1]
+ [/.sha-1 /.as-sha-1 /.not-a-sha-1]
[/.md5 /.as-md5 /.not-a-md5]
))))
(~~ (template [<codec> <hash>]
[(_.with-cover [<codec>]
($codec.spec /.equivalence <codec> (..random <hash>)))]
- [/.sha1-codec /.sha1]
+ [/.sha-1-codec /.sha-1]
[/.md5-codec /.md5]
))
(_.with-cover [/.not-a-hash]
@@ -89,7 +89,7 @@
(#try.Failure error)
(exception.match? /.not-a-hash error))))]
- [/.sha1-codec /.sha1]
+ [/.sha-1-codec /.sha-1]
[/.md5-codec /.md5]
))))
))))
diff --git a/stdlib/source/test/aedifex/package.lux b/stdlib/source/test/aedifex/package.lux
new file mode 100644
index 000000000..b85f6ce4a
--- /dev/null
+++ b/stdlib/source/test/aedifex/package.lux
@@ -0,0 +1,64 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." try]
+ [concurrency
+ [promise (#+ Promise)]]]
+ [data
+ ["." text]
+ [collection
+ ["." set (#+ Set)]]
+ [number
+ ["n" nat]]]
+ [math
+ ["." random (#+ Random)]]
+ [world
+ ["." file]]]
+ [//
+ ["@." profile]
+ [//
+ [lux
+ [data
+ ["_." binary]]]]]
+ {#program
+ ["." /
+ ["/#" // #_
+ ["#" profile]
+ ["#." dependency (#+ Dependency)]
+ ["#." pom]
+ ["#." hash]]]})
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.with-cover [/.Package])
+ (do {! random.monad}
+ [content-size (:: ! map (n.% 100) random.nat)
+ content (_binary.random content-size)
+ [profile pom] (random.one (function (_ profile)
+ (try.to-maybe
+ (do try.monad
+ [pom (//pom.write profile)]
+ (wrap [profile pom]))))
+ @profile.random)]
+ ($_ _.and
+ (_.cover [/.local]
+ (let [package (/.local pom content)]
+ (and (:: //hash.equivalence =
+ (//hash.sha-1 content)
+ (get@ #/.sha-1 package))
+ (:: //hash.equivalence =
+ (//hash.md5 content)
+ (get@ #/.md5 package)))))
+ (_.cover [/.dependencies]
+ (let [expected (get@ #//.dependencies profile)]
+ (case (/.dependencies (/.local pom content))
+ (#try.Success actual)
+ (:: set.equivalence = expected actual)
+
+ (#try.Failure error)
+ false)))
+ ))))
diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux
index f63de1509..d31e6aef8 100644
--- a/stdlib/source/test/lux/control/concurrency/actor.lux
+++ b/stdlib/source/test/lux/control/concurrency/actor.lux
@@ -1,7 +1,8 @@
(.module:
[lux #*
["_" test (#+ Test)]
- [abstract/monad (#+ do)]
+ [abstract
+ [monad (#+ do)]]
[control
["." try (#+ Try)]
["." exception (#+ exception:)]
@@ -18,143 +19,144 @@
[//
["." promise (#+ Promise Resolver) ("#@." monad)]]]})
-(exception: get-wrecked)
+(exception: got-wrecked)
-(actor: Counter
+(actor: counter
Nat
- ((handle [message state self])
+ ((on-mail message state self)
(message state self))
- ((stop [cause state])
- (promise@wrap [])))
+ ((on-stop cause state)
+ (promise@wrap []))
-(message: #export Counter
- (count! {increment Nat} state self Nat)
- (let [state' (n.+ increment state)]
- (promise@wrap (#try.Success [state' state']))))
+ (message: (count! {increment Nat} state self Nat)
+ (let [state' (n.+ increment state)]
+ (promise@wrap (#try.Success [state' state']))))
+ )
+
+(def: (mailed? outcome)
+ (-> (Try Any) Bit)
+ (case outcome
+ (#try.Success _) true
+ (#try.Failure _) false))
(def: #export test
Test
(do random.monad
- [initial-state random.nat]
+ [initial-state random.nat
+ #let [inc! (: (/.Mail Nat)
+ (function (_ state actor)
+ (promise@wrap
+ (#try.Success
+ (inc state)))))]]
(<| (_.covering /._)
(_.with-cover [/.Actor])
($_ _.and
(_.cover [/.alive?]
(io.run (do io.monad
- [actor (/.spawn /.default-behavior 0)]
+ [actor (/.spawn! /.default 0)]
(/.alive? actor))))
+
+ (_.cover [/.poison!]
+ (let [poisoned-actors-die!
+ (io.run (do io.monad
+ [actor (/.spawn! /.default 0)
+ poisoned? (/.poison! actor)
+ alive? (/.alive? actor)]
+ (wrap (and (..mailed? poisoned?)
+ (not alive?)))))
+
+ cannot-poison-more-than-once!
+ (io.run (do io.monad
+ [actor (/.spawn! /.default 0)
+ first-time? (/.poison! actor)
+ second-time? (/.poison! actor)]
+ (wrap (and (..mailed? first-time?)
+ (not (..mailed? second-time?))))))]
+ (and poisoned-actors-die!
+ cannot-poison-more-than-once!)))
- (_.cover [/.poison]
- (and (io.run (do io.monad
- [actor (/.spawn /.default-behavior 0)
- poisoned? (/.poison actor)
- alive? (/.alive? actor)]
- (wrap (and poisoned?
- (not alive?)))))
- (io.run (do io.monad
- [actor (/.spawn /.default-behavior 0)
- first-time? (/.poison actor)
- second-time? (/.poison actor)]
- (wrap (and first-time?
- (not second-time?)))))))
-
- (let [inc! (: (/.Message Nat)
- (function (_ state actor)
- (promise@wrap
- (#try.Success
- (inc state)))))]
- (:: random.monad wrap
- (do promise.monad
+ (let [[read write] (: [(Promise Text) (Resolver Text)]
+ (promise.promise []))]
+ (wrap (do promise.monad
+ [_ (promise.future (do io.monad
+ [actor (/.spawn! (: (/.Behavior Any Any)
+ {#/.on-init (|>>)
+ #/.on-mail (function (_ message state self)
+ (message state self))
+ #/.on-stop (function (_ cause state)
+ (promise.future (write cause)))})
+ [])]
+ (/.poison! actor)))
+ _ (promise.wait 100)
+ result (promise.future (promise.poll read))]
+ (_.claim [/.poisoned]
+ (case result
+ (#.Some error)
+ (exception.match? /.poisoned error)
+
+ #.None
+ false)))))
+
+ (wrap (do promise.monad
+ [sent? (promise.future (do io.monad
+ [actor (/.spawn! /.default 0)
+ sent? (/.mail! inc! actor)]
+ (wrap (..mailed? sent?))))]
+ (_.claim [/.Behavior /.Mail
+ /.default /.spawn! /.mail!]
+ sent?)))
+
+ (wrap (do promise.monad
[result (promise.future (do io.monad
- [actor (/.spawn /.default-behavior 0)
- sent? (/.send inc! actor)]
- (wrap (#try.Success sent?))))]
- (_.claim [/.Behavior /.Message
- /.default-behavior /.spawn /.send]
+ [counter (/.spawn! /.default 0)
+ _ (/.poison! counter)]
+ (/.mail! inc! counter)))]
+ (_.claim [/.dead]
(case result
(#try.Success outcome)
- outcome
+ false
(#try.Failure error)
- false)))))
+ (exception.match? /.dead error)))))
- (let [[read write] (: [(Promise Text) (Resolver Text)]
- (promise.promise []))]
- (:: random.monad wrap
- (do promise.monad
- [_ (promise.future (do io.monad
- [actor (/.spawn {#/.handle (function (_ message state self)
- (message state self))
- #/.end (function (_ cause state)
- (promise.future (write cause)))}
- write)]
- (/.poison actor)))
- _ (promise.wait 100)
- result (promise.future (promise.poll read))]
- (_.claim [/.poisoned]
- (case result
- (#.Some error)
- (exception.match? /.poisoned error)
-
- #.None
- false)))))
-
- (:: random.monad wrap
- (do promise.monad
- [result (do (try.with promise.monad)
- [#let [counter (io.run (new@Counter 0))]
- output-1 (count! 1 counter)
- output-2 (count! 1 counter)
- output-3 (count! 1 counter)]
- (wrap (and (n.= 1 output-1)
- (n.= 2 output-2)
- (n.= 3 output-3))))]
- (_.claim [/.actor: /.message:]
- (case result
- (#try.Success outcome)
- outcome
-
- (#try.Failure error)
- false))))
-
- (:: random.monad wrap
- (do promise.monad
- [result (do (try.with promise.monad)
- [counter (promise.future (do io.monad
- [counter (new@Counter 0)
- _ (/.poison counter)]
- (wrap (#try.Success counter))))]
- (count! 1 counter))]
- (_.claim [/.dead]
- (case result
- (#try.Success outcome)
- false
-
- (#try.Failure error)
- (exception.match? /.dead error)))))
-
- (let [die! (: (/.Message Nat)
+ (let [die! (: (/.Mail Nat)
(function (_ state actor)
- (promise@wrap (exception.throw ..get-wrecked []))))]
- (:: random.monad wrap
- (do promise.monad
- [result (promise.future (do io.monad
- [actor (/.spawn /.default-behavior initial-state)
- sent? (/.send die! actor)
- alive? (/.alive? actor)
- obituary (/.obituary actor)]
- (wrap (#try.Success [actor sent? alive? obituary]))))]
- (_.claim [/.Obituary /.obituary]
+ (promise@wrap (exception.throw ..got-wrecked []))))]
+ (wrap (do promise.monad
+ [result (promise.future (do io.monad
+ [actor (/.spawn! /.default initial-state)
+ sent? (/.mail! die! actor)
+ alive? (/.alive? actor)
+ obituary (/.obituary actor)]
+ (wrap (#try.Success [actor sent? alive? obituary]))))]
+ (_.claim [/.Obituary /.obituary]
+ (case result
+ (^ (#try.Success [actor sent? alive? (#.Some [error state (list single-pending-message)])]))
+ (and (..mailed? sent?)
+ (not alive?)
+ (exception.match? ..got-wrecked error)
+ (n.= initial-state state)
+ (is? die! single-pending-message))
+
+ _
+ false)))))
+
+ (wrap (do promise.monad
+ [counter (promise.future (/.spawn! ..counter 0))
+ result (do (try.with promise.monad)
+ [output-1 (/.tell! (count! 1) counter)
+ output-2 (/.tell! (count! 1) counter)
+ output-3 (/.tell! (count! 1) counter)]
+ (wrap (and (n.= 1 output-1)
+ (n.= 2 output-2)
+ (n.= 3 output-3))))]
+ (_.claim [/.actor: /.message: /.tell!]
(case result
- (^ (#try.Success [actor sent? alive? (#.Some [error state (list single-pending-message)])]))
- (and sent?
- (not alive?)
- (exception.match? ..get-wrecked error)
- (n.= initial-state state)
- (is? die! single-pending-message))
-
- _
- false)))))
+ (#try.Success outcome)
+ outcome
+
+ (#try.Failure error)
+ false))))
))))
diff --git a/stdlib/source/test/lux/control/parser/binary.lux b/stdlib/source/test/lux/control/parser/binary.lux
index 98b8bab90..b02a94f0f 100644
--- a/stdlib/source/test/lux/control/parser/binary.lux
+++ b/stdlib/source/test/lux/control/parser/binary.lux
@@ -89,8 +89,8 @@
(Random Code)
(random.rec
(function (_ recur)
- (let [random-sequence (do {@ random.monad}
- [size (:: @ map (n.% 2) random.nat)]
+ (let [random-sequence (do {! random.monad}
+ [size (:: ! map (n.% 2) random.nat)]
(random.list size recur))]
($_ random.and
..random-location
@@ -106,8 +106,8 @@
..random-name
random-sequence
random-sequence
- (do {@ random.monad}
- [size (:: @ map (n.% 2) random.nat)]
+ (do {! random.monad}
+ [size (:: ! map (n.% 2) random.nat)]
(random.list size (random.and recur recur)))
)))))))
@@ -125,8 +125,8 @@
(<| (_.with-cover [/.Size])
(`` ($_ _.and
(~~ (template [<size> <parser> <format>]
- [(do {@ random.monad}
- [expected (:: @ map (i64.and (i64.mask <size>))
+ [(do {! random.monad}
+ [expected (:: ! map (i64.and (i64.mask <size>))
random.nat)]
(_.cover [<size> <parser>]
(|> (format.run <format> expected)
@@ -145,8 +145,8 @@
Test
(`` ($_ _.and
(~~ (template [<parser> <format>]
- [(do {@ random.monad}
- [expected (:: @ map encoding.to-utf8 (random.ascii ..segment-size))]
+ [(do {! random.monad}
+ [expected (:: ! map encoding.to-utf8 (random.ascii ..segment-size))]
(_.cover [<parser>]
(|> (format.run <format> expected)
(/.run <parser>)
@@ -163,7 +163,7 @@
Test
(`` ($_ _.and
(~~ (template [<parser> <format>]
- [(do {@ random.monad}
+ [(do {! random.monad}
[expected (random.ascii ..segment-size)]
(_.cover [<parser>]
(|> (format.run <format> expected)
@@ -182,7 +182,7 @@
Test
(`` ($_ _.and
(~~ (template [<parser> <format>]
- [(do {@ random.monad}
+ [(do {! random.monad}
[expected (random.row ..segment-size random.nat)]
(_.cover [<parser>]
(|> expected
@@ -201,7 +201,7 @@
Test
(`` ($_ _.and
(~~ (template [<parser> <format> <random> <equivalence>]
- [(do {@ random.monad}
+ [(do {! random.monad}
[expected <random>]
(_.cover [<parser>]
(|> expected
@@ -214,7 +214,7 @@
[/.nat format.nat random.nat n.equivalence]
[/.int format.int random.int int.equivalence]
[/.rev format.rev random.rev rev.equivalence]))
- (do {@ random.monad}
+ (do {! random.monad}
[expected random.frac]
(_.cover [/.frac]
(|> expected
@@ -224,8 +224,8 @@
(or (:: frac.equivalence = expected actual)
(and (frac.not-a-number? expected)
(frac.not-a-number? actual))))))))
- (do {@ random.monad}
- [expected (:: @ map (|>> (i64.and (i64.mask /.size/8))
+ (do {! random.monad}
+ [expected (:: ! map (|>> (i64.and (i64.mask /.size/8))
(n.max 2))
random.nat)]
(_.cover [/.not-a-bit]
@@ -240,7 +240,7 @@
Test
(`` ($_ _.and
(~~ (template [<parser> <format> <random> <equivalence>]
- [(do {@ random.monad}
+ [(do {! random.monad}
[expected <random>]
(_.cover [<parser>]
(|> expected
@@ -254,7 +254,7 @@
[/.type format.type random-type type.equivalence]
))
(~~ (template [<cover> <parser> <format> <random> <equivalence>]
- [(do {@ random.monad}
+ [(do {! random.monad}
[expected <random>]
(_.cover [<cover>]
(|> expected
@@ -267,15 +267,15 @@
[/.list (/.list /.nat) (format.list format.nat) (random.list ..segment-size random.nat) (list.equivalence n.equivalence)]
[/.set (/.set n.hash /.nat) (format.set format.nat) (random.set n.hash ..segment-size random.nat) set.equivalence]
[/.name /.name format.name ..random-name name.equivalence]))
- (do {@ random.monad}
- [expected (:: @ map (list.repeat ..segment-size) random.nat)]
+ (do {! random.monad}
+ [expected (:: ! map (list.repeat ..segment-size) random.nat)]
(_.cover [/.set-elements-are-not-unique]
(|> expected
(format.run (format.list format.nat))
(/.run (/.set n.hash /.nat))
(!expect (^multi (#try.Failure error)
(exception.match? /.set-elements-are-not-unique error))))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected (random.or random.bit random.nat)]
(_.cover [/.or]
(|> expected
@@ -286,8 +286,8 @@
(:: (sum.equivalence bit.equivalence n.equivalence) =
expected
actual))))))
- (do {@ random.monad}
- [tag (:: @ map (|>> (i64.and (i64.mask /.size/8))
+ (do {! random.monad}
+ [tag (:: ! map (|>> (i64.and (i64.mask /.size/8))
(n.max 2))
random.nat)
value random.bit]
@@ -298,7 +298,7 @@
(/.or /.bit /.nat)))
(!expect (^multi (#try.Failure error)
(exception.match? /.invalid-tag error))))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected (random.list ..segment-size random.nat)]
(_.cover [/.rec]
(|> expected
@@ -324,22 +324,22 @@
(|> (binary.create 0)
(/.run /.any)
(!expect (#try.Success _))))
- (do {@ random.monad}
- [data (:: @ map encoding.to-utf8 (random.ascii ..segment-size))]
+ (do {! random.monad}
+ [data (:: ! map encoding.to-utf8 (random.ascii ..segment-size))]
(_.cover [/.binary-was-not-fully-read]
(|> data
(/.run /.any)
(!expect (^multi (#try.Failure error)
(exception.match? /.binary-was-not-fully-read error))))))
- (do {@ random.monad}
- [expected (:: @ map encoding.to-utf8 (random.ascii ..segment-size))]
+ (do {! random.monad}
+ [expected (:: ! map encoding.to-utf8 (random.ascii ..segment-size))]
(_.cover [/.segment]
(|> expected
(/.run (/.segment ..segment-size))
(!expect (^multi (#try.Success actual)
(:: binary.equivalence = expected actual))))))
- (do {@ random.monad}
- [data (:: @ map encoding.to-utf8 (random.ascii ..segment-size))]
+ (do {! random.monad}
+ [data (:: ! map encoding.to-utf8 (random.ascii ..segment-size))]
(_.cover [/.end?]
(|> data
(/.run (do <>.monad
@@ -349,9 +349,9 @@
(wrap (and (not pre)
post))))
(!expect (#try.Success #1)))))
- (do {@ random.monad}
- [to-read (:: @ map (n.% (inc ..segment-size)) random.nat)
- data (:: @ map encoding.to-utf8 (random.ascii ..segment-size))]
+ (do {! random.monad}
+ [to-read (:: ! map (n.% (inc ..segment-size)) random.nat)
+ data (:: ! map encoding.to-utf8 (random.ascii ..segment-size))]
(_.cover [/.Offset /.offset]
(|> data
(/.run (do <>.monad
@@ -364,9 +364,9 @@
(n.= to-read offset)
(n.= ..segment-size nothing-left)))))
(!expect (#try.Success #1)))))
- (do {@ random.monad}
- [to-read (:: @ map (n.% (inc ..segment-size)) random.nat)
- data (:: @ map encoding.to-utf8 (random.ascii ..segment-size))]
+ (do {! random.monad}
+ [to-read (:: ! map (n.% (inc ..segment-size)) random.nat)
+ data (:: ! map encoding.to-utf8 (random.ascii ..segment-size))]
(_.cover [/.remaining]
(|> data
(/.run (do <>.monad
diff --git a/stdlib/source/test/lux/control/parser/cli.lux b/stdlib/source/test/lux/control/parser/cli.lux
index 2c781e4fc..7d90eb49d 100644
--- a/stdlib/source/test/lux/control/parser/cli.lux
+++ b/stdlib/source/test/lux/control/parser/cli.lux
@@ -29,8 +29,8 @@
Test
(<| (_.covering /._)
(_.with-cover [/.Parser])
- (do {@ random.monad}
- [expected (:: @ map n@encode random.nat)
+ (do {! random.monad}
+ [expected (:: ! map n@encode random.nat)
#let [random-dummy (random.filter (|>> (text@= expected) not)
(random.unicode 5))]
dummy random-dummy
diff --git a/stdlib/source/test/lux/control/parser/json.lux b/stdlib/source/test/lux/control/parser/json.lux
index 8ed632ac5..4b3bfeb7d 100644
--- a/stdlib/source/test/lux/control/parser/json.lux
+++ b/stdlib/source/test/lux/control/parser/json.lux
@@ -44,8 +44,8 @@
(<| (_.covering /._)
(_.with-cover [/.Parser])
(`` ($_ _.and
- (do {@ random.monad}
- [expected (:: @ map (|>> #json.String) (random.unicode 1))]
+ (do {! random.monad}
+ [expected (:: ! map (|>> #json.String) (random.unicode 1))]
(_.cover [/.run /.any]
(|> (/.run /.any expected)
(!expect (^multi (#try.Success actual)
@@ -54,7 +54,7 @@
(|> (/.run /.null #json.Null)
(!expect (#try.Success _))))
(~~ (template [<query> <test> <check> <random> <json> <equivalence>]
- [(do {@ random.monad}
+ [(do {! random.monad}
[expected <random>
dummy (|> <random> (random.filter (|>> (:: <equivalence> = expected) not)))]
($_ _.and
@@ -77,21 +77,21 @@
[/.number /.number? /.number! ..safe-frac #json.Number frac.equivalence]
[/.string /.string? /.string! (random.unicode 1) #json.String text.equivalence]
))
- (do {@ random.monad}
+ (do {! random.monad}
[expected (random.unicode 1)
dummy random.bit]
(_.cover [/.unexpected-value]
(|> (/.run /.string (#json.Boolean dummy))
(!expect (^multi (#try.Failure error)
(exception.match? /.unexpected-value error))))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected (random.unicode 1)
dummy (|> (random.unicode 1) (random.filter (|>> (:: text.equivalence = expected) not)))]
(_.cover [/.value-mismatch]
(|> (/.run (/.string! expected) (#json.String dummy))
(!expect (^multi (#try.Failure error)
(exception.match? /.value-mismatch error))))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected (random.unicode 1)]
(_.cover [/.nullable]
(and (|> (/.run (/.nullable /.string) #json.Null)
@@ -100,18 +100,18 @@
(|> (/.run (/.nullable /.string) (#json.String expected))
(!expect (^multi (#try.Success actual)
(:: (maybe.equivalence text.equivalence) = (#.Some expected) actual)))))))
- (do {@ random.monad}
- [size (:: @ map (n.% 10) random.nat)
+ (do {! random.monad}
+ [size (:: ! map (n.% 10) random.nat)
expected (|> (random.unicode 1)
(random.list size)
- (:: @ map row.from-list))]
+ (:: ! map row.from-list))]
(_.cover [/.array]
(|> (/.run (/.array (<>.some /.string))
(#json.Array (row@map (|>> #json.String) expected)))
(!expect (^multi (#try.Success actual)
(:: (row.equivalence text.equivalence) = expected (row.from-list actual)))))))
- (do {@ random.monad}
- [expected (:: @ map (|>> #json.String) (random.unicode 1))]
+ (do {! random.monad}
+ [expected (:: ! map (|>> #json.String) (random.unicode 1))]
(_.cover [/.unconsumed-input]
(|> (/.run (/.array /.any) (#json.Array (row expected expected)))
(!expect (^multi (#try.Failure error)
@@ -120,12 +120,12 @@
(|> (/.run (/.array /.any) (#json.Array (row)))
(!expect (^multi (#try.Failure error)
(exception.match? /.empty-input error)))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected-boolean random.bit
expected-number ..safe-frac
expected-string (random.unicode 1)
[boolean-field number-field string-field] (|> (random.set text.hash 3 (random.unicode 3))
- (:: @ map (|>> set.to-list
+ (:: ! map (|>> set.to-list
(case> (^ (list boolean-field number-field string-field))
[boolean-field number-field string-field]
@@ -145,8 +145,8 @@
(and (:: bit.equivalence = expected-boolean actual-boolean)
(:: frac.equivalence = expected-number actual-number)
(:: text.equivalence = expected-string actual-string)))))))
- (do {@ random.monad}
- [size (:: @ map (n.% 10) random.nat)
+ (do {! random.monad}
+ [size (:: ! map (n.% 10) random.nat)
keys (random.list size (random.unicode 1))
values (random.list size (random.unicode 1))
#let [expected (dictionary.from-list text.hash (list.zip/2 keys values))]]
diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux
index 4b207b257..206b93b12 100644
--- a/stdlib/source/test/lux/control/parser/text.lux
+++ b/stdlib/source/test/lux/control/parser/text.lux
@@ -68,50 +68,50 @@
(def: character-classes
Test
($_ _.and
- (do {@ random.monad}
- [offset (:: @ map (n.% 50) random.nat)
- range (:: @ map (|>> (n.% 50) (n.+ 10)) random.nat)
+ (do {! random.monad}
+ [offset (:: ! map (n.% 50) random.nat)
+ range (:: ! map (|>> (n.% 50) (n.+ 10)) random.nat)
#let [limit (n.+ offset range)]
- expected (:: @ map (|>> (n.% range) (n.+ offset) text.from-code) random.nat)
+ expected (:: ! map (|>> (n.% range) (n.+ offset) text.from-code) random.nat)
out-of-range (case offset
- 0 (:: @ map (|>> (n.% 10) inc (n.+ limit) text.from-code) random.nat)
- _ (:: @ map (|>> (n.% offset) text.from-code) random.nat))]
+ 0 (:: ! map (|>> (n.% 10) inc (n.+ limit) text.from-code) random.nat)
+ _ (:: ! map (|>> (n.% offset) text.from-code) random.nat))]
(_.cover [/.range]
(and (..should-pass expected (/.range offset limit))
(..should-fail out-of-range (/.range offset limit)))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected (random.char unicode.ascii/upper-alpha)
invalid (random.filter (|>> (unicode.within? unicode.basic-latin/upper-alpha) not)
(random.char unicode.full))]
(_.cover [/.upper]
(and (..should-pass (text.from-code expected) /.upper)
(..should-fail (text.from-code invalid) /.upper))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected (random.char unicode.ascii/lower-alpha)
invalid (random.filter (|>> (unicode.within? unicode.basic-latin/lower-alpha) not)
(random.char unicode.full))]
(_.cover [/.lower]
(and (..should-pass (text.from-code expected) /.lower)
(..should-fail (text.from-code invalid) /.lower))))
- (do {@ random.monad}
- [expected (:: @ map (n.% 10) random.nat)
+ (do {! random.monad}
+ [expected (:: ! map (n.% 10) random.nat)
invalid (random.char (unicode.set [unicode.number-forms (list)]))]
(_.cover [/.decimal]
(and (..should-pass (:: n.decimal encode expected) /.decimal)
(..should-fail (text.from-code invalid) /.decimal))))
- (do {@ random.monad}
- [expected (:: @ map (n.% 8) random.nat)
+ (do {! random.monad}
+ [expected (:: ! map (n.% 8) random.nat)
invalid (random.char (unicode.set [unicode.number-forms (list)]))]
(_.cover [/.octal]
(and (..should-pass (:: n.octal encode expected) /.octal)
(..should-fail (text.from-code invalid) /.octal))))
- (do {@ random.monad}
- [expected (:: @ map (n.% 16) random.nat)
+ (do {! random.monad}
+ [expected (:: ! map (n.% 16) random.nat)
invalid (random.char (unicode.set [unicode.number-forms (list)]))]
(_.cover [/.hexadecimal]
(and (..should-pass (:: n.hex encode expected) /.hexadecimal)
(..should-fail (text.from-code invalid) /.hexadecimal))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected (random.char unicode.ascii/alpha)
invalid (random.filter (function (_ char)
(not (or (unicode.within? unicode.basic-latin/upper-alpha char)
@@ -120,7 +120,7 @@
(_.cover [/.alpha]
(and (..should-pass (text.from-code expected) /.alpha)
(..should-fail (text.from-code invalid) /.alpha))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected (random.char unicode.ascii/alpha-num)
invalid (random.filter (function (_ char)
(not (or (unicode.within? unicode.basic-latin/upper-alpha char)
@@ -130,7 +130,7 @@
(_.cover [/.alpha-num]
(and (..should-pass (text.from-code expected) /.alpha-num)
(..should-fail (text.from-code invalid) /.alpha-num))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected ($_ random.either
(wrap text.tab)
(wrap text.vertical-tab)
@@ -148,14 +148,14 @@
(_.cover [/.space]
(and (..should-pass expected /.space)
(..should-fail invalid /.space))))
- (do {@ random.monad}
+ (do {! random.monad}
[#let [num-options 3]
options (|> (random.char unicode.full)
(random.set n.hash num-options)
- (:: @ map (|>> set.to-list
+ (:: ! map (|>> set.to-list
(list@map text.from-code)
(text.join-with ""))))
- expected (:: @ map (function (_ value)
+ expected (:: ! map (function (_ value)
(|> options
(text.nth (n.% num-options value))
maybe.assume))
@@ -174,14 +174,14 @@
(..should-fail (text.from-code invalid) (/.one-of! options))
(..should-fail' (text.from-code invalid) (/.one-of! options)
/.character-should-be))))
- (do {@ random.monad}
+ (do {! random.monad}
[#let [num-options 3]
options (|> (random.char unicode.full)
(random.set n.hash num-options)
- (:: @ map (|>> set.to-list
+ (:: ! map (|>> set.to-list
(list@map text.from-code)
(text.join-with ""))))
- invalid (:: @ map (function (_ value)
+ invalid (:: ! map (function (_ value)
(|> options
(text.nth (n.% num-options value))
maybe.assume))
@@ -206,27 +206,27 @@
Test
(let [octal! (/.one-of! "01234567")]
($_ _.and
- (do {@ random.monad}
- [left (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)
- right (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)
+ (do {! random.monad}
+ [left (:: ! map (|>> (n.% 8) (:: n.octal encode)) random.nat)
+ right (:: ! map (|>> (n.% 8) (:: n.octal encode)) random.nat)
#let [expected (format left right)]
invalid (|> random.nat
- (:: @ map (n.% 16))
+ (:: ! map (n.% 16))
(random.filter (n.>= 8))
- (:: @ map (:: n.hex encode)))]
+ (:: ! map (:: n.hex encode)))]
(_.cover [/.many /.many!]
(and (..should-pass expected (/.many /.octal))
(..should-fail invalid (/.many /.octal))
(..should-pass! expected (/.many! octal!)))))
- (do {@ random.monad}
- [left (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)
- right (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)
+ (do {! random.monad}
+ [left (:: ! map (|>> (n.% 8) (:: n.octal encode)) random.nat)
+ right (:: ! map (|>> (n.% 8) (:: n.octal encode)) random.nat)
#let [expected (format left right)]
invalid (|> random.nat
- (:: @ map (n.% 16))
+ (:: ! map (n.% 16))
(random.filter (n.>= 8))
- (:: @ map (:: n.hex encode)))]
+ (:: ! map (:: n.hex encode)))]
(_.cover [/.some /.some!]
(and (..should-pass expected (/.some /.octal))
(..should-pass "" (/.some /.octal))
@@ -234,8 +234,8 @@
(..should-pass! expected (/.some! octal!))
(..should-pass! "" (/.some! octal!)))))
- (do {@ random.monad}
- [#let [octal (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)]
+ (do {! random.monad}
+ [#let [octal (:: ! map (|>> (n.% 8) (:: n.octal encode)) random.nat)]
first octal
second octal
third octal]
@@ -247,8 +247,8 @@
(..should-pass! (format first second) (/.exactly! 2 octal!))
(..should-fail (format first second third) (/.exactly! 2 octal!))
(..should-fail (format first) (/.exactly! 2 octal!)))))
- (do {@ random.monad}
- [#let [octal (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)]
+ (do {! random.monad}
+ [#let [octal (:: ! map (|>> (n.% 8) (:: n.octal encode)) random.nat)]
first octal
second octal
third octal]
@@ -260,8 +260,8 @@
(..should-pass! (format first second) (/.at-most! 2 octal!))
(..should-pass! (format first) (/.at-most! 2 octal!))
(..should-fail (format first second third) (/.at-most! 2 octal!)))))
- (do {@ random.monad}
- [#let [octal (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)]
+ (do {! random.monad}
+ [#let [octal (:: ! map (|>> (n.% 8) (:: n.octal encode)) random.nat)]
first octal
second octal
third octal]
@@ -273,8 +273,8 @@
(..should-pass! (format first second) (/.at-least! 2 octal!))
(..should-pass! (format first second third) (/.at-least! 2 octal!))
(..should-fail (format first) (/.at-least! 2 octal!)))))
- (do {@ random.monad}
- [#let [octal (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)]
+ (do {! random.monad}
+ [#let [octal (:: ! map (|>> (n.% 8) (:: n.octal encode)) random.nat)]
first octal
second octal
third octal]
@@ -293,7 +293,7 @@
(<| (_.covering /._)
(_.with-cover [/.Parser])
($_ _.and
- (do {@ random.monad}
+ (do {! random.monad}
[sample (random.unicode 1)]
(_.cover [/.run /.end!]
(and (|> (/.run /.end!
@@ -302,7 +302,7 @@
(|> (/.run /.end!
sample)
(!expect (#try.Failure _))))))
- (do {@ random.monad}
+ (do {! random.monad}
[#let [size 10]
expected (random.unicode size)
dummy (|> (random.unicode size)
@@ -320,7 +320,7 @@
(/.run (/.slice /.any!))
(!expect (^multi (#try.Failure error)
(exception.match? /.cannot-slice error)))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected (random.unicode 1)]
(_.cover [/.any /.any!]
(and (..should-pass expected /.any)
@@ -328,7 +328,7 @@
(..should-pass! expected /.any!)
(..should-fail "" /.any!))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected (random.unicode 1)]
(_.cover [/.peek /.cannot-parse]
(and (..should-pass expected (<>.before /.any /.peek))
@@ -336,14 +336,14 @@
(/.run (<>.before /.any /.peek))
(!expect (^multi (#try.Failure error)
(exception.match? /.cannot-parse error)))))))
- (do {@ random.monad}
+ (do {! random.monad}
[dummy (random.unicode 1)]
(_.cover [/.unconsumed-input]
(|> (format dummy dummy)
(/.run /.any)
(!expect (^multi (#try.Failure error)
(exception.match? /.unconsumed-input error))))))
- (do {@ random.monad}
+ (do {! random.monad}
[sample (random.unicode 1)]
(_.cover [/.Offset /.offset]
(|> sample
@@ -353,7 +353,7 @@
post /.offset]
(wrap [pre post])))
(!expect (#try.Success [0 1])))))
- (do {@ random.monad}
+ (do {! random.monad}
[left (random.unicode 1)
right (random.unicode 1)
#let [input (format left right)]]
@@ -367,7 +367,7 @@
(wrap (and (text@= input pre)
(text@= right post)))))
(!expect (#try.Success #1)))))
- (do {@ random.monad}
+ (do {! random.monad}
[left (random.unicode 1)
right (random.unicode 1)
expected (random.filter (|>> (text@= right) not)
@@ -376,7 +376,7 @@
(|> (format left expected right)
(/.run (/.enclosed [left right] (/.this expected)))
(!expect (#try.Success _)))))
- (do {@ random.monad}
+ (do {! random.monad}
[in (random.unicode 1)
out (random.unicode 1)]
(_.cover [/.local]
@@ -385,14 +385,14 @@
[_ (/.local in (/.this in))]
(/.this out)))
(!expect (#try.Success _)))))
- (do {@ random.monad}
- [expected (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)]
+ (do {! random.monad}
+ [expected (:: ! map (|>> (n.% 8) (:: n.octal encode)) random.nat)]
(_.cover [/.embed]
(|> (list (code.text expected))
(<c>.run (/.embed /.octal <c>.text))
(!expect (^multi (#try.Success actual)
(text@= expected actual))))))
- (do {@ random.monad}
+ (do {! random.monad}
[invalid (random.ascii/upper-alpha 1)
expected (random.filter (|>> (unicode.within? unicode.basic-latin/upper-alpha)
not)
@@ -410,7 +410,7 @@
(/.run (/.not! upper!))
(!expect (^multi (#try.Failure error)
(exception.match? /.expected-to-fail error)))))))
- (do {@ random.monad}
+ (do {! random.monad}
[upper (random.ascii/upper-alpha 1)
lower (random.ascii/lower-alpha 1)
invalid (random.filter (function (_ char)
@@ -427,7 +427,7 @@
(..should-pass! (format upper lower) (/.and! upper! lower!))
(..should-fail (format (text.from-code invalid) lower) (/.and! upper! lower!))
(..should-fail (format upper (text.from-code invalid)) (/.and! upper! lower!)))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected (random.unicode 1)
invalid (random.unicode 1)]
(_.cover [/.satisfies /.character-does-not-satisfy-predicate]
diff --git a/stdlib/source/test/lux/control/parser/type.lux b/stdlib/source/test/lux/control/parser/type.lux
index 99e995f2d..10925cb12 100644
--- a/stdlib/source/test/lux/control/parser/type.lux
+++ b/stdlib/source/test/lux/control/parser/type.lux
@@ -34,7 +34,7 @@
(def: matches
Test
(<| (_.with-cover [/.types-do-not-match])
- (do {@ random.monad}
+ (do {! random.monad}
[expected ..primitive
dummy (random.filter (|>> (type@= expected) not)
..primitive)])
@@ -69,7 +69,7 @@
(def: aggregate
Test
- (do {@ random.monad}
+ (do {! random.monad}
[expected-left ..primitive
expected-middle ..primitive
expected-right ..primitive]
@@ -120,13 +120,13 @@
(<| (_.covering /._)
(_.with-cover [/.Parser])
($_ _.and
- (do {@ random.monad}
+ (do {! random.monad}
[expected ..primitive]
(_.cover [/.run /.any]
(|> (/.run /.any expected)
(!expect (^multi (#try.Success actual)
(type@= expected actual))))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected ..primitive]
(_.cover [/.peek /.unconsumed-input]
(and (|> (/.run (do //.monad
@@ -139,7 +139,7 @@
(|> (/.run /.peek expected)
(!expect (^multi (#try.Failure error)
(exception.match? /.unconsumed-input error)))))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected ..primitive]
(_.cover [/.empty-input]
(`` (and (~~ (template [<parser>]
@@ -153,7 +153,7 @@
[/.any]
[/.peek]
))))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected ..primitive]
(_.cover [/.Env /.env /.fresh]
(|> (/.run (do //.monad
@@ -163,7 +163,7 @@
expected)
(!expect (^multi (#try.Success environment)
(is? /.fresh environment))))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected ..primitive
dummy (random.filter (|>> (type@= expected) not)
..primitive)]
@@ -175,14 +175,14 @@
dummy)
(!expect (^multi (#try.Success actual)
(type@= expected actual))))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected random.nat]
(_.cover [/.existential /.not-existential]
(|> (/.run /.existential
(#.Ex expected))
(!expect (^multi (#try.Success actual)
(n.= expected actual))))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected-name (random.and (random.ascii/alpha-num 1)
(random.ascii/alpha-num 1))
expected-type ..primitive]
diff --git a/stdlib/source/test/lux/control/parser/xml.lux b/stdlib/source/test/lux/control/parser/xml.lux
index b46994c97..db7a51d39 100644
--- a/stdlib/source/test/lux/control/parser/xml.lux
+++ b/stdlib/source/test/lux/control/parser/xml.lux
@@ -34,7 +34,7 @@
(template: (!failure <exception> <cases>)
(with-expansions [<<cases>> (template.splice <cases>)]
- (do {@ random.monad}
+ (do {! random.monad}
[expected (random.ascii/alpha 1)]
(_.cover [<exception>]
(`` (and (~~ (template [<parser> <input>]
@@ -57,7 +57,7 @@
(<| (_.covering /._)
(_.with-cover [/.Parser])
($_ _.and
- (do {@ random.monad}
+ (do {! random.monad}
[expected (random.ascii/alpha 1)]
(_.cover [/.run /.text]
(|> (/.run /.text (#xml.Text expected))
@@ -66,12 +66,12 @@
(!failure /.unconsumed-inputs
[[(//@wrap expected)
(#xml.Text expected)]])
- (do {@ random.monad}
+ (do {! random.monad}
[expected (random.ascii/alpha 1)]
(_.cover [/.ignore]
(|> (/.run /.ignore (#xml.Text expected))
(!expect (#try.Success [])))))
- (do {@ random.monad}
+ (do {! random.monad}
[expected ..random-tag]
(_.cover [/.node]
(|> (/.run (do //.monad
@@ -82,7 +82,7 @@
(!failure /.wrong-tag
[[(/.node ["" expected])
(#xml.Node [expected ""] (dictionary.new name.hash) (list))]])
- (do {@ random.monad}
+ (do {! random.monad}
[expected-tag ..random-tag
expected-attribute ..random-attribute
expected-value (random.ascii/alpha 1)]
@@ -104,13 +104,13 @@
(|> (dictionary.new name.hash)
(dictionary.put [expected ""] expected))
(list))]])
- (do {@ random.monad}
+ (do {! random.monad}
[expected ..random-tag]
(_.cover [/.children]
- (|> (/.run (do {@ //.monad}
+ (|> (/.run (do {! //.monad}
[_ (/.node expected)]
(/.children
- (do @
+ (do !
[_ (/.node expected)]
/.ignore)))
(#xml.Node expected
@@ -161,10 +161,10 @@
[_ (/.attribute [expected expected])]
/.ignore)
(#xml.Text expected)]
- [(do {@ //.monad}
+ [(do {! //.monad}
[_ (/.node [expected expected])]
(/.children
- (do @
+ (do !
[_ (/.node [expected expected])]
/.ignore)))
(#xml.Text expected)]])
diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux
index 287a93526..6ae68a061 100644
--- a/stdlib/source/test/lux/data.lux
+++ b/stdlib/source/test/lux/data.lux
@@ -42,28 +42,6 @@
[_ (wrap [])]
body)))
-(def: number
- Test
- ## TODO: Inline ASAP
- (let [part0 ($_ _.and
- /i8.test
- /i16.test
- /i32.test
- /i64.test)
- part1 ($_ _.and
- /nat.test
- /int.test
- /rev.test)
- part2 ($_ _.and
- /frac.test
- /ratio.test
- /complex.test)]
- ($_ _.and
- (!bundle part0)
- (!bundle part1)
- (!bundle part2)
- )))
-
(def: text
($_ _.and
/text.test
@@ -93,10 +71,10 @@
/product.test)
test2 ($_ _.and
/sum.test
- ..number
..text
..format
- /collection.test)]
+ /collection.test
+ )]
($_ _.and
(!bundle test0)
(!bundle test1)
diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux
index a81de6c24..2190c2fe2 100644
--- a/stdlib/source/test/lux/data/collection/list.lux
+++ b/stdlib/source/test/lux/data/collection/list.lux
@@ -177,7 +177,8 @@
(let [(^open "/@.") (/.equivalence n.equivalence)
(^open "/@.") /.monoid]
(do {! random.monad}
- [sample ..random
+ [sample (random.filter (|>> /.size (n.> 0))
+ ..random)
#let [size (/.size sample)]
idx (:: ! map (n.% size) random.nat)
chunk-size (:: ! map (|>> (n.% size) inc) random.nat)]
diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux
index 8ba66ef02..ccd4a1d70 100644
--- a/stdlib/source/test/lux/data/collection/tree.lux
+++ b/stdlib/source/test/lux/data/collection/tree.lux
@@ -1,63 +1,91 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
["_" test (#+ Test)]
[abstract
- [monad (#+ do)]
+ ["." monad (#+ do)]
{[0 #spec]
[/
["$." equivalence]
["$." fold]
["$." functor]]}]
[data
+ ["." product]
[number
["n" nat]]
[collection
["." list ("#@." functor fold)]]]
[math
- ["r" random (#+ Random)]]]
+ ["." random (#+ Random)]]]
{1
["." / (#+ Tree)]})
-(def: #export (tree size gen-value)
- (All [a] (-> Nat (Random a) (Random (Tree a))))
- (let [singleton (:: r.monad map /.leaf gen-value)]
- (case size
- 0
- singleton
-
- 1
- singleton
-
- 2
- (do r.monad
- [value gen-value
- single (tree 1 gen-value)]
- (wrap (/.branch value (list single))))
-
- _
- (do r.monad
- [value gen-value
- #let [size (dec size)]
- left (tree (n./ 2 size) gen-value)
- right (tree (n.+ (n.% 2 size) (n./ 2 size))
- gen-value)]
- (wrap (/.branch value (list left right))))
- )))
+(def: #export (tree gen-value)
+ (All [a] (-> (Random a) (Random [Nat (Tree a)])))
+ (do {! random.monad}
+ [value gen-value
+ num-children (:: ! map (n.% 2) random.nat)
+ children (random.list num-children (tree gen-value))]
+ (wrap [(|> children
+ (list@map product.left)
+ (list@fold n.+ 1))
+ {#/.value value
+ #/.children (list@map product.right children)}])))
(def: #export test
Test
- (<| (_.context (%.name (name-of /.Tree)))
- (do {! r.monad}
- [size (:: ! map (|>> (n.% 100) (n.+ 1)) r.nat)]
- ($_ _.and
- ($equivalence.spec (/.equivalence n.equivalence) (..tree size r.nat))
- ($fold.spec /.leaf /.equivalence /.fold)
- ($functor.spec /.leaf /.equivalence /.functor)
-
- (do !
- [sample (..tree size r.nat)]
- (_.test "Can flatten a tree to get all the nodes as a flat tree."
- (n.= size
- (list.size (/.flatten sample)))))
- ))))
+ (<| (_.covering /._)
+ (_.with-cover [/.Tree])
+ ($_ _.and
+ (_.with-cover [/.equivalence]
+ (|> (..tree random.nat)
+ (:: random.monad map product.right)
+ ($equivalence.spec (/.equivalence n.equivalence))))
+ (_.with-cover [/.fold]
+ ($fold.spec /.leaf /.equivalence /.fold))
+ (_.with-cover [/.functor]
+ ($functor.spec /.leaf /.equivalence /.functor))
+
+ (do random.monad
+ [[size sample] (..tree random.nat)]
+ (_.cover [/.flatten]
+ (n.= size
+ (list.size (/.flatten sample)))))
+ (do random.monad
+ [expected random.nat]
+ (_.cover [/.leaf]
+ (:: (list.equivalence n.equivalence) =
+ (list expected)
+ (/.flatten (/.leaf expected)))))
+ (do {! random.monad}
+ [value random.nat
+ num-children (:: ! map (n.% 3) random.nat)
+ children (random.list num-children random.nat)]
+ (_.cover [/.branch]
+ (:: (list.equivalence n.equivalence) =
+ (list& value children)
+ (/.flatten (/.branch value (list@map /.leaf children))))))
+ (do random.monad
+ [expected/0 random.nat
+ expected/1 random.nat
+ expected/2 random.nat
+ expected/3 random.nat
+ expected/4 random.nat
+ expected/5 random.nat]
+ (_.cover [/.tree]
+ (and (:: (list.equivalence n.equivalence) =
+ (list expected/0)
+ (/.flatten (/.tree expected/0)))
+ (:: (list.equivalence n.equivalence) =
+ (list expected/0 expected/1 expected/2)
+ (/.flatten (/.tree expected/0
+ {expected/1 {}
+ expected/2 {}})))
+ (:: (list.equivalence n.equivalence) =
+ (list expected/0 expected/1 expected/2
+ expected/3 expected/4 expected/5)
+ (/.flatten (/.tree expected/0
+ {expected/1 {}
+ expected/2 {expected/3 {}
+ expected/4 {expected/5 {}}}})))
+ )))
+ )))
diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux
index 7354eafed..6d0ab8a6c 100644
--- a/stdlib/source/test/lux/data/collection/tree/zipper.lux
+++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux
@@ -24,8 +24,7 @@
Test
(<| (_.context (%.name (name-of /.Zipper)))
(do {! r.monad}
- [size (:: ! map (|>> (n.% 90) (n.+ 10)) r.nat)
- sample (//.tree size r.nat)
+ [[size sample] (//.tree r.nat)
mid-val r.nat
new-val r.nat
pre-val r.nat
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux
index b59ae9ca2..faa3fa85f 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux
@@ -61,11 +61,11 @@
(^template [<tag> <gen> <wrapper>]
[_ (<tag> _)]
(if allow-literals?
- (do {@ r.monad}
+ (do {! r.monad}
[?sample (r.maybe <gen>)]
(case ?sample
(#.Some sample)
- (do @
+ (do !
[else (exhaustive-branches allow-literals? variantTC inputC)]
(wrap (list& (<wrapper> sample) else)))
@@ -82,8 +82,8 @@
(r@wrap (list (' [])))
[_ (#.Tuple members)]
- (do {@ r.monad}
- [member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) members)]
+ (do {! r.monad}
+ [member-wise-patterns (monad.map ! (exhaustive-branches allow-literals? variantTC) members)]
(wrap (|> member-wise-patterns
exhaustive-weaving
(list@map code.tuple))))
@@ -92,19 +92,19 @@
(r@wrap (list (' {})))
[_ (#.Record kvs)]
- (do {@ r.monad}
+ (do {! r.monad}
[#let [ks (list@map product.left kvs)
vs (list@map product.right kvs)]
- member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) vs)]
+ member-wise-patterns (monad.map ! (exhaustive-branches allow-literals? variantTC) vs)]
(wrap (|> member-wise-patterns
exhaustive-weaving
(list@map (|>> (list.zip/2 ks) code.record)))))
(^ [_ (#.Form (list [_ (#.Tag _)] _))])
- (do {@ r.monad}
- [bundles (monad.map @
+ (do {! r.monad}
+ [bundles (monad.map !
(function (_ [_tag _code])
- (do @
+ (do !
[v-branches (exhaustive-branches allow-literals? variantTC _code)]
(wrap (list@map (function (_ pattern) (` ((~ _tag) (~ pattern))))
v-branches))))
@@ -121,13 +121,13 @@
(function (_ input)
($_ r.either
(r@map product.right _primitive.primitive)
- (do {@ r.monad}
- [choice (|> r.nat (:: @ map (n.% (list.size variant-tags))))
+ (do {! r.monad}
+ [choice (|> r.nat (:: ! map (n.% (list.size variant-tags))))
#let [choiceT (maybe.assume (list.nth choice variant-tags))
choiceC (maybe.assume (list.nth choice primitivesC))]]
(wrap (` ((~ choiceT) (~ choiceC)))))
- (do {@ r.monad}
- [size (|> r.nat (:: @ map (n.% 3)))
+ (do {! r.monad}
+ [size (|> r.nat (:: ! map (n.% 3)))
elems (r.list size input)]
(wrap (code.tuple elems)))
(r@wrap (code.record (list.zip/2 record-tags primitivesC)))
@@ -139,13 +139,13 @@
(def: #export test
(<| (_.context (name.module (name-of /._)))
- (do {@ r.monad}
+ (do {! r.monad}
[module-name (r.unicode 5)
variant-name (r.unicode 5)
record-name (|> (r.unicode 5) (r.filter (|>> (text@= variant-name) not)))
- size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2))))
- variant-tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list))
- record-tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list))
+ size (|> r.nat (:: ! map (|>> (n.% 10) (n.max 2))))
+ variant-tags (|> (r.set text.hash size (r.unicode 5)) (:: ! map set.to-list))
+ record-tags (|> (r.set text.hash size (r.unicode 5)) (:: ! map set.to-list))
primitivesTC (r.list size _primitive.primitive)
#let [primitivesT (list@map product.left primitivesTC)
primitivesC (list@map product.right primitivesTC)
@@ -183,10 +183,10 @@
(_.test "Will reject non-exhaustive pattern-matching."
(|> (analyse-pm non-exhaustive-branchesC)
_structure.check-fails)))
- (do @
+ (do !
[redundant-patterns (exhaustive-branches false variantTC inputC)
- redundancy-idx (|> r.nat (:: @ map (n.% (list.size redundant-patterns))))
- #let [redundant-branchesC (<| (list@map (branch outputC))
+ redundancy-idx (|> r.nat (:: ! map (n.% (list.size redundant-patterns))))
+ #let [redundant-branchesC (<| (list!map (branch outputC))
list.concat
(list (list.take redundancy-idx redundant-patterns)
(list (maybe.assume (list.nth redundancy-idx redundant-patterns)))
@@ -194,10 +194,10 @@
(_.test "Will reject redundant pattern-matching."
(|> (analyse-pm redundant-branchesC)
_structure.check-fails)))
- (do @
+ (do !
[[heterogeneousT heterogeneousC] (r.filter (|>> product.left (check.checks? outputT) not)
_primitive.primitive)
- heterogeneous-idx (|> r.nat (:: @ map (n.% (list.size exhaustive-patterns))))
+ heterogeneous-idx (|> r.nat (:: ! map (n.% (list.size exhaustive-patterns))))
#let [heterogeneous-branchesC (list.concat (list (list.take heterogeneous-idx exhaustive-branchesC)
(list (let [[_pattern _body] (maybe.assume (list.nth heterogeneous-idx exhaustive-branchesC))]
[_pattern heterogeneousC]))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux
index 3dbacc0e2..4fa365850 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux
@@ -80,10 +80,10 @@
))))
(def: apply
- (do {@ r.monad}
- [full-args (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2))))
- partial-args (|> r.nat (:: @ map (n.% full-args)))
- var-idx (|> r.nat (:: @ map (|>> (n.% full-args) (n.max 1))))
+ (do {! r.monad}
+ [full-args (|> r.nat (:: ! map (|>> (n.% 10) (n.max 2))))
+ partial-args (|> r.nat (:: ! map (n.% full-args)))
+ var-idx (|> r.nat (:: ! map (|>> (n.% full-args) (n.max 1))))
inputsTC (r.list full-args _primitive.primitive)
#let [inputsT (list@map product.left inputsTC)
inputsC (list@map product.right inputsTC)]
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux
index 7197dbca6..b67193533 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux
@@ -49,11 +49,11 @@
(def: (reach-test var-name [export? def-module] [import? dependent-module] check!)
(-> Text [Bit Text] [Bit Text] Check Bit)
- (|> (do {@ phase.monad}
+ (|> (do {! phase.monad}
[_ (//module.with-module 0 def-module
(//module.define var-name (#.Right [export? Any (' {}) []])))]
(//module.with-module 0 dependent-module
- (do @
+ (do !
[_ (if import?
(//module.import def-module)
(wrap []))]
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux
index 6da982c17..fc6d49b3d 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux
@@ -117,11 +117,11 @@
false)))
(def: sum
- (do {@ r.monad}
- [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2))))
- choice (|> r.nat (:: @ map (n.% size)))
+ (do {! r.monad}
+ [size (|> r.nat (:: ! map (|>> (n.% 10) (n.max 2))))
+ choice (|> r.nat (:: ! map (n.% size)))
primitives (r.list size _primitive.primitive)
- +choice (|> r.nat (:: @ map (n.% (inc size))))
+ +choice (|> r.nat (:: ! map (n.% (inc size))))
[_ +valueC] _primitive.primitive
#let [variantT (type.variant (list@map product.left primitives))
[valueT valueC] (maybe.assume (list.nth choice primitives))
@@ -169,10 +169,10 @@
))))
(def: product
- (do {@ r.monad}
- [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2))))
+ (do {! r.monad}
+ [size (|> r.nat (:: ! map (|>> (n.% 10) (n.max 2))))
primitives (r.list size _primitive.primitive)
- choice (|> r.nat (:: @ map (n.% size)))
+ choice (|> r.nat (:: ! map (n.% size)))
[_ +valueC] _primitive.primitive
#let [tupleT (type.tuple (list@map product.left primitives))
[singletonT singletonC] (|> primitives (list.nth choice) maybe.assume)
@@ -229,11 +229,11 @@
))))
(def: variant
- (do {@ r.monad}
- [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2))))
- tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list))
- choice (|> r.nat (:: @ map (n.% size)))
- other-choice (|> r.nat (:: @ map (n.% size)) (r.filter (|>> (n.= choice) not)))
+ (do {! r.monad}
+ [size (|> r.nat (:: ! map (|>> (n.% 10) (n.max 2))))
+ tags (|> (r.set text.hash size (r.unicode 5)) (:: ! map set.to-list))
+ choice (|> r.nat (:: ! map (n.% size)))
+ other-choice (|> r.nat (:: ! map (n.% size)) (r.filter (|>> (n.= choice) not)))
primitives (r.list size _primitive.primitive)
module-name (r.unicode 5)
type-name (r.unicode 5)
@@ -275,13 +275,13 @@
))))
(def: record
- (do {@ r.monad}
- [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2))))
- tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list))
+ (do {! r.monad}
+ [size (|> r.nat (:: ! map (|>> (n.% 10) (n.max 2))))
+ tags (|> (r.set text.hash size (r.unicode 5)) (:: ! map set.to-list))
primitives (r.list size _primitive.primitive)
module-name (r.unicode 5)
type-name (r.unicode 5)
- choice (|> r.nat (:: @ map (n.% size)))
+ choice (|> r.nat (:: ! map (n.% size)))
#let [varT (#.Parameter 1)
tagsC (list@map (|>> [module-name] code.tag) tags)
primitivesT (list@map product.left primitives)
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux
index a7686e0f2..0c0a2d467 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux
@@ -72,10 +72,10 @@
(def: i64
Test
- (do {@ r.monad}
- [subjectC (|> r.nat (:: @ map code.nat))
- signedC (|> r.int (:: @ map code.int))
- paramC (|> r.nat (:: @ map code.nat))]
+ (do {! r.monad}
+ [subjectC (|> r.nat (:: ! map code.nat))
+ signedC (|> r.int (:: ! map code.int))
+ paramC (|> r.nat (:: ! map code.nat))]
($_ _.and
(_.test "i64 'and'."
(check-success+ "lux i64 and" (list paramC subjectC) Nat))
@@ -99,9 +99,9 @@
(def: int
Test
- (do {@ r.monad}
- [subjectC (|> r.int (:: @ map code.int))
- paramC (|> r.int (:: @ map code.int))]
+ (do {! r.monad}
+ [subjectC (|> r.int (:: ! map code.int))
+ paramC (|> r.int (:: ! map code.int))]
($_ _.and
(_.test "Can multiply integers."
(check-success+ "lux i64 *" (list paramC subjectC) Int))
@@ -119,10 +119,10 @@
(def: frac
Test
- (do {@ r.monad}
- [subjectC (|> r.safe-frac (:: @ map code.frac))
- paramC (|> r.safe-frac (:: @ map code.frac))
- encodedC (|> r.safe-frac (:: @ map (|>> %.frac code.text)))]
+ (do {! r.monad}
+ [subjectC (|> r.safe-frac (:: ! map code.frac))
+ paramC (|> r.safe-frac (:: ! map code.frac))
+ encodedC (|> r.safe-frac (:: ! map (|>> %.frac code.text)))]
($_ _.and
(_.test "Can add frac numbers."
(check-success+ "lux f64 +" (list paramC subjectC) Frac))
@@ -154,12 +154,12 @@
(def: text
Test
- (do {@ r.monad}
- [subjectC (|> (r.unicode 5) (:: @ map code.text))
- paramC (|> (r.unicode 5) (:: @ map code.text))
- replacementC (|> (r.unicode 5) (:: @ map code.text))
- fromC (|> r.nat (:: @ map code.nat))
- toC (|> r.nat (:: @ map code.nat))]
+ (do {! r.monad}
+ [subjectC (|> (r.unicode 5) (:: ! map code.text))
+ paramC (|> (r.unicode 5) (:: ! map code.text))
+ replacementC (|> (r.unicode 5) (:: ! map code.text))
+ fromC (|> r.nat (:: ! map code.nat))
+ toC (|> r.nat (:: ! map code.nat))]
($_ _.and
(_.test "Can test text equivalence."
(check-success+ "lux text =" (list paramC subjectC) Bit))
@@ -179,9 +179,9 @@
(def: io
Test
- (do {@ r.monad}
- [logC (|> (r.unicode 5) (:: @ map code.text))
- exitC (|> r.int (:: @ map code.int))]
+ (do {! r.monad}
+ [logC (|> (r.unicode 5) (:: ! map code.text))
+ exitC (|> r.int (:: ! map code.int))]
($_ _.and
(_.test "Can log messages to standard output."
(check-success+ "lux io log" (list logC) Any))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux
index 0789d5ddd..45706256b 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux
@@ -44,13 +44,13 @@
(template [<name> <synthesis> <random>]
[(def: (<name> context)
(Scenario Synthesis)
- (do {@ random.monad}
+ (do {! random.monad}
[value <random>]
(wrap [(<synthesis> value)
(<synthesis> value)])))]
[bit-scenario synthesis.bit random.bit]
- [i64-scenario synthesis.i64 (:: @ map .i64 random.nat)]
+ [i64-scenario synthesis.i64 (:: ! map .i64 random.nat)]
[f64-scenario synthesis.f64 random.frac]
[text-scenario synthesis.text (random.unicode 1)]
)
@@ -64,10 +64,10 @@
(def: (with-redundancy scenario context)
(-> (Scenario Synthesis) (Scenario Synthesis))
- (do {@ random.monad}
+ (do {! random.monad}
[redundant? random.bit]
(if redundant?
- (do @
+ (do !
[let? random.bit
[expected-input actual-input] (..primitive-scenario context)
#let [fake-register (n.+ (get@ #redundants context)
@@ -86,7 +86,7 @@
(def: (variant-scenario scenario context)
(-> (Scenario Synthesis) (Scenario Synthesis))
- (do {@ random.monad}
+ (do {! random.monad}
[lefts random.nat
right? random.bit
[expected input] (scenario context)]
@@ -142,8 +142,8 @@
(def: (get-scenario scenario context)
(-> (Scenario Synthesis) (Scenario Synthesis))
- (do {@ random.monad}
- [length (:: @ map (|>> (n.% 5) inc) random.nat)
+ (do {! random.monad}
+ [length (:: ! map (|>> (n.% 5) inc) random.nat)
path (random.list length ..random-member)
[expected-record actual-record] (scenario context)]
(wrap [(synthesis.branch/get [path expected-record])
@@ -157,14 +157,14 @@
(-> (Scenario Synthesis) (Scenario Path))
(`` ($_ random.either
($_ random.either
- (do {@ random.monad}
+ (do {! random.monad}
[_ (wrap [])
[expected-then actual-then] (scenario context)]
(wrap [(#synthesis.Seq #synthesis.Pop
(#synthesis.Then expected-then))
(#synthesis.Seq #synthesis.Pop
(#synthesis.Then actual-then))]))
- (do {@ random.monad}
+ (do {! random.monad}
[_ (wrap [])
#let [real-register (dictionary.size (get@ #necessary context))
fake-register (n.+ (get@ #redundants context)
@@ -178,7 +178,7 @@
(#synthesis.Then actual-then)))])))
($_ random.either
(~~ (template [<tag> <random>]
- [(do {@ random.monad}
+ [(do {! random.monad}
[test <random>
[expected-then actual-then] (scenario context)]
(wrap [(#synthesis.Seq (#synthesis.Test (<tag> test))
@@ -187,26 +187,26 @@
(#synthesis.Then actual-then))]))]
[#synthesis.Bit random.bit]
- [#synthesis.I64 (:: @ map .i64 random.nat)]
+ [#synthesis.I64 (:: ! map .i64 random.nat)]
[#synthesis.F64 random.frac]
[#synthesis.Text (random.unicode 1)]
)))
($_ random.either
- (do {@ random.monad}
+ (do {! random.monad}
[side ..random-side
[expected-next actual-next] (path-scenario scenario context)]
(wrap [(#synthesis.Seq (#synthesis.Access (#synthesis.Side side))
expected-next)
(#synthesis.Seq (#synthesis.Access (#synthesis.Side side))
actual-next)]))
- (do {@ random.monad}
+ (do {! random.monad}
[member ..random-member
[expected-next actual-next] (path-scenario scenario context)]
(wrap [(#synthesis.Seq (#synthesis.Access (#synthesis.Member member))
expected-next)
(#synthesis.Seq (#synthesis.Access (#synthesis.Member member))
actual-next)])))
- (do {@ random.monad}
+ (do {! random.monad}
[_ (wrap [])
[expected-left actual-left] (path-scenario scenario context)
[expected-right actual-right] (path-scenario scenario context)]
@@ -216,7 +216,7 @@
(def: (case-scenario scenario context)
(-> (Scenario Synthesis) (Scenario Synthesis))
- (do {@ random.monad}
+ (do {! random.monad}
[_ (wrap [])
[expected-input actual-input] (scenario context)
[expected-path actual-path] (..path-scenario scenario context)]
@@ -236,7 +236,7 @@
(def: (scope-scenario scenario context)
(-> (Scenario Synthesis) (Scenario Synthesis))
- (do {@ random.monad}
+ (do {! random.monad}
[_ (wrap [])
#let [real-start (dictionary.size (get@ #necessary context))
fake-start (n.+ (get@ #redundants context)
@@ -256,7 +256,7 @@
(def: (recur-scenario scenario context)
(-> (Scenario Synthesis) (Scenario Synthesis))
- (do {@ random.monad}
+ (do {! random.monad}
[_ (wrap [])
resets (random.list ..scope-arity (scenario context))]
(wrap [(synthesis.loop/recur (list@map product.left resets))
@@ -271,7 +271,7 @@
(def: (abstraction-scenario scenario context)
(-> (Scenario Synthesis) (Scenario Synthesis))
- (do {@ random.monad}
+ (do {! random.monad}
[_ (wrap [])
#let [registers (dictionary.entries (get@ #necessary context))
expected-environment (list@map (|>> product.left #variable.Local) registers)
@@ -282,8 +282,8 @@
(def: (apply-scenario scenario context)
(-> (Scenario Synthesis) (Scenario Synthesis))
- (do {@ random.monad}
- [abstraction (:: @ map (|>> synthesis.constant)
+ (do {! random.monad}
+ [abstraction (:: ! map (|>> synthesis.constant)
(random.and (random.unicode 1)
(random.unicode 1)))
inputs (random.list ..scope-arity (scenario context))]
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux
index 819f6ccf1..7c2ece82e 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux
@@ -26,8 +26,8 @@
(def: name-part^
(Random Text)
- (do {@ r.monad}
- [size (|> r.nat (:: @ map (|>> (n.% 20) (n.max 1))))]
+ (do {! r.monad}
+ [size (|> r.nat (:: ! map (|>> (n.% 20) (n.max 1))))]
(r.ascii/lower-alpha size)))
(def: name^
@@ -73,7 +73,7 @@
(def: code
Test
- (do {@ r.monad}
+ (do {! r.monad}
[sample code^]
($_ _.and
(_.test "Can parse Lux code."
@@ -85,7 +85,7 @@
(#.Right [_ parsed])
(:: code.equivalence = parsed sample)))
- (do @
+ (do !
[other code^]
(_.test "Can parse multiple Lux code nodes."
(let [source-code (format (%.code sample) " " (%.code other))