blob: 53aa37483fe17b4bfb1d5152da272a7d7b520b9a (
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
|
(.module:
[lux #*
[control
[equivalence (#+ Equivalence)]
[order (#+ Order)]
[enum (#+ Enum)]]])
(type: #export Day
#Sunday
#Monday
#Tuesday
#Wednesday
#Thursday
#Friday
#Saturday)
(structure: #export equivalence (Equivalence Day)
(def: (= reference sample)
(case [reference sample]
(^template [<tag>]
[<tag> <tag>]
#1)
([#Sunday]
[#Monday]
[#Tuesday]
[#Wednesday]
[#Thursday]
[#Friday]
[#Saturday])
_
#0)))
(def: (day-to-nat day)
(-> Day Nat)
(case day
#Sunday 0
#Monday 1
#Tuesday 2
#Wednesday 3
#Thursday 4
#Friday 5
#Saturday 6))
(`` (structure: #export order (Order Day)
(def: &equivalence ..equivalence)
(~~ (template [<name> <comp>]
[(def: (<name> reference sample)
(<comp> (day-to-nat reference) (day-to-nat sample)))]
[< n/<]
[<= n/<=]
[> n/>]
[>= n/>=]
))))
(structure: #export enum (Enum Day)
(def: &order ..order)
(def: (succ day)
(case day
#Sunday #Monday
#Monday #Tuesday
#Tuesday #Wednesday
#Wednesday #Thursday
#Thursday #Friday
#Friday #Saturday
#Saturday #Sunday))
(def: (pred day)
(case day
#Monday #Sunday
#Tuesday #Monday
#Wednesday #Tuesday
#Thursday #Wednesday
#Friday #Thursday
#Saturday #Friday
#Sunday #Saturday)))
|
