blob: 11c1faa88373ab3f8314a9fae1500c3c39b2d1b3 (
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
97
98
|
(.using
[library
[lux "*"
["_" test {"+" Test}]
[abstract
[monad {"+" do}]
[\\specification
["$[0]" equivalence]]]
[data
["[0]" product]
["[0]" bit ("[1]#[0]" equivalence)]
[collection
["[0]" set ("[1]#[0]" equivalence)]]]
[math
["[0]" random {"+" Random}]
[number
["n" nat]]]]]
["[0]" / "_"
["/[1]" // "_"
["[1][0]" block]]]
[\\library
["[0]" /
[//
["[0]" block]]]])
(def: .public random
(Random /.Set)
(do [! random.monad]
[left //block.random
right //block.random]
(in (/.set [left (list right)]))))
(def: .public test
Test
(<| (_.covering /._)
(_.for [/.Set])
(do [! random.monad]
[block //block.random
inside (# ! each
(|>> (n.% (block.size block))
(n.+ (block.start block)))
random.nat)
left //block.random
right //block.random
.let [equivalence (product.equivalence n.equivalence
n.equivalence)]]
(`` (all _.and
(_.for [/.equivalence]
($equivalence.spec /.equivalence ..random))
(_.cover [/.set]
(and (n.= (block.start left)
(/.start (/.set [left (list)])))
(n.= (block.end left)
(/.end (/.set [left (list)])))))
(_.cover [/.start]
(n.= (n.min (block.start left)
(block.start right))
(/.start (/.set [left (list right)]))))
(_.cover [/.end]
(n.= (n.max (block.end left)
(block.end right))
(/.end (/.set [left (list right)]))))
(_.cover [/.member?]
(bit#= (block.within? block inside)
(/.member? (/.set [block (list)]) inside)))
(_.cover [/.composite]
(let [composed (/.composite (/.set [left (list)])
(/.set [right (list)]))]
(and (n.= (n.min (block.start left)
(block.start right))
(/.start composed))
(n.= (n.max (block.end left)
(block.end right))
(/.end composed)))))
(~~ (template [<set>]
[(do random.monad
[char (random.char <set>)
.let [start (/.start <set>)
end (/.end <set>)]]
(_.cover [<set>]
(and (/.member? <set> char)
(not (/.member? <set> (-- start)))
(not (/.member? <set> (++ end))))))]
[/.ascii]
[/.alphabetic]
[/.alpha_numeric]
[/.lower_case]
[/.upper_case]
[/.numeric]
[/.character]
[/.non_character]
[/.full]
))
//block.test
)))))
|