stdlib/source/test/lux/data/text/unicode/block.lux


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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215

(.require
 [library
  [lux (.except)
   [abstract
    [monad (.only do)]
    [\\specification
     ["$[0]" equivalence]
     ["$[0]" hash]
     ["$[0]" monoid]]]
   [data
    ["[0]" text]
    [collection
     ["[0]" set]
     ["[0]" list]]]
   [math
    ["[0]" random (.only Random)]
    [number (.only hex)
     ["n" nat]]]
   [meta
    [macro
     ["[0]" template]]]
   [test
    ["_" property (.only Test)]]]]
 [\\library
  ["[0]" /]])

(def .public random
  (Random /.Block)
  (do [! random.monad]
    [start (of ! each (n.% 1,000,000) random.nat)
     additional (of ! each (n.% 1,000,000) random.nat)]
    (in (/.block start additional))))

(with_expansions [<blocks> (these [blocks/0
                                   [/.basic_latin
                                    /.latin_1_supplement
                                    /.latin_extended_a
                                    /.latin_extended_b
                                    /.ipa_extensions
                                    /.spacing_modifier_letters
                                    /.combining_diacritical_marks
                                    /.greek_and_coptic
                                    /.cyrillic
                                    /.cyrillic_supplementary
                                    /.armenian
                                    /.hebrew
                                    /.arabic
                                    /.syriac
                                    /.thaana
                                    /.devanagari
                                    /.bengali
                                    /.gurmukhi
                                    /.gujarati
                                    /.oriya]]
                                  [blocks/1
                                   [/.tamil
                                    /.telugu
                                    /.kannada
                                    /.malayalam
                                    /.sinhala
                                    /.thai
                                    /.lao
                                    /.tibetan
                                    /.myanmar
                                    /.georgian
                                    /.hangul_jamo
                                    /.ethiopic
                                    /.cherokee
                                    /.unified_canadian_aboriginal_syllabics
                                    /.ogham
                                    /.runic
                                    /.tagalog
                                    /.hanunoo
                                    /.buhid
                                    /.tagbanwa
                                    /.khmer
                                    /.mongolian]]
                                  [blocks/2
                                   [/.limbu
                                    /.tai_le
                                    /.khmer_symbols
                                    /.phonetic_extensions
                                    /.latin_extended_additional
                                    /.greek_extended
                                    /.general_punctuation
                                    /.superscripts_and_subscripts
                                    /.currency_symbols
                                    /.combining_diacritical_marks_for_symbols
                                    /.letterlike_symbols
                                    /.number_forms
                                    /.arrows
                                    /.mathematical_operators
                                    /.miscellaneous_technical
                                    /.control_pictures
                                    /.optical_character_recognition
                                    /.enclosed_alphanumerics
                                    /.box_drawing
                                    /.block_elements
                                    /.geometric_shapes
                                    /.miscellaneous_symbols]]
                                  [blocks/3
                                   [/.dingbats
                                    /.miscellaneous_mathematical_symbols_a
                                    /.supplemental_arrows_a
                                    /.braille_patterns
                                    /.supplemental_arrows_b
                                    /.miscellaneous_mathematical_symbols_b
                                    /.supplemental_mathematical_operators
                                    /.miscellaneous_symbols_and_arrows
                                    /.cjk_radicals_supplement
                                    /.kangxi_radicals
                                    /.ideographic_description_characters
                                    /.cjk_symbols_and_punctuation
                                    /.hiragana
                                    /.katakana
                                    /.bopomofo
                                    /.hangul_compatibility_jamo
                                    /.kanbun
                                    /.bopomofo_extended]]
                                  [blocks/4
                                   [/.katakana_phonetic_extensions
                                    /.enclosed_cjk_letters_and_months
                                    /.cjk_compatibility
                                    /.cjk_unified_ideographs_extension_a
                                    /.yijing_hexagram_symbols
                                    /.cjk_unified_ideographs
                                    /.yi_syllables
                                    /.yi_radicals
                                    /.hangul_syllables
                                    /.high_surrogates
                                    /.high_private_use_surrogates
                                    /.low_surrogates
                                    /.private_use_area
                                    /.cjk_compatibility_ideographs
                                    /.alphabetic_presentation_forms]]
                                  [blocks/5
                                   [/.arabic_presentation_forms_a
                                    /.variation_selectors
                                    /.combining_half_marks
                                    /.cjk_compatibility_forms
                                    /.small_form_variants
                                    /.arabic_presentation_forms_b
                                    /.halfwidth_and_fullwidth_forms
                                    /.specials
                                    
                                    ... Specialized blocks
                                    /.numeric
                                    /.upper_case
                                    /.lower_case]]
                                  )
                  <named> (with_template [<definition> <part>]
                            [((is (-> Any (List /.Block))
                                  (function (_ _)
                                    (`` (list (,, (template.spliced <part>))))))
                              [])]
                            
                            <blocks>)]
  (with_template [<definition> <part>]
    [(def <definition>
       Test
       (`` (_.coverage [(,, (template.spliced <part>))]
             (let [all (list.together (list <named>))
                   unique (set.of_list /.hash all)]
               (n.= (list.size all)
                    (set.size unique))))))]
    
    <blocks>
    )

  (def .public test
    Test
    (<| (_.covering /._)
        (_.for [/.Block])
        (do [! random.monad]
          [.let [top_start (hex "AC00")
                 top_end (hex "D7AF")
                 end_range (n.- top_start top_end)]
           start (of ! each (|>> (n.% top_start) ++) random.nat)
           end (of ! each (|>> (n.% end_range) (n.+ top_start)) random.nat)
           .let [additional (n.- start end)
                 sample (/.block start additional)
                 size (/.size sample)]
           inside (of ! each
                      (|>> (n.% size)
                           (n.+ (/.start sample)))
                      random.nat)]
          (`` (all _.and
                   (_.for [/.equivalence]
                          ($equivalence.spec /.equivalence ..random))
                   (_.for [/.hash]
                          ($hash.spec /.hash ..random))
                   (_.for [/.monoid]
                          ($monoid.spec /.equivalence /.monoid ..random))
                   
                   (_.for [/.block]
                          (all _.and
                               (_.coverage [/.start]
                                 (n.= start
                                      (/.start sample)))
                               (_.coverage [/.end]
                                 (n.= end
                                      (/.end sample)))
                               (_.coverage [/.size]
                                 (n.= (++ additional)
                                      (/.size sample)))
                               (_.coverage [/.within?]
                                 (and (/.within? sample inside)
                                      (not (/.within? sample (-- (/.start sample))))
                                      (not (/.within? sample (++ (/.end sample))))))
                               (,, (with_template [<definition> <part>]
                                     [<definition>]
                                     
                                     <blocks>))))
                   )))))
  )