aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/pipe.lux38
-rw-r--r--stdlib/source/lux/data/identity.lux17
-rw-r--r--stdlib/source/test/lux.lux1
-rw-r--r--stdlib/source/test/lux/control.lux7
-rw-r--r--stdlib/source/test/lux/control/pipe.lux165
5 files changed, 135 insertions, 93 deletions
diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux
index ec1e787e2..e5118469f 100644
--- a/stdlib/source/lux/control/pipe.lux
+++ b/stdlib/source/lux/control/pipe.lux
@@ -11,28 +11,26 @@
["s" syntax (#+ syntax: Syntax)]
["." code]]])
-## [Syntax]
(def: body^
(Syntax (List Code))
(s.tuple (p.some s.any)))
-(syntax: #export (new> {tokens (p.at-least 2 s.any)})
+(syntax: #export (new> start
+ {body body^}
+ prev)
{#.doc (doc "Ignores the piped argument, and begins a new pipe."
- (|> +20
- (i/* +3)
- (i/+ +4)
- (new> +0 inc)))}
- (case (list.reverse tokens)
- (^ (list& _ r-body))
- (wrap (list (` (|> (~+ (list.reverse r-body))))))
-
- _
- (undefined)))
+ (n/= 1
+ (|> 20
+ (n/* 3)
+ (n/+ 4)
+ (new> 0 [inc]))))}
+ (wrap (list (` (|> (~ start) (~+ body))))))
(syntax: #export (let> binding body prev)
{#.doc (doc "Gives a name to the piped-argument, within the given expression."
- (|> +5
- (let> X (i/+ X X))))}
+ (n/= 10
+ (|> 5
+ (let> x (n/+ x x)))))}
(wrap (list (` (let [(~ binding) (~ prev)]
(~ body))))))
@@ -51,7 +49,7 @@
(|> +5
(cond> [i/even?] [(i/* +2)]
[i/odd?] [(i/* +3)]
- [(new> -1)])))}
+ [(new> -1 [])])))}
(with-gensyms [g!temp]
(wrap (list (` (let [(~ g!temp) (~ prev)]
(cond (~+ (do list.monad
@@ -60,13 +58,13 @@
(` (|> (~ g!temp) (~+ then))))))
(|> (~ g!temp) (~+ else)))))))))
-(syntax: #export (if> {then body^} {else body^} prev)
- (wrap (list (` (cond> [] [(new> (~+ then))]
- [(new> (~+ else))]
+(syntax: #export (if> {test body^} {then body^} {else body^} prev)
+ (wrap (list (` (cond> [(~+ test)] [(~+ then)]
+ [(~+ else)]
(~ prev))))))
-(syntax: #export (when> test {then body^} prev)
- (wrap (list (` (cond> [(new> (~ test))] [(~+ then)]
+(syntax: #export (when> {test body^} {then body^} prev)
+ (wrap (list (` (cond> [(~+ test)] [(~+ then)]
[]
(~ prev))))))
diff --git a/stdlib/source/lux/data/identity.lux b/stdlib/source/lux/data/identity.lux
index 6f1fc60ef..7793bd7f5 100644
--- a/stdlib/source/lux/data/identity.lux
+++ b/stdlib/source/lux/data/identity.lux
@@ -3,16 +3,15 @@
[control
[functor (#+ Functor)]
[apply (#+ Apply)]
- ["M" monad #*]
- ["CM" comonad #*]]])
+ [monad (#+ Monad)]
+ [comonad (#+ CoMonad)]]
+ ["." function]])
-## [Types]
(type: #export (Identity a)
a)
-## [Structures]
(structure: #export functor (Functor Identity)
- (def: map id))
+ (def: map function.identity))
(structure: #export apply (Apply Identity)
(def: &functor ..functor)
@@ -21,10 +20,10 @@
(structure: #export monad (Monad Identity)
(def: &functor ..functor)
- (def: wrap id)
- (def: join id))
+ (def: wrap function.identity)
+ (def: join function.identity))
(structure: #export comonad (CoMonad Identity)
(def: &functor ..functor)
- (def: unwrap id)
- (def: split id))
+ (def: unwrap function.identity)
+ (def: split function.identity))
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index ef37237ba..08c77a303 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -96,7 +96,6 @@
["/." jvm]]
["/." control]]
## [control
- ## ## [pipe (#+)]
## ## [continuation (#+)]
## ## [reader (#+)]
## ## [writer (#+)]
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index 6c2204fbc..79dab5322 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -3,7 +3,8 @@
["_" test (#+ Test)]]
[/
["/." exception]
- ["/." interval]])
+ ["/." interval]
+ ["/." pipe]])
(def: #export test
Test
@@ -11,4 +12,6 @@
(<| (_.context "/exception Exception-handling.")
/exception.test)
(<| (_.context "/interval")
- /interval.test)))
+ /interval.test)
+ (<| (_.context "/pipe")
+ /pipe.test)))
diff --git a/stdlib/source/test/lux/control/pipe.lux b/stdlib/source/test/lux/control/pipe.lux
index aaaa18616..21d7b8b90 100644
--- a/stdlib/source/test/lux/control/pipe.lux
+++ b/stdlib/source/test/lux/control/pipe.lux
@@ -1,72 +1,115 @@
(.module:
[lux #*
+ ["_" test (#+ Test)]
[control
- [monad (#+ Monad do)]
- pipe]
+ [monad (#+ do)]]
[data
["." identity]
[text ("text/." equivalence)
format]]
[math
["r" random]]]
- lux/test)
+ {1
+ /})
-(context: "Pipes"
- ($_ seq
- (test "Can dismiss previous pipeline results and begin a new line."
- (|> +20
- (i/* +3)
- (i/+ +4)
- (new> +0 inc)
- (i/= +1)))
-
- (test "Can give names to piped values within a pipeline's scope."
- (|> +5
- (let> X [(i/+ X X)])
- (i/= +10)))
-
- (test "Can do branching in pipelines."
- (and (|> +5
- (cond> [i/even?] [(i/* +2)]
- [i/odd?] [(i/* +3)]
- [(new> -1)])
- (i/= +15))
- (|> +4
- (cond> [i/even?] [(i/* +2)]
- [i/odd?] [(i/* +3)]
- [])
- (i/= +8))
- (|> +5
- (cond> [i/even?] [(i/* +2)]
- [(new> -1)])
- (i/= -1))))
+(def: #export test
+ Test
+ (do r.monad
+ [sample r.nat]
+ ($_ _.and
+ (do @
+ [another r.nat]
+ (_.test "Can dismiss previous pipeline results and begin a new one."
+ (n/= (inc another)
+ (|> sample
+ (n/* 3)
+ (n/+ 4)
+ (new> another [inc])))))
+
+ (_.test "Let-binding"
+ (n/= (n/+ sample sample)
+ (|> sample
+ (let> x [(n/+ x x)]))))
+
+ (_.test "'Conditional' branching."
+ (text/= (cond (n/= 0 sample) "zero"
+ (n/even? sample) "even"
+ "odd")
+ (|> sample
+ (cond> [(n/= 0)] [(new> "zero" [])]
+ [n/even?] [(new> "even" [])]
+ [(new> "odd" [])]))))
- (test "Can loop within pipelines."
- (|> +1
- (loop> [(i/< +10)]
- [inc])
- (i/= +10)))
-
- (test "Can use monads within pipelines."
- (|> +5
- (do> identity.monad
- [(i/* +3)]
- [(i/+ +4)]
- [inc])
- (i/= +20)))
-
- (test "Can pattern-match against piped values."
- (|> +5
- (case> +0 "zero"
- +1 "one"
- +2 "two"
- +3 "three"
- +4 "four"
- +5 "five"
- +6 "six"
- +7 "seven"
- +8 "eight"
- +9 "nine"
- _ "???")
- (text/= "five")))
- ))
+ (_.test "'If' branching."
+ (text/= (if (n/even? sample)
+ "even"
+ "odd")
+ (|> sample
+ (if> [n/even?]
+ [(new> "even" [])]
+ [(new> "odd" [])]))))
+
+ (_.test "'When' branching."
+ (n/= (if (n/even? sample)
+ (n/* 2 sample)
+ sample)
+ (|> sample
+ (when> [n/even?]
+ [(n/* 2)]))))
+
+ (_.test "Can loop."
+ (n/= (n/* 10 sample)
+ (|> sample
+ (loop> [(n/= (n/* 10 sample)) not]
+ [(n/+ sample)]))))
+
+ (_.test "Monads."
+ (n/= (inc (n/+ 4 (n/* 3 sample)))
+ (|> sample
+ (do> identity.monad
+ [(n/* 3)]
+ [(n/+ 4)]
+ [inc]))))
+
+ (_.test "Execution."
+ (n/= (n/* 10 sample)
+ (|> sample
+ (exec> [%n (format "sample = ") log!])
+ (n/* 10))))
+
+ (_.test "Tuple."
+ (let [[left middle right] (|> sample
+ (tuple> [inc]
+ [dec]
+ [%n]))]
+ (and (n/= (inc sample) left)
+ (n/= (dec sample) middle)
+ (text/= (%n sample) right))))
+
+ (_.test "Pattern-matching."
+ (text/= (case (n/% 10 sample)
+ 0 "zero"
+ 1 "one"
+ 2 "two"
+ 3 "three"
+ 4 "four"
+ 5 "five"
+ 6 "six"
+ 7 "seven"
+ 8 "eight"
+ 9 "nine"
+ _ "???")
+ (|> sample
+ (n/% 10)
+ (case> 0 "zero"
+ 1 "one"
+ 2 "two"
+ 3 "three"
+ 4 "four"
+ 5 "five"
+ 6 "six"
+ 7 "seven"
+ 8 "eight"
+ 9 "nine"
+ _ "???"))))
+ )))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 09:18:20 +0000