aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/concurrency/actor.lux66
-rw-r--r--stdlib/source/lux/control/parser/xml.lux40
-rw-r--r--stdlib/source/lux/debug.lux26
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux24
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux74
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux85
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux29
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux91
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux19
-rw-r--r--stdlib/source/lux/type.lux11
-rw-r--r--stdlib/source/lux/type/abstract.lux59
-rw-r--r--stdlib/source/program/aedifex/artifact/snapshot/build.lux (renamed from stdlib/source/program/aedifex/artifact/build.lux)0
-rw-r--r--stdlib/source/program/aedifex/artifact/snapshot/stamp.lux55
-rw-r--r--stdlib/source/program/aedifex/artifact/snapshot/time.lux45
-rw-r--r--stdlib/source/program/aedifex/artifact/time_stamp.lux35
-rw-r--r--stdlib/source/spec/lux/world/console.lux19
-rw-r--r--stdlib/source/test/aedifex/artifact/snapshot/build.lux (renamed from stdlib/source/test/aedifex/artifact/build.lux)11
-rw-r--r--stdlib/source/test/aedifex/artifact/snapshot/stamp.lux48
-rw-r--r--stdlib/source/test/aedifex/artifact/snapshot/time.lux42
-rw-r--r--stdlib/source/test/aedifex/artifact/time_stamp.lux33
-rw-r--r--stdlib/source/test/lux/control/concurrency/actor.lux22
-rw-r--r--stdlib/source/test/lux/control/parser/xml.lux40
-rw-r--r--stdlib/source/test/lux/macro/template.lux25
-rw-r--r--stdlib/source/test/lux/type.lux2
-rw-r--r--stdlib/source/test/lux/type/abstract.lux110
25 files changed, 699 insertions, 312 deletions
diff --git a/stdlib/source/lux/control/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux
index 3828b6d83..584bf614e 100644
--- a/stdlib/source/lux/control/concurrency/actor.lux
+++ b/stdlib/source/lux/control/concurrency/actor.lux
@@ -74,13 +74,12 @@
(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))})
+ #on_mail (-> (Mail s) s (Actor s) (Promise (Try s)))})
(def: #export (spawn! behavior init)
{#.doc "Given a behavior and initial state, spawns an actor and returns it."}
(All [o s] (-> (Behavior o s) o (IO (Actor s))))
- (io (let [[on_init on_mail on_stop] behavior
+ (io (let [[on_init on_mail] behavior
self (:share [o s]
{(Behavior o s)
behavior}
@@ -94,14 +93,12 @@
?state' (on_mail head state self)]
(case ?state'
(#try.Failure error)
- (do !
- [_ (on_stop error state)]
- (let [[_ resolve] (get@ #obituary (:representation self))]
- (exec (io.run
- (do io.monad
- [pending (..pending tail)]
- (resolve [error state (#.Cons head pending)])))
- (wrap []))))
+ (let [[_ resolve] (get@ #obituary (:representation self))]
+ (exec (io.run
+ (do io.monad
+ [pending (..pending tail)]
+ (resolve [error state (#.Cons head pending)])))
+ (wrap [])))
(#try.Success state')
(recur state' tail))))]
@@ -199,15 +196,10 @@
(All [s] (-> (Mail s) s (Actor s) (Promise (Try s))))
(mail state self))
-(def: (default_on_stop cause state)
- (All [s] (-> Text s (Promise Any)))
- (promise\wrap []))
-
(def: #export default
(All [s] (Behavior s s))
{#on_init function.identity
- #on_mail ..default_on_mail
- #on_stop ..default_on_stop})
+ #on_mail ..default_on_mail})
(def: #export (poison! actor)
{#.doc (doc "Kills the actor by sending mail that will kill it upon processing,"
@@ -225,11 +217,8 @@
(type: On_MailC
[[Text Text Text] Code])
-(type: On_StopC
- [[Text Text] Code])
-
(type: BehaviorC
- [(Maybe On_MailC) (Maybe On_StopC) (List Code)])
+ [(Maybe On_MailC) (List Code)])
(def: argument
(Parser Text)
@@ -237,13 +226,10 @@
(def: behavior^
(Parser BehaviorC)
- (let [on_mail_args ($_ <>.and ..argument ..argument ..argument)
- on_stop_args ($_ <>.and ..argument ..argument)]
+ (let [on_mail_args ($_ <>.and ..argument ..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)
@@ -259,18 +245,6 @@
(~ (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)
@@ -288,12 +262,6 @@
(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']))))
@@ -305,9 +273,9 @@
{[name vars] actor_decl^}
{annotations (<>.default |annotations|.empty |annotations|.parser)}
state_type
- {[?on_mail ?on_stop messages] behavior^})
+ {[?on_mail 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."
+ "Messages for the actor must be defined after the on_mail handler."
<examples>)}
(with_gensyms [g!_]
(do meta.monad
@@ -321,19 +289,17 @@
(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))})
+ #..on_mail (~ (..on_mail g!_ ?on_mail))})
(~+ messages))))))))
(syntax: #export (actor {[state_type init] (<c>.record (<>.and <c>.any <c>.any))}
- {[?on_mail ?on_stop messages] behavior^})
+ {[?on_mail messages] behavior^})
(with_gensyms [g!_]
(wrap (list (` (: ((~! io.IO) (..Actor (~ state_type)))
(..spawn! (: (..Behavior (~ state_type) (~ state_type))
{#..on_init (|>>)
- #..on_mail (~ (..on_mail g!_ ?on_mail))
- #..on_stop (~ (..on_stop g!_ ?on_stop))})
+ #..on_mail (~ (..on_mail g!_ ?on_mail))})
(: (~ state_type)
(~ init)))))))))
diff --git a/stdlib/source/lux/control/parser/xml.lux b/stdlib/source/lux/control/parser/xml.lux
index 3b9732ae5..a9d9144b8 100644
--- a/stdlib/source/lux/control/parser/xml.lux
+++ b/stdlib/source/lux/control/parser/xml.lux
@@ -38,8 +38,8 @@
(def: #export text
(Parser Text)
- (function (_ docs)
- (case docs
+ (function (_ documents)
+ (case documents
#.Nil
(exception.throw ..empty_input [])
@@ -53,8 +53,8 @@
(def: #export (node expected)
(-> Tag (Parser Any))
- (function (_ docs)
- (case docs
+ (function (_ documents)
+ (case documents
#.Nil
(exception.throw ..empty_input [])
@@ -65,13 +65,13 @@
(#/.Node actual _attributes _children)
(if (name\= expected actual)
- (#try.Success [docs []])
+ (#try.Success [documents []])
(exception.throw ..wrong_tag [expected actual]))))))
(def: #export tag
(Parser Tag)
- (function (_ docs)
- (case docs
+ (function (_ documents)
+ (case documents
#.Nil
(exception.throw ..empty_input [])
@@ -81,12 +81,12 @@
(exception.throw ..unexpected_input [])
(#/.Node tag _attributes _children)
- (#try.Success [docs tag])))))
+ (#try.Success [documents tag])))))
(def: #export (attribute name)
(-> Attribute (Parser Text))
- (function (_ docs)
- (case docs
+ (function (_ documents)
+ (case documents
#.Nil
(exception.throw ..empty_input [])
@@ -101,11 +101,11 @@
(exception.throw ..unknown_attribute [name (dictionary.keys attributes)])
(#.Some value)
- (#try.Success [docs value]))))))
+ (#try.Success [documents value]))))))
-(def: (run' parser docs)
+(def: #export (run parser documents)
(All [a] (-> (Parser a) (List XML) (Try a)))
- (case (//.run parser docs)
+ (case (//.run parser documents)
(#try.Success [remaining output])
(if (list.empty? remaining)
(#try.Success output)
@@ -116,8 +116,8 @@
(def: #export (children parser)
(All [a] (-> (Parser a) (Parser a)))
- (function (_ docs)
- (case docs
+ (function (_ documents)
+ (case documents
#.Nil
(exception.throw ..empty_input [])
@@ -128,23 +128,19 @@
(#/.Node _tag _attributes children)
(do try.monad
- [output (run' parser children)]
+ [output (..run parser children)]
(wrap [tail output]))))))
(def: #export ignore
(Parser Any)
- (function (_ docs)
- (case docs
+ (function (_ documents)
+ (case documents
#.Nil
(exception.throw ..empty_input [])
(#.Cons head tail)
(#try.Success [tail []]))))
-(def: #export (run parser document)
- (All [a] (-> (Parser a) XML (Try a)))
- (..run' parser (list document)))
-
(exception: #export nowhere)
(def: #export (somewhere parser)
diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux
index 088504f2d..b60d62c11 100644
--- a/stdlib/source/lux/debug.lux
+++ b/stdlib/source/lux/debug.lux
@@ -22,14 +22,16 @@
[collection
["." array]
["." list ("#\." functor)]]]
- [time
- [instant (#+ Instant)]
- [duration (#+ Duration)]
- [date (#+ Date)]]
+ ["." meta
+ ["." location]]
[macro
["." template]
["." syntax (#+ syntax:)]
- ["." code]]])
+ ["." code]]
+ [time
+ [instant (#+ Instant)]
+ [duration (#+ Duration)]
+ [date (#+ Date)]]])
(with_expansions [<jvm> (as_is (import: java/lang/String)
@@ -161,7 +163,8 @@
(exception.report
["Type" (%.type type)]))
-(type: Representation (-> Any Text))
+(type: Representation
+ (-> Any Text))
(def: primitive_representation
(Parser Representation)
@@ -304,3 +307,14 @@
"Useful for debugging.")}
(-> Text Any)
("lux io log" message))
+
+(exception: #export (type_hole {location Location} {type Type})
+ (exception.report
+ ["Location" (location.format location)]
+ ["Type" (%.type type)]))
+
+(syntax: #export (:hole)
+ (do meta.monad
+ [location meta.location
+ expectedT meta.expected_type]
+ (meta.fail (exception.construct ..type_hole [location expectedT]))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux
index 1c45a95b5..38f5125ea 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux
@@ -304,27 +304,19 @@
pattern_matching!)
(_.throw (_.string ////synthesis/case.pattern_matching_error))))))
-(def: #export (case statement expression archive [valueS pathP])
- (-> Phase! (Generator [Synthesis Path]))
- (do ///////phase.monad
- [stack_init (expression archive valueS)
- pattern_matching! (pattern_matching statement expression archive pathP)
- #let [closure (<| (_.closure (list))
- ($_ _.then
- (_.declare @temp)
- (_.define @cursor (_.array (list stack_init)))
- (_.define @savepoint (_.array (list)))
- pattern_matching!
- ))]]
- (wrap (_.apply/* closure (list)))))
-
(def: #export (case! statement expression archive [valueS pathP])
(Generator! [Synthesis Path])
(do ///////phase.monad
[stack_init (expression archive valueS)
- path! (pattern_matching statement expression archive pathP)]
+ pattern_matching! (pattern_matching statement expression archive pathP)]
(wrap ($_ _.then
(_.declare @temp)
(_.define @cursor (_.array (list stack_init)))
(_.define @savepoint (_.array (list)))
- path!))))
+ pattern_matching!))))
+
+(def: #export (case statement expression archive [valueS pathP])
+ (-> Phase! (Generator [Synthesis Path]))
+ (do ///////phase.monad
+ [pattern_matching! (..case! statement expression archive [valueS pathP])]
+ (wrap (_.apply/* (_.closure (list) pattern_matching!) (list)))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux
index 93300a02d..9ab6f4056 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux
@@ -1,9 +1,13 @@
(.module:
[lux #*
[abstract
- [monad (#+ do)]]]
+ [monad (#+ do)]]
+ [control
+ ["." exception (#+ exception:)]]
+ [target
+ ["_" python]]]
["." / #_
- [runtime (#+ Phase)]
+ [runtime (#+ Phase Phase!)]
["#." primitive]
["#." structure]
["#." reference]
@@ -21,7 +25,45 @@
[reference (#+)
[variable (#+)]]]]]]])
-(def: #export (generate archive synthesis)
+(exception: #export cannot-recur-as-an-expression)
+
+(def: (statement expression archive synthesis)
+ Phase!
+ (case synthesis
+ (^template [<tag>]
+ [(^ (<tag> value))
+ (//////phase\map _.return (expression archive synthesis))])
+ ([////synthesis.bit]
+ [////synthesis.i64]
+ [////synthesis.f64]
+ [////synthesis.text]
+ [////synthesis.variant]
+ [////synthesis.tuple]
+ [#////synthesis.Reference]
+ [////synthesis.branch/get]
+ [////synthesis.function/apply]
+ [#////synthesis.Extension])
+
+ (^ (////synthesis.branch/case case))
+ (/case.case! statement expression archive case)
+
+ (^ (////synthesis.branch/let let))
+ (/case.let! statement expression archive let)
+
+ (^ (////synthesis.branch/if if))
+ (/case.if! statement expression archive if)
+
+ (^ (////synthesis.loop/scope scope))
+ (/loop.scope! statement expression archive scope)
+
+ (^ (////synthesis.loop/recur updates))
+ (/loop.recur! statement expression archive updates)
+
+ (^ (////synthesis.function/abstraction abstraction))
+ (//////phase\map _.return (/function.function statement expression archive abstraction))
+ ))
+
+(def: #export (expression archive synthesis)
Phase
(case synthesis
(^template [<tag> <generator>]
@@ -33,37 +75,41 @@
[////synthesis.text /primitive.text])
(^ (////synthesis.variant variantS))
- (/structure.variant generate archive variantS)
+ (/structure.variant expression archive variantS)
(^ (////synthesis.tuple members))
- (/structure.tuple generate archive members)
+ (/structure.tuple expression archive members)
(#////synthesis.Reference value)
(//reference.reference /reference.system archive value)
(^ (////synthesis.branch/case case))
- (/case.case generate archive case)
+ (/case.case ..statement expression archive case)
(^ (////synthesis.branch/let let))
- (/case.let generate archive let)
+ (/case.let expression archive let)
(^ (////synthesis.branch/if if))
- (/case.if generate archive if)
+ (/case.if expression archive if)
(^ (////synthesis.branch/get get))
- (/case.get generate archive get)
+ (/case.get expression archive get)
(^ (////synthesis.loop/scope scope))
- (/loop.scope generate archive scope)
+ (/loop.scope ..statement expression archive scope)
(^ (////synthesis.loop/recur updates))
- (/loop.recur generate archive updates)
+ (//////phase.throw ..cannot-recur-as-an-expression [])
(^ (////synthesis.function/abstraction abstraction))
- (/function.function generate archive abstraction)
+ (/function.function ..statement expression archive abstraction)
(^ (////synthesis.function/apply application))
- (/function.apply generate archive application)
+ (/function.apply expression archive application)
(#////synthesis.Extension extension)
- (///extension.apply archive generate extension)))
+ (///extension.apply archive expression extension)))
+
+(def: #export generate
+ Phase
+ ..expression)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux
index dfc327985..e3be48bc6 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux
@@ -17,7 +17,7 @@
[target
["_" python (#+ Expression SVar Statement)]]]
["." // #_
- ["#." runtime (#+ Operation Phase Generator)]
+ ["#." runtime (#+ Operation Phase Generator Phase! Generator!)]
["#." reference]
["#." primitive]
["/#" // #_
@@ -43,28 +43,47 @@
(-> Register SVar)
(|>> (///reference.foreign //reference.system) :assume))
-(def: #export (let generate archive [valueS register bodyS])
+(def: #export (let expression archive [valueS register bodyS])
(Generator [Synthesis Register Synthesis])
(do ///////phase.monad
- [valueO (generate archive valueS)
- bodyO (generate archive bodyS)]
+ [valueO (expression archive valueS)
+ bodyO (expression archive bodyS)]
## TODO: Find some way to do 'let' without paying the price of the closure.
(wrap (_.apply/* (_.lambda (list (..register register))
bodyO)
(list valueO)))))
-(def: #export (if generate archive [testS thenS elseS])
+(def: #export (let! statement expression archive [valueS register bodyS])
+ (Generator! [Synthesis Register Synthesis])
+ (do ///////phase.monad
+ [valueO (expression archive valueS)
+ bodyO (statement expression archive bodyS)]
+ (wrap ($_ _.then
+ (_.set (list (..register register)) valueO)
+ bodyO))))
+
+(def: #export (if expression archive [testS thenS elseS])
(Generator [Synthesis Synthesis Synthesis])
(do ///////phase.monad
- [testO (generate archive testS)
- thenO (generate archive thenS)
- elseO (generate archive elseS)]
+ [testO (expression archive testS)
+ thenO (expression archive thenS)
+ elseO (expression archive elseS)]
(wrap (_.? testO thenO elseO))))
-(def: #export (get generate archive [pathP valueS])
+(def: #export (if! statement expression archive [testS thenS elseS])
+ (Generator! [Synthesis Synthesis Synthesis])
+ (do ///////phase.monad
+ [test! (expression archive testS)
+ then! (statement expression archive thenS)
+ else! (statement expression archive elseS)]
+ (wrap (_.if test!
+ then!
+ else!))))
+
+(def: #export (get expression archive [pathP valueS])
(Generator [(List Member) Synthesis])
(do ///////phase.monad
- [valueO (generate archive valueS)]
+ [valueO (expression archive valueS)]
(wrap (list\fold (function (_ side source)
(.let [method (.case side
(^template [<side> <accessor>]
@@ -139,12 +158,12 @@
..restore!
post!)))
-(def: (pattern_matching' generate archive)
- (-> Phase Archive Path (Operation (Statement Any)))
+(def: (pattern_matching' statement expression archive)
+ (-> Phase! Phase Archive Path (Operation (Statement Any)))
(function (recur pathP)
(.case pathP
(^ (/////synthesis.path/then bodyS))
- (///////phase\map _.return (generate archive bodyS))
+ (statement expression archive bodyS)
#/////synthesis.Pop
(///////phase\wrap ..pop!)
@@ -239,16 +258,16 @@
([/////synthesis.path/seq _.then]
[/////synthesis.path/alt ..alternation]))))
-(def: (pattern_matching generate archive pathP)
- (-> Phase Archive Path (Operation (Statement Any)))
+(def: (pattern_matching statement expression archive pathP)
+ (-> Phase! Phase Archive Path (Operation (Statement Any)))
(do ///////phase.monad
- [pattern_matching! (pattern_matching' generate archive pathP)]
+ [pattern_matching! (pattern_matching' statement expression archive pathP)]
(wrap ($_ _.then
(_.while (_.bool true)
pattern_matching!)
(_.raise (_.Exception/1 (_.string case.pattern_matching_error)))))))
-(def: (gensym prefix)
+(def: #export (gensym prefix)
(-> Text (Operation SVar))
(///////phase\map (|>> %.nat (format prefix) _.var) /////generation.next))
@@ -265,20 +284,26 @@
(#///////variable.Foreign register)
(..capture register))))))
-(def: #export (case generate archive [valueS pathP])
- (Generator [Synthesis Path])
+(def: #export (case! statement expression archive [valueS pathP])
+ (Generator! [Synthesis Path])
+ (do ///////phase.monad
+ [stack_init (expression archive valueS)
+ pattern_matching! (pattern_matching statement expression archive pathP)]
+ (wrap ($_ _.then
+ (_.set (list @cursor) (_.list (list stack_init)))
+ (_.set (list @savepoint) (_.list (list)))
+ pattern_matching!
+ ))))
+
+(def: #export (case statement expression archive [valueS pathP])
+ (-> Phase! (Generator [Synthesis Path]))
(do ///////phase.monad
- [initG (generate archive valueS)
- pattern_matching! (pattern_matching generate archive pathP)
+ [pattern_matching! (case! statement expression archive [valueS pathP])
@case (..gensym "case")
- @init (..gensym "init")
- #let [@dependencies+ (..dependencies pathP)
- directive (_.def @case (list& @init @dependencies+)
- ($_ _.then
- (_.set (list @cursor) (_.list (list @init)))
- (_.set (list @savepoint) (_.list (list)))
- pattern_matching!
- ))]
+ #let [@dependencies+ (..dependencies (/////synthesis.path/seq (/////synthesis.path/then valueS)
+ pathP))
+ directive (_.def @case @dependencies+
+ pattern_matching!)]
_ (/////generation.execute! directive)
_ (/////generation.save! (_.code @case) directive)]
- (wrap (_.apply/* @case (list& initG @dependencies+)))))
+ (wrap (_.apply/* @case @dependencies+))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux
index 8c97fec96..23619eafc 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux
@@ -11,9 +11,10 @@
[target
["_" python (#+ SVar Expression Statement)]]]
["." // #_
- [runtime (#+ Operation Phase Generator)]
+ [runtime (#+ Operation Phase Generator Phase! Generator!)]
["#." reference]
["#." case]
+ ["#." loop]
["/#" // #_
["#." reference]
["//#" /// #_
@@ -26,11 +27,11 @@
[reference
[variable (#+ Register Variable)]]]]]])
-(def: #export (apply generate archive [functionS argsS+])
+(def: #export (apply expression archive [functionS argsS+])
(Generator (Application Synthesis))
(do {! ///////phase.monad}
- [functionO (generate archive functionS)
- argsO+ (monad.map ! (generate archive) argsS+)]
+ [functionO (expression archive functionS)
+ argsO+ (monad.map ! (expression archive) argsS+)]
(wrap (_.apply/* functionO argsO+))))
(def: #export capture
@@ -62,16 +63,18 @@
(def: input
(|>> inc //case.register))
-(def: #export (function generate archive [environment arity bodyS])
- (Generator (Abstraction Synthesis))
+(def: #export (function statement expression archive [environment arity bodyS])
+ (-> Phase! (Generator (Abstraction Synthesis)))
(do {! ///////phase.monad}
- [[function_name bodyO] (/////generation.with_new_context archive
+ [@expected_exception (//case.gensym "expected_exception")
+ @actual_exception (//case.gensym "actual_exception")
+ [function_name body!] (/////generation.with_new_context archive
(do !
[function_name (\ ! map ///reference.artifact
(/////generation.context archive))]
- (/////generation.with_anchor (_.var function_name)
- (generate archive bodyS))))
- environment (monad.map ! (generate archive) environment)
+ (/////generation.with_anchor [1 @expected_exception]
+ (statement expression archive bodyS))))
+ environment (monad.map ! (expression archive) environment)
#let [function_name (///reference.artifact function_name)
@curried (_.var "curried")
arityO (|> arity .int _.int)
@@ -91,9 +94,9 @@
($_ _.then
(_.set (list @num_args) (_.len/1 @curried))
(_.cond (list [(|> @num_args (_.= arityO))
- ($_ _.then
- initialize!
- (_.return bodyO))]
+ (<| (_.then initialize!)
+ (//loop.set_scope @expected_exception @actual_exception)
+ body!)]
[(|> @num_args (_.> arityO))
(let [arity_inputs (_.slice (_.int +0) arityO @curried)
extra_inputs (_.slice arityO @num_args @curried)]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux
index 7e92ddb74..563e8ee61 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux
@@ -7,15 +7,15 @@
[text
["%" format (#+ format)]]
[collection
- ["." list ("#\." functor)]
+ ["." list ("#\." functor fold)]
["." set]]]
[math
[number
["n" nat]]]
[target
- ["_" python (#+ Expression SVar)]]]
+ ["_" python (#+ Expression SVar Statement)]]]
["." // #_
- [runtime (#+ Operation Phase Generator)]
+ [runtime (#+ Operation Phase Generator Phase! Generator!)]
["#." case]
["//#" /// #_
[synthesis
@@ -26,44 +26,89 @@
["//#" /// #_
["#." phase]
[reference
- ["#." variable]]]]]])
+ ["#." variable (#+ Register)]]]]]])
(def: loop_name
(-> Nat SVar)
(|>> %.nat (format "loop") _.var))
-(def: #export (scope generate archive [start initsS+ bodyS])
- (Generator (Scope Synthesis))
+(def: (setup offset bindings body)
+ (-> Register (List (Expression Any)) (Statement Any) (Statement Any))
+ (|> bindings
+ list.enumeration
+ (list\map (function (_ [register value])
+ (_.set (list (//case.register (n.+ offset register)))
+ value)))
+ list.reverse
+ (list\fold _.then body)))
+
+(def: #export (set_scope @expected_exception @actual_exception body!)
+ (-> SVar SVar (Statement Any) (Statement Any))
+ (let [exception_class (_.var "Exception")]
+ ($_ _.then
+ (_.set (list @expected_exception) (_.apply/* exception_class (list (_.string ""))))
+ (_.while (_.bool true)
+ (_.try body!
+ (list {#_.classes (list exception_class)
+ #_.exception @actual_exception
+ #_.handler (_.if (_.is @expected_exception @actual_exception)
+ _.continue
+ (_.raise @actual_exception))}))))))
+
+(def: #export (scope! statement expression archive [start initsS+ bodyS])
+ (Generator! (Scope Synthesis))
(case initsS+
## function/false/non-independent loop
#.Nil
- (generate archive bodyS)
+ (statement expression archive bodyS)
+
+ ## true loop
+ _
+ (do {! ///////phase.monad}
+ [initsO+ (monad.map ! (expression archive) initsS+)
+ @expected_exception (//case.gensym "expected_exception")
+ @actual_exception (//case.gensym "actual_exception")
+ body! (/////generation.with_anchor [start @expected_exception]
+ (statement expression archive bodyS))]
+ (wrap (<| (..setup start initsO+)
+ (set_scope @expected_exception @actual_exception)
+ body!)))))
+
+(def: #export (scope statement expression archive [start initsS+ bodyS])
+ (-> Phase! (Generator (Scope Synthesis)))
+ (case initsS+
+ ## function/false/non-independent loop
+ #.Nil
+ (expression archive bodyS)
## true loop
_
(do {! ///////phase.monad}
[@loop (\ ! map ..loop_name /////generation.next)
- initsO+ (monad.map ! (generate archive) initsS+)
- bodyO (/////generation.with_anchor @loop
- (generate archive bodyS))
+ @expected_exception (//case.gensym "expected_exception")
+ @actual_exception (//case.gensym "actual_exception")
+ initsO+ (monad.map ! (expression archive) initsS+)
+ body! (/////generation.with_anchor [start @expected_exception]
+ (statement expression archive bodyS))
#let [locals (|> initsS+
list.enumeration
(list\map (|>> product.left (n.+ start) //case.register)))
+ actual_loop (<| (_.def @loop locals)
+ (set_scope @expected_exception @actual_exception)
+ body!)
[directive instantiation] (case (|> (synthesis.path/then bodyS)
//case.dependencies
(set.from_list _.hash)
(set.difference (set.from_list _.hash locals))
set.to_list)
#.Nil
- [(_.def @loop locals
- (_.return bodyO))
+ [actual_loop
(_.apply/* @loop initsO+)]
foreigns
[(_.def @loop foreigns
($_ _.then
- (_.def @loop locals
- (_.return bodyO))
+ actual_loop
(_.return @loop)
))
(_.apply/* (_.apply/* @loop
@@ -73,9 +118,17 @@
_ (/////generation.save! (_.code @loop) directive)]
(wrap instantiation))))
-(def: #export (recur generate archive argsS+)
- (Generator (List Synthesis))
+(def: #export (recur! statement expression archive argsS+)
+ (Generator! (List Synthesis))
(do {! ///////phase.monad}
- [@scope /////generation.anchor
- argsO+ (monad.map ! (generate archive) argsS+)]
- (wrap (_.apply/* @scope argsO+))))
+ [[offset @exception] /////generation.anchor
+ @temp (//case.gensym "lux_recur_values")
+ argsO+ (monad.map ! (expression archive) argsS+)
+ #let [re_binds (|> argsO+
+ list.enumeration
+ (list\map (function (_ [idx _])
+ (_.nth (_.int (.int idx)) @temp))))]]
+ (wrap ($_ _.then
+ (_.set (list @temp) (_.list argsO+))
+ (..setup offset re_binds
+ (_.raise @exception))))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
index 5ed9e7d2a..fc2e95789 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
@@ -27,17 +27,19 @@
["#." reference]
["//#" /// #_
["$" version]
- ["#." synthesis]
+ ["#." synthesis (#+ Synthesis)]
["#." generation]
["//#" /// (#+ Output)
["#." phase]
+ [reference
+ [variable (#+ Register)]]
[meta
[archive (#+ Archive)
["." artifact (#+ Registry)]]]]]])
(template [<name> <base>]
[(type: #export <name>
- (<base> SVar (Expression Any) (Statement Any)))]
+ (<base> [Register SVar] (Expression Any) (Statement Any)))]
[Operation /////generation.Operation]
[Phase /////generation.Phase]
@@ -45,12 +47,21 @@
[Bundle /////generation.Bundle]
)
+(type: #export Phase!
+ (-> Phase Archive Synthesis (Operation (Statement Any))))
+
+(type: #export (Generator! i)
+ (-> Phase! Phase Archive i (Operation (Statement Any))))
+
(type: #export (Generator i)
(-> Phase Archive i (Operation (Expression Any))))
-(def: prefix Text "LuxRuntime")
+(def: prefix
+ "LuxRuntime")
-(def: #export unit (_.string /////synthesis.unit))
+(def: #export
+ unit
+ (_.string /////synthesis.unit))
(def: (flag value)
(-> Bit Literal)
diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux
index bcc71cd12..9372cc4e0 100644
--- a/stdlib/source/lux/type.lux
+++ b/stdlib/source/lux/type.lux
@@ -435,14 +435,3 @@
(~ (get@ #expression exemplar))}
{(~ extraction)
(:assume [])}))))))
-
-(exception: #export (hole_type {location Location} {type Type})
- (exception.report
- ["Location" (location.format location)]
- ["Type" (..format type)]))
-
-(syntax: #export (:hole)
- (do meta.monad
- [location meta.location
- expectedT meta.expected_type]
- (meta.fail (exception.construct ..hole_type [location expectedT]))))
diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux
index 2c7c00506..15534b996 100644
--- a/stdlib/source/lux/type/abstract.lux
+++ b/stdlib/source/lux/type/abstract.lux
@@ -7,7 +7,7 @@
[control
["." exception (#+ exception:)]
["<>" parser ("#\." monad)
- ["<c>" code (#+ Parser)]]]
+ ["<.>" code (#+ Parser)]]]
[data
["." name ("#\." codec)]
["." text ("#\." equivalence monoid)]
@@ -170,8 +170,8 @@
(def: cast
(Parser [(Maybe Text) Code])
- (<>.either (<>.and (<>.maybe <c>.local_identifier) <c>.any)
- (<>.and (<>\wrap #.None) <c>.any)))
+ (<>.either (<>.and (<>.maybe <code>.local_identifier) <code>.any)
+ (<>.and (<>\wrap #.None) <code>.any)))
(template [<name> <from> <to>]
[(syntax: #export (<name> {[frame value] ..cast})
@@ -194,13 +194,13 @@
(def: representation_definition_name
(-> Text Text)
(|>> ($_ text\compose
- (name\encode (name_of #Representation))
+ (name\encode (name_of #..Representation))
" ")))
(def: declaration
(Parser [Text (List Text)])
- (<>.either (<c>.form (<>.and <c>.local_identifier (<>.some <c>.local_identifier)))
- (<>.and <c>.local_identifier (\ <>.monad wrap (list)))))
+ (<>.either (<code>.form (<>.and <code>.local_identifier (<>.some <code>.local_identifier)))
+ (<>.and <code>.local_identifier (\ <>.monad wrap (list)))))
## TODO: Make sure the generated code always gets optimized away.
## (This applies to uses of ":abstraction" and ":representation")
@@ -209,7 +209,7 @@
{[name type_vars] declaration}
representation_type
{annotations (<>.default |annotations|.empty |annotations|.parser)}
- {primitives (<>.some <c>.any)})
+ {primitives (<>.some <code>.any)})
(do meta.monad
[current_module meta.current_module_name
#let [type_varsC (list\map code.local_identifier type_vars)
@@ -230,14 +230,39 @@
primitives
(list (` ((~! ..pop!)))))))))
-(syntax: #export (:transmutation value)
- (wrap (list (` (..:abstraction (..:representation (~ value)))))))
-
-(syntax: #export (^:representation {name (<c>.form <c>.local_identifier)}
+(type: (Selection a)
+ (#Specific Code a)
+ (#Current a))
+
+(def: (selection parser)
+ (All [a] (-> (Parser a) (Parser (Selection a))))
+ (<>.or (<>.and <code>.any parser)
+ parser))
+
+(syntax: #export (:transmutation {selection (..selection <code>.any)})
+ (case selection
+ (#Specific specific value)
+ (wrap (list (` (..:abstraction (~ specific)
+ (..:representation (~ specific)
+ (~ value))))))
+
+ (#Current value)
+ (wrap (list (` (..:abstraction (..:representation (~ value))))))))
+
+(syntax: #export (^:representation {selection (<code>.form (..selection <code>.local_identifier))}
body
- {branches (<>.some <c>.any)})
- (let [g!var (code.local_identifier name)]
- (wrap (list& g!var
- (` (.let [(~ g!var) (..:representation (~ g!var))]
- (~ body)))
- branches))))
+ {branches (<>.some <code>.any)})
+ (case selection
+ (#Specific specific name)
+ (let [g!var (code.local_identifier name)]
+ (wrap (list& g!var
+ (` (.let [(~ g!var) (..:representation (~ specific) (~ g!var))]
+ (~ body)))
+ branches)))
+
+ (#Current name)
+ (let [g!var (code.local_identifier name)]
+ (wrap (list& g!var
+ (` (.let [(~ g!var) (..:representation (~ g!var))]
+ (~ body)))
+ branches)))))
diff --git a/stdlib/source/program/aedifex/artifact/build.lux b/stdlib/source/program/aedifex/artifact/snapshot/build.lux
index d9a8b729e..d9a8b729e 100644
--- a/stdlib/source/program/aedifex/artifact/build.lux
+++ b/stdlib/source/program/aedifex/artifact/snapshot/build.lux
diff --git a/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux
new file mode 100644
index 000000000..c1efcc8ee
--- /dev/null
+++ b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux
@@ -0,0 +1,55 @@
+(.module:
+ [lux #*
+ [abstract
+ [equivalence (#+ Equivalence)]]
+ [data
+ ["." product]
+ [format
+ [xml (#+ XML)]]]]
+ ["." // #_
+ ["#." time (#+ Time)]
+ ["#." build (#+ Build)]])
+
+(type: #export Stamp
+ {#time Time
+ #build Build})
+
+(def: #export equivalence
+ (Equivalence Stamp)
+ ($_ product.equivalence
+ //time.equivalence
+ //build.equivalence
+ ))
+
+(def: time_format
+ (-> Time XML)
+ (|>> //time.format
+ #xml.Text
+ list
+ (#xml.Node ..tag xml.attributes)))
+
+(def: #export (format (^slots [#time #build]))
+ (-> Stamp (List XML))
+ (list (..time_format time)
+ (//build.format build)))
+
+(def: <timestamp>
+ xml.Tag
+ ["" "timestamp"])
+
+## (exception: #export (mismatch {expected Instant} {actual Instant})
+## (exception.report
+## ["Expected" (%.instant expected)]
+## ["Actual" (%.instant actual)]))
+
+(def: time_parser
+ (Parser Time)
+ (do <>.monad
+ [_ (<xml>.node <timestamp>)]
+ (<text>.embed //time.parser
+ (<xml>.children <xml>.text))))
+
+(def: #export parser
+ (Parser Stamp)
+ (<>.and (<xml>.somewhere ..time_parser)
+ (<xml>.somewhere //build.parser)))
diff --git a/stdlib/source/program/aedifex/artifact/snapshot/time.lux b/stdlib/source/program/aedifex/artifact/snapshot/time.lux
new file mode 100644
index 000000000..ea9bf3047
--- /dev/null
+++ b/stdlib/source/program/aedifex/artifact/snapshot/time.lux
@@ -0,0 +1,45 @@
+(.module:
+ [lux #*
+ [abstract
+ [equivalence (#+ Equivalence)]
+ [monad (#+ do)]]
+ [control
+ ["." exception (#+ exception:)]
+ ["<>" parser
+ ["<.>" text]
+ ["<.>" xml (#+ Parser)]]]
+ [data
+ [text
+ ["%" format]]
+ [format
+ ["." xml (#+ XML)]]]
+ [time
+ ["." instant (#+ Instant)]]]
+ ["." /// #_
+ [time
+ ["#." date]
+ ["#." time]]])
+
+(type: #export Time
+ Instant)
+
+(def: #export equivalence
+ (Equivalence Time)
+ instant.equivalence)
+
+(def: separator
+ ".")
+
+(def: #export (format value)
+ (%.Format Time)
+ (%.format (///date.format (instant.date value))
+ ..separator
+ (///time.format (instant.time value))))
+
+(def: #export parser
+ (<text>.Parser Time)
+ (do <>.monad
+ [date ///date.parser
+ _ (<text>.this ..separator)
+ time ///time.parser]
+ (wrap (instant.from_date_time date time))))
diff --git a/stdlib/source/program/aedifex/artifact/time_stamp.lux b/stdlib/source/program/aedifex/artifact/time_stamp.lux
deleted file mode 100644
index 0eab45a14..000000000
--- a/stdlib/source/program/aedifex/artifact/time_stamp.lux
+++ /dev/null
@@ -1,35 +0,0 @@
-(.module:
- [lux #*
- [abstract
- [monad (#+ do)]]
- [control
- ["<>" parser
- ["<.>" text (#+ Parser)]]]
- [data
- [text
- ["%" format]]]
- [time
- ["." instant (#+ Instant)]]]
- ["." / #_
- ["#." date]
- ["#." time]])
-
-(type: #export Time_Stamp
- Instant)
-
-(def: #export separator
- ".")
-
-(def: #export (format value)
- (%.Format Time_Stamp)
- (%.format (/date.format (instant.date value))
- ..separator
- (/time.format (instant.time value))))
-
-(def: #export parser
- (Parser Time_Stamp)
- (do <>.monad
- [date /date.parser
- _ (<text>.this ..separator)
- time /time.parser]
- (wrap (instant.from_date_time date time))))
diff --git a/stdlib/source/spec/lux/world/console.lux b/stdlib/source/spec/lux/world/console.lux
index f875cd07e..5bfcf1ff8 100644
--- a/stdlib/source/spec/lux/world/console.lux
+++ b/stdlib/source/spec/lux/world/console.lux
@@ -10,6 +10,9 @@
["!" capability]]
[concurrency
["." promise (#+ Promise)]]]
+ [data
+ ["." text
+ ["%" format (#+ format)]]]
[math
["." random]]]
{1
@@ -22,19 +25,12 @@
[message (random.ascii/alpha 10)]
(wrap (do promise.monad
[console (promise.future console)
+ ?write (!.use (\ console write) [(format message text.new_line)])
?read (!.use (\ console read) [])
?read_line (!.use (\ console read_line) [])
- ?write (!.use (\ console write) [message])
?close/good (!.use (\ console close) [])
?close/bad (!.use (\ console close) [])]
($_ _.and'
- (_.cover' [/.Can_Read]
- (case [?read ?read_line]
- [(#try.Success _) (#try.Success _)]
- true
-
- _
- false))
(_.cover' [/.Can_Write]
(case ?write
(#try.Success _)
@@ -42,6 +38,13 @@
_
false))
+ (_.cover' [/.Can_Read]
+ (case [?read ?read_line]
+ [(#try.Success _) (#try.Success _)]
+ true
+
+ _
+ false))
(_.cover' [/.Can_Close]
(case [?close/good ?close/bad]
[(#try.Success _) (#try.Failure _)]
diff --git a/stdlib/source/test/aedifex/artifact/build.lux b/stdlib/source/test/aedifex/artifact/snapshot/build.lux
index d0920b44c..e3fdcab62 100644
--- a/stdlib/source/test/aedifex/artifact/build.lux
+++ b/stdlib/source/test/aedifex/artifact/snapshot/build.lux
@@ -11,23 +11,28 @@
[parser
["<.>" xml]]]
[math
- ["." random]]]
+ ["." random (#+ Random)]]]
{#program
["." /]})
+(def: #export random
+ (Random /.Build)
+ random.nat)
+
(def: #export test
Test
(<| (_.covering /._)
(_.for [/.Build]
($_ _.and
(_.for [/.equivalence]
- ($equivalence.spec /.equivalence random.nat))
+ ($equivalence.spec /.equivalence ..random))
(do random.monad
- [expected random.nat]
+ [expected ..random]
(_.cover [/.format /.parser]
(|> expected
/.format
+ list
(<xml>.run /.parser)
(try\map (\ /.equivalence = expected))
(try.default false))))
diff --git a/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux b/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux
new file mode 100644
index 000000000..aab722cad
--- /dev/null
+++ b/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux
@@ -0,0 +1,48 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]
+ {[0 #spec]
+ [/
+ ["$." equivalence]]}]
+ [control
+ ["." try ("#\." functor)]
+ [parser
+ ["<.>" xml]]]
+ [math
+ ["." random (#+ Random)]]
+ [time
+ ["." instant]]]
+ {#program
+ ["." /]}
+ ["$." // #_
+ ["#." time]
+ ["#." build]])
+
+(def: #export random
+ (Random /.Stamp)
+ ($_ random.and
+ $//time.random
+ $//build.random
+ ))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.Stamp])
+ ($_ _.and
+ (_.for [/.equivalence]
+ ($equivalence.spec /.equivalence ..random))
+
+ (do random.monad
+ [expected ..random]
+ ($_ _.and
+ (_.cover [/.format /.parser]
+ (|> expected
+ /.format
+ (<xml>.run' /.parser)
+ (try\map (\ instant.equivalence = expected))
+ (try.default false)))
+ ))
+ )))
diff --git a/stdlib/source/test/aedifex/artifact/snapshot/time.lux b/stdlib/source/test/aedifex/artifact/snapshot/time.lux
new file mode 100644
index 000000000..567c70ce4
--- /dev/null
+++ b/stdlib/source/test/aedifex/artifact/snapshot/time.lux
@@ -0,0 +1,42 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]
+ {[0 #spec]
+ [/
+ ["$." equivalence]]}]
+ [control
+ ["." try ("#\." functor)]
+ [parser
+ ["<.>" text]]]
+ [math
+ ["." random (#+ Random)]]
+ [time
+ ["." instant]]]
+ {#program
+ ["." /]})
+
+(def: #export random
+ (Random /.Time)
+ random.instant)
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.Time])
+ ($_ _.and
+ (_.for [/.equivalence]
+ ($equivalence.spec /.equivalence ..random))
+
+ (do random.monad
+ [expected ..random]
+ ($_ _.and
+ (_.cover [/.format /.parser]
+ (|> expected
+ /.format
+ (<text>.run /.parser)
+ (try\map (\ instant.equivalence = expected))
+ (try.default false)))
+ ))
+ )))
diff --git a/stdlib/source/test/aedifex/artifact/time_stamp.lux b/stdlib/source/test/aedifex/artifact/time_stamp.lux
deleted file mode 100644
index 7dea57392..000000000
--- a/stdlib/source/test/aedifex/artifact/time_stamp.lux
+++ /dev/null
@@ -1,33 +0,0 @@
-(.module:
- [lux #*
- ["_" test (#+ Test)]
- [abstract
- [monad (#+ do)]]
- [control
- ["." try ("#\." functor)]
- [parser
- ["<.>" text]]]
- [math
- ["." random (#+ Random)]
- [number
- ["n" nat]
- ["i" int]]]
- [time
- ["." instant]]]
- {#program
- ["." /]})
-
-(def: #export test
- Test
- (<| (_.covering /._)
- (_.for [/.Time_Stamp])
- ($_ _.and
- (do random.monad
- [expected random.instant]
- (_.cover [/.format /.parser]
- (|> expected
- /.format
- (<text>.run /.parser)
- (try\map (\ instant.equivalence = expected))
- (try.default false))))
- )))
diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux
index d983ab382..487e4c48c 100644
--- a/stdlib/source/test/lux/control/concurrency/actor.lux
+++ b/stdlib/source/test/lux/control/concurrency/actor.lux
@@ -32,9 +32,6 @@
((on_mail message state self)
(message state self))
- ((on_stop cause state)
- (promise\wrap []))
-
(message: (count! {increment Nat} state self Nat)
(let [state' (n.+ increment state)]
(promise\wrap (#try.Success [state' state']))))
@@ -90,9 +87,16 @@
[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)))})
+ (do {! promise.monad}
+ [outcome (message state self)]
+ (case outcome
+ (#try.Failure cause)
+ (do !
+ [_ (promise.future (write cause))]
+ (wrap outcome))
+
+ (#try.Success _)
+ (wrap outcome))))})
[])]
(/.poison! actor)))
_ (promise.wait 100)
@@ -172,11 +176,7 @@
[anonymous (/.actor {Nat
initial_state}
((on_mail message state self)
- (message (inc state) self))
-
- ((on_stop cause state)
- (promise\wrap (exec (%.nat state)
- []))))
+ (message (inc state) self)))
sent/inc? (/.mail! inc! anonymous)
sent/dec? (/.mail! dec! anonymous)
poisoned? (/.poison! anonymous)
diff --git a/stdlib/source/test/lux/control/parser/xml.lux b/stdlib/source/test/lux/control/parser/xml.lux
index a9f71af71..c2d0ac4e2 100644
--- a/stdlib/source/test/lux/control/parser/xml.lux
+++ b/stdlib/source/test/lux/control/parser/xml.lux
@@ -39,7 +39,7 @@
[expected (random.ascii/alpha 1)]
(_.cover [<exception>]
(`` (and (~~ (template [<parser> <input>]
- [(|> (/.run <parser> <input>)
+ [(|> (/.run <parser> (list <input>))
(!expect (^multi (#try.Failure error)
(exception.match? <exception> error))))]
@@ -61,7 +61,7 @@
(do {! random.monad}
[expected (random.ascii/alpha 1)]
(_.cover [/.run /.text]
- (|> (/.run /.text (#xml.Text expected))
+ (|> (/.run /.text (list (#xml.Text expected)))
(!expect (^multi (#try.Success actual)
(text\= expected actual))))))
(!failure /.unconsumed_inputs
@@ -70,7 +70,7 @@
(do {! random.monad}
[expected (random.ascii/alpha 1)]
(_.cover [/.ignore]
- (|> (/.run /.ignore (#xml.Text expected))
+ (|> (/.run /.ignore (list (#xml.Text expected)))
(!expect (#try.Success [])))))
(do {! random.monad}
[expected ..random_tag]
@@ -79,7 +79,7 @@
[actual /.tag
_ /.ignore]
(wrap (name\= expected actual)))
- (#xml.Node expected (dictionary.new name.hash) (list)))
+ (list (#xml.Node expected (dictionary.new name.hash) (list))))
(!expect (#try.Success #1)))))
(do {! random.monad}
[expected ..random_tag]
@@ -87,7 +87,7 @@
(|> (/.run (do //.monad
[_ (/.node expected)]
/.ignore)
- (#xml.Node expected (dictionary.new name.hash) (list)))
+ (list (#xml.Node expected (dictionary.new name.hash) (list))))
(!expect (#try.Success [])))))
(!failure /.wrong_tag
[[(/.node ["" expected])
@@ -101,10 +101,10 @@
[_ (/.node expected_tag)
_ (/.attribute expected_attribute)]
/.ignore)
- (#xml.Node expected_tag
- (|> (dictionary.new name.hash)
- (dictionary.put expected_attribute expected_value))
- (list)))
+ (list (#xml.Node expected_tag
+ (|> (dictionary.new name.hash)
+ (dictionary.put expected_attribute expected_value))
+ (list))))
(!expect (#try.Success [])))))
(!failure /.unknown_attribute
[[(do //.monad
@@ -123,11 +123,11 @@
(do !
[_ (/.node expected)]
/.ignore)))
- (#xml.Node expected
- (dictionary.new name.hash)
- (list (#xml.Node expected
- (dictionary.new name.hash)
- (list)))))
+ (list (#xml.Node expected
+ (dictionary.new name.hash)
+ (list (#xml.Node expected
+ (dictionary.new name.hash)
+ (list))))))
(!expect (#try.Success [])))))
(!failure /.empty_input
[[(do //.monad
@@ -195,15 +195,15 @@
($_ _.and
(_.cover [/.somewhere]
(|> (/.run parser
- (node parent
- (list.concat (list (list.repeat repetitions (node wrong (list)))
- (list (node right (list)))
- (list.repeat repetitions (node wrong (list)))))))
+ (list (node parent
+ (list.concat (list (list.repeat repetitions (node wrong (list)))
+ (list (node right (list)))
+ (list.repeat repetitions (node wrong (list))))))))
(!expect (#try.Success []))))
(_.cover [/.nowhere]
(|> (/.run parser
- (node parent
- (list.repeat repetitions (node wrong (list)))))
+ (list (node parent
+ (list.repeat repetitions (node wrong (list))))))
(!expect (^multi (#try.Failure error)
(exception.match? /.nowhere error)))))
))
diff --git a/stdlib/source/test/lux/macro/template.lux b/stdlib/source/test/lux/macro/template.lux
index 53d7d114e..b129aaaef 100644
--- a/stdlib/source/test/lux/macro/template.lux
+++ b/stdlib/source/test/lux/macro/template.lux
@@ -3,9 +3,15 @@
["_" test (#+ Test)]
[abstract
[monad (#+ do)]]
+ [control
+ ["." try]
+ ["." exception]]
[data
[collection
["." list]]]
+ ["." macro
+ [syntax (#+ syntax:)]
+ ["." code]]
[math
["." random (#+ Random)]
[number
@@ -19,6 +25,15 @@
(-> Nat Nat)
(|>> !pow/2)))
+(syntax: (macro_error macro)
+ (function (_ compiler)
+ (case ((macro.expand macro) compiler)
+ (#try.Failure error)
+ (#try.Success [compiler (list (code.text error))])
+
+ (#try.Success _)
+ (#try.Failure "OOPS!"))))
+
(def: #export test
Test
(<| (_.covering /._)
@@ -97,5 +112,15 @@
can_refer!
can_shadow!)))
))))
+ (_.cover [/.irregular_arguments]
+ (/.with [(arity/3 <0> <1> <2>)
+ ""]
+ (exception.match? /.irregular_arguments
+ (macro_error (arity/3 "a" "b")))))
+ (_.cover [/.cannot_shadow_definition]
+ (exception.match? /.cannot_shadow_definition
+ (macro_error (/.with [(macro_error <0> <1> <2>)
+ ""]
+ ""))))
)))
))
diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux
index 168ed29d1..70b13a382 100644
--- a/stdlib/source/test/lux/type.lux
+++ b/stdlib/source/test/lux/type.lux
@@ -17,6 +17,7 @@
{1
["." / ("#\." equivalence)]}
["." / #_
+ ["#." abstract]
["#." check]
["#." dynamic]
["#." implicit]
@@ -164,6 +165,7 @@
{(Maybe a) example}
(List a)))))
+ /abstract.test
/check.test
/dynamic.test
/implicit.test
diff --git a/stdlib/source/test/lux/type/abstract.lux b/stdlib/source/test/lux/type/abstract.lux
new file mode 100644
index 000000000..30ad27687
--- /dev/null
+++ b/stdlib/source/test/lux/type/abstract.lux
@@ -0,0 +1,110 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ ["." meta]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." try]
+ ["." exception]]
+ [data
+ ["." text ("#\." equivalence)]]
+ ["." macro
+ [syntax (#+ syntax:)]
+ ["." code]
+ ["." template]]
+ ["." math
+ ["." random]
+ [number
+ ["n" nat]]]]
+ {1
+ ["." /]})
+
+(template.with_locals [g!Foo g!Bar]
+ (as_is (template [<syntax> <meta>]
+ [(syntax: (<syntax>)
+ (do meta.monad
+ [frame <meta>]
+ (wrap (list (code.text (get@ #/.name frame))))))]
+
+ [current /.current]
+ [specific (/.specific (template.text [g!Foo]))]
+ )
+
+ (syntax: (with_no_active_frames macro)
+ (function (_ compiler)
+ (let [verdict (case ((macro.expand macro) compiler)
+ (#try.Failure error)
+ (exception.match? /.no_active_frames error)
+
+ (#try.Success _)
+ false)]
+ (#try.Success [compiler (list (code.bit verdict))]))))
+
+ (with_expansions [no_current! (..with_no_active_frames (..current))
+ no_specific! (..with_no_active_frames (..specific))]
+ (/.abstract: (g!Foo a)
+ Text
+
+ (/.abstract: (g!Bar a)
+ Nat
+
+ (def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.abstract:])
+ (do random.monad
+ [expected_foo (random.ascii/lower 5)
+ expected_bar random.nat]
+ ($_ _.and
+ (_.cover [/.:abstraction]
+ (and (exec (: (g!Foo Text)
+ (/.:abstraction g!Foo expected_foo))
+ true)
+ (exec (: (g!Bar Text)
+ (/.:abstraction expected_bar))
+ true)))
+ (_.cover [/.:representation]
+ (and (|> expected_foo
+ (/.:abstraction g!Foo)
+ (: (g!Foo Bit))
+ (/.:representation g!Foo)
+ (text\= expected_foo))
+ (|> (/.:abstraction expected_bar)
+ (: (g!Bar Bit))
+ /.:representation
+ (n.= expected_bar))))
+ (_.cover [/.:transmutation]
+ (and (exec (|> expected_foo
+ (/.:abstraction g!Foo)
+ (: (g!Foo .Macro))
+ (/.:transmutation g!Foo)
+ (: (g!Foo .Lux)))
+ true)
+ (exec (|> (/.:abstraction expected_bar)
+ (: (g!Bar .Macro))
+ /.:transmutation
+ (: (g!Bar .Lux)))
+ true)))
+ (_.cover [/.^:representation]
+ (and (let [(/.^:representation g!Foo actual_foo)
+ (: (g!Foo .Module)
+ (/.:abstraction g!Foo expected_foo))]
+ (text\= expected_foo actual_foo))
+ (let [(/.^:representation actual_bar)
+ (: (g!Bar .Module)
+ (/.:abstraction expected_bar))]
+ (n.= expected_bar actual_bar))))
+ (_.for [/.Frame]
+ ($_ _.and
+ (_.cover [/.current]
+ (text\= (template.text [g!Bar])
+ (..current)))
+ (_.cover [/.specific]
+ (text\= (template.text [g!Foo])
+ (..specific)))
+ (_.cover [/.no_active_frames]
+ (and no_current!
+ no_specific!))
+ ))
+ )))))))))