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

(.module:
  [library
   [lux #*
    ["_" test (#+ Test)]
    [abstract
     [monad (#+ do)]
     [\\specification
      ["$." equivalence]
      ["$." hash]
      ["$." monoid]]]
    [data
     ["." text]
     [collection
      ["." set]
      ["." list]]]
    [macro
     ["." template]]
    [math
     ["." random (#+ Random)]
     [number (#+ hex)
      ["n" nat]]]]]
  [\\library
   ["." /]])

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

(with_expansions [<blocks> (as_is [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
                                    /.basic_latin/decimal
                                    /.basic_latin/upper
                                    /.basic_latin/lower]]
                                  )
                  <named> (template [<definition> <part>]
                            [((: (-> Any (List /.Block))
                                 (function (_ _)
                                   (`` (list (~~ (template.spliced <part>))))))
                              [])]
                            
                            <blocks>)]
  (template [<definition> <part>]
    [(def: <definition>
       Test
       (`` (_.cover [(~~ (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 (\ ! each (|>> (n.% top_start) ++) random.nat)
           end (\ ! each (|>> (n.% end_range) (n.+ top_start)) random.nat)
           .let [additional (n.- start end)
                 sample (/.block start additional)
                 size (/.size sample)]
           inside (\ ! each
                     (|>> (n.% size)
                          (n.+ (/.start sample)))
                     random.nat)]
          (`` ($_ _.and
                  (_.for [/.equivalence]
                         ($equivalence.spec /.equivalence ..random))
                  (_.for [/.hash]
                         ($hash.spec /.hash ..random))
                  (_.for [/.monoid]
                         ($monoid.spec /.equivalence /.monoid ..random))
                  
                  (_.for [/.block]
                         ($_ _.and
                             (_.cover [/.start]
                                      (n.= start
                                           (/.start sample)))
                             (_.cover [/.end]
                                      (n.= end
                                           (/.end sample)))
                             (_.cover [/.size]
                                      (n.= (++ additional)
                                           (/.size sample)))
                             (_.cover [/.within?]
                                      (and (/.within? sample inside)
                                           (not (/.within? sample (-- (/.start sample))))
                                           (not (/.within? sample (++ (/.end sample))))))
                             (~~ (template [<definition> <part>]
                                   [<definition>]
                                   
                                   <blocks>))))
                  )))))
  )