blob: 571225ecc4a1fac41ffd9766d60584338895f07f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
(.module:
[lux #*
["_" test (#+ Test)]
[abstract
[monad (#+ do)]
{[0 #test]
[/
["$." functor (#+ Injection Comparison)]
["$." apply]
["$." monad]]}]
[data
[number
["." nat]]
[text
format]
[collection
["." list]]]
[math
["r" random]]]
{1
["." / (#+ Cont)]})
(def: injection
(All [o] (Injection (All [i] (Cont i o))))
(|>> /.pending))
(def: comparison
(Comparison Cont)
(function (_ == left right)
(== (/.run left) (/.run right))))
(def: #export test
Test
(<| (_.context (%name (name-of /.Cont)))
(do r.monad
[sample r.nat
#let [(^open "_;.") /.apply
(^open "_;.") /.monad]
elems (r.list 3 r.nat)]
($_ _.and
($functor.spec ..injection ..comparison /.functor)
($apply.spec ..injection ..comparison /.apply)
($monad.spec ..injection ..comparison /.monad)
(_.test "Can run continuations to compute their values."
(n/= sample (/.run (_;wrap sample))))
(_.test "Can use the current-continuation as a escape hatch."
(n/= (n/* 2 sample)
(/.run (do /.monad
[value (/.call/cc
(function (_ k)
(do @
[temp (k sample)]
## If this code where to run,
## the output would be
## (n/* 4 sample)
(k temp))))]
(wrap (n/* 2 value))))))
(_.test "Can use the current-continuation to build a time machine."
(n/= (n/+ 100 sample)
(/.run (do /.monad
[[restart [output idx]] (/.portal [sample 0])]
(if (n/< 10 idx)
(restart [(n/+ 10 output) (inc idx)])
(wrap output))))))
(_.test "Can use delimited continuations with shifting."
(let [(^open "_;.") /.monad
(^open "list;.") (list.equivalence nat.equivalence)
visit (: (-> (List Nat)
(Cont (List Nat) (List Nat)))
(function (visit xs)
(case xs
#.Nil
(_;wrap #.Nil)
(#.Cons x xs')
(do /.monad
[output (/.shift (function (_ k)
(do @
[tail (k xs')]
(wrap (#.Cons x tail)))))]
(visit output)))))]
(list;= elems
(/.run (/.reset (visit elems))))))
))))
|
