blob: 0b05387455a1f0f806926c68ea2fca556ad44cb2 (
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
89
90
91
92
93
94
95
96
|
(.module:
[lux #*
["_" test (#+ Test)]
[abstract
[monad (#+ do)]
{[0 #spec]
[/
["$." functor (#+ Injection Comparison)]
["$." apply]
["$." monad]]}]
[data
[number
["n" nat]]
[collection
["." list]]]
[math
["." random]]]
{1
["." /]})
(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
(<| (_.covering /._)
(do random.monad
[sample random.nat
#let [(^open "_@.") /.apply
(^open "_@.") /.monad]
elems (random.list 3 random.nat)])
(_.with-cover [/.Cont])
($_ _.and
(_.with-cover [/.functor]
($functor.spec ..injection ..comparison /.functor))
(_.with-cover [/.apply]
($apply.spec ..injection ..comparison /.apply))
(_.with-cover [/.monad]
($monad.spec ..injection ..comparison /.monad))
(_.cover [/.run]
(n.= sample (/.run (_@wrap sample))))
(_.cover [/.call/cc]
(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))))))
(_.cover [/.portal]
(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))))))
(_.cover [/.shift /.reset]
(let [(^open "_@.") /.monad
(^open "list@.") (list.equivalence n.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))))))
(_.cover [/.continue]
(/.continue (is? sample)
(: (/.Cont Nat Bit)
(function (_ next)
(next sample)))))
(_.cover [/.pending]
(/.continue (is? sample)
(: (/.Cont Nat Bit)
(/.pending sample))))
)))
|
